From d4282db45d84d51ba422b7e30d6df122c2cd0bb1 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 6 Nov 2023 22:26:36 +0000 Subject: [PATCH 001/529] use branch with spot kokkos commit --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index 2ff5853316e..a468d04e442 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit 2ff5853316e15d4e8004c21890329fd257fa7459 +Subproject commit a468d04e442a3a7fa170563afa9a103c61170b10 From 2f256a2225317976d477eda66e273231795268be Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 6 Nov 2023 22:48:59 +0000 Subject: [PATCH 002/529] hardcopying homme sycl branch --- components/homme/CMakeLists.txt | 18 +- components/homme/cmake/HommeMacros.cmake | 10 +- components/homme/src/prim_main.F90 | 7 +- .../homme/src/share/compose/compose.hpp | 2 +- components/homme/src/share/cxx/Config.hpp | 2 +- components/homme/src/share/cxx/ErrorDefs.cpp | 2 + .../src/share/cxx/EulerStepFunctorImpl.hpp | 5 + .../homme/src/share/cxx/ExecSpaceDefs.cpp | 17 ++ .../homme/src/share/cxx/ExecSpaceDefs.hpp | 4 + .../homme/src/share/cxx/Hommexx_Session.cpp | 11 + .../homme/src/share/cxx/SphereOperators.hpp | 215 ++++++++++++++++++ .../src/share/cxx/utilities/BfbUtils.hpp | 2 +- components/homme/src/share/gllfvremap_mod.F90 | 21 +- .../src/test_src/dcmip2016-supercell.F90 | 36 +-- .../src/theta-l_kokkos/config.h.cmake.in | 2 + .../theta-l_kokkos/cxx/CaarFunctorImpl.hpp | 35 ++- .../theta-l_kokkos/cxx/DirkFunctorImpl.hpp | 2 +- .../src/theta-l_kokkos/cxx/LimiterFunctor.hpp | 4 +- .../theta-l_kokkos/cxx/RemapStateProvider.hpp | 85 ++++++- 19 files changed, 427 insertions(+), 53 deletions(-) diff --git a/components/homme/CMakeLists.txt b/components/homme/CMakeLists.txt index 4486ed47e24..4f3c335f25c 100644 --- a/components/homme/CMakeLists.txt +++ b/components/homme/CMakeLists.txt @@ -206,7 +206,10 @@ IF (HOMME_USE_KOKKOS) STRING (TOUPPER ${HOMMEXX_EXEC_SPACE} HOMMEXX_EXEC_SPACE_UPPER) - IF (HOMMEXX_EXEC_SPACE_UPPER STREQUAL "HIP") + #not user afaik + IF (${HOMMEXX_EXEC_SPACE_UPPER} STREQUAL "SYCL") + SET (HOMMEXX_SYCL_SPACE ON) + ELSEIF (${HOMMEXX_EXEC_SPACE_UPPER} STREQUAL "HIP") SET (HOMMEXX_HIP_SPACE ON) ELSEIF (HOMMEXX_EXEC_SPACE_UPPER STREQUAL "CUDA") SET (HOMMEXX_CUDA_SPACE ON) @@ -302,15 +305,18 @@ SET (HOMMEXX_ENABLE_GPU FALSE) IF (HOMME_USE_KOKKOS) - IF (CUDA_BUILD OR HIP_BUILD) + IF (CUDA_BUILD OR HIP_BUILD OR SYCL_BUILD) SET (DEFAULT_VECTOR_SIZE 1) SET (HOMMEXX_ENABLE_GPU TRUE) + + message("OG Set HOMMEXX_ENABLE_GPU to ${HOMMEXX_ENABLE_GPU}") + ELSE () SET (DEFAULT_VECTOR_SIZE 8) ENDIF() SET (HOMMEXX_VECTOR_SIZE ${DEFAULT_VECTOR_SIZE} CACHE STRING - "If AVX or Cuda or HIP don't take priority, use this software vector size.") + "If AVX or Cuda or HIP or SYCL don't take priority, use this software vector size.") IF (CMAKE_BUILD_TYPE_UPPER MATCHES "DEBUG" OR CMAKE_BUILD_TYPE_UPPER MATCHES "RELWITHDEBINFO") SET (HOMMEXX_DEBUG ON) @@ -447,6 +453,7 @@ ENDIF () # If we don't need kokkos we don't need EKAT, and if # Homme is built in EAMxx EKAT is already built +if("${E3SM_KOKKOS_PATH}" STREQUAL "") IF (HOMME_USE_KOKKOS AND HOMME_STANDALONE) # Add ekat's cmake/pkg_build folder to cmake path set (EKAT_SOURCE_DIR ${CMAKE_CURRENT_SOURCE_DIR}/../../externals/ekat) @@ -458,6 +465,11 @@ IF (HOMME_USE_KOKKOS AND HOMME_STANDALONE) include (EkatBuildKokkos) BuildKokkos() ENDIF () +ELSE () + IF (${HOMME_USE_KOKKOS}) + INCLUDE(Kokkos) + ENDIF () +ENDIF () # This folder contains the CMake macro used to build cxx unit tests # Add unit tests for C++ code diff --git a/components/homme/cmake/HommeMacros.cmake b/components/homme/cmake/HommeMacros.cmake index 8595988bf23..4a42326b9d5 100644 --- a/components/homme/cmake/HommeMacros.cmake +++ b/components/homme/cmake/HommeMacros.cmake @@ -112,7 +112,7 @@ macro(createTestExec execName execType macroNP macroNC ADD_DEFINITIONS(-DHAVE_CONFIG_H) ADD_EXECUTABLE(${execName} ${EXEC_SOURCES}) - SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE Fortran) + SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE CXX) IF(BUILD_HOMME_WITHOUT_PIOLIBRARY) TARGET_COMPILE_DEFINITIONS(${execName} PUBLIC HOMME_WITHOUT_PIOLIBRARY) ENDIF() @@ -156,7 +156,11 @@ macro(createTestExec execName execType macroNP macroNC ENDIF () IF (HOMME_USE_KOKKOS) + if("${E3SM_KOKKOS_PATH}" STREQUAL "") target_link_libraries(${execName} kokkos) + else() + link_to_kokkos(${execName}) + endif() ENDIF () # Move the module files out of the way so the parallel build @@ -169,8 +173,8 @@ macro(createTestExec execName execType macroNP macroNC TARGET_LINK_LIBRARIES(${execName} -mkl) ELSE() IF (NOT HOMME_FIND_BLASLAPACK) - TARGET_LINK_LIBRARIES(${execName} lapack blas) - ADD_DEPENDENCIES(${execName} blas lapack) + #TARGET_LINK_LIBRARIES(${execName} lapack blas) + #ADD_DEPENDENCIES(${execName} blas lapack) ENDIF() ENDIF() diff --git a/components/homme/src/prim_main.F90 b/components/homme/src/prim_main.F90 index bfbe57e8b31..1d7f48e95a1 100644 --- a/components/homme/src/prim_main.F90 +++ b/components/homme/src/prim_main.F90 @@ -20,7 +20,7 @@ program prim_main use element_mod, only: element_t use common_io_mod, only: output_dir, infilenames use common_movie_mod, only: nextoutputstep - use perf_mod, only: t_initf, t_prf, t_finalizef, t_startf, t_stopf ! _EXTERNAL + use perf_mod, only: t_initf, t_prf, t_finalizef, t_startf, t_stopf,t_disablef, t_enablef ! _EXTERNAL use restart_io_mod , only: restartheader_t, writerestart use hybrid_mod, only: hybrid_create #if (defined MODEL_THETA_L && defined ARKODE) @@ -240,6 +240,11 @@ end subroutine finalize_kokkos_f90 nstep = nextoutputstep(tl) do while(tl%nstep= 2) call t_enablef() call t_startf('prim_run') call prim_run_subcycle(elem, hybrid,nets,nete, tstep, .false., tl, hvcoord,1) call t_stopf('prim_run') diff --git a/components/homme/src/share/compose/compose.hpp b/components/homme/src/share/compose/compose.hpp index 01be2635fcf..cd65102610e 100644 --- a/components/homme/src/share/compose/compose.hpp +++ b/components/homme/src/share/compose/compose.hpp @@ -23,7 +23,7 @@ typedef Kokkos::Experimental::HIPSpace ComposeGpuSpace; # endif # if defined KOKKOS_ENABLE_SYCL typedef Kokkos::Experimental::SYCL ComposeGpuExeSpace; -typedef Kokkos::Experimental::SYCL> ComposeGpuSpace; +typedef Kokkos::Experimental::SYCL ComposeGpuSpace; # endif #endif diff --git a/components/homme/src/share/cxx/Config.hpp b/components/homme/src/share/cxx/Config.hpp index 684f9143bea..b204b1dbd04 100644 --- a/components/homme/src/share/cxx/Config.hpp +++ b/components/homme/src/share/cxx/Config.hpp @@ -21,7 +21,7 @@ # endif #endif -#if ! defined HOMMEXX_CUDA_SPACE && ! defined HOMMEXX_OPENMP_SPACE && ! defined HOMMEXX_THREADS_SPACE && ! defined HOMMEXX_SERIAL_SPACE && ! defined HOMMEXX_HIP_SPACE +#if ! defined HOMMEXX_CUDA_SPACE && ! defined HOMMEXX_OPENMP_SPACE && ! defined HOMMEXX_THREADS_SPACE && ! defined HOMMEXX_SERIAL_SPACE && ! defined HOMMEXX_HIP_SPACE && ! defined HOMMEXX_SYCL_SPACE # define HOMMEXX_DEFAULT_SPACE #endif diff --git a/components/homme/src/share/cxx/ErrorDefs.cpp b/components/homme/src/share/cxx/ErrorDefs.cpp index ccb4631100d..a6eabfa1cf7 100644 --- a/components/homme/src/share/cxx/ErrorDefs.cpp +++ b/components/homme/src/share/cxx/ErrorDefs.cpp @@ -45,7 +45,9 @@ void runtime_abort(const std::string& message, int code) { } else { std::cerr << message << std::endl << "Exiting..." << std::endl; finalize_hommexx_session(); +#ifndef TESTER_NOMPI MPI_Abort(MPI_COMM_WORLD, code); +#endif } } diff --git a/components/homme/src/share/cxx/EulerStepFunctorImpl.hpp b/components/homme/src/share/cxx/EulerStepFunctorImpl.hpp index f3029764dac..f87bb108beb 100644 --- a/components/homme/src/share/cxx/EulerStepFunctorImpl.hpp +++ b/components/homme/src/share/cxx/EulerStepFunctorImpl.hpp @@ -652,7 +652,10 @@ class EulerStepFunctorImpl { minmax_and_biharmonic(); } } + + GPTLstart("tl-at adv-n-limit"); advect_and_limit(); + GPTLstop("tl-at adv-n-limit"); exchange_qdp_dss_var(); } @@ -667,6 +670,7 @@ class EulerStepFunctorImpl { void run_tracer_phase (const KernelVariables& kv) const { compute_qtens(kv); kv.team_barrier(); + if (m_data.limiter_option == 8) { limiter_optim_iter_full(kv); kv.team_barrier(); @@ -674,6 +678,7 @@ class EulerStepFunctorImpl { limiter_clip_and_sum(kv); kv.team_barrier(); } + apply_spheremp(kv); } diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.cpp b/components/homme/src/share/cxx/ExecSpaceDefs.cpp index 784d37b65d2..2ec0ebb6fe0 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.cpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.cpp @@ -21,6 +21,10 @@ #include #endif +#ifdef KOKKOS_ENABLE_SYCL +#include +#endif + namespace Homme { // Since we're initializing from inside a Fortran code and don't have access to @@ -52,7 +56,16 @@ void initialize_kokkos () { // It isn't a big deal if we can't get the device count. nd = 1; } +#elif defined(KOKKOS_ENABLE_SYCL) + +//https://developer.codeplay.com/products/computecpp/ce/2.11.0/guides/sycl-for-cuda-developers/migrating-from-cuda-to-sycl + +//to make it build + int nd = 1; + #endif + + #ifdef HOMMEXX_ENABLE_GPU std::stringstream ss; ss << "--kokkos-num-devices=" << nd; @@ -117,6 +130,7 @@ team_num_threads_vectors_for_gpu ( assert(num_warps_total >= max_num_warps); assert(tp.max_threads_usable >= 1 && tp.max_vectors_usable >= 1); +#ifndef KOKKOS_ENABLE_SYCL int num_warps; if (tp.prefer_larger_team) { const int num_warps_usable = @@ -161,6 +175,9 @@ team_num_threads_vectors_for_gpu ( return std::make_pair( num_device_threads / num_vectors, num_vectors ); } +#else + return std::make_pair(4,16); +#endif } } // namespace Parallel diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.hpp b/components/homme/src/share/cxx/ExecSpaceDefs.hpp index 8c18d8bcbb9..d799af38783 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.hpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.hpp @@ -31,6 +31,10 @@ using HommexxGPU = Kokkos::Cuda; using HommexxGPU = Kokkos::Experimental::HIP; #endif +#ifdef KOKKOS_ENABLE_SYCL +using HommexxGPU = Kokkos::Experimental::SYCL; +#endif + #else using HommexxGPU = void; #endif diff --git a/components/homme/src/share/cxx/Hommexx_Session.cpp b/components/homme/src/share/cxx/Hommexx_Session.cpp index c93174d2442..db50ec27d6c 100644 --- a/components/homme/src/share/cxx/Hommexx_Session.cpp +++ b/components/homme/src/share/cxx/Hommexx_Session.cpp @@ -7,8 +7,12 @@ #include "Config.hpp" #include "Hommexx_Session.hpp" #include "ExecSpaceDefs.hpp" +#include "Types.hpp" + +#ifndef TESTER_NOMPI #include "profiling.hpp" #include "mpi/Comm.hpp" +#endif #include "Context.hpp" @@ -75,7 +79,10 @@ void initialize_hommexx_session () // If hommexx session is not currently inited, then init it. if (!Session::m_inited) { /* Make certain profiling is only done for code we're working on */ + +#ifndef TESTER_NOMPI profiling_pause(); +#endif /* Set Environment variables to control how many * threads/processors Kokkos uses */ @@ -83,12 +90,16 @@ void initialize_hommexx_session () initialize_kokkos(); } +#ifndef TESTER_NOMPI // Note: at this point, the Comm *should* already be created. const auto& comm = Context::singleton().get(); if (comm.root()) { ExecSpace().print_configuration(std::cout, true); print_homme_config_settings (); } +#else + ExecSpace().print_configuration(std::cout, true); +#endif Session::m_inited = true; } diff --git a/components/homme/src/share/cxx/SphereOperators.hpp b/components/homme/src/share/cxx/SphereOperators.hpp index c227d97ea70..e8571c57f3b 100644 --- a/components/homme/src/share/cxx/SphereOperators.hpp +++ b/components/homme/src/share/cxx/SphereOperators.hpp @@ -244,6 +244,8 @@ class SphereOperators kv.team_barrier(); } + + KOKKOS_INLINE_FUNCTION void divergence_sphere_wk_sl (const KernelVariables &kv, const ExecViewUnmanaged& v, @@ -296,6 +298,102 @@ class SphereOperators } // end of divergence_sphere_wk_sl + + + + +#if 0 + KOKKOS_INLINE_FUNCTION void + divergence_sphere_wk_sl (const KernelVariables &kv, + const ExecViewUnmanaged& v, + const ExecViewUnmanaged< Real [NP][NP]>& div_v) const + { + // Make sure the buffers have been created + assert (vector_buf_sl.size()>0); + + const auto& D_inv = Homme::subview(m_dinv,kv.ie); + const auto& spheremp = Homme::subview(m_spheremp,kv.ie); + const auto& gv_buf = Homme::subview(vector_buf_sl,kv.team_idx,0); + + // copied from strong divergence as is but without metdet + // conversion to contravariant + + double * ggv = &gv_buf(0,0,0); + + const int s1 = &v(1,0,0)-&v(0,0,0); + const int s2 = &v(0,1,0)-&v(0,0,0); + const int s3 = &v(0,0,1)-&v(0,0,0); + + //not sure we can reuse strides above, so using new ones + const int d1 = &D_inv(1,0,0,0)-&D_inv(0,0,0,0); + const int d2 = &D_inv(0,1,0,0)-&D_inv(0,0,0,0); + const int d3 = &D_inv(0,0,1,0)-&D_inv(0,0,0,0); + const int d4 = &D_inv(0,0,0,1)-&D_inv(0,0,0,0); + + constexpr int np_squared = NP * NP; + Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, np_squared), + [&](const int loop_idx) { + const int igp = loop_idx / NP; + const int jgp = loop_idx % NP; + + int linind1 = s1 * 0 + s2 * igp + s3 * jgp; + const auto& vv0 = (&v(0,0,0) + linind1); + int linind2 = s1 * 1 + s2 * igp + s3 * jgp; + const auto& vv1 = (&v(0,0,0) + linind2); + + int linind3 = d1 * 0 + d2 * 0 + d3 * igp + d4 * jgp; + int linind4 = d1 * 1 + d2 * 0 + d3 * igp + d4 * jgp; + *(&gv_buf(0,0,0)+linind1) = *(&D_inv(0,0,0,0)+linind3) * (*vv0) + *(&D_inv(0,0,0,0)+linind4) * (*vv1); + + linind3 = d1 * 0 + d2 * 1 + d3 * igp + d4 * jgp; + linind4 = d1 * 1 + d2 * 1 + d3 * igp + d4 * jgp; + *(&gv_buf(0,0,0)+linind2) = *(&D_inv(0,0,0,0)+linind3) * (*vv0) + *(&D_inv(0,0,0,0)+linind4) * (*vv1); + + }); + kv.team_barrier(); + + // in strong div + // kgp = i in strong code, jgp=j, igp=l + // in weak div, n is like j in strong div, + // n(weak)=j(strong)=jgp + // m(weak)=l(strong)=igp + // j(weak)=i(strong)=kgp + constexpr int div_iters = NP * NP; + // keeping indices' names as in F + + //gv_buf strides are as before, s1 s2 s3 + //dvv, div_v, and spheremp should have the same strides + const int f1 = &dvv(1,0)-&dvv(0,0); + const int f2 = &dvv(0,1)-&dvv(0,0); + + Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, div_iters), + [&](const int loop_idx) { + // Note: for this one time, it is better if m strides faster, due to + // the way the views are accessed. + const int mgp = loop_idx % NP; + const int ngp = loop_idx / NP; + Real dd = 0.0; + for (int jgp = 0; jgp < NP; ++jgp) { + int linind1 = s1 * 0 + s2 * ngp + s3 * jgp; + int linind2 = s1 * 1 + s2 * jgp + s3 * mgp; + + int l1 = f1 * ngp + f2 * jgp; + int l2 = f1 * jgp + f2 * mgp; + int l3 = f1 * jgp + f2 * ngp; + + dd -= ( *(&spheremp(0,0)+l1) * *(&gv_buf(0,0,0)+linind1) * *(&dvv(0,0)+l2) + + *(&spheremp(0,0)+l2) * *(&gv_buf(0,0,0)+linind2) * *(&dvv(0,0)+l3)) * + m_scale_factor_inv; + } + int l1 = f1 * ngp + f2 * mgp; + *(&div_v(0,0)+l1) = dd; + }); + kv.team_barrier(); + + } // end of divergence_sphere_wk_sl +#endif + + // Note that divergence_sphere requires scratch space of 3 x NP x NP Reals // This must be called from the device space KOKKOS_INLINE_FUNCTION void @@ -715,6 +813,116 @@ class SphereOperators vorticity_sphere(kv, v, vort, NUM_LEV_REQUEST); } + + + +#if 0 + + template + KOKKOS_INLINE_FUNCTION void + divergence_sphere_wk (const KernelVariables &kv, + // On input, a field whose divergence is sought; on + // output, the view's data are invalid. + const ExecViewUnmanaged& v, + const ExecViewUnmanaged& div_v, + const int NUM_LEV_REQUEST) const + { + assert(NUM_LEV_REQUEST>=0); + assert(NUM_LEV_REQUEST<=NUM_LEV_IN); + assert(NUM_LEV_REQUEST<=NUM_LEV_OUT); + + // Make sure the buffers have been created + assert (vector_buf_ml.size()>0); + + const auto& D_inv = Homme::subview(m_dinv, kv.ie); + const auto& spheremp = Homme::subview(m_spheremp, kv.ie); + constexpr int np_squared = NP * NP; + + const int s1 = &v(1,0,0,0)[0]-&v(0,0,0,0)[0]; + const int s2 = &v(0,1,0,0)[0]-&v(0,0,0,0)[0]; + const int s3 = &v(0,0,1,0)[0]-&v(0,0,0,0)[0]; + const int s4 = &v(0,0,0,1)[0]-&v(0,0,0,0)[0]; + + const int d1 = &D_inv(1,0,0,0)-&D_inv(0,0,0,0); + const int d2 = &D_inv(0,1,0,0)-&D_inv(0,0,0,0); + const int d3 = &D_inv(0,0,1,0)-&D_inv(0,0,0,0); + const int d4 = &D_inv(0,0,0,1)-&D_inv(0,0,0,0); + + Real * const vv = &v(0,0,0,0)[0]; + const Real * const dd = &D_inv(0,0,0,0); + + Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, np_squared), + [&](const int loop_idx) { + const int igp = loop_idx / NP; + const int jgp = loop_idx % NP; + Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV_REQUEST), [&] (const int& ilev) { + + const int l1 = s1*0 + s2*igp + s3*jgp + s4*ilev; + const int l2 = s1*1 + l1; + const Real v0old = vv[l1]; + const Real v1old = vv[l2]; + + int l3 = d1*0 + d2*0 + d3*igp + d4*jgp; + int l4 = d1*1 + d2*0 + d3*igp + d4*jgp; + + vv[l1] = dd[l3] * v0old + dd[l4] * v1old; + + l3 = d1*0 + d2*1 + d3*igp + d4*jgp; + l4 = d1*1 + d2*1 + d3*igp + d4*jgp; + + vv[l2] = dd[l3] * v0old + dd[l4] * v1old; + + }); + }); + kv.team_barrier(); + + const int f1 = &dvv(1,0)-&dvv(0,0); + const int f2 = &dvv(0,1)-&dvv(0,0); + + const Real * const ss = &spheremp(0,0); + const Real * const ddv = &dvv(0,0); + + const int k1 = &div_v(1,0,0)[0]-&div_v(0,0,0)[0]; + const int k2 = &div_v(0,1,0)[0]-&div_v(0,0,0)[0]; + const int k3 = &div_v(0,0,1)[0]-&div_v(0,0,0)[0]; + + constexpr int div_iters = NP * NP; + Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, div_iters), + [&](const int loop_idx) { + // Note: for this one time, it is better if m strides faster, due to + // the way the views are accessed. + const int mgp = loop_idx % NP; + const int ngp = loop_idx / NP; + Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV_REQUEST), [&] (const int& ilev) { + Real dd = 0.0; + // TODO: move multiplication by scale_factor_inv outside the loop + for (int jgp = 0; jgp < NP; ++jgp) { + // Here, v is the temporary buffer, aliased on the input v. + + const int l1 = s1*0 + s2*ngp + s3*jgp + s4*ilev; + const int l2 = s1*1 + s2*jgp + s3*mgp + s4*ilev; + + const int x1 = f1 * ngp + f2 * jgp; + const int x2 = f1 * jgp + f2 * mgp; + const int x3 = f1 * jgp + f2 * ngp; + + dd -= (ss[x1] * vv[l1] * ddv[x2] + + ss[x2] * vv[l2] * ddv[x3]) * + m_scale_factor_inv; + } + //div_v(ngp, mgp, ilev) = dd; + const int l1 = k1 * ngp + k2 * mgp + k3 * ilev; + *(&div_v(0,0,0)[0]+l1) = dd; + }); + }); + kv.team_barrier(); + + }//end of divergence_sphere_wk + +#else + + + template KOKKOS_INLINE_FUNCTION void divergence_sphere_wk (const KernelVariables &kv, @@ -770,6 +978,13 @@ class SphereOperators }//end of divergence_sphere_wk + +#endif + + + + + template KOKKOS_INLINE_FUNCTION void divergence_sphere_wk (const KernelVariables &kv, diff --git a/components/homme/src/share/cxx/utilities/BfbUtils.hpp b/components/homme/src/share/cxx/utilities/BfbUtils.hpp index e3570874e26..475cd9f2d95 100644 --- a/components/homme/src/share/cxx/utilities/BfbUtils.hpp +++ b/components/homme/src/share/cxx/utilities/BfbUtils.hpp @@ -64,7 +64,7 @@ KOKKOS_INLINE_FUNCTION ScalarType int_pow (ScalarType val, int k) { constexpr int max_shift = 30; if (k<0) { - printf ("k = %d\n",k); + Kokkos::print ("k = %d\n",k); Kokkos::abort("int_pow implemented only for k>=0.\n"); } diff --git a/components/homme/src/share/gllfvremap_mod.F90 b/components/homme/src/share/gllfvremap_mod.F90 index 1e0ee9b8184..13b863c44e4 100644 --- a/components/homme/src/share/gllfvremap_mod.F90 +++ b/components/homme/src/share/gllfvremap_mod.F90 @@ -989,7 +989,7 @@ subroutine gfr_init_R(np, nphys, w_gg, M_gf, R, tau) end do end do end do - call dgeqrf(np*np, nphys*nphys, R, size(R,1), tau, wrk, np*np*nphys*nphys, info) +! call dgeqrf(np*np, nphys*nphys, R, size(R,1), tau, wrk, np*np*nphys*nphys, info) end subroutine gfr_init_R subroutine gfr_init_interp_matrix(npsrc, interp) @@ -1071,12 +1071,13 @@ subroutine gfr_f2g_remapd_op(gfr, R, tau, f, g) ! g = inv(M_sgsg) M_sgf inv(S) M_ff f wrk = reshape(gfr%w_ff(:nf2), (/nf,nf/))*f(:nf,:nf) if (nf == npi) then - call dtrsm('L', 'U', 'T', 'N', nf2, 1, one, R, size(R,1), wrk, nf2) - call dormqr('L', 'N', nf2, 1, nf2, R, size(R,1), tau, wrk, nf2, wr, np2, info) + +! call dtrsm('l', 'u', 't', 'n', nf2, 1, one, R, size(R,1), wrk, nf2) +! call dormqr('l', 'n', nf2, 1, nf2, R, size(R,1), tau, wrk, nf2, wr, np2, info) g(:npi,:npi) = wrk else - call dtrtrs('U', 'T', 'N', nf2, 1, R, size(R,1), wrk, nf2, info) - call dtrtrs('U', 'N', 'N', nf2, 1, R, size(R,1), wrk, nf2, info) +! call dtrtrs('u', 't', 'n', nf2, 1, R, size(R,1), wrk, nf2, info) +! call dtrtrs('u', 'n', 'n', nf2, 1, R, size(R,1), wrk, nf2, info) g(:npi,:npi) = zero do fj = 1,nf do fi = 1,nf @@ -1620,7 +1621,7 @@ subroutine gfr_pg1_init(gfr) n = np*np - call dpotrf('U', n, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), info) +! call dpotrf('u', n, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), info) if (info /= 0) print *, 'gfr ERROR> dpotrf returned', info do i = 1,n @@ -1631,8 +1632,8 @@ subroutine gfr_pg1_init(gfr) gfr%pg1sd%s = reshape(gfr%w_gg(:np,:np), (/np*np/)) ! Form R's = c - call dtrtrs('U', 'T', 'N', n, 1, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), & - gfr%pg1sd%s, np*np, info) +! call dtrtrs('u', 't', 'n', n, 1, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), & +! gfr%pg1sd%s, np*np, info) if (info /= 0) print *, 'gfr ERROR> dtrtrs returned', info gfr%pg1sd%sts = sum(gfr%pg1sd%s*gfr%pg1sd%s) end subroutine gfr_pg1_init @@ -1665,11 +1666,11 @@ subroutine gfr_pg1_solve(gfr, s, g) mass = sum(gfr%w_gg*g) ! Solve R'z = b. - call dtrtrs('U', 'T', 'N', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) +! call dtrtrs('u', 't', 'n', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) ! Assemble z + (d - s'z)/(s's) s. x(:n) = x(:n) + ((mass - sum(s%s(:n)*x(:n)))/s%sts)*s%s(:n) ! Solve R x = z + (d - s'z)/(s's) s. - call dtrtrs('U', 'N', 'N', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) +! call dtrtrs('u', 'n', 'n', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) ! Extract g(I). g = reshape(x(:n), (/np,np/)) diff --git a/components/homme/src/test_src/dcmip2016-supercell.F90 b/components/homme/src/test_src/dcmip2016-supercell.F90 index afd1c2a3914..20489e87564 100644 --- a/components/homme/src/test_src/dcmip2016-supercell.F90 +++ b/components/homme/src/test_src/dcmip2016-supercell.F90 @@ -203,10 +203,10 @@ SUBROUTINE supercell_init() & lwork = 5*nphi ddphibak = ddphi - call DGESVD('A', 'A', & - nphi, nphi, ddphibak, nphi, & - svdps, svdpu, nphi, svdpvt, nphi, & - pwork, lwork, info) +! call DGESVD('A', 'A', & +! nphi, nphi, ddphibak, nphi, & +! svdps, svdpu, nphi, svdpvt, nphi, & +! pwork, lwork, info) if (info .ne. 0) then write(*,*) 'Unable to compute SVD of d/dphi matrix' @@ -215,23 +215,23 @@ SUBROUTINE supercell_init() & do i = 1, nphi if (abs(svdps(i)) .le. 1.0d-12) then - call DSCAL(nphi, 0.0d0, svdpu(1,i), 1) +! call DSCAL(nphi, 0.0d0, svdpu(1,i), 1) else - call DSCAL(nphi, 1.0d0 / svdps(i), svdpu(1,i), 1) +! call DSCAL(nphi, 1.0d0 / svdps(i), svdpu(1,i), 1) end if end do - call DGEMM('T', 'T', & - nphi, nphi, nphi, 1.0d0, svdpvt, nphi, svdpu, nphi, 0.0d0, & - intphi, nphi) +! call DGEMM('T', 'T', & +! nphi, nphi, nphi, 1.0d0, svdpvt, nphi, svdpu, nphi, 0.0d0, & +! intphi, nphi) ! Compute the int(dz) operator via pseudoinverse lwork = 5*nz ddzbak = ddz - call DGESVD('A', 'A', & - nz, nz, ddzbak, nz, & - svdzs, svdzu, nz, svdzvt, nz, & - zwork, lwork, info) +! call DGESVD('A', 'A', & +! nz, nz, ddzbak, nz, & +! svdzs, svdzu, nz, svdzvt, nz, & +! zwork, lwork, info) if (info .ne. 0) then write(*,*) 'Unable to compute SVD of d/dz matrix' @@ -240,14 +240,14 @@ SUBROUTINE supercell_init() & do i = 1, nz if (abs(svdzs(i)) .le. 1.0d-12) then - call DSCAL(nz, 0.0d0, svdzu(1,i), 1) +! call DSCAL(nz, 0.0d0, svdzu(1,i), 1) else - call DSCAL(nz, 1.0d0 / svdzs(i), svdzu(1,i), 1) +! call DSCAL(nz, 1.0d0 / svdzs(i), svdzu(1,i), 1) end if end do - call DGEMM('T', 'T', & - nz, nz, nz, 1.0d0, svdzvt, nz, svdzu, nz, 0.0d0, & - intz, nz) +! call DGEMM('T', 'T', & +! nz, nz, nz, 1.0d0, svdzvt, nz, svdzu, nz, 0.0d0, & +! intz, nz) ! Sample the equatorial velocity field and its derivative do k = 1, nz diff --git a/components/homme/src/theta-l_kokkos/config.h.cmake.in b/components/homme/src/theta-l_kokkos/config.h.cmake.in index f5cacd509ff..b36d7d55bc2 100644 --- a/components/homme/src/theta-l_kokkos/config.h.cmake.in +++ b/components/homme/src/theta-l_kokkos/config.h.cmake.in @@ -75,3 +75,5 @@ /* Detect whether COMPOSE passive tracer transport is enabled */ #cmakedefine HOMME_ENABLE_COMPOSE + +#cmakedefine TESTER_NOMPI diff --git a/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp index 38f9dc8573d..febb7eb0a7f 100644 --- a/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp @@ -350,6 +350,8 @@ struct CaarFunctorImpl { Kokkos::parallel_reduce("caar loop pre-boundary exchange", m_policy_pre, *this, nerr); Kokkos::fence(); GPTLstop("caar compute"); + +#ifndef TESTER_NOMPI if (nerr > 0) check_print_abort_on_bad_elems("CaarFunctorImpl::run TagPreExchange", data.n0); @@ -366,10 +368,19 @@ struct CaarFunctorImpl { } limiter.run(data.np1); +#endif profiling_pause(); } +#define K1 +#undef K2 +#undef K3 +#undef K4 +#undef K5 +#undef K6 +#undef K7 + KOKKOS_INLINE_FUNCTION void operator()(const TagPreExchange&, const TeamMember &team, int& nerr) const { // In this body, we use '====' to separate sync epochs (delimited by barriers) @@ -377,54 +388,76 @@ struct CaarFunctorImpl { KernelVariables kv(team, m_tu); +#ifdef K1 // =========== EPOCH 1 =========== // compute_div_vdp(kv); +#endif +#ifdef K2 // =========== EPOCH 2 =========== // kv.team_barrier(); - // Computes pi, omega, and phi. const bool ok = compute_scan_quantities(kv); if ( ! ok) nerr = 1; +#endif +#if 0 if (m_rsplit==0 || !m_theta_hydrostatic_mode) { // ============ EPOCH 2.1 =========== // kv.team_barrier(); compute_interface_quantities(kv); } +#endif +#if 0 if (m_rsplit==0) { // ============= EPOCH 2.2 ============ // kv.team_barrier(); compute_vertical_advection(kv); } +#endif +#ifdef K3 // ============= EPOCH 3 ============== // kv.team_barrier(); compute_accumulated_quantities(kv); +#endif +#if 0 // Compute update quantities if (!m_theta_hydrostatic_mode) { compute_w_and_phi_tens (kv); } +#endif +#ifdef K4 compute_dp_and_theta_tens (kv); +#endif +#ifdef K5 // ============= EPOCH 4 =========== // // compute_v_tens reuses some buffers used by compute_dp_and_theta_tens kv.team_barrier(); compute_v_tens (kv); +#endif +#if 0 // Update states if (!m_theta_hydrostatic_mode) { compute_w_and_phi_np1(kv); } +#endif + +#ifdef K6 compute_dp3d_and_theta_np1(kv); +#endif +#ifdef K7 // ============= EPOCH 5 =========== // // v_tens has been computed after last barrier. Need to make sure it's done kv.team_barrier(); compute_v_np1(kv); +#endif } KOKKOS_INLINE_FUNCTION diff --git a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp index ace1ba92014..671c46bfc54 100644 --- a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp @@ -382,7 +382,7 @@ struct DirkFunctorImpl { kv.team_barrier(); if (it >= maxiter) { - printf("[DIRK] WARNING! Newton reached max iteration count," + Kokkos::print("[DIRK] WARNING! Newton reached max iteration count," " with deltaerr = %3.17f\n", deltaerr); nerr = 1; } diff --git a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp index bf93be710e9..00585505510 100644 --- a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp @@ -141,7 +141,7 @@ struct LimiterFunctor { [&](const int k,Real& result) { #ifndef HOMMEXX_BFB_TESTING if(diff_as_real(k) < 0){ - printf("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", + Kokkos::print("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", k+1,dp_as_real(k),dp0_as_real(k)); } #endif @@ -202,7 +202,7 @@ struct LimiterFunctor { for (int ivec=0; ivec 0) { + +std::cout << "INSIDE w phi assignment m_process_nh_vars is true \n"; - if (m_process_nh_vars) { m_delta_w = decltype(m_delta_w) ("w_i increments",elements.num_elems()); m_delta_phinh = decltype(m_delta_phinh) ("phinh_i increments",elements.num_elems()); } +if(m_process_nh_vars){ + std::cout << "2hey m_process_nh_vars is true \n"; +}else +{ + std::cout << "2hey m_process_nh_vars is false \n"; +} + m_hvcoord = Context::singleton().get(); assert (m_hvcoord.m_inited); +if(m_process_nh_vars){ + std::cout << "3hey m_process_nh_vars is true \n"; +}else +{ + std::cout << "3hey m_process_nh_vars is false \n"; +} + m_eos.init(params.theta_hydrostatic_mode,m_hvcoord); m_elem_ops.init(m_hvcoord); - } + + if(m_process_nh_vars){ + std::cout << "4hey m_process_nh_vars is true \n"; +}else +{ + std::cout << "4hey m_process_nh_vars is false \n"; +} + + } int requested_buffer_size (int num_teams) const { - if (!m_process_nh_vars) { + +if(m_process_nh_vars){ + std::cout << "IN REQUESTED hey m_process_nh_vars is true \n"; +}else +{ + std::cout << "IN REQUESTED hey m_process_nh_vars is false \n"; +} + + //if (!m_process_nh_vars) { + if (m_process_nh_vars==0) { return 0; } @@ -81,8 +129,20 @@ struct RemapStateProvider { } void init_buffers(const FunctorsBuffersManager& fbm, int num_teams) { - if (!m_process_nh_vars) { - return; + +if(m_process_nh_vars){ + std::cout << "IN BUFFERS hey m_process_nh_vars is true \n"; +}else +{ + std::cout << "IN BUFFERS hey m_process_nh_vars is false \n"; +} + + + //if (!m_process_nh_vars) { + if (m_process_nh_vars==0) { + + std::cout << "hey we should be returning from init_buffers \n"; + return; } Scalar* mem = reinterpret_cast(fbm.get_memory()); @@ -95,17 +155,20 @@ struct RemapStateProvider { KOKKOS_INLINE_FUNCTION int num_states_remap() const { - return (m_process_nh_vars ? 5 : 3); + //return (m_process_nh_vars ? 5 : 3); + return ( (m_process_nh_vars>0) ? 5 : 3); } KOKKOS_INLINE_FUNCTION int num_states_preprocess() const { - return (m_process_nh_vars ? 2 : 0); + //return (m_process_nh_vars ? 2 : 0); + return ( (m_process_nh_vars>0) ? 2 : 0); } KOKKOS_INLINE_FUNCTION int num_states_postprocess() const { - return (m_process_nh_vars ? 2 : 0); + //return (m_process_nh_vars ? 2 : 0); + return ((m_process_nh_vars>0) ? 2 : 0); } KOKKOS_INLINE_FUNCTION From 4f24ef4e31b6acf5f7ca80437cfcf0b0f08f987e Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 7 Nov 2023 16:34:31 +0000 Subject: [PATCH 003/529] wip cime changes --- .../machines/cmake_macros/oneapi-ifxgpu.cmake | 9 ++++--- .../oneapi-ifxgpu_sunspot-gen.cmake | 26 +++++++++++++++++++ 2 files changed, 32 insertions(+), 3 deletions(-) create mode 100644 cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake index bc92818df9b..a44dc2bfa16 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake @@ -14,9 +14,9 @@ if (DEBUG) string(APPEND CFLAGS " -O0 -g") string(APPEND CXXFLAGS " -O0 -g") endif() -string(APPEND CFLAGS " -traceback -fp-model precise -std=gnu99") -string(APPEND CXXFLAGS " -traceback -fp-model precise") -string(APPEND FFLAGS " -traceback -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise") +string(APPEND CFLAGS " -fp-model precise -std=gnu99") +string(APPEND CXXFLAGS " -fp-model precise") +string(APPEND FFLAGS " -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise") set(SUPPORTS_CXX "TRUE") string(APPEND CPPDEFS " -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL -DHAVE_SLASHPROC -DHIDE_MPI") string(APPEND FC_AUTO_R8 " -r8") @@ -30,3 +30,6 @@ set(MPICXX "mpicxx") set(SCC "icx") set(SCXX "icpx") set(SFC "ifx") + + + diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake new file mode 100644 index 00000000000..1f355208ff1 --- /dev/null +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake @@ -0,0 +1,26 @@ + +set(CXX_LINKER "CXX") + +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) + +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib -lmkl_intel_lp64 -lmkl_sequential -lmkl_core") + +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) + +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0}") +string(APPEND SLIBS " -fiopenmp -fopenmp-targets=spir64") + +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") + +set(USE_SYCL "TRUE") + +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_GEN=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") + +string(APPEND SYCL_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -fsycl -mlong-double-64 -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") + +#string(APPEND SYCL_FLAGS " -\-intel -fsycl") +string(APPEND CXX_LDFLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -fsycl -lsycl -mlong-double-64 -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64") + + + From 18800c6e46b38dbd14be744e60332cf5c4e5f521 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 8 Nov 2023 19:00:33 +0000 Subject: [PATCH 004/529] sync ekat with its branch --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index a468d04e442..0d851fc93b3 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit a468d04e442a3a7fa170563afa9a103c61170b10 +Subproject commit 0d851fc93b3a79b716bc32b2c32166f491d44aac From ea9006e9a10f890832f10062f80d582c9b1c9bba Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 8 Nov 2023 19:02:07 +0000 Subject: [PATCH 005/529] config, wip --- .../oneapi-ifxgpu_sunspot-gen.cmake | 4 + cime_config/machines/config_batch.xml | 8 ++ cime_config/machines/config_machines.xml | 116 ++++++++++++++++++ components/eamxx/CMakeLists.txt | 13 +- .../cmake/machine-files/sunspot-gen.cmake | 31 +++++ .../eamxx/src/dynamics/homme/CMakeLists.txt | 3 +- .../eamxx/src/physics/rrtmgp/CMakeLists.txt | 3 + 7 files changed, 175 insertions(+), 3 deletions(-) create mode 100644 components/eamxx/cmake/machine-files/sunspot-gen.cmake diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake index 1f355208ff1..9c9eb97add1 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-gen.cmake @@ -22,5 +22,9 @@ string(APPEND SYCL_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -fsyc #string(APPEND SYCL_FLAGS " -\-intel -fsycl") string(APPEND CXX_LDFLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -fsycl -lsycl -mlong-double-64 -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64") +SET(CMAKE_CXX_COMPILER "mpicxx" CACHE STRING "") +SET(CMAKE_C_COMPILER "mpicc" CACHE STRING "") +SET(CMAKE_FORTRAN_COMPILER "mpifort" CACHE STRING "") + diff --git a/cime_config/machines/config_batch.xml b/cime_config/machines/config_batch.xml index 726714c40f2..632abc2b3e2 100644 --- a/cime_config/machines/config_batch.xml +++ b/cime_config/machines/config_batch.xml @@ -520,6 +520,14 @@ + + /lus/gila/projects/CSC249ADSE15_CNDA/tools/qsub/throttle + + workq + debug + + + --output=slurm.out diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 5f69e3c61f3..31c2134e342 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3048,6 +3048,122 @@ + + + + + + + + + ANL Sunspot Test and Development System (TDS), batch system is pbspro + uan-.* + LINUX + oneapi-ifxgpu + mpich + CSC249ADSE15_CNDA + /gila/CSC249ADSE15_CNDA/performance_archive + .* + /lus/gila/projects/CSC249ADSE15_CNDA/$USER/scratch + /lus/gila/projects/CSC249ADSE15_CNDA/inputdata + /lus/gila/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /lus/gila/projects/CSC249ADSE15_CNDA/baselines/$COMPILER + /lus/gila/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc + 16 + e3sm_developer + 4 + pbspro + e3sm + 12 + 12 + 12 + 12 + FALSE + + mpiexec + + + -np {{ total_tasks }} --label + -ppn {{ tasks_per_node }} + --cpu-bind depth -envall + -d $ENV{OMP_NUM_THREADS} + $ENV{GPU_TILE_COMPACT} + + + + /soft/packaging/lmod/lmod/init/sh + /soft/packaging/lmod/lmod/init/csh + /soft/packaging/lmod/lmod/init/env_modules_python.py + module + module + /soft/packaging/lmod/lmod/libexec/lmod python + + + /soft/modulefiles + spack cmake + /soft/restricted/CNDA/updates/modulefiles + + + oneapi/eng-compiler/2022.12.30.003 + mpich/52.2/icc-all-pmix-gpu + + + + + + + + cray-pals + append-deps/default + libfabric/1.15.2.0 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf + + + 1 + + + level_zero:gpu + NO_GPU + 0 + disable + disable + 1 + 4000MB + 0 + /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh + 131072 + 20 + + + verbose,granularity=thread,balanced + 128M + + + -1 + + + + + + + + + + + + + + + + + ANL Sunspot Test and Development System (TDS), batch system is pbspro uan-.* diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 263e8d4b9b6..9c193f68e3f 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -120,6 +120,7 @@ include(CTest) set (EAMXX_ENABLE_GPU FALSE CACHE BOOL "") set (CUDA_BUILD FALSE CACHE BOOL "") #needed for yakl if kokkos vars are not visible there? set (HIP_BUILD FALSE CACHE BOOL "") #needed for yakl if kokkos vars are not visible there? +set (SYCL_BUILD FALSE CACHE BOOL "") #needed for yakl if kokkos vars are not visible there? # Determine if this is a Cuda build. if (Kokkos_ENABLE_CUDA) @@ -129,7 +130,7 @@ if (Kokkos_ENABLE_CUDA) set (CUDA_BUILD TRUE CACHE BOOL "" FORCE) #needed for yakl if kokkos vars are not visible there? endif () -# Determine if this is a Cuda build. +# Determine if this is a HIP build. if (Kokkos_ENABLE_HIP) # Add CUDA as a language for CUDA builds enable_language(HIP) @@ -137,6 +138,13 @@ if (Kokkos_ENABLE_HIP) set (HIP_BUILD TRUE CACHE BOOL "" FORCE) #needed for yakl if kokkos vars are not visible there? endif () +# Determine if this is a sycl build. +if (Kokkos_ENABLE_SYCL) + #enable_language(SYCL) + set (EAMXX_ENABLE_GPU TRUE CACHE BOOL "" FORCE) + set (SYCL_BUILD TRUE CACHE BOOL "" FORCE) #needed for yakl if kokkos vars are not visible there? +endif () + if( NOT "${CMAKE_CXX_COMPILER_ID}" MATCHES "[Cc]lang" ) set (CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp") endif() @@ -198,7 +206,7 @@ elseif(MACH) endif() set(DEFAULT_SMALL_KERNELS FALSE) -if (Kokkos_ENABLE_HIP) +if (Kokkos_ENABLE_HIP OR Kokkos_ENABLE_SYCL) set(DEFAULT_SMALL_KERNELS TRUE) endif() @@ -435,6 +443,7 @@ print_var(SCREAM_MACHINE) print_var(EAMXX_ENABLE_GPU) print_var(CUDA_BUILD) print_var(HIP_BUILD) +print_var(SYCL_BUILD) print_var(SCREAM_DOUBLE_PRECISION) print_var(SCREAM_MIMIC_GPU) print_var(SCREAM_FPE) diff --git a/components/eamxx/cmake/machine-files/sunspot-gen.cmake b/components/eamxx/cmake/machine-files/sunspot-gen.cmake new file mode 100644 index 00000000000..3e33ac7b461 --- /dev/null +++ b/components/eamxx/cmake/machine-files/sunspot-gen.cmake @@ -0,0 +1,31 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +include (${EKAT_MACH_FILES_PATH}/kokkos/intel-gen.cmake) +include (${EKAT_MACH_FILES_PATH}/kokkos/sycl.cmake) +include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) + +#AB flags from ekat +# -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel +SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") +SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64") + +#SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") + +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) +set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) +#set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) + + + +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(NETCDF_C_PATH "$ENV{NETCDF_PATH}") +#this one is for rrtmgp +set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") + + + diff --git a/components/eamxx/src/dynamics/homme/CMakeLists.txt b/components/eamxx/src/dynamics/homme/CMakeLists.txt index 2613eadefeb..c818b5a8ae4 100644 --- a/components/eamxx/src/dynamics/homme/CMakeLists.txt +++ b/components/eamxx/src/dynamics/homme/CMakeLists.txt @@ -23,7 +23,8 @@ set(BUILD_HOMME_PREQX_KOKKOS OFF CACHE BOOL "") set(BUILD_HOMME_PESE OFF CACHE BOOL "") set(BUILD_HOMME_SWIM OFF CACHE BOOL "") set(BUILD_HOMME_PRIM OFF CACHE BOOL "") -set(HOMME_ENABLE_COMPOSE ON CACHE BOOL "") +#set(HOMME_ENABLE_COMPOSE ON CACHE BOOL "") +set(HOMME_ENABLE_COMPOSE OFF CACHE BOOL "") set(BUILD_HOMME_TOOL OFF CACHE BOOL "") if (NOT Kokkos_ENABLE_SERIAL) diff --git a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt index fa22062bc32..160cc355e4d 100644 --- a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt +++ b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt @@ -26,6 +26,9 @@ else () string (REPLACE " " ";" YAKL_HIP_FLAGS_LIST ${YAKL_HIP_FLAGS}) endif() + ####### SYCL here + + set (YAKL_SOURCE_DIR ${SCREAM_BASE_DIR}/../../externals/YAKL) add_subdirectory(${YAKL_SOURCE_DIR} ${CMAKE_BINARY_DIR}/externals/YAKL) From b8fe4ace54329ae53d57b5d13a60a44b3ed900c6 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 10 Nov 2023 19:20:12 +0000 Subject: [PATCH 006/529] typo --- components/homme/src/share/cxx/utilities/BfbUtils.hpp | 2 +- components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp | 2 +- components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/components/homme/src/share/cxx/utilities/BfbUtils.hpp b/components/homme/src/share/cxx/utilities/BfbUtils.hpp index 475cd9f2d95..7fb4d042f7f 100644 --- a/components/homme/src/share/cxx/utilities/BfbUtils.hpp +++ b/components/homme/src/share/cxx/utilities/BfbUtils.hpp @@ -64,7 +64,7 @@ KOKKOS_INLINE_FUNCTION ScalarType int_pow (ScalarType val, int k) { constexpr int max_shift = 30; if (k<0) { - Kokkos::print ("k = %d\n",k); + Kokkos::printf ("k = %d\n",k); Kokkos::abort("int_pow implemented only for k>=0.\n"); } diff --git a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp index 671c46bfc54..a5cf2aa0111 100644 --- a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp @@ -382,7 +382,7 @@ struct DirkFunctorImpl { kv.team_barrier(); if (it >= maxiter) { - Kokkos::print("[DIRK] WARNING! Newton reached max iteration count," + Kokkos::printf("[DIRK] WARNING! Newton reached max iteration count," " with deltaerr = %3.17f\n", deltaerr); nerr = 1; } diff --git a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp index 00585505510..79906948638 100644 --- a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp @@ -141,7 +141,7 @@ struct LimiterFunctor { [&](const int k,Real& result) { #ifndef HOMMEXX_BFB_TESTING if(diff_as_real(k) < 0){ - Kokkos::print("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", + Kokkos::printf("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", k+1,dp_as_real(k),dp0_as_real(k)); } #endif @@ -202,7 +202,7 @@ struct LimiterFunctor { for (int ivec=0; ivec Date: Fri, 10 Nov 2023 19:20:34 +0000 Subject: [PATCH 007/529] hardwire team size to 4 --- .../eamxx/src/dynamics/homme/physics_dynamics_remapper.cpp | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/components/eamxx/src/dynamics/homme/physics_dynamics_remapper.cpp b/components/eamxx/src/dynamics/homme/physics_dynamics_remapper.cpp index 8b41a9fee7c..2b4a9a741cc 100644 --- a/components/eamxx/src/dynamics/homme/physics_dynamics_remapper.cpp +++ b/components/eamxx/src/dynamics/homme/physics_dynamics_remapper.cpp @@ -418,6 +418,10 @@ do_remap_fwd() const int team_size = std::min(256, std::min(128*m_num_phys_cols,32*(concurrency/this->m_num_fields+31)/32)); #endif +#ifdef KOKKOS_ENABLE_SYCL + const int team_size = 4; +#endif + //should exclude above cases of CUDA and HIP #ifndef EAMXX_ENABLE_GPU const int team_size = (concurrencym_num_fields ? 1 : concurrency/this->m_num_fields); From 0601c69bef4035dbd046397c5a4e7d53e872dc2a Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 10 Nov 2023 19:20:57 +0000 Subject: [PATCH 008/529] kokkos prinf --- .../eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp index a407e83c2ee..97025116383 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp @@ -234,10 +234,10 @@ void Functions::shoc_assumed_pdf( const Smask is_nan_Tl1_1 = isnan(Tl1_1) && active_entries; const Smask is_nan_Tl1_2 = isnan(Tl1_2) && active_entries; if (is_nan_Tl1_1.any() || is_nan_Tl1_2.any()) { - printf("WARNING: NaN Detected in Tl1_1 or Tl1_2!\n"); + Kokkos::printf("WARNING: NaN Detected in Tl1_1 or Tl1_2!\n"); for (int i=0; i::shoc_assumed_pdf( n_mask++; } } - printf("WARNING: Tl1_1 has %d values <= allowable value. Resetting to minimum value.\n",n_mask); + Kokkos::printf("WARNING: Tl1_1 has %d values <= allowable value. Resetting to minimum value.\n",n_mask); } if( is_small_Tl1_2.any() ) { Tl1_2.set(is_small_Tl1_2,Tl_min); @@ -277,7 +277,7 @@ void Functions::shoc_assumed_pdf( n_mask++; } } - printf("WARNING: Tl1_2 has %d values <= allowable value. Resetting to minimum value.\n",n_mask); + Kokkos::printf("WARNING: Tl1_2 has %d values <= allowable value. Resetting to minimum value.\n",n_mask); } // Compute qs and beta From f425901be69fe269683a01b1016143be25127fa5 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 10 Nov 2023 19:36:25 +0000 Subject: [PATCH 009/529] add sunspot-pvc --- .../oneapi-ifxgpu_sunspot-pvc.cmake | 30 +++++ cime_config/machines/config_batch.xml | 8 ++ cime_config/machines/config_machines.xml | 103 +++++++++++++++++- .../cmake/machine-files/sunspot-pvc.cmake | 32 ++++++ 4 files changed, 170 insertions(+), 3 deletions(-) create mode 100644 cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake create mode 100644 components/eamxx/cmake/machine-files/sunspot-pvc.cmake diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake new file mode 100644 index 00000000000..d62f94c40fe --- /dev/null +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake @@ -0,0 +1,30 @@ + +set(CXX_LINKER "CXX") + +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) + +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib -lmkl_intel_lp64 -lmkl_sequential -lmkl_core") + +execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) + +string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0}") +string(APPEND SLIBS " -fiopenmp -fopenmp-targets=spir64") + +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") + +set(USE_SYCL "TRUE") + +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_GEN=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") + +string(APPEND SYCL_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -fsycl -mlong-double-64 -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") + +#string(APPEND SYCL_FLAGS " -\-intel -fsycl") +string(APPEND CXX_LDFLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -fsycl -lsycl -mlong-double-64 -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64 -Xsycl-target-backend \"-device 12.60.7\"") + +SET(CMAKE_CXX_COMPILER "mpicxx" CACHE STRING "") +SET(CMAKE_C_COMPILER "mpicc" CACHE STRING "") +SET(CMAKE_FORTRAN_COMPILER "mpifort" CACHE STRING "") + + + diff --git a/cime_config/machines/config_batch.xml b/cime_config/machines/config_batch.xml index 632abc2b3e2..95918ce2848 100644 --- a/cime_config/machines/config_batch.xml +++ b/cime_config/machines/config_batch.xml @@ -520,6 +520,14 @@ + + /lus/gila/projects/CSC249ADSE15_CNDA/tools/qsub/throttle + + workq + debug + + + /lus/gila/projects/CSC249ADSE15_CNDA/tools/qsub/throttle diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 31c2134e342..4ceece26afc 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3055,7 +3055,7 @@ - + ANL Sunspot Test and Development System (TDS), batch system is pbspro uan-.* LINUX @@ -3105,8 +3105,8 @@ /soft/restricted/CNDA/updates/modulefiles - oneapi/eng-compiler/2022.12.30.003 - mpich/52.2/icc-all-pmix-gpu + oneapi/eng-compiler/2023.10.15.002 + mpich/52.2-256/icc-all-pmix-gpu @@ -3153,6 +3153,103 @@ + + ANL Sunspot Test and Development System (TDS), batch system is pbspro + uan-.* + LINUX + oneapi-ifxgpu + mpich + CSC249ADSE15_CNDA + /gila/CSC249ADSE15_CNDA/performance_archive + .* + /lus/gila/projects/CSC249ADSE15_CNDA/$USER/scratch + /lus/gila/projects/CSC249ADSE15_CNDA/inputdata + /lus/gila/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /lus/gila/projects/CSC249ADSE15_CNDA/baselines/$COMPILER + /lus/gila/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc + 16 + e3sm_developer + 4 + pbspro + e3sm + 12 + 12 + 12 + 12 + FALSE + + mpiexec + + + -np {{ total_tasks }} --label + -ppn {{ tasks_per_node }} + --cpu-bind depth -envall + -d $ENV{OMP_NUM_THREADS} + $ENV{GPU_TILE_COMPACT} + + + + /soft/packaging/lmod/lmod/init/sh + /soft/packaging/lmod/lmod/init/csh + /soft/packaging/lmod/lmod/init/env_modules_python.py + module + module + /soft/packaging/lmod/lmod/libexec/lmod python + + + /soft/modulefiles + spack cmake + /soft/restricted/CNDA/updates/modulefiles + + + oneapi/eng-compiler/2023.10.15.002 + mpich/52.2-256/icc-all-pmix-gpu + + + + + + + + cray-pals + append-deps/default + libfabric/1.15.2.0 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf + + + 1 + + + level_zero:gpu + NO_GPU + 0 + disable + disable + 1 + 4000MB + 0 + /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh + 131072 + 20 + + + verbose,granularity=thread,balanced + 128M + + + -1 + + + + + diff --git a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake new file mode 100644 index 00000000000..874b73e34eb --- /dev/null +++ b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake @@ -0,0 +1,32 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +include (${EKAT_MACH_FILES_PATH}/kokkos/intel-pvc.cmake) +# kokkos sycl is on in the above file +#include (${EKAT_MACH_FILES_PATH}/kokkos/sycl.cmake) +include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) + +#AB flags from ekat +# -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel +SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") +SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"") + +#SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") + +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) +set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) +#set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) + + + +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(NETCDF_C_PATH "$ENV{NETCDF_PATH}") +#this one is for rrtmgp +set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") + + + From a8a9599d6dd1a39b3fdfd21a617fe4f456407725 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 10 Nov 2023 20:42:37 +0000 Subject: [PATCH 010/529] update ekat, ekat/kokkos --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index 0d851fc93b3..3b1a7f9fee7 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit 0d851fc93b3a79b716bc32b2c32166f491d44aac +Subproject commit 3b1a7f9fee7848006e5aa53ae0fd334701d8f5a7 From 09602cd3689deda5fb2fc3e8fe161aab2b7f1286 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 10 Nov 2023 20:43:37 +0000 Subject: [PATCH 011/529] load certain cmake and python --- cime_config/machines/config_machines.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 4ceece26afc..b31e9748010 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3101,7 +3101,7 @@ /soft/modulefiles - spack cmake + spack cmake/3.24.2 python/3.9.13-gcc-11.2.0-76jlbxs /soft/restricted/CNDA/updates/modulefiles @@ -3199,7 +3199,7 @@ /soft/modulefiles - spack cmake + spack cmake/3.24.2 python/3.9.13-gcc-11.2.0-76jlbxs /soft/restricted/CNDA/updates/modulefiles From 80bf0d53655bf8913c43f69574c4ea278cb611bc Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 12 Dec 2023 02:14:29 +0000 Subject: [PATCH 012/529] build issue fixed thatnks to Andrew and Daniel A --- .../eamxx/src/control/atmosphere_surface_coupling_exporter.hpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp b/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp index 18db413ca32..9707c137f2b 100644 --- a/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp +++ b/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp @@ -23,7 +23,7 @@ namespace scream */ // enum to track how exported fields will be set. -enum ExportType { +enum ExportType:int { FROM_MODEL = 0, // Variable will be derived from atmosphere model state FROM_FILE = 1, // Variable will be set given data from a file CONSTANT = 2 // Set variable to a constant value From e2792ba614102685c15f98368f58508df7479f0e Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 29 Jan 2024 21:51:53 +0000 Subject: [PATCH 013/529] bad conflict resolution fixed --- components/homme/cmake/HommeMacros.cmake | 8 -------- 1 file changed, 8 deletions(-) diff --git a/components/homme/cmake/HommeMacros.cmake b/components/homme/cmake/HommeMacros.cmake index 532bd762950..1a49c27e852 100644 --- a/components/homme/cmake/HommeMacros.cmake +++ b/components/homme/cmake/HommeMacros.cmake @@ -156,15 +156,7 @@ macro(createTestExec execName execType macroNP macroNC ENDIF () IF (HOMME_USE_KOKKOS) -<<<<<<< HEAD - if("${E3SM_KOKKOS_PATH}" STREQUAL "") - target_link_libraries(${execName} kokkos) - else() - link_to_kokkos(${execName}) - endif() -======= target_link_libraries(${execName} Kokkos::kokkos) ->>>>>>> origin/master ENDIF () # Move the module files out of the way so the parallel build From 735bac660641d9e22c764429e9e5155f9aff818c Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 30 Jan 2024 20:16:09 +0000 Subject: [PATCH 014/529] changes for aurora --- cime_config/machines/config_machines.xml | 9 ++++----- components/eamxx/src/physics/rrtmgp/CMakeLists.txt | 4 ++-- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index b0803f499ed..826397f2891 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3503,19 +3503,18 @@ /soft/modulefiles /soft/restricted/CNDA/updates/modulefiles - spack-pe-gcc cmake + spack-pe-gcc/0.4-rc1 cmake/3.26.4-gcc-testing - oneapi/eng-compiler/2023.05.15.007 + oneapi/release/2023.12.15.001 spack-pe-gcc cmake - gcc/10.3.0 + gcc/11.2.0 - cray-pals + cray-pals/1.3.3 libfabric/1.15.2.0 - cray-libpals/1.3.2 $CIME_OUTPUT_ROOT/$CASE/run diff --git a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt index 0f0b3eff6af..b5403587ca7 100644 --- a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt +++ b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt @@ -127,12 +127,12 @@ yakl_process_target(scream_rrtmgp_yakl) # NOTE: cannot use 'PUBLIC' in target_link_libraries, # since yakl_process_target already used it # with the "plain" signature -find_library(NETCDF_C netcdf HINTS ${NetCDF_C_PATH}/lib) +find_library(NETCDF_C netcdf HINTS $ENV{NETCDF_C_PATH}/lib) target_link_libraries(scream_rrtmgp_yakl ${NETCDF_C} rrtmgp scream_share) target_include_directories(scream_rrtmgp_yakl PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) target_include_directories(scream_rrtmgp_yakl SYSTEM PUBLIC - ${NetCDF_C_PATH}/include + ${NETCDF_C_PATH}/include ${EAM_RRTMGP_DIR}/external) ################################## From f5dfd58bf13c4812eeec1ab157cd6cf58e7cbe6f Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 30 Jan 2024 20:16:32 +0000 Subject: [PATCH 015/529] cache file --- .../eamxx/cmake/machine-files/aurora.cmake | 32 +++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 components/eamxx/cmake/machine-files/aurora.cmake diff --git a/components/eamxx/cmake/machine-files/aurora.cmake b/components/eamxx/cmake/machine-files/aurora.cmake new file mode 100644 index 00000000000..874b73e34eb --- /dev/null +++ b/components/eamxx/cmake/machine-files/aurora.cmake @@ -0,0 +1,32 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +include (${EKAT_MACH_FILES_PATH}/kokkos/intel-pvc.cmake) +# kokkos sycl is on in the above file +#include (${EKAT_MACH_FILES_PATH}/kokkos/sycl.cmake) +include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) + +#AB flags from ekat +# -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel +SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") +SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"") + +#SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") + +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) +set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) +#set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) + + + +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(NETCDF_C_PATH "$ENV{NETCDF_PATH}") +#this one is for rrtmgp +set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") + + + From 69b07b8a4fdeade85bedb3218e99b83947b6889a Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 9 Feb 2024 19:06:26 +0000 Subject: [PATCH 016/529] wip --- .../cmake_macros/oneapi-ifxgpu_aurora.cmake | 8 +++- cime_config/machines/config_machines.xml | 7 ++-- .../eamxx/src/control/atmosphere_driver.cpp | 32 ++++++++++++++++ .../eamxx/src/mct_coupling/atm_comp_mct.F90 | 38 +++++++++++++++++-- .../mct_coupling/scream_cxx_f90_interface.cpp | 9 +++++ .../atm_process/atmosphere_process_group.cpp | 10 +++++ .../homme/src/share/cxx/prim_driver.cpp | 10 ++++- 7 files changed, 104 insertions(+), 10 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake index 47d513408c2..f72f2f6b0e2 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake @@ -1,7 +1,13 @@ -string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core") +string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -fsycl-device-code-split=per_kernel -fsycl-max-parallel-link-jobs=16") if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") + +set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") + + + + diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 826397f2891..70306fbc7bf 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3503,6 +3503,7 @@ /soft/modulefiles /soft/restricted/CNDA/updates/modulefiles + cray-python/3.9.13.1 spack-pe-gcc/0.4-rc1 cmake/3.26.4-gcc-testing @@ -3523,8 +3524,8 @@ /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 - /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} - /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} + /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} + /opt/cray/pe/python/3.9.13.1/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 @@ -3532,7 +3533,7 @@ level_zero:gpu - NO_GPU + 0 disable disable diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index b9e0862c5a1..8268caf9653 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -209,25 +209,40 @@ setup_intensive_observation_period () void AtmosphereDriver::create_atm_processes() { + + std::cout << "OG cinit 1 \n" << std::flush; + m_atm_logger->info("[EAMxx] create_atm_processes ..."); + std::cout << "OG cinit 2 \n" << std::flush; start_timer("EAMxx::init"); + std::cout << "OG cinit 3 \n" << std::flush; start_timer("EAMxx::create_atm_processes"); + std::cout << "OG cinit 4 \n" << std::flush; // At this point, must have comm and params set. check_ad_status(s_comm_set | s_params_set); + std::cout << "OG cinit 5 \n" << std::flush; // Create the group of processes. This will recursively create the processes // tree, storing also the information regarding parallel execution (if needed). // See AtmosphereProcessGroup class documentation for more details. auto& atm_proc_params = m_atm_params.sublist("atmosphere_processes"); + std::cout << "OG cinit 6 \n" << std::flush; atm_proc_params.rename("EAMxx"); + std::cout << "OG cinit 7 \n" << std::flush; atm_proc_params.set("Logger",m_atm_logger); + std::cout << "OG cinit 8 \n" << std::flush; m_atm_process_group = std::make_shared(m_atm_comm,atm_proc_params); + std::cout << "OG cinit 9 \n" << std::flush; m_ad_status |= s_procs_created; + std::cout << "OG cinit 10 \n" << std::flush; stop_timer("EAMxx::create_atm_processes"); + std::cout << "OG cinit 11 \n" << std::flush; stop_timer("EAMxx::init"); + std::cout << "OG cinit 12 \n" << std::flush; m_atm_logger->info("[EAMxx] create_atm_processes ... done!"); + std::cout << "OG cinit 13 \n" << std::flush; } void AtmosphereDriver::create_grids() @@ -1492,15 +1507,25 @@ initialize_constant_field(const FieldIdentifier& fid, void AtmosphereDriver::initialize_atm_procs () { + std::cout << "OG init 1 \n" << std::flush; m_atm_logger->info("[EAMxx] initialize_atm_procs ..."); start_timer("EAMxx::init"); start_timer("EAMxx::initialize_atm_procs"); + std::cout << "OG init 2 \n" << std::flush; // Initialize memory buffer for all atm processes + std::cout << "OG hhhinit 3 \n" << std::flush; m_memory_buffer = std::make_shared(); + std::cout << "OG init 4 \n" << std::flush; + + + m_memory_buffer->request_bytes(m_atm_process_group->requested_buffer_size_in_bytes()); + std::cout << "OG init 5 \n" << std::flush; m_memory_buffer->allocate(); + std::cout << "OG init 6 \n" << std::flush; m_atm_process_group->init_buffers(*m_memory_buffer); + std::cout << "OG init 7 \n" << std::flush; const bool restarted_run = m_case_t0 < m_run_t0; @@ -1509,19 +1534,24 @@ void AtmosphereDriver::initialize_atm_procs () setup_surface_coupling_processes(); } + std::cout << "OG init 8 \n" << std::flush; // Initialize the processes m_atm_process_group->initialize(m_current_ts, restarted_run ? RunType::Restarted : RunType::Initial); + std::cout << "OG init 9 \n" << std::flush; // Create and add energy and mass conservation check to appropriate atm procs setup_column_conservation_checks(); + std::cout << "OG init 10 \n" << std::flush; // If user requests it, we set up NaN checks for all computed fields after each atm proc run if (m_atm_params.sublist("driver_options").get("check_all_computed_fields_for_nans",true)) { m_atm_process_group->add_postcondition_nan_checks(); } + std::cout << "OG init 11 \n" << std::flush; // Add additional column data fields to pre/postcondition checks (if they exist) add_additional_column_data_to_property_checks(); + std::cout << "OG init 12 \n" << std::flush; if (fvphyshack) { // [CGLL ICs in pg2] See related notes in atmosphere_dynamics.cpp. @@ -1530,12 +1560,14 @@ void AtmosphereDriver::initialize_atm_procs () m_field_mgrs.erase(gn); } + std::cout << "OG init 13 \n" << std::flush; m_ad_status |= s_procs_inited; stop_timer("EAMxx::initialize_atm_procs"); stop_timer("EAMxx::init"); m_atm_logger->info("[EAMxx] initialize_atm_procs ... done!"); + std::cout << "OG init 14 \n" << std::flush; report_res_dep_memory_footprint (); } diff --git a/components/eamxx/src/mct_coupling/atm_comp_mct.F90 b/components/eamxx/src/mct_coupling/atm_comp_mct.F90 index 34bbbedcc5c..2471280135f 100644 --- a/components/eamxx/src/mct_coupling/atm_comp_mct.F90 +++ b/components/eamxx/src/mct_coupling/atm_comp_mct.F90 @@ -35,8 +35,8 @@ module atm_comp_mct integer :: mpicom_atm ! mpi communicator integer(IN) :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001') + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "') integer(IN) :: ATM_ID ! mct comp id integer(IN),parameter :: master_task=0 ! task number of master task @@ -97,6 +97,8 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) !------------------------------------------------------------------------------- +print *,'OG a 1' + ! Grab some data from the cdata structure (coming from the coupler) call seq_cdata_setptrs(cdata, & id=ATM_ID, & @@ -104,38 +106,51 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) gsMap=gsmap_atm, & dom=dom_atm, & infodata=infodata) +print *, 'OG a 2' call seq_infodata_getData(infodata, atm_phase=phase, start_type=run_type, & username=username, case_name=caseid, hostname=hostname) - call seq_infodata_PutData(infodata, atm_aero=.true.) +print *, 'OG a 3' + call seq_infodata_PutData(infodata, atm_aero=.true.) +print *, 'OG a 4' call seq_infodata_PutData(infodata, atm_prognostic=.true.) +print *, 'OG a 5' if (phase > 1) RETURN +print *, 'OG a 6' ! Determine instance information inst_name = seq_comm_name(ATM_ID) inst_index = seq_comm_inst(ATM_ID) inst_suffix = seq_comm_suffix(ATM_ID) +print *, 'OG a 7' ! Determine communicator group call mpi_comm_rank(mpicom_atm, my_task, ierr) +print *, 'OG a 8' !---------------------------------------------------------------------------- ! Init atm.log !---------------------------------------------------------------------------- - +print *, 'OG a 9' if (my_task == master_task) then +print *, 'OG a 10' atm_log_unit = shr_file_getUnit() call shr_file_setIO ('atm_modelio.nml'//trim(inst_suffix),atm_log_unit) inquire(unit=atm_log_unit,name=atm_log_fname) endif +print *, 'OG a 11' call mpi_bcast(atm_log_unit,1,MPI_INTEGER,master_task,mpicom_atm,mpi_ierr) +print *, 'OG a 12' if (ierr /= 0) then +print *, 'OG a 13' print *,'[eamxx] ERROR broadcasting atm.log unit' call mpi_abort(mpicom_atm,ierr,mpi_ierr) end if +print *, 'OG a 14' call mpi_bcast(atm_log_fname,256,MPI_CHARACTER,master_task,mpicom_atm,ierr) +print *, 'OG a 15' if (ierr /= 0) then print *,'[eamxx] ERROR broadcasting atm.log file name' call mpi_abort(mpicom_atm,ierr,mpi_ierr) @@ -146,29 +161,40 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) !---------------------------------------------------------------------------- ! Init the AD +print *, 'OG a 16' call seq_timemgr_EClockGetData(EClock, calendar=calendar, & curr_ymd=cur_ymd, curr_tod=cur_tod, & start_ymd=case_start_ymd, start_tod=case_start_tod) +print *, 'OG a 17' call string_f2c(yaml_fname,yaml_fname_c) +print *, 'OG a 18' call string_f2c(calendar,calendar_c) +print *, 'OG a 19' call string_f2c(trim(atm_log_fname),atm_log_fname_c) +print *, 'OG a 20' call scream_create_atm_instance (mpicom_atm, ATM_ID, yaml_fname_c, atm_log_fname_c, & INT(cur_ymd,kind=C_INT), INT(cur_tod,kind=C_INT), & INT(case_start_ymd,kind=C_INT), INT(case_start_tod,kind=C_INT), & calendar_c) +print *, 'OG a 21' ! Init MCT gsMap call atm_Set_gsMap_mct (mpicom_atm, ATM_ID, gsMap_atm) +print *, 'OG a 22' lsize = mct_gsMap_lsize(gsMap_atm, mpicom_atm) +print *, 'OG a 23' ! Init MCT domain structure call atm_domain_mct (lsize, gsMap_atm, dom_atm) +print *, 'OG a 24' ! Init import/export mct attribute vectors call mct_aVect_init(x2a, rList=seq_flds_x2a_fields, lsize=lsize) +print *, 'OG a 25' call mct_aVect_init(a2x, rList=seq_flds_a2x_fields, lsize=lsize) +print *, 'OG a 26' ! Complete AD initialization based on run type if (trim(run_type) == trim(seq_infodata_start_type_start)) then restarted_run = .false. @@ -179,8 +205,10 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) call mpi_abort(mpicom_atm,ierr,mpi_ierr) endif +print *, 'OG a 27' ! Init surface coupling stuff in the AD call scream_set_cpl_indices (x2a, a2x) +print *, 'OG a 28' call scream_setup_surface_coupling (c_loc(import_field_names), c_loc(import_cpl_indices), & c_loc(x2a%rAttr), c_loc(import_vector_components), & @@ -191,11 +219,13 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) c_loc(export_constant_multiple), c_loc(do_export_during_init), & num_cpl_exports, num_scream_exports, export_field_size) +print *, 'OG a 29' call string_f2c(trim(caseid),caseid_c) call string_f2c(trim(username),username_c) call string_f2c(trim(hostname),hostname_c) call scream_init_atm (caseid_c,hostname_c,username_c) +print *, 'OG a 30' end subroutine atm_init_mct !=============================================================================== diff --git a/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp b/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp index 0bdf90eeb71..83bf5ba8741 100644 --- a/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp +++ b/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp @@ -210,19 +210,28 @@ void scream_init_atm (const char* caseid, using namespace scream::control; fpe_guard_wrapper([&](){ + + std::cout << "OG s 1 \n" << std::flush; + // Get the ad, then complete initialization auto& ad = get_ad_nonconst(); + std::cout << "OG s 2 \n" << std::flush; // Set provenance info in the driver (will be added to the output files) ad.set_provenance_data (caseid,hostname,username); + std::cout << "OG s 3 \n" << std::flush; // Init all fields, atm processes, and output streams ad.initialize_fields (); + std::cout << "OG s 4 \n" << std::flush; ad.initialize_atm_procs (); + std::cout << "OG s 5 \n" << std::flush; // Do this before init-ing the output managers, // so the fields are valid if outputing at t=0 ad.reset_accumulated_fields(); + std::cout << "OG s 6 \n" << std::flush; ad.initialize_output_managers (); + std::cout << "OG s 7 \n" << std::flush; }); } diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp index 9d5ff488929..7985c9dc2dc 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp @@ -365,7 +365,17 @@ void AtmosphereProcessGroup::add_additional_data_fields_to_property_checks (cons } void AtmosphereProcessGroup::initialize_impl (const RunType run_type) { + + int mmm = 0; + for (auto& atm_proc : m_atm_processes) { + + mmm++; + std::cout << "process is "<< mmm << "\n" << std::flush; + std::cout << "process name is "<< atm_proc->name() << "\n"<< std::flush; + + m_atm_logger->flush(); + atm_proc->initialize(timestamp(),run_type); #ifdef SCREAM_HAS_MEMORY_USAGE long long my_mem_usage = get_mem_usage(MB); diff --git a/components/homme/src/share/cxx/prim_driver.cpp b/components/homme/src/share/cxx/prim_driver.cpp index b0f41a68ce7..b795ece613f 100644 --- a/components/homme/src/share/cxx/prim_driver.cpp +++ b/components/homme/src/share/cxx/prim_driver.cpp @@ -62,7 +62,10 @@ void prim_run_subcycle_c (const Real& dt, int& nstep, int& nm1, int& n0, int& np { GPTLstart("tl-sc prim_run_subcycle_c"); - auto& context = Context::singleton(); + std::cout << "OG--------------- In SUBCYCLE?\n"; + + + auto& context = Context::singleton(); // Get simulation params SimulationParams& params = context.get(); @@ -160,7 +163,10 @@ void prim_run_subcycle_c (const Real& dt, int& nstep, int& nm1, int& n0, int& np //////////////////////////////////////////////////////////////////////// update_q(tl.np1_qdp,tl.np1); } else { // independent_time_steps - prim_step_flexible(dt, compute_diagnostics); + + std::cout << "OG --------------- In FLEXIBLE?\n"; + + prim_step_flexible(dt, compute_diagnostics); } if (compute_diagnostics) { From 094798fda0b3870d34c662d1286fbce83b4fbd0c Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 9 Feb 2024 19:49:19 +0000 Subject: [PATCH 017/529] point to newest ekat changes --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index 3b1a7f9fee7..5b785f02cb2 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit 3b1a7f9fee7848006e5aa53ae0fd334701d8f5a7 +Subproject commit 5b785f02cb29f5226aad9b175f86c79a31b32037 From 8daf07470460174c025519a82987aed2ca42c4b0 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 13 Feb 2024 23:34:05 +0000 Subject: [PATCH 018/529] add auroracpu machine --- .../machines/cmake_macros/oneapi-ifx.cmake | 4 +- .../cmake_macros/oneapi-ifx_auroracpu.cmake | 19 ++++ cime_config/machines/config_batch.xml | 11 +- cime_config/machines/config_machines.xml | 101 ++++++++++++++++++ .../eamxx/cmake/machine-files/auroracpu.cmake | 29 +++++ 5 files changed, 162 insertions(+), 2 deletions(-) create mode 100644 cime_config/machines/cmake_macros/oneapi-ifx_auroracpu.cmake create mode 100644 components/eamxx/cmake/machine-files/auroracpu.cmake diff --git a/cime_config/machines/cmake_macros/oneapi-ifx.cmake b/cime_config/machines/cmake_macros/oneapi-ifx.cmake index e98a65d32a6..e9a0f838b1f 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifx.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifx.cmake @@ -23,4 +23,6 @@ set(MPICXX "mpicxx") set(SCC "icx") set(SCXX "icpx") set(SFC "ifx") -set(E3SM_LINK_WITH_FORTRAN "TRUE") + + +#set(E3SM_LINK_WITH_FORTRAN "TRUE") diff --git a/cime_config/machines/cmake_macros/oneapi-ifx_auroracpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifx_auroracpu.cmake new file mode 100644 index 00000000000..bd6ec8ed913 --- /dev/null +++ b/cime_config/machines/cmake_macros/oneapi-ifx_auroracpu.cmake @@ -0,0 +1,19 @@ + +string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core") +if (compile_threaded) + string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") +endif() + +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") + +#set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") + + + + + + + + + + diff --git a/cime_config/machines/config_batch.xml b/cime_config/machines/config_batch.xml index 86d6673de60..d1347eaa0df 100644 --- a/cime_config/machines/config_batch.xml +++ b/cime_config/machines/config_batch.xml @@ -575,7 +575,16 @@ workq - + + + /lus/gecko/projects/CSC249ADSE15_CNDA/tools/qsub/throttle + + EarlyAppAccess + workq-route + workq + + + --output=slurm.out diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 70306fbc7bf..2a1c0da8f2d 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3565,6 +3565,107 @@ + + + + ALCF Aurora, 10624 nodes, 2x52c SPR, 6x2s PVC, 2x512GB DDR5, 2x64GB CPU-HBM, 6x128GB GPU-HBM, Slingshot 11, PBSPro + aurora-uan-.* + LINUX + oneapi-ifx + mpich + CSC249ADSE15_CNDA + /lus/gecko/projects/CSC249ADSE15_CNDA/performance_archive + .* + /lus/gecko/projects/CSC249ADSE15_CNDA/$USER/scratch + /lus/gecko/projects/CSC249ADSE15_CNDA/inputdata + /lus/gecko/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /lus/gecko/projects/CSC249ADSE15_CNDA/baselines/$COMPILER + /lus/gecko/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc + 16 + e3sm_developer + 4 + pbspro + e3sm + 208 + 104 + FALSE + + mpiexec + + + -np {{ total_tasks }} --label + -ppn {{ tasks_per_node }} + --cpu-bind $ENV{RANKS_BIND} -envall + -d $ENV{OMP_NUM_THREADS} + $ENV{GPU_TILE_COMPACT} + + + + /lus/gecko/projects/CSC249ADSE15_CNDA/modules/lmod.sh + /soft/sunspot_migrate/soft/packaging/lmod/lmod/init/csh + /soft/sunspot_migrate/soft/packaging/lmod/lmod/init/env_modules_python.py + module + module + /soft/sunspot_migrate/soft/packaging/lmod/lmod/libexec/lmod python + + + /soft/modulefiles + /soft/restricted/CNDA/updates/modulefiles + cray-python/3.9.13.1 + spack-pe-gcc/0.4-rc1 cmake/3.26.4-gcc-testing + + + oneapi/release/2023.12.15.001 + + + cray-pals/1.3.3 + libfabric/1.15.2.0 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 + /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 + /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 + /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} + /opt/cray/pe/python/3.9.13.1/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} + list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 + + + 1 + + + 0 + DISABLED + 131072 + 20 + 0 + + + + verbose,granularity=thread,balanced + 128M + + + threads + 128M + + + -1 + + + + + + + + + + + + PNL cluster, OS is Linux, batch system is SLURM sooty diff --git a/components/eamxx/cmake/machine-files/auroracpu.cmake b/components/eamxx/cmake/machine-files/auroracpu.cmake new file mode 100644 index 00000000000..839c4c09814 --- /dev/null +++ b/components/eamxx/cmake/machine-files/auroracpu.cmake @@ -0,0 +1,29 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +include (${EKAT_MACH_FILES_PATH}/kokkos/serial.cmake) +# kokkos sycl is on in the above file +#include (${EKAT_MACH_FILES_PATH}/kokkos/sycl.cmake) +include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) + +#AB flags from ekat +# -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel + +#SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") + +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) +set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -mlong-double-64 -DNDEBUG -fortlib" CACHE STRING "" FORCE) +#set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) + + +set(NETCDF_PATH "$ENV{NETCDF_PATH}") +set(NETCDF_C_PATH "$ENV{NETCDF_PATH}") +#this one is for rrtmgp +set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") + + + From 1c44b208b230646f7d35fd1ab82e32df80dc4829 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 13 Feb 2024 23:34:24 +0000 Subject: [PATCH 019/529] adding iostream --- components/eamxx/src/share/util/scream_utils.hpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/eamxx/src/share/util/scream_utils.hpp b/components/eamxx/src/share/util/scream_utils.hpp index 4dddebf75aa..1989ce07e0b 100644 --- a/components/eamxx/src/share/util/scream_utils.hpp +++ b/components/eamxx/src/share/util/scream_utils.hpp @@ -12,6 +12,8 @@ #include #include +#include + namespace scream { enum MemoryUnits { From ca14fc6271f28bf0b70f844abe2c02898d67ed3b Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 13 Feb 2024 23:38:48 +0000 Subject: [PATCH 020/529] updated ekat branch --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index 5b785f02cb2..d252d191a18 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit 5b785f02cb29f5226aad9b175f86c79a31b32037 +Subproject commit d252d191a184aa73cd7666cf986bea94eb3f3688 From 1caf5dc228e0180deccc05372cf9d2db6bcadcbb Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 21 Feb 2024 19:16:16 +0000 Subject: [PATCH 021/529] bring changes from standalone homme sycl branch --- .../homme/src/share/cxx/ExecSpaceDefs.hpp | 6 + .../homme/src/share/cxx/prim_driver.cpp | 10 +- .../src/share/cxx/utilities/BfbUtils.hpp | 4 + .../theta-l_kokkos/cxx/CaarFunctorImpl.hpp | 162 +++++++++++++++++- .../theta-l_kokkos/cxx/DirkFunctorImpl.hpp | 6 +- .../cxx/HyperviscosityFunctorImpl.cpp | 9 +- .../cxx/HyperviscosityFunctorImpl.hpp | 2 +- .../src/theta-l_kokkos/cxx/LimiterFunctor.hpp | 14 +- .../theta-l_kokkos/cxx/RemapStateProvider.hpp | 70 ++++++-- .../cxx/cxx_f90_interface_theta.cpp | 18 +- 10 files changed, 263 insertions(+), 38 deletions(-) diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.hpp b/components/homme/src/share/cxx/ExecSpaceDefs.hpp index d799af38783..6c0da08d7f0 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.hpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.hpp @@ -65,6 +65,12 @@ using Hommexx_Serial = void; # define HOMMEXX_STATIC static #endif + +// a hack to have a cpu build without rebuilding kokkos +//#define HOMMEXX_SERIAL_SPACE + + + // Selecting the execution space. If no specific request, use Kokkos default // exec space #ifdef HOMMEXX_ENABLE_GPU diff --git a/components/homme/src/share/cxx/prim_driver.cpp b/components/homme/src/share/cxx/prim_driver.cpp index b795ece613f..b0f41a68ce7 100644 --- a/components/homme/src/share/cxx/prim_driver.cpp +++ b/components/homme/src/share/cxx/prim_driver.cpp @@ -62,10 +62,7 @@ void prim_run_subcycle_c (const Real& dt, int& nstep, int& nm1, int& n0, int& np { GPTLstart("tl-sc prim_run_subcycle_c"); - std::cout << "OG--------------- In SUBCYCLE?\n"; - - - auto& context = Context::singleton(); + auto& context = Context::singleton(); // Get simulation params SimulationParams& params = context.get(); @@ -163,10 +160,7 @@ void prim_run_subcycle_c (const Real& dt, int& nstep, int& nm1, int& n0, int& np //////////////////////////////////////////////////////////////////////// update_q(tl.np1_qdp,tl.np1); } else { // independent_time_steps - - std::cout << "OG --------------- In FLEXIBLE?\n"; - - prim_step_flexible(dt, compute_diagnostics); + prim_step_flexible(dt, compute_diagnostics); } if (compute_diagnostics) { diff --git a/components/homme/src/share/cxx/utilities/BfbUtils.hpp b/components/homme/src/share/cxx/utilities/BfbUtils.hpp index 7fb4d042f7f..2d85109e2a2 100644 --- a/components/homme/src/share/cxx/utilities/BfbUtils.hpp +++ b/components/homme/src/share/cxx/utilities/BfbUtils.hpp @@ -64,7 +64,11 @@ KOKKOS_INLINE_FUNCTION ScalarType int_pow (ScalarType val, int k) { constexpr int max_shift = 30; if (k<0) { +#ifdef KOKKOS_ENABLE_SYCL Kokkos::printf ("k = %d\n",k); +#else + printf ("k = %d\n",k); +#endif Kokkos::abort("int_pow implemented only for k>=0.\n"); } diff --git a/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp index febb7eb0a7f..4a861d5c747 100644 --- a/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp @@ -41,7 +41,7 @@ struct CaarFunctorImpl { struct Buffers { static constexpr int num_3d_scalar_mid_buf = 10; - static constexpr int num_3d_vector_mid_buf = 5; + static constexpr int num_3d_vector_mid_buf = 6; //<-- for vvdp variable static constexpr int num_3d_scalar_int_buf = 6; static constexpr int num_3d_vector_int_buf = 3; @@ -76,6 +76,9 @@ struct CaarFunctorImpl { ExecViewUnmanaged phi_tens; }; + ExecViewUnmanaged vvdp; + //ExecViewUnmanaged vv_tens; + using deriv_type = ReferenceElement::deriv_type; RKStageData m_data; @@ -106,6 +109,10 @@ struct CaarFunctorImpl { struct TagPreExchange {}; struct TagPostExchange {}; +#ifdef TESTER_NOMPI + struct TagPreExchangeTest {}; +#endif + // Policies #ifndef NDEBUG template @@ -117,6 +124,10 @@ struct CaarFunctorImpl { TeamPolicyType m_policy_pre; +#ifdef TESTER_NOMPI + TeamPolicyType m_policy_pre_test; +#endif + Kokkos::RangePolicy m_policy_post; TeamUtils m_tu; @@ -138,6 +149,9 @@ struct CaarFunctorImpl { , m_deriv(ref_FE.get_deriv()) , m_sphere_ops(sphere_ops) , m_policy_pre (Homme::get_default_team_policy(m_num_elems)) +#ifdef TESTER_NOMPI + , m_policy_pre_test (Homme::get_default_team_policy(m_num_elems)) +#endif , m_policy_post (0,m_num_elems*NP*NP) , m_tu(m_policy_pre) { @@ -155,6 +169,9 @@ struct CaarFunctorImpl { , m_theta_advection_form(params.theta_adv_form) , m_pgrad_correction(params.pgrad_correction) , m_policy_pre (Homme::get_default_team_policy(m_num_elems)) +#ifdef TESTER_NOMPI + , m_policy_pre_test (Homme::get_default_team_policy(m_num_elems)) +#endif , m_policy_post (0,num_elems*NP*NP) , m_tu(m_policy_pre) {} @@ -256,6 +273,10 @@ struct CaarFunctorImpl { m_buffers.vdp = decltype(m_buffers.vdp )(mem,nslots); mem += m_buffers.vdp.size(); + + vvdp = decltype(vvdp )(mem,nslots); + mem += vvdp.size(); + m_buffers.v_tens = decltype(m_buffers.v_tens )(mem,nslots); mem += m_buffers.v_tens.size(); @@ -349,6 +370,10 @@ struct CaarFunctorImpl { int nerr; Kokkos::parallel_reduce("caar loop pre-boundary exchange", m_policy_pre, *this, nerr); Kokkos::fence(); +#ifdef TESTER_NOMPI + Kokkos::parallel_for("caar loop pre-boundary test", m_policy_pre_test, *this); + Kokkos::fence(); +#endif GPTLstop("caar compute"); #ifndef TESTER_NOMPI @@ -373,13 +398,43 @@ struct CaarFunctorImpl { profiling_pause(); } +#ifdef TESTER_NOMPI + KOKKOS_INLINE_FUNCTION + void operator()(const TagPreExchangeTest&, const TeamMember& team) const { + KernelVariables kv(team, m_tu); + test_dp_tendency(kv); + } +#endif + + +#ifndef TESTER_NOMPI +#define K1 +#define K2 +#define K2a +#define K2b +#define K3 +#define K3b +#define K4 +#define K5 +#define K5a +#define K6 +#define K7 + +#else + #define K1 #undef K2 +#undef K2a +#undef K2b #undef K3 +#undef K3b #undef K4 #undef K5 +#undef K5a #undef K6 #undef K7 +#endif + KOKKOS_INLINE_FUNCTION void operator()(const TagPreExchange&, const TeamMember &team, int& nerr) const { @@ -401,7 +456,7 @@ struct CaarFunctorImpl { if ( ! ok) nerr = 1; #endif -#if 0 +#ifdef K2a if (m_rsplit==0 || !m_theta_hydrostatic_mode) { // ============ EPOCH 2.1 =========== // kv.team_barrier(); @@ -409,7 +464,7 @@ struct CaarFunctorImpl { } #endif -#if 0 +#ifdef K2b if (m_rsplit==0) { // ============= EPOCH 2.2 ============ // kv.team_barrier(); @@ -423,7 +478,7 @@ struct CaarFunctorImpl { compute_accumulated_quantities(kv); #endif -#if 0 +#ifdef K3b // Compute update quantities if (!m_theta_hydrostatic_mode) { compute_w_and_phi_tens (kv); @@ -441,7 +496,7 @@ struct CaarFunctorImpl { compute_v_tens (kv); #endif -#if 0 +#ifdef K5a // Update states if (!m_theta_hydrostatic_mode) { compute_w_and_phi_np1(kv); @@ -532,25 +587,122 @@ struct CaarFunctorImpl { const int igp = idx / NP; const int jgp = idx % NP; +//ORIGINAL = subviews + call to div +//do not use vvdp in the !ORIGINAL version +//because it makes caar_ut fail. udp field is probbaly used in other functors, +//reverting to vvdp array will be easy if needed in c1_ut tests. + +#define ORIGINAL +//#undef ORIGINAL + auto u = Homme::subview(m_state.m_v,kv.ie,m_data.n0,0,igp,jgp); auto v = Homme::subview(m_state.m_v,kv.ie,m_data.n0,1,igp,jgp); auto dp3d = Homme::subview(m_state.m_dp3d,kv.ie,m_data.n0,igp,jgp); auto udp = Homme::subview(m_buffers.vdp,kv.team_idx,0,igp,jgp); auto vdp = Homme::subview(m_buffers.vdp,kv.team_idx,1,igp,jgp); + Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV), [&] (const int& ilev) { udp(ilev) = u(ilev)*dp3d(ilev); vdp(ilev) = v(ilev)*dp3d(ilev); + + //version without subviews + //m_buffers.vdp(kv.team_idx,0,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* + // m_state.m_v(kv.ie,m_data.n0,0,igp,jgp,ilev); + //m_buffers.vdp(kv.team_idx,1,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* + // m_state.m_v(kv.ie,m_data.n0,1,igp,jgp,ilev); + + //version with vvdp instead of udp + //vvdp(kv.team_idx,0,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* + // m_state.m_v(kv.ie,m_data.n0,0,igp,jgp,ilev); + //vvdp(kv.team_idx,1,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* + // m_state.m_v(kv.ie,m_data.n0,1,igp,jgp,ilev); }); }); kv.team_barrier(); // Compute div(vdp) +#ifdef ORIGINAL m_sphere_ops.divergence_sphere(kv, Homme::subview(m_buffers.vdp, kv.team_idx), Homme::subview(m_buffers.div_vdp, kv.team_idx)); +#else + + const Real aa = 1.0, bb=0.0; + + //example of calling _cm + //m_sphere_ops.divergence_sphere_cm(kv, + // Homme::subview(vvdp, kv.team_idx), + // Homme::subview(m_buffers.div_vdp, kv.team_idx), + // aa, bb, NUM_LEV); + +//inlined version of divergence_sphere_cm + const auto& D_inv = Homme::subview(m_sphere_ops.m_dinv, kv.ie); + const auto& metdet = Homme::subview(m_sphere_ops.m_metdet, kv.ie); + ExecViewUnmanaged gv_buf( + Homme::subview(m_sphere_ops.vector_buf_ml,kv.team_idx, 0).data()); + constexpr int np_squared = NP * NP; + Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, np_squared), + [&](const int loop_idx) { + const int igp = loop_idx / NP; + const int jgp = loop_idx % NP; + Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV), [&] (const int& ilev) { + //const auto& v0 = vvdp(kv.team_idx,0, igp, jgp, ilev); + //const auto& v1 = vvdp(kv.team_idx,1, igp, jgp, ilev); + + const auto& v0 = m_buffers.vdp(kv.team_idx,0, igp, jgp, ilev); + const auto& v1 = m_buffers.vdp(kv.team_idx,1, igp, jgp, ilev); + + gv_buf(0,igp,jgp,ilev) = (D_inv(0,0,igp,jgp) * v0 + D_inv(1,0,igp,jgp) * v1) * metdet(igp,jgp); + gv_buf(1,igp,jgp,ilev) = (D_inv(0,1,igp,jgp) * v0 + D_inv(1,1,igp,jgp) * v1) * metdet(igp,jgp); + }); + }); + kv.team_barrier(); + // j, l, i -> i, j, k + constexpr int div_iters = NP * NP; + Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, div_iters), + [&](const int loop_idx) { + const int igp = loop_idx / NP; + const int jgp = loop_idx % NP; + Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV), [&] (const int& ilev) { + Scalar dudx, dvdy; + for (int kgp = 0; kgp < NP; ++kgp) { + dudx += m_sphere_ops.dvv(jgp, kgp) * gv_buf(0, igp, kgp, ilev); + dvdy += m_sphere_ops.dvv(igp, kgp) * gv_buf(1, kgp, jgp, ilev); + } + combine((dudx + dvdy) * (1.0 / metdet(igp, jgp) * m_sphere_ops.m_scale_factor_inv), + m_buffers.div_vdp(kv.team_idx,igp, jgp, ilev), aa, bb); + }); + }); + kv.team_barrier(); + +#endif } + +#ifdef TESTER_NOMPI +// a kernel only for perf c1 test, to put div(vdp) into dp tendency +// to print it on host for verification + KOKKOS_INLINE_FUNCTION + void test_dp_tendency(KernelVariables &kv) const { + // Compute vdp + Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, NP * NP), + [&](const int idx) { + const int igp = idx / NP; + const int jgp = idx % NP; + + auto div_vdp = Homme::subview(m_buffers.div_vdp,kv.team_idx,igp,jgp); + auto dp_np1 = Homme::subview(m_state.m_dp3d,kv.ie,m_data.np1,igp,jgp); + + Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team,NUM_LEV), + [&](const int ilev) { + dp_np1(ilev) += div_vdp(ilev); + }); + }); + } +#endif + + KOKKOS_INLINE_FUNCTION bool compute_scan_quantities (KernelVariables &kv) const { bool ok = true; diff --git a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp index a5cf2aa0111..44a8af7fb70 100644 --- a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp @@ -382,8 +382,12 @@ struct DirkFunctorImpl { kv.team_barrier(); if (it >= maxiter) { +#ifdef KOKKOS_ENABLE_SYCL Kokkos::printf("[DIRK] WARNING! Newton reached max iteration count," - " with deltaerr = %3.17f\n", deltaerr); +#else + printf("[DIRK] WARNING! Newton reached max iteration count," +#endif + " with deltaerr = %3.17f\n", deltaerr); nerr = 1; } diff --git a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp index 046e6f9956d..24750a570a9 100644 --- a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp @@ -118,9 +118,14 @@ void HyperviscosityFunctorImpl::init_params(const SimulationParams& params) m_eos.init(params.theta_hydrostatic_mode,m_hvcoord); #ifdef HOMMEXX_BFB_TESTING - m_process_nh_vars = true; + m_process_nh_vars = 1; #else - m_process_nh_vars = !params.theta_hydrostatic_mode; + //m_process_nh_vars = !params.theta_hydrostatic_mode; + if (params.theta_hydrostatic_mode){ + m_process_nh_vars = 0; + }else{ + m_process_nh_vars = 1; + } #endif } diff --git a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp index a55ecbb365f..993d525422f 100644 --- a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp @@ -397,7 +397,7 @@ class HyperviscosityFunctorImpl Buffers m_buffers; HybridVCoord m_hvcoord; - bool m_process_nh_vars; + int m_process_nh_vars; // Policies Kokkos::TeamPolicy m_policy_update_states; diff --git a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp index 79906948638..8513cb39d30 100644 --- a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp @@ -141,8 +141,12 @@ struct LimiterFunctor { [&](const int k,Real& result) { #ifndef HOMMEXX_BFB_TESTING if(diff_as_real(k) < 0){ +#ifdef KOKKOS_ENABLE_SYCL Kokkos::printf("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", - k+1,dp_as_real(k),dp0_as_real(k)); +#else + printf("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", +#endif + k+1,dp_as_real(k),dp0_as_real(k)); } #endif result = result<=diff_as_real(k) ? result : diff_as_real(k); @@ -202,8 +206,12 @@ struct LimiterFunctor { for (int ivec=0; ivec>>>>>>>>>>> m_process_nh_vars " << m_process_nh_vars << " \n"; + std::cout << ">>>>>>>>>>>> m_process_nh_vars_bool " << m_process_nh_vars_bool << " \n"; +if(m_process_nh_vars){ std::cout << "hey m_process_nh_vars is true \n"; -}else -{ +}else{ std::cout << "hey m_process_nh_vars is false \n"; } +if(m_process_nh_vars_bool){ + std::cout << "hey m_process_nh_vars_bool is true \n"; +}else{ + std::cout << "hey m_process_nh_vars_bool is false \n"; +} + +////////////////////////// put abort if bool assignment failed + + +//if(params.theta_hydrostatic_mode && m_process_nh_vars_bool) +//Kokkos::abort("BOOL assignment failed, (params.theta_hydrostatic_mode && m_process_nh_vars_bool) == TRUE.\n"); - if (m_process_nh_vars > 0) { + + + + + if (m_process_nh_vars) { std::cout << "INSIDE w phi assignment m_process_nh_vars is true \n"; @@ -116,8 +156,8 @@ if(m_process_nh_vars){ std::cout << "IN REQUESTED hey m_process_nh_vars is false \n"; } - //if (!m_process_nh_vars) { - if (m_process_nh_vars==0) { + if (!m_process_nh_vars) { + //if (m_process_nh_vars==0) { return 0; } @@ -137,9 +177,7 @@ if(m_process_nh_vars){ std::cout << "IN BUFFERS hey m_process_nh_vars is false \n"; } - - //if (!m_process_nh_vars) { - if (m_process_nh_vars==0) { + if (!m_process_nh_vars) { std::cout << "hey we should be returning from init_buffers \n"; return; @@ -156,19 +194,19 @@ if(m_process_nh_vars){ KOKKOS_INLINE_FUNCTION int num_states_remap() const { //return (m_process_nh_vars ? 5 : 3); - return ( (m_process_nh_vars>0) ? 5 : 3); + return ( (m_process_nh_vars) ? 5 : 3); } KOKKOS_INLINE_FUNCTION int num_states_preprocess() const { //return (m_process_nh_vars ? 2 : 0); - return ( (m_process_nh_vars>0) ? 2 : 0); + return ( (m_process_nh_vars) ? 2 : 0); } KOKKOS_INLINE_FUNCTION int num_states_postprocess() const { //return (m_process_nh_vars ? 2 : 0); - return ((m_process_nh_vars>0) ? 2 : 0); + return ((m_process_nh_vars) ? 2 : 0); } KOKKOS_INLINE_FUNCTION diff --git a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp index ec4e2cbe632..f0f59205bde 100644 --- a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp @@ -49,7 +49,15 @@ void init_simulation_params_c (const int& remap_alg, const int& limiter_option, const double& scale_factor, const double& laplacian_rigid_factor, const int& nsplit, const bool& pgrad_correction, const double& dp3d_thresh, const double& vtheta_thresh, const int& internal_diagnostics_level) { - // Check that the simulation options are supported. This helps us in the future, since we + +if(theta_hydrostatic_mode){ + std::cout << " HEEEEEEEEEEEtheta_hydrostatic_mode =TRUE \n"; +}else +{ + std::cout << " HEEEEEEEEEEEtheta_hydrostatic_mode =FALSE \n"; +} + + // Check that the simulation options are supported. This helps us in the future, since we // are currently 'assuming' some option have/not have certain values. As we support for more // options in the C++ build, we will remove some checks Errors::check_option("init_simulation_params_c","vert_remap_q_alg",remap_alg,{1,3,10}); @@ -115,7 +123,13 @@ void init_simulation_params_c (const int& remap_alg, const int& limiter_option, params.moisture = (moisture ? MoistDry::MOIST : MoistDry::DRY); params.use_cpstar = use_cpstar; params.transport_alg = transport_alg; - params.theta_hydrostatic_mode = theta_hydrostatic_mode; + +if(theta_hydrostatic_mode){ + params.theta_hydrostatic_mode = true; +}else{ + params.theta_hydrostatic_mode = false; +} + //params.theta_hydrostatic_mode = theta_hydrostatic_mode; params.dcmip16_mu = dcmip16_mu; params.nsplit = nsplit; params.scale_factor = scale_factor; From 6bca905574b241eee51a01d8e9b4f478b69e4d1c Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 23 Feb 2024 03:02:32 +0000 Subject: [PATCH 022/529] partial fix, adds escaped quotation marks --- components/eamxx/src/physics/rrtmgp/CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt index b5403587ca7..8fbdd1435a8 100644 --- a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt +++ b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt @@ -28,6 +28,12 @@ else () endif() ####### SYCL here + if (SYCL_BUILD) + set(YAKL_ARCH "SYCL") + set(YAKL_SYCL_FLAGS "-DYAKL_ARCH_SYCL -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") + string (REPLACE " " ";" YAKL_SYCL_FLAGS_LIST ${YAKL_SYCL_FLAGS}) + endif() + set (YAKL_SOURCE_DIR ${SCREAM_BASE_DIR}/../../externals/YAKL) From 9f954b82cb05cee5fe390443852df7cb7fcb50ab Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 7 Mar 2024 16:38:48 +0000 Subject: [PATCH 023/529] debug statements --- .../atm_process/atmosphere_process_group.cpp | 38 +++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp index 7985c9dc2dc..cf69e569697 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp @@ -8,6 +8,14 @@ #include + +#include "share/scream_session.hpp" +#include "mct_coupling/ScreamContext.hpp" +#include "control/atmosphere_driver.hpp" +#include +#include "physics/share/physics_constants.hpp" + + namespace scream { AtmosphereProcessGroup:: @@ -399,12 +407,42 @@ void AtmosphereProcessGroup::run_sequential (const double dt) { auto ts = timestamp(); ts += dt; + + + auto& c = scream::ScreamContext::singleton(); + auto ad = c.getNonConst(); + const auto gn = "Physics"; + //const auto gn = "Physics GLL"; + const auto& phys_grid = ad.get_grids_manager()->get_grid(gn); + //auto area = phys_grid->get_geometry_data("area").get_view(); + const auto fm = ad.get_field_mgr(gn); + const int ncols = fm->get_grid()->get_num_local_dofs(); + const int nlevs = fm->get_grid()->get_num_vertical_levels(); + + //fm->get_field("T_mid").sync_to_host(); + auto ff = fm->get_field("T_mid").get_view(); + +#if 0 + //const auto vv = ff(1,1); + for (int ii = 0; ii < ncols; ii++) + for (int jj = 0; jj < nlevs; jj++){ + const auto vv = ff(ii,jj); +m_atm_logger->info("OG T field ("+std::to_string(ii)+","+std::to_string(jj)+") = "+std::to_string(vv)); +std::cout << "OG T field (" <name() << " dt="<set_update_time_stamps(do_update); // Run the process atm_proc->run(dt); From f61ce743938684035ccf7c9ae60afc07c0020013 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 7 Mar 2024 16:39:45 +0000 Subject: [PATCH 024/529] -g flags --- cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake index 9d08ca6c630..857f194bf72 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake @@ -4,9 +4,9 @@ if (compile_threaded) string(APPEND CMAKE_CXX_FLAGS " -qopenmp") string(APPEND CMAKE_EXE_LINKER_FLAGS " -qopenmp") endif() -string(APPEND CMAKE_C_FLAGS_RELEASE " -O2") -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2") -string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2") +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -g") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -g") +string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2 -g") string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") From 263da75856f61b96052a6ebe585c6cb93c79a5c4 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 7 Mar 2024 16:40:03 +0000 Subject: [PATCH 025/529] debug printf --- components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp index 47d543ded02..3e8cc6642ec 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp @@ -256,6 +256,8 @@ class P3Microphysics : public AtmosphereProcess // Unlike above, these fluxes do not need to be accumulated // since the conservation checks are run after each // Microphysics step. + + Kokkos::printf("OG -- before compute_mass_and_energy_fluxes"); if (compute_mass_and_energy_fluxes) { vapor_flux(icol) = 0.0; water_flux(icol) = precip_liq_surf_flux(icol)+precip_ice_surf_flux(icol); From 706bc26662f866722015898f13f8c2661c82d4ba Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 17 Mar 2024 22:40:21 +0000 Subject: [PATCH 026/529] modify sunspot config, change yakl files --- .../oneapi-ifxgpu_sunspot-pvc.cmake | 35 +++++++------------ cime_config/machines/config_machines.xml | 14 +++++--- .../eamxx/src/physics/rrtmgp/CMakeLists.txt | 2 +- 3 files changed, 23 insertions(+), 28 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake index d62f94c40fe..2719498f760 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake @@ -1,30 +1,21 @@ -set(CXX_LINKER "CXX") +string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -fsycl-device-code-split=per_kernel -fsycl-max-parallel-link-jobs=16") +if (compile_threaded) + string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") +endif() -execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) +if (DEBUG) +#undefined reference to `__msan.... +#https://community.intel.com/t5/Intel-Fortran-Compiler/Linking-errors-when-using-memory-sanitizer-in-fortran-project/m-p/1521476 +#When you compile with -check uninit (or -check all) you also need to link with that compiler option. +# string(APPEND CMAKE_EXE_LINKER_FLAGS " -check uninit") +endif() -string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0} -Wl,-rpath -Wl,$ENV{NETCDF_PATH}/lib -lmkl_intel_lp64 -lmkl_sequential -lmkl_core") +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") +string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") -execute_process(COMMAND $ENV{NETCDF_PATH}/bin/nc-config --libs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE) +set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") -string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0}") -string(APPEND SLIBS " -fiopenmp -fopenmp-targets=spir64") - -set(NETCDF_PATH "$ENV{NETCDF_PATH}") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") - -set(USE_SYCL "TRUE") - -string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_GEN=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") - -string(APPEND SYCL_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -fsycl -mlong-double-64 -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") - -#string(APPEND SYCL_FLAGS " -\-intel -fsycl") -string(APPEND CXX_LDFLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -fsycl -lsycl -mlong-double-64 -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64 -Xsycl-target-backend \"-device 12.60.7\"") - -SET(CMAKE_CXX_COMPILER "mpicxx" CACHE STRING "") -SET(CMAKE_C_COMPILER "mpicc" CACHE STRING "") -SET(CMAKE_FORTRAN_COMPILER "mpifort" CACHE STRING "") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 2a1c0da8f2d..c312835a09e 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3182,8 +3182,9 @@ /soft/restricted/CNDA/updates/modulefiles - oneapi/eng-compiler/2023.10.15.002 - mpich/52.2-256/icc-all-pmix-gpu + + oneapi/release/2023.12.15.001 + mpich/52.2-1024/icc-all-pmix-gpu @@ -3199,8 +3200,10 @@ $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld - /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf - /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf + list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 1 @@ -3297,7 +3300,8 @@ $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld - /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf diff --git a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt index 8fbdd1435a8..a385a1783bc 100644 --- a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt +++ b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt @@ -30,7 +30,7 @@ else () ####### SYCL here if (SYCL_BUILD) set(YAKL_ARCH "SYCL") - set(YAKL_SYCL_FLAGS "-DYAKL_ARCH_SYCL -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") + set(YAKL_SYCL_FLAGS "-DYAKL_ARCH_SYCL -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64") string (REPLACE " " ";" YAKL_SYCL_FLAGS_LIST ${YAKL_SYCL_FLAGS}) endif() From 3aa29f54bcf4175ff116f956bc61564f34d9cc73 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Mon, 1 Apr 2024 20:18:11 -0700 Subject: [PATCH 027/529] Do not update FCT masks between RK stages Do not update FCT masks between RK stages. The masking for FCT is now calculated in the first RK stage and not updated again in the time step. --- .../src/mode_forward/mpas_li_advection.F | 10 +------ .../mpas_li_time_integration_fe_rk.F | 29 +++++++++++++++++-- 2 files changed, 28 insertions(+), 11 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F index 56b018cdd39..f06c8d1a67e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F @@ -717,13 +717,7 @@ subroutine li_advection_thickness_tracers(& ! Deallocate arrays for fct if ( (trim(config_thickness_advection) .eq. 'fct') .or. & (trim(config_tracer_advection) .eq. 'fct') ) then - deallocate( nAdvCellsForEdge, & - advCellsForEdge, & - advCoefs, & - advCoefs3rd, & - advMaskHighOrder, & - advMask2ndOrder, & - tend) + deallocate(tend) endif ! clean up @@ -1093,7 +1087,6 @@ subroutine tracer_setup(& nTracers) use li_thermal, only: li_temperature_to_enthalpy_kelvin - use li_tracer_advection_fct_shared use li_tracer_advection_fct !----------------------------------------------------------------- ! @@ -1301,7 +1294,6 @@ subroutine tracer_setup(& ! May need to increase maxTracers in the Registry. if ( (trim(config_tracer_advection) == 'fct') .or. & (trim(config_thickness_advection) == 'fct') ) then - call li_tracer_advection_fct_shared_init(geometryPool, err1) call li_tracer_advection_fct_init(err2) if (err1 /= 0 .or. err2 /= 0) then diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index 6ca13f8deb0..52e3dd22844 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -37,6 +37,7 @@ module li_time_integration_fe_rk use li_constants use li_mesh use li_mask + use li_tracer_advection_fct_shared implicit none private @@ -112,7 +113,8 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) logical, pointer :: config_calculate_damage logical, pointer :: config_finalize_damage_after_advection logical, pointer :: config_update_velocity_before_calving - character (len=StrKIND), pointer :: config_thickness_advection + character (len=StrKIND), pointer :: config_thickness_advection, & + config_tracer_advection character (len=StrKIND), pointer :: config_thermal_solver character (len=StrKIND), pointer :: config_time_integration integer, pointer :: config_rk_order, config_rk3_stages @@ -164,9 +166,10 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) call mpas_pool_get_config(liConfigs, 'config_restore_calving_front', config_restore_calving_front) call mpas_pool_get_config(liConfigs, 'config_restore_calving_front_prevent_retreat', config_restore_calving_front_prevent_retreat) - call mpas_pool_get_config(liConfigs, 'config_calculate_damage',config_calculate_damage) + call mpas_pool_get_config(liConfigs, 'config_calculate_damage', config_calculate_damage) call mpas_pool_get_config(liConfigs, 'config_finalize_damage_after_advection', config_finalize_damage_after_advection) call mpas_pool_get_config(liConfigs, 'config_thickness_advection', config_thickness_advection) + call mpas_pool_get_config(liConfigs, 'config_tracer_advection', config_tracer_advection) call mpas_pool_get_config(liConfigs, 'config_thermal_solver', config_thermal_solver) call mpas_pool_get_config(liConfigs, 'config_rk_order', config_rk_order) call mpas_pool_get_config(liConfigs, 'config_rk3_stages', config_rk3_stages) @@ -279,6 +282,17 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) enddo deltatFull = deltat ! Save deltat in order to reset it at end of RK loop + if ( (trim(config_tracer_advection) == 'fct') .or. & + (trim(config_thickness_advection) == 'fct') ) then + call li_tracer_advection_fct_shared_init(geometryPool, err_tmp) + if (err_tmp /= 0) then + err = 1 + call mpas_log_write( & + 'Error encountered during fct tracer advection shared init', & + MPAS_LOG_ERR, masterOnly=.true.) + endif + endif + ! Set RK weights based on desired time integration method. Note ! that rkSubstepWeights are used to update at each sub-step, and ! are thus offset from the typical writing of the coefficients @@ -514,6 +528,17 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) fluxAcrossGroundingLine(:) = fluxAcrossGroundingLineAccum(:) fluxAcrossGroundingLineOnCells(:) = fluxAcrossGroundingLineOnCellsAccum(:) + ! Deallocate arrays for fct + if ( (trim(config_thickness_advection) .eq. 'fct') .or. & + (trim(config_tracer_advection) .eq. 'fct') ) then + deallocate( nAdvCellsForEdge, & + advCellsForEdge, & + advCoefs, & + advCoefs3rd, & + advMaskHighOrder, & + advMask2ndOrder) + endif + ! Reset time step to full length after RK loop deltat = deltatFull From cc10432d118cfa09fe3f9d53fe0a89acfdbf0532 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 22 Apr 2024 21:51:23 +0000 Subject: [PATCH 028/529] updates for sunspot sw stack --- .../machines/cmake_macros/oneapi-ifxgpu.cmake | 6 +-- cime_config/machines/config_machines.xml | 26 ++++++------- .../cmake/machine-files/sunspot-pvc.cmake | 38 ++++++++++++++----- 3 files changed, 42 insertions(+), 28 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake index 857f194bf72..0ee9c4706ed 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake @@ -5,14 +5,14 @@ if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -qopenmp") endif() string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -g") -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -g") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -g -fpscomp logicals") string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2 -g") -string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") +string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -fpscomp logicals -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_C_FLAGS " -fp-model precise -std=gnu99") string(APPEND CMAKE_CXX_FLAGS " -fp-model precise") -string(APPEND CMAKE_Fortran_FLAGS " -traceback -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise") +string(APPEND CMAKE_Fortran_FLAGS " -fpscomp logicals -traceback -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise") string(APPEND CPPDEFS " -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL -DHAVE_SLASHPROC -DHIDE_MPI") string(APPEND CMAKE_Fortran_FORMAT_FIXED_FLAG " -fixed -132") string(APPEND CMAKE_Fortran_FORMAT_FREE_FLAG " -free") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index c312835a09e..d0a6caa5409 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3169,31 +3169,27 @@ - /soft/packaging/lmod/lmod/init/sh - /soft/packaging/lmod/lmod/init/csh - /soft/packaging/lmod/lmod/init/env_modules_python.py + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + /usr/share/lmod/lmod/init/env_modules_python.py module module - /soft/packaging/lmod/lmod/libexec/lmod python + /usr/share/lmod/lmod/libexec/lmod python - - /soft/modulefiles - spack cmake/3.24.2 python/3.9.13-gcc-11.2.0-76jlbxs - /soft/restricted/CNDA/updates/modulefiles + + + spack-pe-gcc/0.6.1-23.275.2 cmake python/3.10.10 + - - oneapi/release/2023.12.15.001 - mpich/52.2-1024/icc-all-pmix-gpu - - - + oneapi/eng-compiler/2023.12.15.002 + mpich/icc-all-pmix-gpu/52.2 cray-pals - append-deps/default + libfabric/1.15.2.0 diff --git a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake index 874b73e34eb..d7e2d262b01 100644 --- a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake +++ b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake @@ -1,3 +1,13 @@ +cmake_minimum_required(VERSION 3.18) + +#cmake_policy(SET CMP0057 NEW) +#cmake_policy(SET CMP0074 NEW) +#cmake_policy(SET CMP0079 NEW) # Remove once scorpio in a better state + +#set(CMAKE_CXX_STANDARD 17) + +#project(aaa C CXX Fortran) + include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) common_setup() @@ -8,25 +18,33 @@ include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) #AB flags from ekat # -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel -SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") -SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"") +SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda" CACHE STRING "") +SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"" CACHE STRING "") + + +message("HEY SYCL_COMPILE_FLAGS is ${SYCL_COMPILE_FLAGS}") +message("HEY SYCL_LINK_FLAGS is ${SYCL_LINK_FLAGS}") #SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") -set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) -set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) -set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) -set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG -std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda" CACHE STRING "") +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "") +set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "") +set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG -fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\" -fortlib" CACHE STRING "") #set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) -set(NETCDF_PATH "$ENV{NETCDF_PATH}") -set(NETCDF_C_PATH "$ENV{NETCDF_PATH}") +set(NETCDF_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_DIR "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") #this one is for rrtmgp set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}" CACHE STRING "") + + +set(PNETCDF_DIR "$ENV{PNETCDF_PATH}" CACHE STRING "") From e3b257cb94fda46be4179826e69b1e19011fdb60 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Tue, 10 Jan 2023 16:29:22 -0700 Subject: [PATCH 029/529] Add an empty template for the new routine --- .../src/mode_forward/mpas_li_ocean_extrap.F | 66 +++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F new file mode 100644 index 00000000000..5ac60cb5a76 --- /dev/null +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -0,0 +1,66 @@ +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! + + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! +! li_ocean_extrap +! +!> \brief MPAS land ice ocean thermal forcing extraplation scheme +!> \author Holly Kyeore Han +!> \date January 2023 +!> \details +!> This module contains the extrapolation scheme of +!> ocean thermal forcing +! +!----------------------------------------------------------------------- + +module li_ocean_extrap + + use mpas_derived_types + use mpas_pool_routines + use mpas_dmpar + use mpas_log + + use li_setup + use li_mask + use li_constants + + implicit none + private + + !-------------------------------------------------------------------- + ! + ! Public parameters + ! + !-------------------------------------------------------------------- + + !-------------------------------------------------------------------- + ! + ! Public member functions + ! + !-------------------------------------------------------------------- + + !public :: + + !-------------------------------------------------------------------- + ! + ! Private module variables + ! + !-------------------------------------------------------------------- + + +!*********************************************************************** + contains +!*********************************************************************** + + + + +end module li_ocean_extrap + + From 293c6e38d9897b126e793b5a7a450ebf047392ad Mon Sep 17 00:00:00 2001 From: hollyhan Date: Tue, 10 Jan 2023 16:50:48 -0700 Subject: [PATCH 030/529] Call the new routine from a higher level driver --- .../src/mode_forward/mpas_li_time_integration_fe_rk.F | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index 6ca13f8deb0..1cef0f5c469 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -85,6 +85,7 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) use li_bedtopo use li_mask use li_advection, only: li_grounded_to_floating + use li_ocean_extrap !----------------------------------------------------------------- ! input variables @@ -239,6 +240,12 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) call mpas_timer_stop("advancing clock") !TODO: Determine whether grounded melting should in fact be called first +! === Ocean forcing extrapolation into ice-shelf cavities =========== + call mpas_timer_start("ocean forcing extrapolation") + call li_ocean_extrap_solve(domain, err_tmp) + err = ior(err, err_tmp) + call mpas_timer_stop("ocean forcing extrapolation") + ! === Face melting for grounded ice =========== call mpas_timer_start("face melting for grounded ice") call li_face_melt_grounded_ice(domain, err_tmp) From ee116ae4fffca91caf76997dfd51447df337b47b Mon Sep 17 00:00:00 2001 From: hollyhan Date: Tue, 10 Jan 2023 17:09:05 -0700 Subject: [PATCH 031/529] Edit Makefile --- .../src/mode_forward/.DS_Store | Bin 0 -> 6148 bytes .../src/mode_forward/Makefile | 8 ++++++-- 2 files changed, 6 insertions(+), 2 deletions(-) create mode 100644 components/mpas-albany-landice/src/mode_forward/.DS_Store diff --git a/components/mpas-albany-landice/src/mode_forward/.DS_Store b/components/mpas-albany-landice/src/mode_forward/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..5008ddfcf53c02e82d7eee2e57c38e5672ef89f6 GIT binary patch literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 Date: Tue, 17 Jan 2023 16:30:17 -0800 Subject: [PATCH 032/529] Add a config option to enable/disable the scheme --- .../mpas-albany-landice/src/Registry.xml | 4 + .../src/mode_forward/mpas_li_ocean_extrap.F | 81 ++++++++++++++----- 2 files changed, 66 insertions(+), 19 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 3aa73768f04..37e7ae96eab 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -453,6 +453,10 @@ descrption="Apply a uniform linear submarine melt rate at all grounded marine margins. config_mass_bal_grounded must be set to 'uniform'." possible_values="any non-negative value" /> + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 5ac60cb5a76..f14a2c3b1d1 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -1,3 +1,4 @@ +! Copyright (c) 2013-2018, Los Alamos National Security, LLC (LANS) ! and the University Corporation for Atmospheric Research (UCAR). ! ! Unless noted otherwise source code is licensed under the BSD license. @@ -5,17 +6,17 @@ ! distributed with this code, or at http://mpas-dev.github.com/license.html ! - !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ! ! li_ocean_extrap ! -!> \brief MPAS land ice ocean thermal forcing extraplation scheme -!> \author Holly Kyeore Han -!> \date January 2023 +!> \MPAS land-ice ocean-data extrapolation driver +!> \author Holly Han +!> \date January 2022 !> \details -!> This module contains the extrapolation scheme of -!> ocean thermal forcing +!> This module contains the routines for extrapolating +!> ocean data (e.g., temperature, salinity, thermal forcing) +!> into ice draft ! !----------------------------------------------------------------------- @@ -25,42 +26,84 @@ module li_ocean_extrap use mpas_pool_routines use mpas_dmpar use mpas_log - - use li_setup use li_mask - use li_constants + use li_setup implicit none private !-------------------------------------------------------------------- - ! ! Public parameters - ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- - ! ! Public member functions - ! !-------------------------------------------------------------------- - !public :: + public :: li_ocean_extrap_solve !-------------------------------------------------------------------- - ! ! Private module variables - ! !-------------------------------------------------------------------- - !*********************************************************************** - contains + +contains + !*********************************************************************** +! +! routine li_ocean_extrap_solve +! +!> \brief Initializes ocean extrapolation scheme +!> \author Holly Han +!> \date 12 Jan 2023 +!> \details +!> This routine performs horizontal and vertical extrapolation +!> of ocean data (e.g., temperature, salinity, thermal forcing) +! +!----------------------------------------------------------------------- + subroutine li_ocean_extrap_solve(domain, err) + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- -end module li_ocean_extrap + type (domain_type), intent(inout) :: domain !< Input/Output: domain object + + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + + integer, intent(out) :: err !< Output: error flag + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + + logical, pointer :: config_ocean_data_extrapolation + + ! No init is needed. + err = 0 + call mpas_pool_get_config(liConfigs, 'config_ocean_data_extrapolation', config_ocean_data_extrapolation) + + if ( config_ocean_data_extrapolation ) then + ! call the extrapolation scheme + call mpas_log_write('ocean data will be extrapolated into the MALI ice draft') + else + ! do nothing + call mpas_log_write('ocean data will NOT be extrapolated into the MALI ice draft') + endif + !-------------------------------------------------------------------- + + end subroutine li_ocean_extrap_solve + + +end module li_ocean_extrap +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| \ No newline at end of file From dcc06bc841142c2cefae9df3861830e33127c22a Mon Sep 17 00:00:00 2001 From: hollyhan Date: Wed, 18 Jan 2023 06:00:17 -0800 Subject: [PATCH 033/529] pseudocode --- .../src/mode_forward/mpas_li_ocean_extrap.F | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index f14a2c3b1d1..7eb51f62eb2 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -95,6 +95,21 @@ subroutine li_ocean_extrap_solve(domain, err) if ( config_ocean_data_extrapolation ) then ! call the extrapolation scheme call mpas_log_write('ocean data will be extrapolated into the MALI ice draft') + + ! process temperature field + ! get geometry pool of data e.g., 'ismip6shelfMelt_3dThermalForcing' + ! get a valid mask (preprocessed valid ocean data mask) + ! get an updated seedMask + ! call horizontal extrapolation + ! call vertical extrapolation + ! switch between horizontal and vertical extrap ?? + ! process salinity field + ! get a valid mask (proprocessed valid ocean data mask) + ! get an updated seedMask + ! call horizontal extrapolation + ! call vertical extrapolation + + ! calculate thermal forcing else ! do nothing call mpas_log_write('ocean data will NOT be extrapolated into the MALI ice draft') @@ -103,7 +118,6 @@ subroutine li_ocean_extrap_solve(domain, err) end subroutine li_ocean_extrap_solve - end module li_ocean_extrap !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| \ No newline at end of file From d21f927b1d9d1ec2f28da5d345e7d1cabc11e607 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Mon, 23 Jan 2023 15:01:00 -0700 Subject: [PATCH 034/529] Add mask variables to Registry --- .../mpas-albany-landice/src/Registry.xml | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 37e7ae96eab..00a1c9c9c07 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -685,6 +685,7 @@ + @@ -1647,6 +1648,23 @@ is the value of that variable from the *previous* time level! /> + + + + + + + + + @@ -1731,7 +1749,6 @@ is the value of that variable from the *previous* time level! description="grow mask for flood fill" persistence="scratch" /> - From 1d0d9e049e126f4a33d54fbf0d24de33d60c106c Mon Sep 17 00:00:00 2001 From: hollyhan Date: Fri, 3 Mar 2023 15:12:28 -0700 Subject: [PATCH 035/529] Define mask variables --- .../mpas-albany-landice/src/Registry.xml | 46 ++++-- .../src/mode_forward/mpas_li_ocean_extrap.F | 143 +++++++++++++++--- 2 files changed, 155 insertions(+), 34 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 00a1c9c9c07..76801cfdf76 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -457,7 +457,10 @@ description="If true, extrapolate ocean data (temperature, salinity, thermal forcing) from external source into underneath the ice draft." possible_values=".true. or .false." /> - + + - + @@ -798,6 +801,7 @@ + + @@ -1650,21 +1658,27 @@ is the value of that variable from the *previous* time level! - - - - - - + + + + + + + - + /> + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 7eb51f62eb2..1cf6cd6e2ba 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -72,20 +72,35 @@ subroutine li_ocean_extrap_solve(domain, err) !----------------------------------------------------------------- ! input/output variables !----------------------------------------------------------------- - type (domain_type), intent(inout) :: domain !< Input/Output: domain object !----------------------------------------------------------------- ! output variables !----------------------------------------------------------------- - integer, intent(out) :: err !< Output: error flag !----------------------------------------------------------------- ! local variables !----------------------------------------------------------------- - logical, pointer :: config_ocean_data_extrapolation + real, pointer :: config_sea_level + type (block_type), pointer :: block + type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool + real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld, TFoceanNew + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_zBndsOcean + integer, dimension(:), pointer :: origOceanMaskHoriz + type (field1DInteger), pointer :: origOceanMaskHorizField + !integer, dimension(:,:) pointer :: validOceanMaskField, availOceanMaskField + integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine + real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography + real (kind=RKIND) :: layerTop + integer, dimension(:), allocatable :: seedOceanMaskHorizOld,seedOceanMaskHoriz, growOceanMaskHoriz + integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra + integer, dimension(:), pointer :: cellMask, nEdgesOnCell + integer, dimension(:,:), pointer :: cellsOnCell + integer :: iCell, jCell, iLayer, iNeighbor, iter + ! No init is needed. err = 0 @@ -95,21 +110,113 @@ subroutine li_ocean_extrap_solve(domain, err) if ( config_ocean_data_extrapolation ) then ! call the extrapolation scheme call mpas_log_write('ocean data will be extrapolated into the MALI ice draft') - - ! process temperature field - ! get geometry pool of data e.g., 'ismip6shelfMelt_3dThermalForcing' - ! get a valid mask (preprocessed valid ocean data mask) - ! get an updated seedMask - ! call horizontal extrapolation - ! call vertical extrapolation - ! switch between horizontal and vertical extrap ?? - ! process salinity field - ! get a valid mask (proprocessed valid ocean data mask) - ! get an updated seedMask - ! call horizontal extrapolation - ! call vertical extrapolation - - ! calculate thermal forcing + + ! initialize the ocean data and mask fields + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) + call mpas_pool_get_array(meshPool, 'nCells', nCells) + call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(geometryPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(geometryPool, 'thickness', thickness) + call mpas_pool_get_array(geometryPool, 'bedTropography', bedTopography) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', TFoceanOld) + call mpas_pool_get_array(extrapOceanDataPool, 'origOceanMaskHoriz', origOceanMaskHoriz) + call mpas_pool_get_araay(extrapOceanDataPool, 'validOceanMask', validOceanMask) + call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) + + validOceanMask(:,:) = 0 + call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) + availOceanMask(:,:) = 0 + + ! -------- Switch between horizontal and vertical extrapolation + ! update availOceanMask + ! create a 2D mask based on the open ocean + floating ice + grounded ice mask and n-extra cells into the grounded ice + seedOceanMaskHoriz(:) = 0 + seedOceanMaskHorizOld(:) = 0 + growOceanMaskHoriz(:) = 0 + + ! define seedOceanMaskHoriz and growOceanMaskHoriz for horizontal floodfill + do iCell = 1, nCellsSolve + if ( .not. li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then + seedOceanMaskHoriz(iCell) = 1 + endif + if ( li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then + growOceanMaskHoriz(iCell) = 1 + endif + enddo + + ! Start horizontal floodfill + seedOceanMaskHorizOld(:) = seedOceanMaskHoriz(:) + + ! go through the loop to get nCells extra into grounded ice + do iter = 1, nCellsExtra + do iCell = 1, nCellsSolve + if ( growOceanMaskHoriz(iCell) == 1 ) then + do iNeighbor = 1, nEdgesOnCell(iCell) + jCell = cellsOnCell(iNeighbor, iCell) + if ( seedOceanMaskHorizOld(iCell) == 0 .and. seedOceanMaskHoriz(jCell) == 1 ) then + seedOceanMaskHoriz(iCell) = 1 + endif + enddo + endif + enddo + seedOceanMaskHorizOld(:) = seedOceanMaskHoriz(:) + ! Update halos + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'growOceanMaskHoriz') + call mpas_dmpar_field_halo_exch(domain, 'seedOceanMaskHoriz') + call mpas_timer_stop("halo updates") + enddo + deallocate(seedOceanMaskHorizOld) + + ! make it a 3D mask based on the topography (loop through nISMIP6OceanLayers) + call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) + call mpas_pool_get_array(extrapOceanDataPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) + + availOceanMask(:,:) = 0 + validOceanMask(:,:) = 0 + do iCell = 1, nCellsSolve + do iLayer = 1, nISMIP6OceanLayers + layerTop = ismip6shelfMelt_zBndsOcean(1, iLayer) + if ( (bedTopography(iCell) < layerTop) .and. (seedOceanMaskHoriz(iCell) == 1) ) then + availOceanMask(iLayer,iCell) = 1 + endif + if ( (bedTopography(iCell) < layerTop) .and. (origOceanMaskHoriz(iCell) == 1) ) then + validOceanMask(iLayer,iCell) = 1 + endif + enddo + enddo + + + + ! initialize validOceanMask for the current timestep + ! define validOceanMask to indicate where ocean data exists at the current timestep (original valid ocean data masked out by the current ocean bathymetry => find where ice thickness is zero and where bedrock is below the sea level) + ! initialize the ocean data field based on the valid ocean mask + ! update halo for availOceanMask, validOceanMask and ocean data + ! -------- Start iteration until validOceanMask is unchanged + ! perform horizontal extrapolation + ! perform vertical extrapolation + ! check if validOceanMask is unchanged + + !do iCell = 1, nCells + !if ( (bedTopography(iCell) < config_sea_level .and. thickness(iCell) == 0) ) then + !availOceanMask(iCell) = 1 + !validOceanMask(iCell) = TFoceanOld(iCell) + + ! define availOceanMask to indicate where the ocean data can be extrapolated onto (where ocean => ice thickness is zero and bedrock is below the sea level) + + ! call flood fill routine + + ! update the ocean data field with the updated seedMask + !TFoceanNew(:) = validOceanMaskField(:) + + !! TFoceanOld(:) = TFoceanNew(:) + ! call vertical extrapolation + ! switch between horizontal and vertical extrap ?? + else ! do nothing call mpas_log_write('ocean data will NOT be extrapolated into the MALI ice draft') From 86649425a1a7fda025f732116505dd120d670894 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Thu, 9 Mar 2023 07:57:47 -0800 Subject: [PATCH 036/529] Create initial masks in the module --- .../mpas-albany-landice/src/Registry.xml | 9 +- .../src/mode_forward/mpas_li_ocean_extrap.F | 202 ++++++++---------- 2 files changed, 94 insertions(+), 117 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 76801cfdf76..9845ae73312 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -897,6 +897,7 @@ + @@ -1379,7 +1380,7 @@ is the value of that variable from the *previous* time level! /> + @@ -1675,9 +1679,6 @@ is the value of that variable from the *previous* time level! - diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 1cf6cd6e2ba..17773c25959 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -85,21 +85,19 @@ subroutine li_ocean_extrap_solve(domain, err) logical, pointer :: config_ocean_data_extrapolation real, pointer :: config_sea_level type (block_type), pointer :: block - type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool - real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld, TFoceanNew - real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing - real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_zBndsOcean - integer, dimension(:), pointer :: origOceanMaskHoriz - type (field1DInteger), pointer :: origOceanMaskHorizField - !integer, dimension(:,:) pointer :: validOceanMaskField, availOceanMaskField - integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine - real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography - real (kind=RKIND) :: layerTop - integer, dimension(:), allocatable :: seedOceanMaskHorizOld,seedOceanMaskHoriz, growOceanMaskHoriz + type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, TFoceanOld, TFoceanNew + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_zBndsOcean + integer, dimension(:), pointer :: origOceanMaskHoriz + integer, dimension(:,:), pointer :: validOceanMaskOld, validOceanMask, availOceanMask !masks to pass to flood-fill routine + real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography + real (kind=RKIND) :: layerTop + integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz + integer, dimension(:), allocatable :: seedOceanMaskHorizOld integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra integer, dimension(:), pointer :: cellMask, nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnCell - integer :: iCell, jCell, iLayer, iNeighbor, iter + integer :: iCell, jCell, iLayer, iNeighbor, iter, newMaskCountLocal, localLoopCount, newMaskCountLocalAccum ! No init is needed. @@ -110,112 +108,90 @@ subroutine li_ocean_extrap_solve(domain, err) if ( config_ocean_data_extrapolation ) then ! call the extrapolation scheme call mpas_log_write('ocean data will be extrapolated into the MALI ice draft') - - ! initialize the ocean data and mask fields - call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) - call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) - call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) - call mpas_pool_get_array(meshPool, 'nCells', nCells) - call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) - call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) - call mpas_pool_get_array(geometryPool, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) - call mpas_pool_get_array(geometryPool, 'thickness', thickness) - call mpas_pool_get_array(geometryPool, 'bedTropography', bedTopography) - call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', TFoceanOld) - call mpas_pool_get_array(extrapOceanDataPool, 'origOceanMaskHoriz', origOceanMaskHoriz) - call mpas_pool_get_araay(extrapOceanDataPool, 'validOceanMask', validOceanMask) - call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) - - validOceanMask(:,:) = 0 - call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) - availOceanMask(:,:) = 0 - - ! -------- Switch between horizontal and vertical extrapolation - ! update availOceanMask - ! create a 2D mask based on the open ocean + floating ice + grounded ice mask and n-extra cells into the grounded ice - seedOceanMaskHoriz(:) = 0 - seedOceanMaskHorizOld(:) = 0 - growOceanMaskHoriz(:) = 0 - - ! define seedOceanMaskHoriz and growOceanMaskHoriz for horizontal floodfill + block => domain % blocklist + + ! initialize the ocean data and mask fields + call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) + call mpas_pool_get_config(liConfigs, 'config_ocean_data_extrap_ncells_extra', nCellsExtra) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(geometryPool, 'thickness', thickness) + call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) + call mpas_pool_get_array(geometryPool, 'origOceanMaskHoriz', origOceanMaskHoriz) + call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) + call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) + call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHoriz', seedOceanMaskHoriz) + call mpas_pool_get_array(extrapOceanDataPool, 'growOceanMaskHoriz', growOceanMaskHoriz) + + ! create a 2D mask based on the open ocean + floating ice + grounded ice mask and n-extra cells into the grounded ice + allocate(seedOceanMaskHorizOld(nCells+1)) + seedOceanMaskHorizOld(:) = 0 + seedOceanMaskHoriz(:) = 0 + growOceanMaskHoriz(:) = 0 + ! define seedOceanMaskHoriz and growOceanMaskHoriz for horizontal floodfill + do iCell = 1, nCellsSolve + if ( .not. li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then + seedOceanMaskHoriz(iCell) = 1 + endif + if ( li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then + growOceanMaskHoriz(iCell) = 1 + endif + enddo + + ! Start horizontal floodfill + seedOceanMaskHorizOld(:) = seedOceanMaskHoriz(:) + ! go through the loop to get nCells extra into grounded ice + do iter = 1, nCellsExtra do iCell = 1, nCellsSolve - if ( .not. li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then - seedOceanMaskHoriz(iCell) = 1 - endif - if ( li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then - growOceanMaskHoriz(iCell) = 1 + if ( growOceanMaskHoriz(iCell) == 1 ) then + do iNeighbor = 1, nEdgesOnCell(iCell) + jCell = cellsOnCell(iNeighbor, iCell) + if ( seedOceanMaskHorizOld(iCell) == 0 .and. seedOceanMaskHoriz(jCell) == 1 ) then + seedOceanMaskHoriz(iCell) = 1 + endif + enddo endif enddo - - ! Start horizontal floodfill seedOceanMaskHorizOld(:) = seedOceanMaskHoriz(:) - - ! go through the loop to get nCells extra into grounded ice - do iter = 1, nCellsExtra - do iCell = 1, nCellsSolve - if ( growOceanMaskHoriz(iCell) == 1 ) then - do iNeighbor = 1, nEdgesOnCell(iCell) - jCell = cellsOnCell(iNeighbor, iCell) - if ( seedOceanMaskHorizOld(iCell) == 0 .and. seedOceanMaskHoriz(jCell) == 1 ) then - seedOceanMaskHoriz(iCell) = 1 - endif - enddo - endif - enddo - seedOceanMaskHorizOld(:) = seedOceanMaskHoriz(:) - ! Update halos - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'growOceanMaskHoriz') - call mpas_dmpar_field_halo_exch(domain, 'seedOceanMaskHoriz') - call mpas_timer_stop("halo updates") - enddo - deallocate(seedOceanMaskHorizOld) - - ! make it a 3D mask based on the topography (loop through nISMIP6OceanLayers) - call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) - call mpas_pool_get_array(extrapOceanDataPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) - - availOceanMask(:,:) = 0 - validOceanMask(:,:) = 0 - do iCell = 1, nCellsSolve - do iLayer = 1, nISMIP6OceanLayers - layerTop = ismip6shelfMelt_zBndsOcean(1, iLayer) - if ( (bedTopography(iCell) < layerTop) .and. (seedOceanMaskHoriz(iCell) == 1) ) then - availOceanMask(iLayer,iCell) = 1 - endif - if ( (bedTopography(iCell) < layerTop) .and. (origOceanMaskHoriz(iCell) == 1) ) then - validOceanMask(iLayer,iCell) = 1 - endif - enddo + ! Update halos + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'growOceanMaskHoriz') + call mpas_dmpar_field_halo_exch(domain, 'seedOceanMaskHoriz') + call mpas_timer_stop("halo updates") + enddo + deallocate(seedOceanMaskHorizOld) + + ! make it a 3D mask based on the topography (loop through nISMIP6OceanLayers) + call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) + + availOceanMask(:,:) = 0 + validOceanMask(:,:) = 0 + do iCell = 1, nCellsSolve + do iLayer = 1, nISMIP6OceanLayers + layerTop = ismip6shelfMelt_zBndsOcean(1, iLayer) +! call mpas_log_write('==ismip6shelfMelt zBnds $r', realArgs=(/layerTop/)) + if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then + availOceanMask(iLayer,iCell) = 1 + endif + if ( (origOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then + validOceanMask(iLayer,iCell) = 1 + endif enddo + enddo - - - ! initialize validOceanMask for the current timestep - ! define validOceanMask to indicate where ocean data exists at the current timestep (original valid ocean data masked out by the current ocean bathymetry => find where ice thickness is zero and where bedrock is below the sea level) - ! initialize the ocean data field based on the valid ocean mask - ! update halo for availOceanMask, validOceanMask and ocean data - ! -------- Start iteration until validOceanMask is unchanged - ! perform horizontal extrapolation - ! perform vertical extrapolation - ! check if validOceanMask is unchanged - - !do iCell = 1, nCells - !if ( (bedTopography(iCell) < config_sea_level .and. thickness(iCell) == 0) ) then - !availOceanMask(iCell) = 1 - !validOceanMask(iCell) = TFoceanOld(iCell) - - ! define availOceanMask to indicate where the ocean data can be extrapolated onto (where ocean => ice thickness is zero and bedrock is below the sea level) - - ! call flood fill routine - - ! update the ocean data field with the updated seedMask - !TFoceanNew(:) = validOceanMaskField(:) - - !! TFoceanOld(:) = TFoceanNew(:) - ! call vertical extrapolation - ! switch between horizontal and vertical extrap ?? + ! Update halos + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'availOceanMask') + call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') + call mpas_timer_stop("halo updates") else ! do nothing @@ -227,4 +203,4 @@ end subroutine li_ocean_extrap_solve end module li_ocean_extrap -!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| \ No newline at end of file +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| From 8ba47c5766d13d1ca0fca4c2bb110213e98bec9c Mon Sep 17 00:00:00 2001 From: hollyhan Date: Wed, 22 Mar 2023 15:27:29 -0700 Subject: [PATCH 037/529] Add horizontal and vertical extrap algorithms --- .../src/mode_forward/mpas_li_ocean_extrap.F | 53 +++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 17773c25959..cc87eee5587 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -193,6 +193,59 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') call mpas_timer_stop("halo updates") + ! Algorithem 3: perform horizontal extrapolation until the validOceanMask is unchanged + validOceanMaskOld(:,:) = validOceanMask(:,:) + + ! get initial 3D valid data based on the original ISMIP6 field + TFoceanOld = ismip6shelfMelt_3dThermalForcing * validOceanMask + + ! initialize the local loop and count for validOceanMask + localLoopCount = 0 + newMaskCountLocal = 1 + newMaskCountLocalAccum = 0 + do while ( newMaskCountLocal > 0 ) + localLoopCount = localLoopCount + 1 + newMaskCountLocal = 0 + do iCell = 1, nCellsSolve + do iLayer = 1, nISMIP6OceanLayers + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + do iNeighbor = 1, nEdgesOnCell(iCell) + jCell = cellsOnCell(iNeighbor, iCell) + if ( validOceanMaskOld(jCell) == 1 ) then + ! =========place holder for horizontal averaging========= + !TFoceanNew = average over valid cells using the TFoceanOld + ! update the validOceanMask and new mask count + validOceanMask(iLayer,iCell) = 1 + newMaskCountLocal = newMaskCountLocal + 1 + endif + enddo + endif + validOceanMaskOld(:,:) = validOceanMask(:,:) + enddo + enddo + ! Accumulate cells added locally until we do the next global reduce + newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal + ! update halo for validOceanMask and ocean data + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') + call mpas_timer_stop("halo updates") + enddo + + ! Algorithm 4: perform vertical extrapolation of the ocean data + validOceanMaskOld(:,:) = validOceanMask(:,:) + do iCell = 1, nCellsSolve + do iLayer = 2, nISMIP6OceanLayers + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + ! ========= placeholder for vertical averaging =========== + endif + ! update validOceanMask and new mask count + if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then + validOceanMask(iLayer,iCell) = 1 + endif + enddo + validOceanMaskOld(:,:) = validOceanMask(:,:) + enddo + else ! do nothing call mpas_log_write('ocean data will NOT be extrapolated into the MALI ice draft') From 9c338287771179fab50e33b43138515657248e7b Mon Sep 17 00:00:00 2001 From: hollyhan Date: Mon, 11 Sep 2023 11:03:27 -0700 Subject: [PATCH 038/529] fix the error in the 2D seed/grow mask floodfill --- .../mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index cc87eee5587..a70c45c32bf 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -153,7 +153,7 @@ subroutine li_ocean_extrap_solve(domain, err) if ( growOceanMaskHoriz(iCell) == 1 ) then do iNeighbor = 1, nEdgesOnCell(iCell) jCell = cellsOnCell(iNeighbor, iCell) - if ( seedOceanMaskHorizOld(iCell) == 0 .and. seedOceanMaskHoriz(jCell) == 1 ) then + if ( seedOceanMaskHorizOld(iCell) == 0 .and. seedOceanMaskHorizOld(jCell) == 1 ) then seedOceanMaskHoriz(iCell) = 1 endif enddo From ae4f91601899f32c5645380bfb4c56c47a14530a Mon Sep 17 00:00:00 2001 From: hollyhan Date: Tue, 12 Sep 2023 10:57:05 -0700 Subject: [PATCH 039/529] fix the dimension for the mask variables --- components/mpas-albany-landice/src/Registry.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 9845ae73312..fd2f99b33be 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1667,16 +1667,16 @@ is the value of that variable from the *previous* time level! - - - - From 57b6ce177c88b7803c34667d83b96b1b14978fe8 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Tue, 12 Sep 2023 09:42:05 -0700 Subject: [PATCH 040/529] add variables in Registry for benchmarking the 2D seed and grow masks --- .../mpas-albany-landice/src/Registry.xml | 3 + .../src/mode_forward/mpas_li_ocean_extrap.F | 114 ++++++++++-------- 2 files changed, 64 insertions(+), 53 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index fd2f99b33be..cf2020645d1 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1679,6 +1679,9 @@ is the value of that variable from the *previous* time level! + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index a70c45c32bf..be25656c292 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -89,10 +89,11 @@ subroutine li_ocean_extrap_solve(domain, err) real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, TFoceanOld, TFoceanNew real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_zBndsOcean integer, dimension(:), pointer :: origOceanMaskHoriz - integer, dimension(:,:), pointer :: validOceanMaskOld, validOceanMask, availOceanMask !masks to pass to flood-fill routine + integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine + integer, dimension(:,:), allocatable :: validOceanMaskOld real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography real (kind=RKIND) :: layerTop - integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz + integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit integer, dimension(:), allocatable :: seedOceanMaskHorizOld integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra integer, dimension(:), pointer :: cellMask, nEdgesOnCell @@ -129,6 +130,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHoriz', seedOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'growOceanMaskHoriz', growOceanMaskHoriz) + call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHorizInit', seedOceanMaskHorizInit) ! create a 2D mask based on the open ocean + floating ice + grounded ice mask and n-extra cells into the grounded ice allocate(seedOceanMaskHorizOld(nCells+1)) @@ -142,10 +144,12 @@ subroutine li_ocean_extrap_solve(domain, err) endif if ( li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then growOceanMaskHoriz(iCell) = 1 + call mpas_log_write('growOceanMaskHoriz = 1') endif enddo ! Start horizontal floodfill + seedOceanMaskHorizInit(:) = seedOceanMaskHoriz(:) !HH: benchmark/debug purpose seedOceanMaskHorizOld(:) = seedOceanMaskHoriz(:) ! go through the loop to get nCells extra into grounded ice do iter = 1, nCellsExtra @@ -155,6 +159,7 @@ subroutine li_ocean_extrap_solve(domain, err) jCell = cellsOnCell(iNeighbor, iCell) if ( seedOceanMaskHorizOld(iCell) == 0 .and. seedOceanMaskHorizOld(jCell) == 1 ) then seedOceanMaskHoriz(iCell) = 1 + call mpas_log_write('seedOceanMaskHoriz = 1') endif enddo endif @@ -180,9 +185,11 @@ subroutine li_ocean_extrap_solve(domain, err) ! call mpas_log_write('==ismip6shelfMelt zBnds $r', realArgs=(/layerTop/)) if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then availOceanMask(iLayer,iCell) = 1 + call mpas_log_write('availOceanMask = 1') endif if ( (origOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then validOceanMask(iLayer,iCell) = 1 + call mpas_log_write('validOceanMask = 1') endif enddo enddo @@ -194,57 +201,58 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_timer_stop("halo updates") ! Algorithem 3: perform horizontal extrapolation until the validOceanMask is unchanged - validOceanMaskOld(:,:) = validOceanMask(:,:) - - ! get initial 3D valid data based on the original ISMIP6 field - TFoceanOld = ismip6shelfMelt_3dThermalForcing * validOceanMask - - ! initialize the local loop and count for validOceanMask - localLoopCount = 0 - newMaskCountLocal = 1 - newMaskCountLocalAccum = 0 - do while ( newMaskCountLocal > 0 ) - localLoopCount = localLoopCount + 1 - newMaskCountLocal = 0 - do iCell = 1, nCellsSolve - do iLayer = 1, nISMIP6OceanLayers - if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then - do iNeighbor = 1, nEdgesOnCell(iCell) - jCell = cellsOnCell(iNeighbor, iCell) - if ( validOceanMaskOld(jCell) == 1 ) then - ! =========place holder for horizontal averaging========= - !TFoceanNew = average over valid cells using the TFoceanOld - ! update the validOceanMask and new mask count - validOceanMask(iLayer,iCell) = 1 - newMaskCountLocal = newMaskCountLocal + 1 - endif - enddo - endif - validOceanMaskOld(:,:) = validOceanMask(:,:) - enddo - enddo - ! Accumulate cells added locally until we do the next global reduce - newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal - ! update halo for validOceanMask and ocean data - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') - call mpas_timer_stop("halo updates") - enddo - - ! Algorithm 4: perform vertical extrapolation of the ocean data - validOceanMaskOld(:,:) = validOceanMask(:,:) - do iCell = 1, nCellsSolve - do iLayer = 2, nISMIP6OceanLayers - if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then - ! ========= placeholder for vertical averaging =========== - endif - ! update validOceanMask and new mask count - if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then - validOceanMask(iLayer,iCell) = 1 - endif - enddo - validOceanMaskOld(:,:) = validOceanMask(:,:) - enddo + allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) + validOceanMaskOld(:,:) = 0.0 + +! ! get initial 3D valid data based on the original ISMIP6 field +! !TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) + +! ! initialize the local loop and count for validOceanMask +! localLoopCount = 0 +! newMaskCountLocal = 1 +! newMaskCountLocalAccum = 0 +! do while ( newMaskCountLocal > 0 ) +! localLoopCount = localLoopCount + 1 +! newMaskCountLocal = 0 +! do iCell = 1, nCellsSolve +! do iLayer = 1, nISMIP6OceanLayers +! if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then +! do iNeighbor = 1, nEdgesOnCell(iCell) +! jCell = cellsOnCell(iNeighbor, iCell) +! if ( validOceanMaskOld(iLayer,jCell) == 1 ) then +! ! =========place holder for horizontal averaging========= +! !TFoceanNew = average over valid cells using the TFoceanOld +! ! update the validOceanMask and new mask count +! validOceanMask(iLayer,iCell) = 1 +! newMaskCountLocal = newMaskCountLocal + 1 +! endif +! enddo +!! endif +! validOceanMaskOld(iLayer,iCell) = validOceanMask(iLayer,iCell) +! enddo +! enddo +!! ! Accumulate cells added locally until we do the next global reduce + ! newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal + ! ! update halo for validOceanMask and ocean data + ! call mpas_timer_start("halo updates") + ! call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') + !! call mpas_timer_stop("halo updates") +! enddo + +! ! Algorithm 4: perform vertical extrapolation of the ocean data +! validOceanMaskOld(:,:) = validOceanMask(:,:) +! do iCell = 1, nCellsSolve +! do iLayer = 2, nISMIP6OceanLayers +! if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then +! ! ========= placeholder for vertical averaging =========== +!! endif + ! ! update validOceanMask and new mask count + ! if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then + ! validOceanMask(iLayer,iCell) = 1 + ! endif + ! enddo + ! validOceanMaskOld(:,:) = validOceanMask(:,:) + ! enddo else ! do nothing From d9968f5e35273ad6d28e177cb2e4deadfc1a8262 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Mon, 18 Sep 2023 14:12:12 -0700 Subject: [PATCH 041/529] change the definition of the 2D growOceanMaskHoriz and re-arrange an if-loop for improving efficiency --- .../src/mode_forward/mpas_li_ocean_extrap.F | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index be25656c292..936f21a1c63 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -142,7 +142,7 @@ subroutine li_ocean_extrap_solve(domain, err) if ( .not. li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then seedOceanMaskHoriz(iCell) = 1 endif - if ( li_mask_is_grounded_ice(cellMask(iCell)) .and. bedTopography(iCell) < config_sea_level ) then + if ( bedTopography(iCell) < config_sea_level ) then growOceanMaskHoriz(iCell) = 1 call mpas_log_write('growOceanMaskHoriz = 1') endif @@ -154,10 +154,10 @@ subroutine li_ocean_extrap_solve(domain, err) ! go through the loop to get nCells extra into grounded ice do iter = 1, nCellsExtra do iCell = 1, nCellsSolve - if ( growOceanMaskHoriz(iCell) == 1 ) then + if ( growOceanMaskHoriz(iCell) == 1 .and. seedOceanMaskHorizOld(iCell) == 0 ) then do iNeighbor = 1, nEdgesOnCell(iCell) jCell = cellsOnCell(iNeighbor, iCell) - if ( seedOceanMaskHorizOld(iCell) == 0 .and. seedOceanMaskHorizOld(jCell) == 1 ) then + if ( seedOceanMaskHorizOld(jCell) == 1 ) then seedOceanMaskHoriz(iCell) = 1 call mpas_log_write('seedOceanMaskHoriz = 1') endif From 06eb01addb3cea24d6fc0d2003c2d1d3450e1abc Mon Sep 17 00:00:00 2001 From: hollyhan Date: Tue, 19 Sep 2023 15:07:43 -0700 Subject: [PATCH 042/529] Perform layer-by-layer horizontal extrapolation of 3D validOceanMask --- .../src/mode_forward/mpas_li_ocean_extrap.F | 82 +++++++++---------- 1 file changed, 39 insertions(+), 43 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 936f21a1c63..368e0ffcc94 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -87,7 +87,7 @@ subroutine li_ocean_extrap_solve(domain, err) type (block_type), pointer :: block type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, TFoceanOld, TFoceanNew - real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_zBndsOcean + real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean integer, dimension(:), pointer :: origOceanMaskHoriz integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine integer, dimension(:,:), allocatable :: validOceanMaskOld @@ -144,7 +144,6 @@ subroutine li_ocean_extrap_solve(domain, err) endif if ( bedTopography(iCell) < config_sea_level ) then growOceanMaskHoriz(iCell) = 1 - call mpas_log_write('growOceanMaskHoriz = 1') endif enddo @@ -159,7 +158,6 @@ subroutine li_ocean_extrap_solve(domain, err) jCell = cellsOnCell(iNeighbor, iCell) if ( seedOceanMaskHorizOld(jCell) == 1 ) then seedOceanMaskHoriz(iCell) = 1 - call mpas_log_write('seedOceanMaskHoriz = 1') endif enddo endif @@ -175,21 +173,17 @@ subroutine li_ocean_extrap_solve(domain, err) ! make it a 3D mask based on the topography (loop through nISMIP6OceanLayers) call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) - call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) - + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) availOceanMask(:,:) = 0 validOceanMask(:,:) = 0 do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers - layerTop = ismip6shelfMelt_zBndsOcean(1, iLayer) -! call mpas_log_write('==ismip6shelfMelt zBnds $r', realArgs=(/layerTop/)) + layerTop = ismip6shelfMelt_zOcean(iLayer) if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then availOceanMask(iLayer,iCell) = 1 - call mpas_log_write('availOceanMask = 1') endif if ( (origOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then validOceanMask(iLayer,iCell) = 1 - call mpas_log_write('validOceanMask = 1') endif enddo enddo @@ -204,40 +198,42 @@ subroutine li_ocean_extrap_solve(domain, err) allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) validOceanMaskOld(:,:) = 0.0 -! ! get initial 3D valid data based on the original ISMIP6 field -! !TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) - -! ! initialize the local loop and count for validOceanMask -! localLoopCount = 0 -! newMaskCountLocal = 1 -! newMaskCountLocalAccum = 0 -! do while ( newMaskCountLocal > 0 ) -! localLoopCount = localLoopCount + 1 -! newMaskCountLocal = 0 -! do iCell = 1, nCellsSolve -! do iLayer = 1, nISMIP6OceanLayers -! if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then -! do iNeighbor = 1, nEdgesOnCell(iCell) -! jCell = cellsOnCell(iNeighbor, iCell) -! if ( validOceanMaskOld(iLayer,jCell) == 1 ) then -! ! =========place holder for horizontal averaging========= -! !TFoceanNew = average over valid cells using the TFoceanOld -! ! update the validOceanMask and new mask count -! validOceanMask(iLayer,iCell) = 1 -! newMaskCountLocal = newMaskCountLocal + 1 -! endif -! enddo -!! endif -! validOceanMaskOld(iLayer,iCell) = validOceanMask(iLayer,iCell) -! enddo -! enddo -!! ! Accumulate cells added locally until we do the next global reduce - ! newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal - ! ! update halo for validOceanMask and ocean data - ! call mpas_timer_start("halo updates") - ! call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') - !! call mpas_timer_stop("halo updates") -! enddo + ! get initial 3D valid data based on the original ISMIP6 field + !TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) + + ! initialize the local loop and count for validOceanMask + localLoopCount = 0 + newMaskCountLocal = 1 + newMaskCountLocalAccum = 0 + do while ( newMaskCountLocal > 0 ) + localLoopCount = localLoopCount + 1 + newMaskCountLocal = 0 + do iCell = 1, nCellsSolve + do iLayer = 1, nISMIP6OceanLayers + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + do iNeighbor = 1, nEdgesOnCell(iCell) + jCell = cellsOnCell(iNeighbor, iCell) + if ( validOceanMaskOld(iLayer,jCell) == 1 ) then + ! =========place holder for horizontal averaging========= + !TFoceanNew = average over valid cells using the TFoceanOld + ! update the validOceanMask and new mask count + validOceanMask(iLayer,iCell) = 1 + newMaskCountLocal = newMaskCountLocal + 1 + endif + enddo + endif + enddo + enddo + validOceanMaskOld(:,:) = validOceanMask(:,:) + ! Accumulate cells added locally until we do the next global reduce + newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal + call mpas_log_write('==HH: Added $i new cells to local validOceanMask', intArgs=(/newMaskCountLocal/)) + ! update halo for validOceanMask and ocean data + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'availOceanMask') + call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') + call mpas_timer_stop("halo updates") + enddo ! ! Algorithm 4: perform vertical extrapolation of the ocean data ! validOceanMaskOld(:,:) = validOceanMask(:,:) From 581bc32569434a09fa40fce0c825be109e85c22b Mon Sep 17 00:00:00 2001 From: hollyhan Date: Thu, 21 Sep 2023 13:14:59 -0700 Subject: [PATCH 043/529] add back 'ismip6shelfMelt_zBndsOcean' --- .../src/mode_forward/mpas_li_ocean_extrap.F | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 368e0ffcc94..c68dc4459a6 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -88,6 +88,7 @@ subroutine li_ocean_extrap_solve(domain, err) type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, TFoceanOld, TFoceanNew real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean + real (kind=RKIND), dimension(:,:,:), pointer :: ismip6shelfMelt_zBndsOcean integer, dimension(:), pointer :: origOceanMaskHoriz integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine integer, dimension(:,:), allocatable :: validOceanMaskOld @@ -174,11 +175,14 @@ subroutine li_ocean_extrap_solve(domain, err) ! make it a 3D mask based on the topography (loop through nISMIP6OceanLayers) call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) + availOceanMask(:,:) = 0 validOceanMask(:,:) = 0 do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers - layerTop = ismip6shelfMelt_zOcean(iLayer) + layerTop = ismip6shelfMelt_zOcean(iLayer) + 30.0 !ismip6shelfMelt_zBndsOcean(1,iLayer,1) + call mpas_log_write('==HH: layertop depth $r ', realArgs=(/layerTop/)) if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then availOceanMask(iLayer,iCell) = 1 endif From 8a7d6583b48618bc7727d9ff8e9061966d6cc916 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Sun, 29 Oct 2023 19:51:43 -0700 Subject: [PATCH 044/529] Temp: use TFoceanOld and TFoceanNew test variables for extrapolation Also include a place holder for Algorithm 4 --- .../mpas-albany-landice/src/Registry.xml | 6 ++ .../src/mode_forward/mpas_li_ocean_extrap.F | 72 +++++++++++-------- 2 files changed, 50 insertions(+), 28 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index cf2020645d1..792896c3ce8 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1682,6 +1682,12 @@ is the value of that variable from the *previous* time level! + + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index c68dc4459a6..82c9b560c0f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -86,14 +86,14 @@ subroutine li_ocean_extrap_solve(domain, err) real, pointer :: config_sea_level type (block_type), pointer :: block type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool - real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, TFoceanOld, TFoceanNew + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean + real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld, TFoceanNew real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean - real (kind=RKIND), dimension(:,:,:), pointer :: ismip6shelfMelt_zBndsOcean integer, dimension(:), pointer :: origOceanMaskHoriz integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine integer, dimension(:,:), allocatable :: validOceanMaskOld real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography - real (kind=RKIND) :: layerTop + real (kind=RKIND) :: layerTop, TFsum integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit integer, dimension(:), allocatable :: seedOceanMaskHorizOld integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra @@ -126,6 +126,10 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) + call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) + call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanNew', TFoceanNew) + call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) + call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) call mpas_pool_get_array(geometryPool, 'origOceanMaskHoriz', origOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) @@ -176,13 +180,12 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) - + call mpas_log_write('==HH: layertop depth $r ', realArgs=(/ismip6shelfMelt_zOcean/)) availOceanMask(:,:) = 0 validOceanMask(:,:) = 0 do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers - layerTop = ismip6shelfMelt_zOcean(iLayer) + 30.0 !ismip6shelfMelt_zBndsOcean(1,iLayer,1) - call mpas_log_write('==HH: layertop depth $r ', realArgs=(/layerTop/)) + layerTop = 30!ismip6shelfMelt_zOcean(1, iLayer) if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then availOceanMask(iLayer,iCell) = 1 endif @@ -191,7 +194,7 @@ subroutine li_ocean_extrap_solve(domain, err) endif enddo enddo - + call mpas_log_write('==HH: updating halos for the avail/valid ocean masks') ! Update halos call mpas_timer_start("halo updates") call mpas_dmpar_field_halo_exch(domain, 'availOceanMask') @@ -203,57 +206,70 @@ subroutine li_ocean_extrap_solve(domain, err) validOceanMaskOld(:,:) = 0.0 ! get initial 3D valid data based on the original ISMIP6 field - !TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) + TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) + TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. ! initialize the local loop and count for validOceanMask localLoopCount = 0 newMaskCountLocal = 1 newMaskCountLocalAccum = 0 + !third variable to keep track of the number of valid ocean mask + TFoceanNew(:,:) = TFoceanOld(:,:) + call mpas_log_write('==HH: starting the wrapper loop through newMaskCountLocal') do while ( newMaskCountLocal > 0 ) localLoopCount = localLoopCount + 1 newMaskCountLocal = 0 do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + TFsum = 0.0 + ! new_variable_#ofvalidNeighbors_old = 0.0 do iNeighbor = 1, nEdgesOnCell(iCell) jCell = cellsOnCell(iNeighbor, iCell) if ( validOceanMaskOld(iLayer,jCell) == 1 ) then - ! =========place holder for horizontal averaging========= - !TFoceanNew = average over valid cells using the TFoceanOld ! update the validOceanMask and new mask count validOceanMask(iLayer,iCell) = 1 + ! update the new mask count newMaskCountLocal = newMaskCountLocal + 1 + ! new_variable_#ofvalidNeighbors_new = new_variable_#ofvalidNeighbors_old+1 + ! =========horizontal averaging========= + TFsum = TFsum + TFoceanOld(iLayer,jCell) endif enddo + ! TFoceanNew(iLayer,iCell) = TFsum / new_variable_#ofvalidNeighbors_new endif + call mpas_log_write('==HH: Added $i new cells to the local validOceanMask', intArgs=(/newMaskCountLocal/)) enddo enddo validOceanMaskOld(:,:) = validOceanMask(:,:) + TFoceanOld(:,:) = TFoceanNew(:,:) ! Accumulate cells added locally until we do the next global reduce newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal - call mpas_log_write('==HH: Added $i new cells to local validOceanMask', intArgs=(/newMaskCountLocal/)) + call mpas_log_write('==HH: Added total $i new cells to the validOceanMask', intArgs=(/newMaskCountLocalAccum/)) ! update halo for validOceanMask and ocean data call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'availOceanMask') call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') call mpas_timer_stop("halo updates") - enddo - -! ! Algorithm 4: perform vertical extrapolation of the ocean data -! validOceanMaskOld(:,:) = validOceanMask(:,:) -! do iCell = 1, nCellsSolve -! do iLayer = 2, nISMIP6OceanLayers -! if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then -! ! ========= placeholder for vertical averaging =========== -!! endif - ! ! update validOceanMask and new mask count - ! if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then - ! validOceanMask(iLayer,iCell) = 1 - ! endif - ! enddo - ! validOceanMaskOld(:,:) = validOceanMask(:,:) - ! enddo + ! Algorithm 4: perform vertical extrapolation of the ocean data + newMaskCountLocal = 1 + newMaskCountLocalAccum = 0 + validOceanMaskOld(:,:) = validOceanMask(:,:) + do while ( newMaskCountLocal > 0 ) + do iCell = 1, nCellsSolve + do iLayer = 2, nISMIP6OceanLayers + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + ! ========= placeholder for vertical averaging =========== + endif + ! update validOceanMask and new mask count + if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then + validOceanMask(iLayer,iCell) = 1 + endif + enddo + validOceanMaskOld(:,:) = validOceanMask(:,:) + enddo + enddo + enddo else ! do nothing call mpas_log_write('ocean data will NOT be extrapolated into the MALI ice draft') From b2d879531a243b54ddf8d23d663ee926f9960788 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Mon, 30 Oct 2023 14:00:37 -0700 Subject: [PATCH 045/529] fix typo in ismip6shelfMelt_zBndsOcean --- .../src/mode_forward/mpas_li_ocean_extrap.F | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 82c9b560c0f..f2b221115fb 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -180,12 +180,11 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) - call mpas_log_write('==HH: layertop depth $r ', realArgs=(/ismip6shelfMelt_zOcean/)) availOceanMask(:,:) = 0 validOceanMask(:,:) = 0 do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers - layerTop = 30!ismip6shelfMelt_zOcean(1, iLayer) + layerTop = ismip6shelfMelt_zBndsOcean(1, iLayer) if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then availOceanMask(iLayer,iCell) = 1 endif From be500b7691d33788387fba02fa0c372703268095 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Mon, 30 Oct 2023 15:26:32 -0700 Subject: [PATCH 046/529] update validOceanMask within the horizontal extrapolation loop --- .../src/mode_forward/mpas_li_ocean_extrap.F | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index f2b221115fb..5b01c4bdc7e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -202,8 +202,7 @@ subroutine li_ocean_extrap_solve(domain, err) ! Algorithem 3: perform horizontal extrapolation until the validOceanMask is unchanged allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) - validOceanMaskOld(:,:) = 0.0 - + validOceanMaskOld(:,:) = validOceanMask(:,:) ! get initial 3D valid data based on the original ISMIP6 field TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. @@ -239,8 +238,8 @@ subroutine li_ocean_extrap_solve(domain, err) endif call mpas_log_write('==HH: Added $i new cells to the local validOceanMask', intArgs=(/newMaskCountLocal/)) enddo + validOceanMaskOld(:,:) = validOceanMask(:,:) enddo - validOceanMaskOld(:,:) = validOceanMask(:,:) TFoceanOld(:,:) = TFoceanNew(:,:) ! Accumulate cells added locally until we do the next global reduce newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal From 4991f5c39f29a089031acbf5073baf200e01daff Mon Sep 17 00:00:00 2001 From: hollyhan Date: Mon, 30 Oct 2023 15:27:43 -0700 Subject: [PATCH 047/529] fix a typo in comment --- .../mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 5b01c4bdc7e..2f9bce3e615 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -200,7 +200,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') call mpas_timer_stop("halo updates") - ! Algorithem 3: perform horizontal extrapolation until the validOceanMask is unchanged + ! Algorithm 3: perform horizontal extrapolation until the validOceanMask is unchanged allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) validOceanMaskOld(:,:) = validOceanMask(:,:) ! get initial 3D valid data based on the original ISMIP6 field From 41d9c47e42e8c2452f6dd0a0b46cf2c8423a1610 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Wed, 1 Nov 2023 11:59:20 -0700 Subject: [PATCH 048/529] Create a seperate routine for horizontal extrapolation --- .../src/mode_forward/mpas_li_ocean_extrap.F | 208 +++++++++++++----- 1 file changed, 156 insertions(+), 52 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 2f9bce3e615..1a2835fcc93 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -86,24 +86,24 @@ subroutine li_ocean_extrap_solve(domain, err) real, pointer :: config_sea_level type (block_type), pointer :: block type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool - real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean - real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld, TFoceanNew + real (kind=RKIND) :: layerTop + real (kind=RKIND), dimension(:,:), pointer :: TFocean, TFoceanOld real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean + real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography integer, dimension(:), pointer :: origOceanMaskHoriz integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine - integer, dimension(:,:), allocatable :: validOceanMaskOld - real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography - real (kind=RKIND) :: layerTop, TFsum integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit integer, dimension(:), allocatable :: seedOceanMaskHorizOld integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra integer, dimension(:), pointer :: cellMask, nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnCell - integer :: iCell, jCell, iLayer, iNeighbor, iter, newMaskCountLocal, localLoopCount, newMaskCountLocalAccum - + integer :: iCell, jCell, iLayer, iNeighbor, iter, err_tmp + integer :: newMaskCountLocalAccum_horiz ! No init is needed. err = 0 + err_tmp = 0 call mpas_pool_get_config(liConfigs, 'config_ocean_data_extrapolation', config_ocean_data_extrapolation) @@ -118,6 +118,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) + call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) @@ -126,16 +127,14 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) - call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) - call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanNew', TFoceanNew) - call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) - call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) call mpas_pool_get_array(geometryPool, 'origOceanMaskHoriz', origOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHoriz', seedOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'growOceanMaskHoriz', growOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHorizInit', seedOceanMaskHorizInit) + call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) + call mpas_pool_get_array(extrapOceanDataPool, 'TFocean', TFocean) ! create a 2D mask based on the open ocean + floating ice + grounded ice mask and n-extra cells into the grounded ice allocate(seedOceanMaskHorizOld(nCells+1)) @@ -200,58 +199,24 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') call mpas_timer_stop("halo updates") - ! Algorithm 3: perform horizontal extrapolation until the validOceanMask is unchanged - allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) - validOceanMaskOld(:,:) = validOceanMask(:,:) - ! get initial 3D valid data based on the original ISMIP6 field - TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) - TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. + ! call the horizontal extrapolation routine + call mpas_log_write('==HH: calling the horizontal extrapolation routine') + call horizontal_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountLocalAccum_horiz, TFocean, err_tmp) + err = ior(err, err_tmp) + call mpas_log_write('==HH:Horizontal extrapolation done successfully!') + ! initialize the local loop and count for validOceanMask localLoopCount = 0 newMaskCountLocal = 1 newMaskCountLocalAccum = 0 !third variable to keep track of the number of valid ocean mask - TFoceanNew(:,:) = TFoceanOld(:,:) + TFocean(:,:) = TFoceanOld(:,:) call mpas_log_write('==HH: starting the wrapper loop through newMaskCountLocal') do while ( newMaskCountLocal > 0 ) localLoopCount = localLoopCount + 1 newMaskCountLocal = 0 - do iCell = 1, nCellsSolve - do iLayer = 1, nISMIP6OceanLayers - if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then - TFsum = 0.0 - ! new_variable_#ofvalidNeighbors_old = 0.0 - do iNeighbor = 1, nEdgesOnCell(iCell) - jCell = cellsOnCell(iNeighbor, iCell) - if ( validOceanMaskOld(iLayer,jCell) == 1 ) then - ! update the validOceanMask and new mask count - validOceanMask(iLayer,iCell) = 1 - ! update the new mask count - newMaskCountLocal = newMaskCountLocal + 1 - ! new_variable_#ofvalidNeighbors_new = new_variable_#ofvalidNeighbors_old+1 - ! =========horizontal averaging========= - TFsum = TFsum + TFoceanOld(iLayer,jCell) - endif - enddo - ! TFoceanNew(iLayer,iCell) = TFsum / new_variable_#ofvalidNeighbors_new - endif - call mpas_log_write('==HH: Added $i new cells to the local validOceanMask', intArgs=(/newMaskCountLocal/)) - enddo - validOceanMaskOld(:,:) = validOceanMask(:,:) - enddo - TFoceanOld(:,:) = TFoceanNew(:,:) - ! Accumulate cells added locally until we do the next global reduce - newMaskCountLocalAccum = newMaskCountLocalAccum + newMaskCountLocal - call mpas_log_write('==HH: Added total $i new cells to the validOceanMask', intArgs=(/newMaskCountLocalAccum/)) - ! update halo for validOceanMask and ocean data - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') - call mpas_timer_stop("halo updates") - ! Algorithm 4: perform vertical extrapolation of the ocean data - newMaskCountLocal = 1 - newMaskCountLocalAccum = 0 validOceanMaskOld(:,:) = validOceanMask(:,:) do while ( newMaskCountLocal > 0 ) do iCell = 1, nCellsSolve @@ -275,7 +240,146 @@ subroutine li_ocean_extrap_solve(domain, err) !-------------------------------------------------------------------- end subroutine li_ocean_extrap_solve +!----------------------------------------------------------------------- + + +!*********************************************************************** +!*********************************************************************** +! Private subroutines: +!*********************************************************************** +!*********************************************************************** + + + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! +! ! routine horizontal_extrapolation +! +!> \brief Extrapolate validOceanMask horizontally +!> \author Holly Kyeore Han +!> \date November 2023 +!> \details +!> This routine extrapolates takes the initialized availOceanMask +!> and validOceanMask and extrapolates validOceanMask in horizontal +!> direction until the local new mask count stops updating. +!> The output of the routine is an updated validOceanMask field and +!> newMaskCountLocal. + +!----------------------------------------------------------------------- + + subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err) + + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + integer, dimension(:,:), pointer, intent(in) :: availOceanMask + + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- + type (domain_type), intent(inout) :: domain !< Input/Output: domain object + integer, dimension(:,:), pointer, intent(inout) :: validOceanMask + integer, intent(inout) :: err !< Output: error flag + real (kind=RKIND), dimension(:,:), pointer, intent(inout) :: TFocean + + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + integer, intent(out) :: newMaskCountGlobal + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + type (block_type), pointer :: block + type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool + real (kind=RKIND) :: layerTop, TFsum, areaSum + integer, dimension(:,:), allocatable :: validOceanMaskOld + real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean + real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing + real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld + real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell + integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra + integer, dimension(:), pointer :: cellMask, nEdgesOnCell + integer, dimension(:,:), pointer :: cellsOnCell + integer :: iCell, jCell, iLayer, iNeighbor, iter + integer :: localLoopCount, newValidCount, newMaskCountLocalAccum + + err = 0 + + ! initialize the ocean data and mask fields + block => domain % blocklist + call mpas_pool_get_config(liConfigs, 'config_ocean_data_extrap_ncells_extra', nCellsExtra) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) + call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + call mpas_pool_get_array(meshPool, 'areaCell', areaCell) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(geometryPool, 'thickness', thickness) + call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) + call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) + + ! get initial 3D valid data based on the original ISMIP6 field + !TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) + TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. + ! perform horizontal extrapolation until the validOceanMask is unchanged + allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) + validOceanMaskOld(:,:) = validOceanMask(:,:) + + ! initialize the local loop and count for validOceanMask + localLoopCount = 0 + newMaskCountGlobal = 1 + do while ( newMaskCountGlobal > 0 ) + localLoopCount = localLoopCount + 1 + newMaskCountLocalAccum = 0 + do iCell = 1, nCellsSolve + do iLayer = 1, nISMIP6OceanLayers + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + TFsum = 0.0 + areaSum = 0.0 + newValidCount = 0 + do iNeighbor = 1, nEdgesOnCell(iCell) + jCell = cellsOnCell(iNeighbor, iCell) + if ( validOceanMaskOld(iLayer,jCell) == 1 ) then + validOceanMask(iLayer,iCell) = 1 + newValidCount = 1 + TFsum = TFsum + (TFoceanOld(iLayer,jCell) * areaCell(jCell)) + areaSum = areaSum + areaCell(jCell) + endif + enddo + ! Accumulate cells added locally until we do the next global reduce + newMaskCountLocalAccum = newMaskCountLocalAccum + newValidCount + ! perform averaging of the thermal forcing field + if ( areaSum == 0.0 ) then + TFocean(iLayer,iCell) = 0.0 + else + TFocean(iLayer,iCell) = TFsum / areaSum ! HH: we might want to do this regardless.. i.e. move this out of the if loop + endif + endif + enddo + enddo + validOceanMaskOld(:,:) = validOceanMask(:,:) + TFoceanOld(:,:) = TFocean(:,:) !HH: is this what we want? + + ! update halo for validOceanMask and ocean data + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') + call mpas_dmpar_field_halo_exch(domain, 'TFocean') + call mpas_timer_stop("halo updates") + ! update count of cells added to mask globally + call mpas_dmpar_sum_int(domain % dminfo, newMaskCountLocalAccum, newMaskCountGlobal) + enddo + + deallocate(validOceanMaskOld) + + end subroutine horizontal_extrapolation +!----------------------------------------------------------------------- end module li_ocean_extrap !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| From 7da222b5498c505fa16d39361f3d344a1d9e69d2 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Thu, 2 Nov 2023 06:45:43 -0700 Subject: [PATCH 049/529] Create a seperate routine for vertical extrapolation --- .../src/mode_forward/mpas_li_ocean_extrap.F | 162 ++++++++++++++---- 1 file changed, 129 insertions(+), 33 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 1a2835fcc93..74f65bb24b9 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -199,39 +199,22 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') call mpas_timer_stop("halo updates") - ! call the horizontal extrapolation routine - call mpas_log_write('==HH: calling the horizontal extrapolation routine') - call horizontal_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountLocalAccum_horiz, TFocean, err_tmp) - err = ior(err, err_tmp) - call mpas_log_write('==HH:Horizontal extrapolation done successfully!') - - - ! initialize the local loop and count for validOceanMask - localLoopCount = 0 - newMaskCountLocal = 1 - newMaskCountLocalAccum = 0 - !third variable to keep track of the number of valid ocean mask - TFocean(:,:) = TFoceanOld(:,:) - call mpas_log_write('==HH: starting the wrapper loop through newMaskCountLocal') - do while ( newMaskCountLocal > 0 ) - localLoopCount = localLoopCount + 1 - newMaskCountLocal = 0 - ! Algorithm 4: perform vertical extrapolation of the ocean data - validOceanMaskOld(:,:) = validOceanMask(:,:) - do while ( newMaskCountLocal > 0 ) - do iCell = 1, nCellsSolve - do iLayer = 2, nISMIP6OceanLayers - if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then - ! ========= placeholder for vertical averaging =========== - endif - ! update validOceanMask and new mask count - if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then - validOceanMask(iLayer,iCell) = 1 - endif - enddo - validOceanMaskOld(:,:) = validOceanMask(:,:) - enddo - enddo + ! flood-fill the valid ocean mask and TF field through + ! horizontal and vertial extrapolation + TFocean(:,:) = 0.0 !HH temp variable assignment + newMaskCountGlobal_total = 1 + GlobalLoopCount = 0 + do while (newMaskCountGlobal_total > 0) + newMaskCountGlobal_total = 0 + GlobalLoopCount = GlobalLoopCount + 1 + ! call the horizontal extrapolation routine + call horizontal_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal_horiz, TFocean, err_tmp) + err = ior(err, err_tmp) + ! call the vertical extrapolation routine + call vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal_vert, TFocean, err_tmp) + err = ior(err, err_tmp) + ! check the total number of new masks + newMaskCountGlobal_total = newMaskCountGlobal_horiz + newMaskCountGlobal_vert enddo else ! do nothing @@ -380,6 +363,119 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, newM end subroutine horizontal_extrapolation !----------------------------------------------------------------------- + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! +! ! routine vertical_extrapolation +! +!> \brief Extrapolate validOceanMask vertically +!> \author Holly Kyeore Han +!> \date November 2023 +!> \details +!> This routine extrapolates the horizontally extrapolated +!> validOceanMask through the vertical layers of the ocean. +!> The vertical extrapolation is completed once local new mask count +!> stops updating. The output of the routine is an updated +!> validOceanMask, thermal forcing fields and newMaskCountLocal. + +!----------------------------------------------------------------------- + + subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err) + + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + integer, dimension(:,:), pointer, intent(in) :: availOceanMask + + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- + type (domain_type), intent(inout) :: domain !< Input/Output: domain object + integer, dimension(:,:), pointer, intent(inout) :: validOceanMask + integer, intent(inout) :: err !< Output: error flag + real (kind=RKIND), dimension(:,:), pointer, intent(inout) :: TFocean + + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + integer, intent(out) :: newMaskCountGlobal + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + type (block_type), pointer :: block + type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool + real (kind=RKIND) :: layerTop, TFsum, areaSum + integer, dimension(:,:), allocatable :: validOceanMaskOld + real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean + real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld + real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell + integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers + integer, dimension(:), pointer :: cellMask, nEdgesOnCell + integer, dimension(:,:), pointer :: cellsOnCell + integer :: iCell, jCell, iLayer, iNeighbor, iter + integer :: localLoopCount, newMaskCountLocalAccum + + err = 0 + + ! initialize the ocean data and mask fields + block => domain % blocklist + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) + call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + call mpas_pool_get_array(meshPool, 'areaCell', areaCell) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(geometryPool, 'thickness', thickness) + call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) + + allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) + + ! assign the old validOceanMask and ocean data arrays + validOceanMaskOld(:,:) = validOceanMask(:,:) + TFoceanOld(:,:) = TFocean(:,:) + + ! initialize the local loop and count for validOceanMask + newMaskCountGlobal = 0 + newMaskCountLocalAccum = 0 + do iCell = 1, nCellsSolve + do iLayer = 2, nISMIP6OceanLayers + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + if ( iLayer == nISMIP6OceanLayers ) then + if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then + validOceanMask(iLayer,iCell) = 1 + TFocean(iLayer,iCell) = (TFoceanOld(iLayer-1,iCell)) !HH: need to correct for pressure melting point change + newMaskCountLocalAccum = newMaskCountLocalAccum + 1 + endif + else + if ( (validOceanMaskOld(iLayer-1,iCell) == 1) .or. (validOceanMaskOld(iLayer+1,iCell) == 1) ) then + validOceanMask(iLayer,iCell) = 1 + TFocean(iLayer,iCell) = (TFoceanOld(iLayer-1,iCell) + TFoceanOld(iLayer+1,iCell)) / 2 + newMaskCountLocalAccum = newMaskCountLocalAccum + 1 + endif + endif + endif + enddo + enddo + + ! update halo for validOceanMask and ocean data + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') + call mpas_dmpar_field_halo_exch(domain, 'TFocean') + call mpas_timer_stop("halo updates") + ! update count of cells added to mask globally + call mpas_dmpar_sum_int(domain % dminfo, newMaskCountLocalAccum, newMaskCountGlobal) + call mpas_log_write('Added total $i new cells to the validOceanMask', intArgs=(/newMaskCountGlobal/)) + + deallocate(validOceanMaskOld) + + end subroutine vertical_extrapolation +!----------------------------------------------------------------------- end module li_ocean_extrap !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| From cc64fbcd89866d73524ca89c7b961cc963dc2463 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Thu, 2 Nov 2023 15:14:43 -0700 Subject: [PATCH 050/529] Switch between horizontal and vertical extrapolation sq --- .../src/mode_forward/mpas_li_ocean_extrap.F | 43 ++++++++----------- 1 file changed, 18 insertions(+), 25 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 74f65bb24b9..d0f268dccb5 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -99,7 +99,7 @@ subroutine li_ocean_extrap_solve(domain, err) integer, dimension(:), pointer :: cellMask, nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnCell integer :: iCell, jCell, iLayer, iNeighbor, iter, err_tmp - integer :: newMaskCountLocalAccum_horiz + integer :: GlobalLoopCount, newMaskCountGlobal ! No init is needed. err = 0 @@ -202,19 +202,17 @@ subroutine li_ocean_extrap_solve(domain, err) ! flood-fill the valid ocean mask and TF field through ! horizontal and vertial extrapolation TFocean(:,:) = 0.0 !HH temp variable assignment - newMaskCountGlobal_total = 1 + newMaskCountGlobal = 1 GlobalLoopCount = 0 - do while (newMaskCountGlobal_total > 0) - newMaskCountGlobal_total = 0 + do while (newMaskCountGlobal > 0) + newMaskCountGlobal = 0 GlobalLoopCount = GlobalLoopCount + 1 ! call the horizontal extrapolation routine - call horizontal_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal_horiz, TFocean, err_tmp) + call horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFocean, err_tmp) err = ior(err, err_tmp) ! call the vertical extrapolation routine - call vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal_vert, TFocean, err_tmp) + call vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err_tmp) err = ior(err, err_tmp) - ! check the total number of new masks - newMaskCountGlobal_total = newMaskCountGlobal_horiz + newMaskCountGlobal_vert enddo else ! do nothing @@ -250,7 +248,7 @@ end subroutine li_ocean_extrap_solve !----------------------------------------------------------------------- - subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err) + subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFocean, err) !----------------------------------------------------------------- ! input variables @@ -268,7 +266,6 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, newM !----------------------------------------------------------------- ! output variables !----------------------------------------------------------------- - integer, intent(out) :: newMaskCountGlobal !----------------------------------------------------------------- ! local variables @@ -285,7 +282,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, newM integer, dimension(:), pointer :: cellMask, nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnCell integer :: iCell, jCell, iLayer, iNeighbor, iter - integer :: localLoopCount, newValidCount, newMaskCountLocalAccum + integer :: localLoopCount, newValidCount, newMaskCountLocalAccum, newMaskCountGlobal err = 0 @@ -357,10 +354,14 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, newM call mpas_timer_stop("halo updates") ! update count of cells added to mask globally call mpas_dmpar_sum_int(domain % dminfo, newMaskCountLocalAccum, newMaskCountGlobal) + call mpas_log_write('Horizontal extrap: Added total $i new cells to validOceanMask', intArgs=(/newMaskCountGlobal/)) enddo + call mpas_log_write('Horizontal extrapolation done after $i loops', intArgs=(/localLoopCount/)) deallocate(validOceanMaskOld) + + end subroutine horizontal_extrapolation !----------------------------------------------------------------------- @@ -446,19 +447,11 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas do iCell = 1, nCellsSolve do iLayer = 2, nISMIP6OceanLayers if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then - if ( iLayer == nISMIP6OceanLayers ) then - if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then - validOceanMask(iLayer,iCell) = 1 - TFocean(iLayer,iCell) = (TFoceanOld(iLayer-1,iCell)) !HH: need to correct for pressure melting point change - newMaskCountLocalAccum = newMaskCountLocalAccum + 1 - endif - else - if ( (validOceanMaskOld(iLayer-1,iCell) == 1) .or. (validOceanMaskOld(iLayer+1,iCell) == 1) ) then - validOceanMask(iLayer,iCell) = 1 - TFocean(iLayer,iCell) = (TFoceanOld(iLayer-1,iCell) + TFoceanOld(iLayer+1,iCell)) / 2 - newMaskCountLocalAccum = newMaskCountLocalAccum + 1 - endif - endif + if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then + validOceanMask(iLayer,iCell) = 1 + TFocean(iLayer,iCell) = (TFoceanOld(iLayer-1,iCell)) !HH: need to correct for pressure melting point change + newMaskCountLocalAccum = newMaskCountLocalAccum + 1 + endif endif enddo enddo @@ -470,7 +463,7 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas call mpas_timer_stop("halo updates") ! update count of cells added to mask globally call mpas_dmpar_sum_int(domain % dminfo, newMaskCountLocalAccum, newMaskCountGlobal) - call mpas_log_write('Added total $i new cells to the validOceanMask', intArgs=(/newMaskCountGlobal/)) + call mpas_log_write('Vertical extrap: Added total $i new cells to the validOceanMask', intArgs=(/newMaskCountGlobal/)) deallocate(validOceanMaskOld) From b77eb3f86d8653b74b67d32514af37f9f134342d Mon Sep 17 00:00:00 2001 From: hollyhan Date: Mon, 20 Nov 2023 11:02:40 -0800 Subject: [PATCH 051/529] Add correction for pressure melting point change correction is applied to the TF field. Also include (unrelated) clean-ups --- .../src/mode_forward/mpas_li_ocean_extrap.F | 34 +++++++------------ 1 file changed, 12 insertions(+), 22 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index d0f268dccb5..4f2532ee32e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -192,7 +192,7 @@ subroutine li_ocean_extrap_solve(domain, err) endif enddo enddo - call mpas_log_write('==HH: updating halos for the avail/valid ocean masks') + call mpas_log_write('==HH==: updating halos for the avail/valid ocean masks') ! Update halos call mpas_timer_start("halo updates") call mpas_dmpar_field_halo_exch(domain, 'availOceanMask') @@ -201,7 +201,8 @@ subroutine li_ocean_extrap_solve(domain, err) ! flood-fill the valid ocean mask and TF field through ! horizontal and vertial extrapolation - TFocean(:,:) = 0.0 !HH temp variable assignment + ! get initial 3D valid data based on the original ISMIP6 field + TFocean(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) newMaskCountGlobal = 1 GlobalLoopCount = 0 do while (newMaskCountGlobal > 0) @@ -301,16 +302,14 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFoc call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) - ! get initial 3D valid data based on the original ISMIP6 field - !TFoceanOld(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) - TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. + !TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. ! perform horizontal extrapolation until the validOceanMask is unchanged allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) validOceanMaskOld(:,:) = validOceanMask(:,:) + TFoceanOld(:,:) = TFocean(:,:) ! initialize the local loop and count for validOceanMask localLoopCount = 0 @@ -344,14 +343,16 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFoc endif enddo enddo - validOceanMaskOld(:,:) = validOceanMask(:,:) - TFoceanOld(:,:) = TFocean(:,:) !HH: is this what we want? ! update halo for validOceanMask and ocean data call mpas_timer_start("halo updates") call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') call mpas_dmpar_field_halo_exch(domain, 'TFocean') call mpas_timer_stop("halo updates") + + validOceanMaskOld(:,:) = validOceanMask(:,:) + TFoceanOld(:,:) = TFocean(:,:) + ! update count of cells added to mask globally call mpas_dmpar_sum_int(domain % dminfo, newMaskCountLocalAccum, newMaskCountGlobal) call mpas_log_write('Horizontal extrap: Added total $i new cells to validOceanMask', intArgs=(/newMaskCountGlobal/)) @@ -407,9 +408,7 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas type (block_type), pointer :: block type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool real (kind=RKIND) :: layerTop, TFsum, areaSum - integer, dimension(:,:), allocatable :: validOceanMaskOld real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean - real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers integer, dimension(:), pointer :: cellMask, nEdgesOnCell @@ -433,23 +432,16 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) - - allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) - - ! assign the old validOceanMask and ocean data arrays - validOceanMaskOld(:,:) = validOceanMask(:,:) - TFoceanOld(:,:) = TFocean(:,:) ! initialize the local loop and count for validOceanMask newMaskCountGlobal = 0 newMaskCountLocalAccum = 0 do iCell = 1, nCellsSolve do iLayer = 2, nISMIP6OceanLayers - if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then - if ( validOceanMaskOld(iLayer-1,iCell) == 1 ) then + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMask(iLayer,iCell) == 0) ) then + if ( validOceanMask(iLayer-1,iCell) == 1 ) then validOceanMask(iLayer,iCell) = 1 - TFocean(iLayer,iCell) = (TFoceanOld(iLayer-1,iCell)) !HH: need to correct for pressure melting point change + TFocean(iLayer,iCell) = (TFocean(iLayer-1,iCell)) + (60 * 0.0008) !HH: need to correct for pressure melting point change newMaskCountLocalAccum = newMaskCountLocalAccum + 1 endif endif @@ -465,8 +457,6 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas call mpas_dmpar_sum_int(domain % dminfo, newMaskCountLocalAccum, newMaskCountGlobal) call mpas_log_write('Vertical extrap: Added total $i new cells to the validOceanMask', intArgs=(/newMaskCountGlobal/)) - deallocate(validOceanMaskOld) - end subroutine vertical_extrapolation !----------------------------------------------------------------------- end module li_ocean_extrap From 5c4b0718474f6695912535e2edf537f6fcdc3756 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Thu, 18 Jan 2024 20:33:40 -0800 Subject: [PATCH 052/529] Add smoothing to horizontally extrapolated field --- .../mpas-albany-landice/src/Registry.xml | 19 +++++- .../src/mode_forward/mpas_li_ocean_extrap.F | 64 ++++++++++++++++--- 2 files changed, 73 insertions(+), 10 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 792896c3ce8..d50d91148e4 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -460,6 +460,18 @@ + + + @@ -1670,6 +1682,9 @@ is the value of that variable from the *previous* time level! + @@ -1682,10 +1697,10 @@ is the value of that variable from the *previous* time level! - - diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 4f2532ee32e..17353c69abb 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -92,7 +92,7 @@ subroutine li_ocean_extrap_solve(domain, err) real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography integer, dimension(:), pointer :: origOceanMaskHoriz - integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine + integer, dimension(:,:), pointer :: validOceanMask, validOceanMaskOrig, availOceanMask !masks to pass to flood-fill routine integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit integer, dimension(:), allocatable :: seedOceanMaskHorizOld integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra @@ -129,6 +129,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) call mpas_pool_get_array(geometryPool, 'origOceanMaskHoriz', origOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) + call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMaskOrig', validOceanMaskOrig) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHoriz', seedOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'growOceanMaskHoriz', growOceanMaskHoriz) @@ -199,6 +200,8 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') call mpas_timer_stop("halo updates") + ! save the initial validOceanMask + validOceanMaskOrig(:,:) = validOceanMask(:,:) ! flood-fill the valid ocean mask and TF field through ! horizontal and vertial extrapolation ! get initial 3D valid data based on the original ISMIP6 field @@ -207,9 +210,9 @@ subroutine li_ocean_extrap_solve(domain, err) GlobalLoopCount = 0 do while (newMaskCountGlobal > 0) newMaskCountGlobal = 0 - GlobalLoopCount = GlobalLoopCount + 1 + GlobalLoopCount = GlobalLoopCount + 1 ! call the horizontal extrapolation routine - call horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFocean, err_tmp) + call horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, validOceanMask, TFocean, err_tmp) err = ior(err, err_tmp) ! call the vertical extrapolation routine call vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err_tmp) @@ -249,12 +252,12 @@ end subroutine li_ocean_extrap_solve !----------------------------------------------------------------------- - subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFocean, err) + subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, validOceanMask, TFocean, err) !----------------------------------------------------------------- ! input variables !----------------------------------------------------------------- - integer, dimension(:,:), pointer, intent(in) :: availOceanMask + integer, dimension(:,:), pointer, intent(in) :: availOceanMask, validOceanMaskOrig !----------------------------------------------------------------- ! input/output variables @@ -274,22 +277,25 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFoc type (block_type), pointer :: block type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool real (kind=RKIND) :: layerTop, TFsum, areaSum + real (kind=RKIND), pointer :: weightCell integer, dimension(:,:), allocatable :: validOceanMaskOld real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell - integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra + integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra, nMaxLoopSmoothing integer, dimension(:), pointer :: cellMask, nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnCell integer :: iCell, jCell, iLayer, iNeighbor, iter - integer :: localLoopCount, newValidCount, newMaskCountLocalAccum, newMaskCountGlobal + integer :: localLoopCount, nValidNeighb, newValidCount, newMaskCountLocalAccum, newMaskCountGlobal err = 0 ! initialize the ocean data and mask fields block => domain % blocklist call mpas_pool_get_config(liConfigs, 'config_ocean_data_extrap_ncells_extra', nCellsExtra) + call mpas_pool_get_config(liConfigs,'config_weight_value_cell', weightCell) + call mpas_pool_get_config(liConfigs,'config_number_horiz_smoothing_loop', nMaxLoopSmoothing) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) @@ -304,7 +310,6 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFoc call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) - !TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. ! perform horizontal extrapolation until the validOceanMask is unchanged allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) @@ -359,6 +364,49 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, TFoc enddo call mpas_log_write('Horizontal extrapolation done after $i loops', intArgs=(/localLoopCount/)) + ! Now, smooth the field using a weight + localLoopCount = 1 + do while ( localLoopCount <= nMaxLoopSmoothing ) + call mpas_log_write('Smoothing the horizontally extrapolated field: loop number $i', & + & intArgs=(/localLoopCount/)) + call mpas_log_write('Weight of iCell is $r', & + & realArgs=(/weightCell/)) + localLoopCount = localLoopCount + 1 + do iCell = 1, nCellsSolve + do iLayer = 1, nISMIP6OceanLayers + ! revisit only the cells with an extrapolated value (don't change cells with original ocean data) + if ( (validOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOrig(iLayer,iCell) == 0) ) then + TFsum = 0.0 + areaSum = 0.0 + nValidNeighb = 0 + do iNeighbor = 1, nEdgesOnCell(iCell) + jCell = cellsOnCell(iNeighbor, iCell) + if ( validOceanMask(iLayer,jCell) == 1 ) then + nValidNeighb = nValidNeighb + 1 + TFsum = TFsum + (TFoceanOld(iLayer,jCell) * areaCell(jCell)) + areaSum = areaSum + areaCell(jCell) + endif + enddo + if ( nValidNeighb == 0 ) then + TFocean(iLayer,iCell) = TFoceanOld(iLayer,iCell) + else + ! perform weighted average + TFocean(iLayer,iCell) = ( weightCell * TFoceanOld(iLayer,iCell) * areaCell(iCell) + & + & ((1 - weightCell) * (TFsum / nValidNeighb)) ) / & + & ( weightCell * areaCell(iCell) + & + & (1 - weightCell) * (areaSum / nValidNeighb) ) + endif + endif + enddo + enddo + ! update halo for validOceanMask and ocean data + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'TFocean') + call mpas_timer_stop("halo updates") + + TFoceanOld(:,:) = TFocean(:,:) + + enddo deallocate(validOceanMaskOld) From 036ce782cff826a3f4eb70c32220bbd6934bc1ce Mon Sep 17 00:00:00 2001 From: hollyhan Date: Thu, 8 Feb 2024 18:28:46 -0800 Subject: [PATCH 053/529] Edit the horizontal smoothing algorithm such that smoothing happens synchronously with horizontal extrapolation and with a local weight for a cell, where the local weight value gets defined depending on the cell's validity. --- .../mpas-albany-landice/src/Registry.xml | 8 -- .../src/mode_forward/mpas_li_ocean_extrap.F | 88 ++++++------------- 2 files changed, 28 insertions(+), 68 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index d50d91148e4..386700b559d 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -460,18 +460,10 @@ - - diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 17353c69abb..5e6e307fb1e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -210,9 +210,9 @@ subroutine li_ocean_extrap_solve(domain, err) GlobalLoopCount = 0 do while (newMaskCountGlobal > 0) newMaskCountGlobal = 0 - GlobalLoopCount = GlobalLoopCount + 1 + GlobalLoopCount = GlobalLoopCount + 1 ! call the horizontal extrapolation routine - call horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, validOceanMask, TFocean, err_tmp) + call horizontal_extrapolation(domain, availOceanMask, validOceanMask, validOceanMaskOrig, TFocean, err_tmp) err = ior(err, err_tmp) ! call the vertical extrapolation routine call vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err_tmp) @@ -252,7 +252,7 @@ end subroutine li_ocean_extrap_solve !----------------------------------------------------------------------- - subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, validOceanMask, TFocean, err) + subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, validOceanMaskOrig, TFocean, err) !----------------------------------------------------------------- ! input variables @@ -276,18 +276,19 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, !----------------------------------------------------------------- type (block_type), pointer :: block type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool - real (kind=RKIND) :: layerTop, TFsum, areaSum + real (kind=RKIND) :: layerTop, TFsum, areaSum, weightCellLocal real (kind=RKIND), pointer :: weightCell integer, dimension(:,:), allocatable :: validOceanMaskOld real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell - integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra, nMaxLoopSmoothing + integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra integer, dimension(:), pointer :: cellMask, nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnCell integer :: iCell, jCell, iLayer, iNeighbor, iter - integer :: localLoopCount, nValidNeighb, newValidCount, newMaskCountLocalAccum, newMaskCountGlobal + integer :: localLoopCount + integer :: nValidNeighb, newValidCount, newMaskCountLocalAccum, newMaskCountGlobal err = 0 @@ -295,7 +296,6 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, block => domain % blocklist call mpas_pool_get_config(liConfigs, 'config_ocean_data_extrap_ncells_extra', nCellsExtra) call mpas_pool_get_config(liConfigs,'config_weight_value_cell', weightCell) - call mpas_pool_get_config(liConfigs,'config_number_horiz_smoothing_loop', nMaxLoopSmoothing) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'extrapOceanData', extrapOceanDataPool) @@ -319,32 +319,44 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, ! initialize the local loop and count for validOceanMask localLoopCount = 0 newMaskCountGlobal = 1 + call mpas_log_write('Weight given to the cell with valid data from extrapolation: $r', realArgs=(/weightCell/)) do while ( newMaskCountGlobal > 0 ) localLoopCount = localLoopCount + 1 newMaskCountLocalAccum = 0 do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers - if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOld(iLayer,iCell) == 0) ) then + if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOrig(iLayer,iCell) == 0) ) then TFsum = 0.0 areaSum = 0.0 newValidCount = 0 + nValidNeighb = 0 do iNeighbor = 1, nEdgesOnCell(iCell) jCell = cellsOnCell(iNeighbor, iCell) if ( validOceanMaskOld(iLayer,jCell) == 1 ) then - validOceanMask(iLayer,iCell) = 1 - newValidCount = 1 TFsum = TFsum + (TFoceanOld(iLayer,jCell) * areaCell(jCell)) areaSum = areaSum + areaCell(jCell) + nValidNeighb = nValidNeighb + 1 endif enddo - ! Accumulate cells added locally until we do the next global reduce - newMaskCountLocalAccum = newMaskCountLocalAccum + newValidCount - ! perform averaging of the thermal forcing field - if ( areaSum == 0.0 ) then - TFocean(iLayer,iCell) = 0.0 + if ( validOceanMaskOld(iLayer,iCell) == 0 .and. nValidNeighb > 0 ) then + ! if current cell is not valid, set its weight to zero + weightCellLocal = 0 + validOceanMask(iLayer,iCell) = 1 + newValidCount = 1 else - TFocean(iLayer,iCell) = TFsum / areaSum ! HH: we might want to do this regardless.. i.e. move this out of the if loop + weightCellLocal = weightCell endif + ! perform area-weighted averaging of the thermal forcing field + if ( nValidNeighb == 0 ) then + TFocean(iLayer,iCell) = TFoceanOld(iLayer,iCell) + else + TFocean(iLayer,iCell) = ( weightCellLocal * TFoceanOld(iLayer,iCell) * areaCell(iCell) + & + & ((1 - weightCellLocal) * (TFsum / nValidNeighb)) ) / & + & ( weightCellLocal * areaCell(iCell) + & + & (1 - weightCellLocal) * (areaSum / nValidNeighb) ) + endif + ! Accumulate cells added locally until we do the next global reduce + newMaskCountLocalAccum = newMaskCountLocalAccum + newValidCount endif enddo enddo @@ -363,50 +375,6 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMaskOrig, call mpas_log_write('Horizontal extrap: Added total $i new cells to validOceanMask', intArgs=(/newMaskCountGlobal/)) enddo call mpas_log_write('Horizontal extrapolation done after $i loops', intArgs=(/localLoopCount/)) - - ! Now, smooth the field using a weight - localLoopCount = 1 - do while ( localLoopCount <= nMaxLoopSmoothing ) - call mpas_log_write('Smoothing the horizontally extrapolated field: loop number $i', & - & intArgs=(/localLoopCount/)) - call mpas_log_write('Weight of iCell is $r', & - & realArgs=(/weightCell/)) - localLoopCount = localLoopCount + 1 - do iCell = 1, nCellsSolve - do iLayer = 1, nISMIP6OceanLayers - ! revisit only the cells with an extrapolated value (don't change cells with original ocean data) - if ( (validOceanMask(iLayer,iCell) == 1) .and. (validOceanMaskOrig(iLayer,iCell) == 0) ) then - TFsum = 0.0 - areaSum = 0.0 - nValidNeighb = 0 - do iNeighbor = 1, nEdgesOnCell(iCell) - jCell = cellsOnCell(iNeighbor, iCell) - if ( validOceanMask(iLayer,jCell) == 1 ) then - nValidNeighb = nValidNeighb + 1 - TFsum = TFsum + (TFoceanOld(iLayer,jCell) * areaCell(jCell)) - areaSum = areaSum + areaCell(jCell) - endif - enddo - if ( nValidNeighb == 0 ) then - TFocean(iLayer,iCell) = TFoceanOld(iLayer,iCell) - else - ! perform weighted average - TFocean(iLayer,iCell) = ( weightCell * TFoceanOld(iLayer,iCell) * areaCell(iCell) + & - & ((1 - weightCell) * (TFsum / nValidNeighb)) ) / & - & ( weightCell * areaCell(iCell) + & - & (1 - weightCell) * (areaSum / nValidNeighb) ) - endif - endif - enddo - enddo - ! update halo for validOceanMask and ocean data - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'TFocean') - call mpas_timer_stop("halo updates") - - TFoceanOld(:,:) = TFocean(:,:) - - enddo deallocate(validOceanMaskOld) From 48b053095d7f4dfc7c0d889142057d210a1e23e3 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Fri, 9 Feb 2024 18:05:19 -0800 Subject: [PATCH 054/529] Add a timer for the horizontal and vertical schemes --- .../src/mode_forward/mpas_li_ocean_extrap.F | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 5e6e307fb1e..40365ecf5a8 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -212,11 +212,15 @@ subroutine li_ocean_extrap_solve(domain, err) newMaskCountGlobal = 0 GlobalLoopCount = GlobalLoopCount + 1 ! call the horizontal extrapolation routine + call mpas_timer_start("horizontal scheme") call horizontal_extrapolation(domain, availOceanMask, validOceanMask, validOceanMaskOrig, TFocean, err_tmp) err = ior(err, err_tmp) + call mpas_timer_stop("horizontal scheme") ! call the vertical extrapolation routine + call mpas_timer_start("vertical scheme") call vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err_tmp) err = ior(err, err_tmp) + call mpas_timer_stop("vertical scheme") enddo else ! do nothing From ba9e59cb88a6045e5916f7a8e6336a77e86039c6 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Wed, 14 Feb 2024 16:37:17 -0800 Subject: [PATCH 055/529] Identify invalid ocean data locations --- .../src/mode_forward/mpas_li_ocean_extrap.F | 31 +++++++++++++++++-- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 40365ecf5a8..ac0fb879192 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -202,10 +202,21 @@ subroutine li_ocean_extrap_solve(domain, err) ! save the initial validOceanMask validOceanMaskOrig(:,:) = validOceanMask(:,:) + + ! initialize the TF field + TFocean(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) + ! initialize the invalid data locations with fill value + do iCell = 1, nCellsSolve + do iLayer = 1, nISMIP6OceanLayers + if ( availOceanMask(iLayer,iCell) == 0 ) then + TFocean(iLayer,iCell) = 1.0e36 + endif + enddo + enddo + ! flood-fill the valid ocean mask and TF field through ! horizontal and vertial extrapolation ! get initial 3D valid data based on the original ISMIP6 field - TFocean(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) newMaskCountGlobal = 1 GlobalLoopCount = 0 do while (newMaskCountGlobal > 0) @@ -337,7 +348,14 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali do iNeighbor = 1, nEdgesOnCell(iCell) jCell = cellsOnCell(iNeighbor, iCell) if ( validOceanMaskOld(iLayer,jCell) == 1 ) then - TFsum = TFsum + (TFoceanOld(iLayer,jCell) * areaCell(jCell)) + if ( TFoceanOld(iLayer,jCell) > 1.0e6) then + ! raise error if an invalid ocean data value is used + call mpas_log_write("ocean data value used for extrapolation is invalid", & + MPAS_LOG_ERR) + err = ior(err,1) + else + TFsum = TFsum + (TFoceanOld(iLayer,jCell) * areaCell(jCell)) + endif areaSum = areaSum + areaCell(jCell) nValidNeighb = nValidNeighb + 1 endif @@ -460,8 +478,15 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas do iLayer = 2, nISMIP6OceanLayers if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMask(iLayer,iCell) == 0) ) then if ( validOceanMask(iLayer-1,iCell) == 1 ) then + if ( TFocean(iLayer-1,iCell) > 1.0e6) then + ! raise error if an invalid ocean data value is used + call mpas_log_write("ocean data value used for extrapolation is invalid", & + MPAS_LOG_ERR) + err = ior(err,1) + else + TFocean(iLayer,iCell) = (TFocean(iLayer-1,iCell)) + (60 * 0.0008) + endif validOceanMask(iLayer,iCell) = 1 - TFocean(iLayer,iCell) = (TFocean(iLayer-1,iCell)) + (60 * 0.0008) !HH: need to correct for pressure melting point change newMaskCountLocalAccum = newMaskCountLocalAccum + 1 endif endif From 889ba339e8729c0e0a159a45590c2ea52049a8d1 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Thu, 25 Apr 2024 12:37:38 -0700 Subject: [PATCH 056/529] Activate the ismip6ShelfMelt package when the extrapolation scheme is on --- .../src/mode_forward/mpas_li_core_interface.F | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F index 8a278675da3..e24cc19dccf 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F @@ -108,6 +108,7 @@ function li_setup_packages(configPool, packagePool, iocontext) result(ierr) logical, pointer :: config_SGH logical, pointer :: config_adaptive_timestep_include_DCFL logical, pointer :: config_write_albany_ascii_mesh + logical, pointer :: config_ocean_data_extrapolation logical, pointer :: higherOrderVelocityActive logical, pointer :: SIAvelocityActive @@ -126,6 +127,7 @@ function li_setup_packages(configPool, packagePool, iocontext) result(ierr) call mpas_pool_get_config(configPool, 'config_basal_mass_bal_float', config_basal_mass_bal_float) call mpas_pool_get_config(configPool, 'config_front_mass_bal_grounded', config_front_mass_bal_grounded) call mpas_pool_get_config(configPool, 'config_use_3d_thermal_forcing_for_face_melt', config_use_3d_thermal_forcing_for_face_melt) + call mpas_pool_get_config(configPool, 'config_ocean_data_extrapolation', config_ocean_data_extrapolation) call mpas_pool_get_config(configPool, 'config_thermal_solver', config_thermal_solver) call mpas_pool_get_package(packagePool, 'SIAvelocityActive', SIAvelocityActive) @@ -159,11 +161,13 @@ function li_setup_packages(configPool, packagePool, iocontext) result(ierr) if ( (trim(config_basal_mass_bal_float) == 'ismip6') .or. & ((trim(config_front_mass_bal_grounded) == 'ismip6') .and. & - (config_use_3d_thermal_forcing_for_face_melt)) ) then + (config_use_3d_thermal_forcing_for_face_melt)) .or. & + (config_ocean_data_extrapolation) ) then ismip6ShelfMeltActive = .true. call mpas_log_write("The 'ismip6Melt' package and assocated variables have been enabled because " // & "'config_basal_mass_bal_float' is set to 'ismip6' or 'config_front_mass_bal_grounded' is set to 'ismip6' // & - and 'config_use_3d_thermal_forcing_for_face_melt' is set to .true.") + and 'config_use_3d_thermal_forcing_for_face_melt' is set to .true. " // & + "or 'config_ocean_data_extrapolation' is set to .true.") endif if ((trim(config_front_mass_bal_grounded) == 'ismip6') .or. (trim(config_calving) == 'ismip6_retreat')) then From 22b63d911730adc073c738e1a954c840c40e0090 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Tue, 30 Apr 2024 14:05:41 -0700 Subject: [PATCH 057/529] Check for invalid TF value in TFdraft calculation Also make the invalid value a config option --- components/mpas-albany-landice/src/Registry.xml | 4 ++++ .../src/mode_forward/mpas_li_iceshelf_melt.F | 12 ++++++++++++ .../src/mode_forward/mpas_li_ocean_extrap.F | 5 +++-- 3 files changed, 19 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 386700b559d..1b4e8f954a9 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -460,6 +460,10 @@ + Date: Mon, 6 May 2024 15:30:48 +0000 Subject: [PATCH 058/529] add a flag to kokkos, redo cmake file for sunspot --- .../oneapi-ifxgpu_sunspot-pvc.cmake | 2 +- .../eamxx/cmake/machine-files/sunspot-pvc.cmake | 17 +++++++---------- 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake index 2719498f760..91f65665a14 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake @@ -11,7 +11,7 @@ if (DEBUG) # string(APPEND CMAKE_EXE_LINKER_FLAGS " -check uninit") endif() -string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off -DCMAKE_CXX_FLAGS='-fsycl-device-code-split=per_kernel'") string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") diff --git a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake index d7e2d262b01..ee984e7a586 100644 --- a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake +++ b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake @@ -18,23 +18,20 @@ include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) #AB flags from ekat # -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel -SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda" CACHE STRING "") -SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"" CACHE STRING "") - - -message("HEY SYCL_COMPILE_FLAGS is ${SYCL_COMPILE_FLAGS}") -message("HEY SYCL_LINK_FLAGS is ${SYCL_LINK_FLAGS}") +SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") +SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"") #SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") -set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG -std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda" CACHE STRING "") -set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "") -set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "") -set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG -fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\" -fortlib" CACHE STRING "") +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) +set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) #set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) + set(NETCDF_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") set(NETCDF_DIR "$ENV{NETCDF_PATH}" CACHE STRING "") set(NETCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") From 741b87b2238b8f9092692d81e3ad4fde135e1902 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 25 Apr 2024 13:49:16 -0500 Subject: [PATCH 059/529] bool->int changes, but not linking --- .../homme/src/share/cxx/GllFvRemapImpl.cpp | 2 +- .../homme/src/share/cxx/SimulationParams.hpp | 4 +- .../src/theta-l_kokkos/cxx/CamForcing.cpp | 2 +- .../src/theta-l_kokkos/cxx/ForcingFunctor.hpp | 4 +- .../cxx/cxx_f90_interface_theta.cpp | 24 +++++------- .../src/theta-l_kokkos/prim_driver_mod.F90 | 37 ++++++++++++------- .../src/theta-l_kokkos/theta_f2c_mod.F90 | 12 +++--- 7 files changed, 44 insertions(+), 41 deletions(-) diff --git a/components/homme/src/share/cxx/GllFvRemapImpl.cpp b/components/homme/src/share/cxx/GllFvRemapImpl.cpp index 6148f69cfa9..ea1a52f5efd 100644 --- a/components/homme/src/share/cxx/GllFvRemapImpl.cpp +++ b/components/homme/src/share/cxx/GllFvRemapImpl.cpp @@ -142,7 +142,7 @@ ::init_data (const int nf, const int nf_max, const bool theta_hydrostatic_mode, " nf must be > 1.", Errors::err_not_implemented); auto& sp = Context::singleton().get(); - m_data.use_moisture = sp.moisture == MoistDry::MOIST; + m_data.use_moisture = sp.use_moisture; // Only in the unit test gllfvremap_ut does theta_hydrostatic_mode not already // == sp.theta_hydrostatic_mode. m_data.theta_hydrostatic_mode = sp.theta_hydrostatic_mode = theta_hydrostatic_mode; diff --git a/components/homme/src/share/cxx/SimulationParams.hpp b/components/homme/src/share/cxx/SimulationParams.hpp index b435911da2e..4f36962b16c 100644 --- a/components/homme/src/share/cxx/SimulationParams.hpp +++ b/components/homme/src/share/cxx/SimulationParams.hpp @@ -23,7 +23,7 @@ struct SimulationParams void print(std::ostream& out = std::cout); TimeStepType time_step_type; - MoistDry moisture; + bool use_moisture; RemapAlg remap_alg; TestCase test_case; ForcingAlg ftype = ForcingAlg::FORCING_OFF; @@ -77,7 +77,7 @@ inline void SimulationParams::print (std::ostream& out) { out << "\n************** CXX SimulationParams **********************\n\n"; out << " time_step_type: " << etoi(time_step_type) << "\n"; - out << " moisture: " << (moisture==MoistDry::DRY ? "dry" : "moist") << "\n"; + out << " use_moisture: " << (use_moisture ? "moist" : "dry") << "\n"; out << " remap_alg: " << etoi(remap_alg) << "\n"; out << " test case: " << etoi(test_case) << "\n"; out << " ftype: " << etoi(ftype) << "\n"; diff --git a/components/homme/src/theta-l_kokkos/cxx/CamForcing.cpp b/components/homme/src/theta-l_kokkos/cxx/CamForcing.cpp index 02b999db16e..bd7cee3e7c0 100644 --- a/components/homme/src/theta-l_kokkos/cxx/CamForcing.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/CamForcing.cpp @@ -33,7 +33,7 @@ static void apply_cam_forcing_tracers(const Real dt, ForcingFunctor& ff, if ( p.ftype == ForcingAlg::FORCING_2) adjustment = true; #endif - ff.tracers_forcing(dt, tl.n0, tl.n0_qdp, adjustment, p.moisture); + ff.tracers_forcing(dt, tl.n0, tl.n0_qdp, adjustment, p.use_moisture); GPTLstop("ApplyCAMForcing_tracers"); } diff --git a/components/homme/src/theta-l_kokkos/cxx/ForcingFunctor.hpp b/components/homme/src/theta-l_kokkos/cxx/ForcingFunctor.hpp index 80993d1d0f1..f9b106c3640 100644 --- a/components/homme/src/theta-l_kokkos/cxx/ForcingFunctor.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/ForcingFunctor.hpp @@ -237,7 +237,7 @@ class ForcingFunctor }); } - void tracers_forcing (const Real dt, const int np1, const int np1_qdp, const bool adjustment, const MoistDry moisture) { + void tracers_forcing (const Real dt, const int np1, const int np1_qdp, const bool adjustment, const bool use_moisture) { // The Functor needs to be fully setup to use this function assert (is_setup); @@ -246,7 +246,7 @@ class ForcingFunctor m_np1_qdp = np1_qdp; m_adjustment = adjustment; - m_moist = (moisture==MoistDry::MOIST); + m_moist = use_moisture; Kokkos::parallel_for("temperature, NH perturb press, FQps",m_policy_tracers_pre,*this); Kokkos::fence(); diff --git a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp index f0f59205bde..139da761d67 100644 --- a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp @@ -43,10 +43,10 @@ void init_simulation_params_c (const int& remap_alg, const int& limiter_option, const Real& nu, const Real& nu_p, const Real& nu_q, const Real& nu_s, const Real& nu_div, const Real& nu_top, const int& hypervis_order, const int& hypervis_subcycle, const int& hypervis_subcycle_tom, const double& hypervis_scaling, const double& dcmip16_mu, - const int& ftype, const int& theta_adv_form, const bool& prescribed_wind, const bool& moisture, const bool& disable_diagnostics, - const bool& use_cpstar, const int& transport_alg, const bool& theta_hydrostatic_mode, const char** test_case, + const int& ftype, const int& theta_adv_form, const int& prescribed_wind, const int& use_moisture, const int& disable_diagnostics, + const int& use_cpstar, const int& transport_alg, const int& theta_hydrostatic_mode, const char** test_case, const int& dt_remap_factor, const int& dt_tracer_factor, - const double& scale_factor, const double& laplacian_rigid_factor, const int& nsplit, const bool& pgrad_correction, + const double& scale_factor, const double& laplacian_rigid_factor, const int& nsplit, const int& pgrad_correction, const double& dp3d_thresh, const double& vtheta_thresh, const int& internal_diagnostics_level) { @@ -119,22 +119,16 @@ if(theta_hydrostatic_mode){ params.hypervis_subcycle = hypervis_subcycle; params.hypervis_subcycle_tom = hypervis_subcycle_tom; params.hypervis_scaling = hypervis_scaling; - params.disable_diagnostics = disable_diagnostics; - params.moisture = (moisture ? MoistDry::MOIST : MoistDry::DRY); - params.use_cpstar = use_cpstar; + params.disable_diagnostics = (bool)disable_diagnostics; + params.use_moisture = (bool)use_moisture; + params.use_cpstar = (bool)use_cpstar; params.transport_alg = transport_alg; - -if(theta_hydrostatic_mode){ - params.theta_hydrostatic_mode = true; -}else{ - params.theta_hydrostatic_mode = false; -} - //params.theta_hydrostatic_mode = theta_hydrostatic_mode; + params.theta_hydrostatic_mode = (bool)theta_hydrostatic_mode; params.dcmip16_mu = dcmip16_mu; params.nsplit = nsplit; params.scale_factor = scale_factor; params.laplacian_rigid_factor = laplacian_rigid_factor; - params.pgrad_correction = pgrad_correction; + params.pgrad_correction = (bool)pgrad_correction; params.dp3d_thresh = dp3d_thresh; params.vtheta_thresh = vtheta_thresh; params.internal_diagnostics_level = internal_diagnostics_level; @@ -318,7 +312,7 @@ void init_elements_c (const int& num_elems) c.create_ref(e.m_forcing); } -void init_functors_c (const bool& allocate_buffer) +void init_functors_c (const int& allocate_buffer) { auto& c = Context::singleton(); diff --git a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 index 96b42314453..a613045e7b7 100644 --- a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 +++ b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 @@ -64,7 +64,7 @@ subroutine prim_init2(elem, hybrid, nets, nete, tl, hvcoord) end subroutine prim_init2 subroutine prim_create_c_data_structures (tl, hvcoord, mp) - use iso_c_binding, only : c_loc, c_ptr, c_bool, C_NULL_CHAR + use iso_c_binding, only : c_loc, c_ptr, C_NULL_CHAR use theta_f2c_mod, only : init_reference_element_c, init_simulation_params_c, & init_time_level_c, init_hvcoord_c, init_elements_c use time_mod, only : TimeLevel_t, nsplit @@ -73,7 +73,7 @@ subroutine prim_create_c_data_structures (tl, hvcoord, mp) nu, nu_p, nu_q, nu_s, nu_div, nu_top, vert_remap_q_alg, & hypervis_order, hypervis_subcycle, hypervis_subcycle_tom,& hypervis_scaling, & - ftype, prescribed_wind, moisture, disable_diagnostics, & + ftype, prescribed_wind, use_moisture, disable_diagnostics, & use_cpstar, transport_alg, theta_hydrostatic_mode, & dcmip16_mu, theta_advect_form, test_case, & MAX_STRING_LEN, dt_remap_factor, dt_tracer_factor, & @@ -93,6 +93,8 @@ subroutine prim_create_c_data_structures (tl, hvcoord, mp) type (c_ptr) :: hybrid_am_ptr, hybrid_ai_ptr, hybrid_bm_ptr, hybrid_bi_ptr character(len=MAX_STRING_LEN), target :: test_name + integer :: disable_diagnostics_int, theta_hydrostatic_mode_int, use_moisture_int + ! Initialize the C++ reference element structure (i.e., pseudo-spectral deriv matrix and ref element mass matrix) dvv = deriv1%dvv elem_mp = mp @@ -100,22 +102,28 @@ subroutine prim_create_c_data_structures (tl, hvcoord, mp) ! Fill the simulation params structures in C++ test_name = TRIM(test_case) // C_NULL_CHAR + + if (disable_diagnostics) disable_diagnostics_int=1 + if (.not.disable_diagnostics) disable_diagnostics_int=0 + if (use_moisture) use_moisture_int=1 + if (.not.use_moisture) use_moisture_int=0 + call init_simulation_params_c (vert_remap_q_alg, limiter_option, rsplit, qsplit, tstep_type, & qsize, statefreq, nu, nu_p, nu_q, nu_s, nu_div, nu_top, & hypervis_order, hypervis_subcycle, hypervis_subcycle_tom, & hypervis_scaling, & dcmip16_mu, ftype, theta_advect_form, & - LOGICAL(prescribed_wind==1,c_bool), & - LOGICAL(moisture/="dry",c_bool), & - LOGICAL(disable_diagnostics,c_bool), & - LOGICAL(use_cpstar==1,c_bool), & + prescribed_wind, & + use_moisture_int, & + disable_diagnostics_int, & + use_cpstar, & transport_alg, & - LOGICAL(theta_hydrostatic_mode,c_bool), & + theta_hydrostatic_mode_int, & c_loc(test_name), & dt_remap_factor, dt_tracer_factor, & scale_factor, laplacian_rigid_factor, & nsplit, & - LOGICAL(pgrad_correction==1,c_bool), & + pgrad_correction, & dp3d_thresh, vtheta_thresh, internal_diagnostics_level) ! Initialize time level structure in C++ @@ -343,22 +351,23 @@ subroutine prim_init_elements_views (elem) end subroutine prim_init_elements_views subroutine prim_init_kokkos_functors (allocate_buffer) - use iso_c_binding, only : c_bool use theta_f2c_mod, only : init_functors_c, init_boundary_exchanges_c - ! ! Optional Input ! - logical(kind=c_bool), optional :: allocate_buffer ! Whether functor memory buffer should be allocated internally + logical, intent(in), optional :: allocate_buffer ! Whether functor memory buffer should be allocated internally + + integer :: allocate_buffer_int ! Initialize the C++ functors in the C++ context ! If no argument allocate_buffer is present, ! let Homme internally allocate buffers + allocate_buffer_int=1 if (present(allocate_buffer)) then - call init_functors_c (logical(allocate_buffer,c_bool)) - else - call init_functors_c (logical(.true.,c_bool)) + if (allocate_buffer) allocate_buffer_int=1 + if (.not.allocate_buffer) allocate_buffer_int=0 endif + call init_functors_c (allocate_buffer_int) ! Initialize boundary exchange structure in C++ call init_boundary_exchanges_c () diff --git a/components/homme/src/theta-l_kokkos/theta_f2c_mod.F90 b/components/homme/src/theta-l_kokkos/theta_f2c_mod.F90 index 7a4c0424807..ba39bb03c22 100644 --- a/components/homme/src/theta-l_kokkos/theta_f2c_mod.F90 +++ b/components/homme/src/theta-l_kokkos/theta_f2c_mod.F90 @@ -11,14 +11,14 @@ subroutine init_simulation_params_c (remap_alg, limiter_option, rsplit, qsplit, qsize, state_frequency, nu, nu_p, nu_q, nu_s, nu_div, nu_top, & hypervis_order, hypervis_subcycle, hypervis_subcycle_tom, & hypervis_scaling, & - dcmip16_mu, ftype, theta_adv_form, prescribed_wind, moisture, & + dcmip16_mu, ftype, theta_adv_form, prescribed_wind, use_moisture, & disable_diagnostics, use_cpstar, transport_alg, & theta_hydrostatic_mode, test_case_name, dt_remap_factor, & dt_tracer_factor, scale_factor, laplacian_rigid_factor, & nsplit, pgrad_correction, dp3d_thresh, vtheta_thresh, & internal_diagnostics_level) bind(c) - use iso_c_binding, only: c_int, c_bool, c_double, c_ptr + use iso_c_binding, only: c_int, c_double, c_ptr ! ! Inputs ! @@ -29,8 +29,8 @@ subroutine init_simulation_params_c (remap_alg, limiter_option, rsplit, qsplit, scale_factor, laplacian_rigid_factor, dp3d_thresh, vtheta_thresh integer(kind=c_int), intent(in) :: hypervis_order, hypervis_subcycle, hypervis_subcycle_tom integer(kind=c_int), intent(in) :: ftype, theta_adv_form - logical(kind=c_bool), intent(in) :: prescribed_wind, moisture, disable_diagnostics, use_cpstar - logical(kind=c_bool), intent(in) :: theta_hydrostatic_mode, pgrad_correction + integer(kind=c_int), intent(in) :: prescribed_wind, use_moisture, disable_diagnostics, use_cpstar + integer(kind=c_int), intent(in) :: theta_hydrostatic_mode, pgrad_correction type(c_ptr), intent(in) :: test_case_name end subroutine init_simulation_params_c @@ -138,11 +138,11 @@ end subroutine init_reference_element_c ! Create C++ functors subroutine init_functors_c (allocate_buffer) bind(c) - use iso_c_binding, only: c_bool + use iso_c_binding, only: c_int ! ! Inputs ! - logical(kind=c_bool), intent(in) :: allocate_buffer + integer(kind=c_int), intent(in) :: allocate_buffer end subroutine init_functors_c ! Initialize C++ boundary exchange structures From 0c4da33d48492e59fed4faa515156c254617ceaa Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 26 Apr 2024 23:04:44 -0500 Subject: [PATCH 060/529] fixing bug, all cxx vs f pass --- .../src/theta-l_kokkos/prim_driver_mod.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 index a613045e7b7..262ba19f4b7 100644 --- a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 +++ b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 @@ -107,6 +107,8 @@ subroutine prim_create_c_data_structures (tl, hvcoord, mp) if (.not.disable_diagnostics) disable_diagnostics_int=0 if (use_moisture) use_moisture_int=1 if (.not.use_moisture) use_moisture_int=0 + if(theta_hydrostatic_mode) theta_hydrostatic_mode_int=1 + if(.not.theta_hydrostatic_mode) theta_hydrostatic_mode_int=0 call init_simulation_params_c (vert_remap_q_alg, limiter_option, rsplit, qsplit, tstep_type, & qsize, statefreq, nu, nu_p, nu_q, nu_s, nu_div, nu_top, & @@ -351,23 +353,22 @@ subroutine prim_init_elements_views (elem) end subroutine prim_init_elements_views subroutine prim_init_kokkos_functors (allocate_buffer) + use iso_c_binding, only : c_int use theta_f2c_mod, only : init_functors_c, init_boundary_exchanges_c ! ! Optional Input ! - logical, intent(in), optional :: allocate_buffer ! Whether functor memory buffer should be allocated internally - - integer :: allocate_buffer_int - + integer, intent(in), optional :: allocate_buffer ! Whether functor memory buffer should be allocated internally + integer(kind=c_int) :: dummy ! Initialize the C++ functors in the C++ context ! If no argument allocate_buffer is present, ! let Homme internally allocate buffers - allocate_buffer_int=1 if (present(allocate_buffer)) then - if (allocate_buffer) allocate_buffer_int=1 - if (.not.allocate_buffer) allocate_buffer_int=0 + call init_functors_c (allocate_buffer) + else + dummy=1; + call init_functors_c (dummy) endif - call init_functors_c (allocate_buffer_int) ! Initialize boundary exchange structure in C++ call init_boundary_exchanges_c () From 2caefc04bfabf08753548294799970c83d62accc Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 9 May 2024 20:26:36 +0000 Subject: [PATCH 061/529] make ad consistent with bool->int changes --- .../eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp | 2 +- .../eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp index c535829fbfa..31f2363f4bf 100644 --- a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp +++ b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp @@ -814,7 +814,7 @@ void HommeDynamics::init_homme_views () { std::stringstream msg; msg << "\n************** HOMMEXX SimulationParams **********************\n\n"; msg << " time_step_type: " << Homme::etoi(params.time_step_type) << "\n"; - msg << " moisture: " << (params.moisture==Homme::MoistDry::DRY ? "dry" : "moist") << "\n"; + msg << " moisture: " << (params.use_moisture ? "moist" : "dry") << "\n"; msg << " remap_alg: " << Homme::etoi(params.remap_alg) << "\n"; msg << " test case: " << Homme::etoi(params.test_case) << "\n"; msg << " ftype: " << Homme::etoi(params.ftype) << "\n"; diff --git a/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 b/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 index eefcd65e8d7..3ce903b611d 100644 --- a/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 +++ b/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 @@ -192,7 +192,7 @@ subroutine prim_init_model_f90 () bind(c) elem, hybrid, hvcoord, deriv, tl ! Local variable - logical(kind=c_bool), parameter :: allocate_buffer = .false. + integer, parameter :: allocate_buffer = 0 if (.not. is_data_structures_inited) then call abortmp ("Error! 'prim_init_data_structures_f90' has not been called yet.\n") From 00d936bd47892ae6d65cdc49fb8662e432841007 Mon Sep 17 00:00:00 2001 From: hollyhan Date: Fri, 10 May 2024 15:21:30 -0600 Subject: [PATCH 062/529] Activate extrapOceanData package when TF extrap scheme is on Also move origOceanMaskHoriz to exrapOceanDataPool Also include the variables in the package in restart stream --- .../mpas-albany-landice/src/Registry.xml | 20 ++++++++++++------- .../src/mode_forward/mpas_li_core_interface.F | 8 ++++++++ .../src/mode_forward/mpas_li_ocean_extrap.F | 2 +- 3 files changed, 22 insertions(+), 8 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 1b4e8f954a9..10435fdc94d 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -809,7 +809,7 @@ - + + + + + + + + + + @@ -1190,9 +1199,6 @@ is the value of that variable from the *previous* time level! - @@ -1672,9 +1678,9 @@ is the value of that variable from the *previous* time level! - + /> diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F index e24cc19dccf..f9f0185499c 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_core_interface.F @@ -117,6 +117,7 @@ function li_setup_packages(configPool, packagePool, iocontext) result(ierr) logical, pointer :: ismip6ShelfMeltActive logical, pointer :: ismip6GroundedFaceMeltActive logical, pointer :: thermalActive + logical, pointer :: extrapOceanDataActive ierr = 0 @@ -137,6 +138,7 @@ function li_setup_packages(configPool, packagePool, iocontext) result(ierr) call mpas_pool_get_package(packagePool, 'ismip6ShelfMeltActive', ismip6ShelfMeltActive) call mpas_pool_get_package(packagePool, 'ismip6GroundedFaceMeltActive', ismip6GroundedFaceMeltActive) call mpas_pool_get_package(packagePool, 'thermalActive', thermalActive) + call mpas_pool_get_package(packagePool, 'extrapOceanDataActive', extrapOceanDataActive) if (trim(config_velocity_solver) == 'sia') then SIAvelocityActive = .true. @@ -159,6 +161,12 @@ function li_setup_packages(configPool, packagePool, iocontext) result(ierr) "'config_write_albany_ascii_mesh' is set to .true.") endif + if (config_ocean_data_extrapolation) then + extrapOceanDataActive = .true. + call mpas_log_write("The 'extrapOceanDataActive' package and assocated variables have been enabled because " // & + "'config_ocean_data_extrapolation' is set to .true.") + endif + if ( (trim(config_basal_mass_bal_float) == 'ismip6') .or. & ((trim(config_front_mass_bal_grounded) == 'ismip6') .and. & (config_use_3d_thermal_forcing_for_face_melt)) .or. & diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 6e5c9c31f72..c3dfb396a27 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -127,7 +127,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) - call mpas_pool_get_array(geometryPool, 'origOceanMaskHoriz', origOceanMaskHoriz) + call mpas_pool_get_array(extrapOceanDataPool, 'origOceanMaskHoriz', origOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMaskOrig', validOceanMaskOrig) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) From 9d9eef22efed35778a91dcc597c2f382ec90f3b6 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 11 May 2024 18:43:40 +0000 Subject: [PATCH 063/529] add sunsporspu --- .../cmake_macros/oneapi-ifx_sunspotcpu.cmake | 19 ++++ cime_config/machines/config_batch.xml | 8 ++ cime_config/machines/config_machines.xml | 94 +++++++++++++++++++ .../cmake/machine-files/sunspotcpu.cmake | 33 +++++++ 4 files changed, 154 insertions(+) create mode 100644 cime_config/machines/cmake_macros/oneapi-ifx_sunspotcpu.cmake create mode 100644 components/eamxx/cmake/machine-files/sunspotcpu.cmake diff --git a/cime_config/machines/cmake_macros/oneapi-ifx_sunspotcpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifx_sunspotcpu.cmake new file mode 100644 index 00000000000..bd6ec8ed913 --- /dev/null +++ b/cime_config/machines/cmake_macros/oneapi-ifx_sunspotcpu.cmake @@ -0,0 +1,19 @@ + +string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core") +if (compile_threaded) + string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") +endif() + +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") + +#set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") + + + + + + + + + + diff --git a/cime_config/machines/config_batch.xml b/cime_config/machines/config_batch.xml index d1347eaa0df..5adae921564 100644 --- a/cime_config/machines/config_batch.xml +++ b/cime_config/machines/config_batch.xml @@ -551,6 +551,14 @@ + + /lus/gila/projects/CSC249ADSE15_CNDA/tools/qsub/throttle + + workq + debug + + + /lus/gila/projects/CSC249ADSE15_CNDA/tools/qsub/throttle diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index d0a6caa5409..cb43c4a3684 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3228,6 +3228,100 @@ + + ANL Sunspot Test and Development System (TDS), batch system is pbspro + uan-.* + LINUX + oneapi-ifx + mpich + CSC249ADSE15_CNDA + /gila/CSC249ADSE15_CNDA/performance_archive + .* + /lus/gila/projects/CSC249ADSE15_CNDA/$USER/scratch + /lus/gila/projects/CSC249ADSE15_CNDA/inputdata + /lus/gila/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + /lus/gila/projects/CSC249ADSE15_CNDA/baselines/$COMPILER + /lus/gila/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc + 16 + e3sm_developer + 4 + pbspro + e3sm + 208 + 104 + FALSE + + mpiexec + + + -np {{ total_tasks }} --label + -ppn {{ tasks_per_node }} + --cpu-bind depth -envall + -d $ENV{OMP_NUM_THREADS} + + + + + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + /usr/share/lmod/lmod/init/env_modules_python.py + module + module + /usr/share/lmod/lmod/libexec/lmod python + + + + spack-pe-gcc/0.6.1-23.275.2 cmake python/3.10.10 + + + + oneapi/eng-compiler/2023.12.15.002 + mpich/icc-all-pmix-gpu/52.2 + + + + + cray-pals + + libfabric/1.15.2.0 + + + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf + list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 + + + 1 + + + DISABLED + + + + + + 131072 + 20 + 0 + + + verbose,granularity=thread,balanced + 128M + + + -1 + + + + + + + ANL Sunspot Test and Development System (TDS), batch system is pbspro diff --git a/components/eamxx/cmake/machine-files/sunspotcpu.cmake b/components/eamxx/cmake/machine-files/sunspotcpu.cmake new file mode 100644 index 00000000000..02b05de9720 --- /dev/null +++ b/components/eamxx/cmake/machine-files/sunspotcpu.cmake @@ -0,0 +1,33 @@ +include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) +common_setup() + +include (${EKAT_MACH_FILES_PATH}/kokkos/serial.cmake) +# kokkos sycl is on in the above file +#include (${EKAT_MACH_FILES_PATH}/kokkos/sycl.cmake) +include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) + +#AB flags from ekat +# -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel + +#SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") + +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) +set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -mlong-double-64 -DNDEBUG -fortlib" CACHE STRING "" FORCE) +#set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) + + + +set(NETCDF_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_DIR "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +#this one is for rrtmgp +set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(PNETCDF_PATH "$ENV{PNETCDF_PATH}" CACHE STRING "") + + +set(PNETCDF_DIR "$ENV{PNETCDF_PATH}" CACHE STRING "") + + From 96b62a99b2704359181d1b8364ec76a436f86aa0 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 11 May 2024 18:44:47 +0000 Subject: [PATCH 064/529] remove -g for now --- cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake index 0ee9c4706ed..c798c53ee8b 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake @@ -4,9 +4,11 @@ if (compile_threaded) string(APPEND CMAKE_CXX_FLAGS " -qopenmp") string(APPEND CMAKE_EXE_LINKER_FLAGS " -qopenmp") endif() -string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -g") -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -g -fpscomp logicals") -string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2 -g") + +#adding -g here leads to linker internal errors +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -fpscomp logicals") +string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2") string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -fpscomp logicals -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") From 563321577e2bdef2d29cc8d09ac66c5a59c60764 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 11 May 2024 18:45:49 +0000 Subject: [PATCH 065/529] switch theta_hy_mode to int for now --- components/homme/src/share/cxx/SimulationParams.hpp | 2 +- .../theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp | 12 +++++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/components/homme/src/share/cxx/SimulationParams.hpp b/components/homme/src/share/cxx/SimulationParams.hpp index 4f36962b16c..923f25129c4 100644 --- a/components/homme/src/share/cxx/SimulationParams.hpp +++ b/components/homme/src/share/cxx/SimulationParams.hpp @@ -42,7 +42,7 @@ struct SimulationParams bool disable_diagnostics; int transport_alg; bool use_cpstar; - bool theta_hydrostatic_mode; // Only for theta model + int theta_hydrostatic_mode; // Only for theta model double dcmip16_mu; // Only for theta model double nu; diff --git a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp index 139da761d67..97588045644 100644 --- a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp @@ -50,6 +50,9 @@ void init_simulation_params_c (const int& remap_alg, const int& limiter_option, const double& dp3d_thresh, const double& vtheta_thresh, const int& internal_diagnostics_level) { + std::cout << "In transfer routine theta_hydrostatic_mode =" << theta_hydrostatic_mode << "\n"; + + if(theta_hydrostatic_mode){ std::cout << " HEEEEEEEEEEEtheta_hydrostatic_mode =TRUE \n"; }else @@ -101,6 +104,13 @@ if(theta_hydrostatic_mode){ params.theta_adv_form = AdvectionForm::NonConservative; } +// if (theta_hydrostatic_mode==0) { +// params.theta_hydrostatic_mode = false; +// } else { +// params.theta_hydrostatic_mode = true; +// } + + params.limiter_option = limiter_option; params.rsplit = rsplit; params.qsplit = qsplit; @@ -123,7 +133,7 @@ if(theta_hydrostatic_mode){ params.use_moisture = (bool)use_moisture; params.use_cpstar = (bool)use_cpstar; params.transport_alg = transport_alg; - params.theta_hydrostatic_mode = (bool)theta_hydrostatic_mode; + params.theta_hydrostatic_mode = theta_hydrostatic_mode; params.dcmip16_mu = dcmip16_mu; params.nsplit = nsplit; params.scale_factor = scale_factor; From d38b8e1e955f94e13424e825c755d826c7dc7022 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 13 May 2024 16:55:02 +0000 Subject: [PATCH 066/529] debug statements --- .../eamxx/src/control/atmosphere_driver.cpp | 17 ++++++++++ .../physics/p3/eamxx_p3_process_interface.hpp | 31 +++++++++++++++++-- .../rrtmgp/eamxx_rrtmgp_process_interface.cpp | 13 ++++++++ .../atm_process/atmosphere_process_group.cpp | 26 ++++++++++++++-- 4 files changed, 82 insertions(+), 5 deletions(-) diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index 8268caf9653..467cb415bb6 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -1611,14 +1611,22 @@ initialize (const ekat::Comm& atm_comm, void AtmosphereDriver::run (const int dt) { start_timer("EAMxx::run"); + std::cout << "IN DRIVER 1 \n"; + + // Make sure the end of the time step is after the current start_time EKAT_REQUIRE_MSG (dt>0, "Error! Input time step must be positive.\n"); + + std::cout << "IN DRIVER 2 \n"; + // Print current timestamp information m_atm_logger->log(ekat::logger::LogLevel::info, "Atmosphere step = " + std::to_string(m_current_ts.get_num_steps()) + "\n" + " model start-of-step time = " + m_current_ts.get_date_string() + " " + m_current_ts.get_time_string() + "\n"); + + std::cout << "IN DRIVER 3 \n"; // Reset accum fields to 0 // Note: at the 1st timestep this is redundant, since we did it at init, // to ensure t=0 INSTANT output was correct. However, it's not a @@ -1626,10 +1634,12 @@ void AtmosphereDriver::run (const int dt) { // nano-opt of removing the call for the 1st timestep. reset_accumulated_fields(); + std::cout << "IN DRIVER 4 \n" << std::flush; // The class AtmosphereProcessGroup will take care of dispatching arguments to // the individual processes, which will be called in the correct order. m_atm_process_group->run(dt); + std::cout << "IN DRIVER 5 \n"<< std::flush; // Some accumulated fields need to be divided by dt at the end of the atm step for (auto fm_it : m_field_mgrs) { const auto& fm = fm_it.second; @@ -1643,15 +1653,22 @@ void AtmosphereDriver::run (const int dt) { } } + std::cout << "IN DRIVER 6 \n"<debug("[EAMxx::run] running output managers..."); for (auto& out_mgr : m_output_managers) { out_mgr.run(m_current_ts); } +#endif + #ifdef SCREAM_HAS_MEMORY_USAGE long long my_mem_usage = get_mem_usage(MB); long long max_mem_usage; diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp index 3e8cc6642ec..373d2efe7e3 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp @@ -203,8 +203,17 @@ class P3Microphysics : public AtmosphereProcess struct p3_postamble { p3_postamble() = default; // Functor for Kokkos loop to pre-process every run step + + //Kokkos::printf("OG postamble start"); + KOKKOS_INLINE_FUNCTION void operator()(const int icol) const { + +//Kokkos::printf("OG postamble P################3\n"); + +#if 1 +#if 1 + for (int ipack=0;ipack(get_field_out("T_mid"),m_grid,100.0, 500.0,false); @@ -446,6 +449,13 @@ void RRTMGPRadiation::run_impl (const double dt) { using PC = scream::physics::Constants; using CO = scream::ColumnOps; + + std::cout << "RRTMGP IMPL 1 ------------------------ \n"; + std::cout << std::flush ; + + +#if 0 + // get a host copy of lat/lon auto h_lat = m_lat.get_view(); auto h_lon = m_lon.get_view(); @@ -1108,6 +1118,9 @@ void RRTMGPRadiation::run_impl (const double dt) { }); } +#endif + + } // ========================================================================================= diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp index cf69e569697..b05982e4cf4 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp @@ -392,6 +392,7 @@ void AtmosphereProcessGroup::initialize_impl (const RunType run_type) { m_atm_logger->debug("[EAMxx::initialize::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); #endif } + std::cout << "process GROUP is done\n" << std::flush; } void AtmosphereProcessGroup::run_impl (const double dt) { @@ -400,6 +401,9 @@ void AtmosphereProcessGroup::run_impl (const double dt) { } else { run_parallel(dt); } + + std::cout << "process GROUP RUN is done\n" << std::flush; + } void AtmosphereProcessGroup::run_sequential (const double dt) { @@ -419,11 +423,10 @@ void AtmosphereProcessGroup::run_sequential (const double dt) { const int ncols = fm->get_grid()->get_num_local_dofs(); const int nlevs = fm->get_grid()->get_num_vertical_levels(); - //fm->get_field("T_mid").sync_to_host(); + fm->get_field("T_mid").sync_to_host(); auto ff = fm->get_field("T_mid").get_view(); #if 0 - //const auto vv = ff(1,1); for (int ii = 0; ii < ncols; ii++) for (int jj = 0; jj < nlevs; jj++){ const auto vv = ff(ii,jj); @@ -443,9 +446,28 @@ std::cout << "OG T field (" <name() << " dt="<get_field("T_mid").sync_to_host(); + auto ff = fm->get_field("T_mid").get_view(); + +#if 0 + for (int ii = 0; ii < 5; ii++) + for (int jj = 0; jj < nlevs; jj++){ + const auto vv = ff(ii,jj); +m_atm_logger->info("OG T field ("+std::to_string(ii)+","+std::to_string(jj)+") = "+std::to_string(vv)); +std::cout << "OG T field (" <name() <<"\n"<set_update_time_stamps(do_update); // Run the process atm_proc->run(dt); + +std::cout << "OG proc AFTER RUN " << atm_proc->name() <<"\n"< Date: Wed, 15 May 2024 16:08:04 +0000 Subject: [PATCH 067/529] fixes after merges --- cime_config/machines/config_machines.xml | 82 ++---------------------- 1 file changed, 5 insertions(+), 77 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 23d72218b23..ec65b527772 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3454,7 +3454,7 @@ 131072 20 - + verbose,granularity=thread,balanced 128M @@ -3643,7 +3643,7 @@ 20 0 - + verbose,granularity=thread,balanced 128M @@ -3744,7 +3744,7 @@ 131072 20 - + verbose,granularity=thread,balanced 128M @@ -3754,78 +3754,6 @@ - - - - - - - - - - - - -======= - /usr/share/lmod/8.3.1/init/python - /usr/share/lmod/8.3.1/init/sh - /usr/share/lmod/8.3.1/init/csh - /usr/share/lmod/lmod/libexec/lmod python - module - module - - - cmake/3.23.2 - craype-x86-rome - - - PrgEnv-gnu/8.3.3 - - - gcc/12.2.0 gcc/11.2.0 - cudatoolkit-standalone/11.4.4 - - - PrgEnv-nvhpc/8.3.3 - - - cudatoolkit-standalone/11.4.4 - craype-accel-nvidia80 - - - craype-network-ofi - libfabric/1.15.2.0 - cray-libsci/23.02.1.1 - cray-hdf5-parallel/1.12.2.3 - cray-netcdf-hdf5parallel/4.9.0.3 - cray-parallel-netcdf/1.12.3.3 - - - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - - $ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} - $ENV{CRAY_PARALLEL_NETCDF_PREFIX} - 0 - host - - - - 1 - nvidia80 - /grand/E3SMinput/soft/qsub/set_affinity_gpu_polaris.sh - - - /opt/cray/pe/gcc/11.2.0/snos/lib64/libstdc++.so - - - 128M - spread - threads - - - ->>>>>>> origin/master ANL Sunspot Test and Development System (TDS), batch system is pbspro uan-.* @@ -4132,11 +4060,11 @@ 0 - + verbose,granularity=thread,balanced 128M - + threads 128M From 4a9430ca6880befaa3b5aa77025a9c3e9be094a2 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 16 May 2024 15:37:28 +0000 Subject: [PATCH 068/529] cpu build changes after merge --- components/eamxx/CMakeLists.txt | 84 +++++++++---------- .../cmake/machine-files/sunspotcpu.cmake | 1 + 2 files changed, 43 insertions(+), 42 deletions(-) diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 9cd2109c848..3d59c1010a3 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -549,25 +549,25 @@ if (SCREAM_DOUBLE_PRECISION) endif() endif() -print_var(SCREAM_MACHINE) -print_var(EAMXX_ENABLE_GPU) -print_var(CUDA_BUILD) -print_var(HIP_BUILD) -print_var(SYCL_BUILD) -print_var(SCREAM_DOUBLE_PRECISION) -print_var(SCREAM_MIMIC_GPU) -print_var(SCREAM_FPE) -print_var(SCREAM_NUM_VERTICAL_LEV) -print_var(SCREAM_PACK_SIZE) -print_var(SCREAM_SMALL_PACK_SIZE) -print_var(SCREAM_POSSIBLY_NO_PACK_SIZE) -print_var(SCREAM_LINK_FLAGS) -print_var(SCREAM_FPMODEL) -print_var(SCREAM_LIB_ONLY) -print_var(SCREAM_TPL_LIBRARIES) -print_var(SCREAM_TEST_MAX_THREADS) -print_var(SCREAM_TEST_THREAD_INC) -print_var(SCREAM_TEST_MAX_RANKS) +#print_var(SCREAM_MACHINE) +#print_var(EAMXX_ENABLE_GPU) +#print_var(CUDA_BUILD) +#print_var(HIP_BUILD) +#print_var(SYCL_BUILD) +#print_var(SCREAM_DOUBLE_PRECISION) +#print_var(SCREAM_MIMIC_GPU) +#print_var(SCREAM_FPE) +#print_var(SCREAM_NUM_VERTICAL_LEV) +#print_var(SCREAM_PACK_SIZE) +#print_var(SCREAM_SMALL_PACK_SIZE) +#print_var(SCREAM_POSSIBLY_NO_PACK_SIZE) +#print_var(SCREAM_LINK_FLAGS) +#print_var(SCREAM_FPMODEL) +#print_var(SCREAM_LIB_ONLY) +#print_var(SCREAM_TPL_LIBRARIES) +#print_var(SCREAM_TEST_MAX_THREADS) +#print_var(SCREAM_TEST_THREAD_INC) +#print_var(SCREAM_TEST_MAX_RANKS) # This must be done using add_definitions because it is used to determine # whether to include scream_config.h. @@ -621,29 +621,29 @@ message ("* Summary of EAMxx config settings *") message ("**************************************************") # Shortcut function, to print a variable -function (print_var var) - message ("${var}: ${${var}}") -endfunction () - -print_var(EAMXX_ENABLE_GPU) -print_var(CUDA_BUILD) -print_var(HIP_BUILD) -print_var(SCREAM_MACHINE) -print_var(SCREAM_DYNAMICS_DYCORE) -print_var(SCREAM_DOUBLE_PRECISION) -print_var(SCREAM_MIMIC_GPU) -print_var(SCREAM_FPE) -print_var(SCREAM_NUM_VERTICAL_LEV) -print_var(SCREAM_PACK_SIZE) -print_var(SCREAM_SMALL_PACK_SIZE) -print_var(SCREAM_POSSIBLY_NO_PACK_SIZE) -print_var(SCREAM_LINK_FLAGS) -print_var(SCREAM_FPMODEL) -print_var(SCREAM_LIB_ONLY) -print_var(SCREAM_TPL_LIBRARIES) -print_var(SCREAM_TEST_MAX_THREADS) -print_var(SCREAM_TEST_THREAD_INC) -print_var(SCREAM_TEST_MAX_RANKS) +#function (print_var var) +# message ("${var}: ${${var}}") +#endfunction () + +#print_var(EAMXX_ENABLE_GPU) +#print_var(CUDA_BUILD) +#print_var(HIP_BUILD) +#print_var(SCREAM_MACHINE) +#print_var(SCREAM_DYNAMICS_DYCORE) +#print_var(SCREAM_DOUBLE_PRECISION) +#print_var(SCREAM_MIMIC_GPU) +#print_var(SCREAM_FPE) +#print_var(SCREAM_NUM_VERTICAL_LEV) +#print_var(SCREAM_PACK_SIZE) +#print_var(SCREAM_SMALL_PACK_SIZE) +#print_var(SCREAM_POSSIBLY_NO_PACK_SIZE) +#print_var(SCREAM_LINK_FLAGS) +#print_var(SCREAM_FPMODEL) +#print_var(SCREAM_LIB_ONLY) +#print_var(SCREAM_TPL_LIBRARIES) +#print_var(SCREAM_TEST_MAX_THREADS) +#print_var(SCREAM_TEST_THREAD_INC) +#print_var(SCREAM_TEST_MAX_RANKS) message ("**************************************************") diff --git a/components/eamxx/cmake/machine-files/sunspotcpu.cmake b/components/eamxx/cmake/machine-files/sunspotcpu.cmake index 02b05de9720..7b186e58c42 100644 --- a/components/eamxx/cmake/machine-files/sunspotcpu.cmake +++ b/components/eamxx/cmake/machine-files/sunspotcpu.cmake @@ -22,6 +22,7 @@ set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -mlong-double-64 -DNDEBUG set(NETCDF_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") set(NETCDF_DIR "$ENV{NETCDF_PATH}" CACHE STRING "") set(NETCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_C "$ENV{NETCDF_PATH}" CACHE STRING "") #this one is for rrtmgp set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") From 652575cfc6edafd7c87b84596b6247b35bde1111 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 18 May 2024 23:43:53 +0000 Subject: [PATCH 069/529] fix for use_moisture --- components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp b/components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp index 9e04b4a0092..fe9f65bad5e 100644 --- a/components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp +++ b/components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp @@ -277,7 +277,7 @@ apply_iop_forcing(const Real dt) ElementOps elem_ops; elem_ops.init(hvcoord); - const bool use_moisture = (params.moisture == Homme::MoistDry::MOIST); + const bool use_moisture = params.use_moisture; // Load data from IOP files, if necessary m_iop->read_iop_file_data(timestamp()); From ee9fd25afb45409403e60bef578438fb3ff52fac Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 18 May 2024 23:45:29 +0000 Subject: [PATCH 070/529] cmake changes for cpu and sunspotcpu and debug prints --- .../machines/cmake_macros/oneapi-ifx.cmake | 12 +++++----- .../cmake/machine-files/sunspotcpu.cmake | 22 +++++++++---------- .../atm_process/atmosphere_process_group.cpp | 13 +++++------ 3 files changed, 23 insertions(+), 24 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifx.cmake b/cime_config/machines/cmake_macros/oneapi-ifx.cmake index e9a0f838b1f..5782a126eca 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifx.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifx.cmake @@ -4,15 +4,15 @@ if (compile_threaded) string(APPEND CMAKE_CXX_FLAGS " -qopenmp") string(APPEND CMAKE_EXE_LINKER_FLAGS " -qopenmp") endif() -string(APPEND CMAKE_C_FLAGS_RELEASE " -O2") -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2") -string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2") +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -gline-tables-only -g") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -gline-tables-only -g") +string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2 -gline-tables-only -g") string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") -string(APPEND CMAKE_C_FLAGS " -fp-model precise -std=gnu99") -string(APPEND CMAKE_CXX_FLAGS " -fp-model precise") -string(APPEND CMAKE_Fortran_FLAGS " -traceback -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise") +string(APPEND CMAKE_C_FLAGS " -fp-model precise -std=gnu99 -gline-tables-only -g") +string(APPEND CMAKE_CXX_FLAGS " -fp-model precise -gline-tables-only -g") +string(APPEND CMAKE_Fortran_FLAGS " -traceback -convert big_endian -assume byterecl -assume realloc_lhs -fp-model precise -gline-tables-only -g") string(APPEND CPPDEFS " -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL -DHAVE_SLASHPROC -DHIDE_MPI") string(APPEND CMAKE_Fortran_FORMAT_FIXED_FLAG " -fixed -132") string(APPEND CMAKE_Fortran_FORMAT_FREE_FLAG " -free") diff --git a/components/eamxx/cmake/machine-files/sunspotcpu.cmake b/components/eamxx/cmake/machine-files/sunspotcpu.cmake index 7b186e58c42..ff7773daae1 100644 --- a/components/eamxx/cmake/machine-files/sunspotcpu.cmake +++ b/components/eamxx/cmake/machine-files/sunspotcpu.cmake @@ -11,24 +11,24 @@ include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) #SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") -set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG" CACHE STRING "" FORCE) -set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) -set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) +set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG -gline-tables-only -g" CACHE STRING "" FORCE) +set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g -gline-tables-only" CACHE STRING "" FORCE) +set(CMAKE_C_FLAGS "-O3 -DNDEBUG -gline-tables-only -g" CACHE STRING "" FORCE) set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -mlong-double-64 -DNDEBUG -fortlib" CACHE STRING "" FORCE) #set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) -set(NETCDF_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_DIR "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_C "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_DIR "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_C_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_C "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") #this one is for rrtmgp -set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}" CACHE STRING "") +set(NetCDF_C_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(PNETCDF_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf" CACHE STRING "") -set(PNETCDF_DIR "$ENV{PNETCDF_PATH}" CACHE STRING "") +set(PNETCDF_DIR "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf" CACHE STRING "") diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp index b05982e4cf4..d13f166d6b8 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp @@ -401,9 +401,7 @@ void AtmosphereProcessGroup::run_impl (const double dt) { } else { run_parallel(dt); } - - std::cout << "process GROUP RUN is done\n" << std::flush; - + std::cout << "process GROUP RUN is done\n" << std::flush; } void AtmosphereProcessGroup::run_sequential (const double dt) { @@ -411,9 +409,7 @@ void AtmosphereProcessGroup::run_sequential (const double dt) { auto ts = timestamp(); ts += dt; - - - auto& c = scream::ScreamContext::singleton(); + auto& c = scream::ScreamContext::singleton(); auto ad = c.getNonConst(); const auto gn = "Physics"; //const auto gn = "Physics GLL"; @@ -436,7 +432,6 @@ std::cout << "OG T field (" <name() <<"\n"<debug("[EAMxx::run_sequential::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); #endif + +std::cout << "OG AFTER mem usage " << atm_proc->name() <<"\n"< Date: Mon, 20 May 2024 17:52:40 +0000 Subject: [PATCH 071/529] fix LD path for sunspot --- cime_config/machines/config_machines.xml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index ec65b527772..4f3910c6fb2 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3627,7 +3627,9 @@ /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf - list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/lib:$ENV{LD_LIBRARY_PATH} + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/bin:$ENV{PATH} + list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 1 From 891700f8779c31a44f26fbd862ce11d7840188ac Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 22 May 2024 16:43:18 +0000 Subject: [PATCH 072/529] update aurora builds, cpu built, gpu wip --- cime_config/machines/config_machines.xml | 10 +++++----- .../eamxx/cmake/machine-files/aurora.cmake | 14 +++++++------ .../eamxx/cmake/machine-files/auroracpu.cmake | 20 ++++++++++++++----- 3 files changed, 28 insertions(+), 16 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 4f3910c6fb2..1d99b26bd10 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3920,9 +3920,9 @@ /soft/modulefiles - /soft/restricted/CNDA/updates/modulefiles - cray-python/3.9.13.1 - spack-pe-gcc/0.4-rc1 cmake/3.26.4-gcc-testing + /soft/restricted/CNDA/updates/modulefiles + spack-pe-gcc/0.6.1-23.275.2 cmake + python/3.10.10 oneapi/release/2023.12.15.001 @@ -4030,8 +4030,8 @@ /soft/modulefiles /soft/restricted/CNDA/updates/modulefiles - cray-python/3.9.13.1 - spack-pe-gcc/0.4-rc1 cmake/3.26.4-gcc-testing + spack-pe-gcc/0.6.1-23.275.2 cmake + python/3.10.10 oneapi/release/2023.12.15.001 diff --git a/components/eamxx/cmake/machine-files/aurora.cmake b/components/eamxx/cmake/machine-files/aurora.cmake index 874b73e34eb..cdebb0500a6 100644 --- a/components/eamxx/cmake/machine-files/aurora.cmake +++ b/components/eamxx/cmake/machine-files/aurora.cmake @@ -21,12 +21,14 @@ set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-func -set(NETCDF_PATH "$ENV{NETCDF_PATH}") -set(NETCDF_C_PATH "$ENV{NETCDF_PATH}") +#this is needed for cime builds! +set(NETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_DIR "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") +set(NETCDF_C "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") #this one is for rrtmgp -set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") - +set(NetCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(PNETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007") diff --git a/components/eamxx/cmake/machine-files/auroracpu.cmake b/components/eamxx/cmake/machine-files/auroracpu.cmake index 839c4c09814..1d8f246f63f 100644 --- a/components/eamxx/cmake/machine-files/auroracpu.cmake +++ b/components/eamxx/cmake/machine-files/auroracpu.cmake @@ -18,12 +18,22 @@ set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -mlong-double-64 -DNDEBUG #set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) -set(NETCDF_PATH "$ENV{NETCDF_PATH}") -set(NETCDF_C_PATH "$ENV{NETCDF_PATH}") + +# +# /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 +# /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 +# /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 + + +#this is needed for cime builds! +set(NETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_DIR "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") +set(NETCDF_C "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") #this one is for rrtmgp -set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}") +set(NetCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(PNETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007") From f0f94bb104204a1f6c37bc05c73b2823379372af Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 21 May 2024 15:49:26 -0600 Subject: [PATCH 073/529] Treat phi slopes same as GL at land margins Inserts hydtoTerrestrialMarginMask into logic dealing with hydropotential slopes along ice boundaries --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index b722459761e..e15e98a6aa7 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -923,7 +923,7 @@ subroutine calc_edge_quantities(block, err) ! At boundaries of hydro domain, disallow inflow. Allow outflow if hydropotential gradient requires it. do iEdge = 1, nEdges if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) .or. & - (hydroMarineMarginMask(iEdge)==1)) then + (hydroMarineMarginMask(iEdge)==1) .or. (hydroTerrestrialMarginMask(iEdge)==1) ) then cell1 = cellsOnEdge(1, iEdge) cell2 = cellsOnEdge(2, iEdge) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain From 9955a29c611ec3cfdc5a398fb79dd9fe8f027a5b Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 9 Aug 2023 17:52:29 -0600 Subject: [PATCH 074/529] No waterPress. or hydroPot. where no grounded ice This commit zeros out waterPressure and and hydropotential where there is no grounded ice. This is meant to resolve issues at the grounding line occuring when the grounding line retreats to deeper waters so that the direction of the hydropotential switches and points up glacier. With this commit, we now have undefined waterPressure and hydropotential in the ocean, which should negate this issue. --- .../mode_forward/mpas_li_subglacial_hydro.F | 27 ++++++++----------- 1 file changed, 11 insertions(+), 16 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index e15e98a6aa7..486b1b16184 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -206,9 +206,8 @@ subroutine li_SGH_init(domain, err) ! set pressure correctly under floating ice and open ocean call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - where ( (li_mask_is_floating_ice(cellMask)) .or. & - ( (.not. li_mask_is_ice(cellMask)) .and. (bedTopography < config_sea_level) ) ) - waterPressure = rhoo * gravity * (config_sea_level - bedTopography) + where (.not. (li_mask_is_grounded_ice(cellMask))) + waterPressure = 0.0_RKIND end where ! Initialize diagnostic pressure variables @@ -1617,14 +1616,11 @@ subroutine calc_pressure(block, err) select case (trim(config_SGH_pressure_calc)) case ('cavity') - where (li_mask_is_floating_ice(cellMask)) - waterPressure = rhoi * gravity * iceThicknessHydro - elsewhere (.not. li_mask_is_ice(cellMask)) - waterPressure = 0.0_RKIND - elsewhere - waterPressure = (zeroOrderSum - divergence - divergenceChannel - channelAreaChangeCell) * & - rho_water * gravity * deltatSGH / porosity + waterPressureOld - end where + where (li_mask_is_grounded_ice(cellMask)) + waterPressure = (zeroOrderSum - divergence - divergenceChannel - channelAreaChangeCell) * & + elsewhere + waterPressure = 0.0_RKIND ! zero waterPressure where no grounded ice + end where case ('overburden') where (li_mask_is_floating_ice(cellMask)) @@ -1738,15 +1734,14 @@ subroutine calc_pressure_diag_vars(block, err) effectivePressure = rhoi * gravity * iceThicknessHydro - waterPressure ! < this should evalute to 0 for floating ice if Pw set correctly there. - where (.not. li_mask_is_grounded_ice(cellmask)) + where (.not. (li_mask_is_grounded_ice(cellMask))) effectivePressure = 0.0_RKIND ! zero effective pressure where no ice to avoid confusion end where hydropotentialBase = rho_water * gravity * bedTopography + waterPressure - ! This is still correct under ice shelves/open ocean because waterPressure has been set appropriately there already. - ! Note this leads to a nonuniform hydropotential at sea level that is a function of the ocean depth. - ! That is what we want because we use this as a boundary condition on the subglacial system, - ! and we want the subglacial system to feel the pressure of the ocean column at its edge. + where (.not. (li_mask_is_grounded_ice(cellMask))) + hydropotentialBase = 0.0_RKIND !zero hydropotential where no grounded ice + end where ! hydropotential with water thickness hydropotential = hydropotentialBase + rho_water * gravity * waterThickness From 4c3598167c8c631b7cddc2ff4159fc89952ddcb2 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 14 Aug 2023 11:46:31 -0700 Subject: [PATCH 075/529] Debug no waterPressure where no grounded ice --- .../mode_forward/mpas_li_subglacial_hydro.F | 30 ++++++++----------- 1 file changed, 12 insertions(+), 18 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 486b1b16184..309b3bd87b8 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1640,24 +1640,18 @@ subroutine calc_pressure(block, err) waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) do iCell = 1, nCells - if ( li_mask_is_floating_ice(cellMask(iCell)) .or. & - ((.not. li_mask_is_ice(cellMask(iCell))) .and. (bedTopography(iCell) < config_sea_level) ) ) then - ! set pressure correctly under floating ice and open ocean - waterPressure(iCell) = rhoo * gravity * (config_sea_level - bedTopography(iCell)) - else - onMarineMargin = .false. - do iEdge = 1, nEdgesOnCell(iCell) - if (hydroMarineMarginMask(edgesOnCell(iEdge, iCell)) == 1) then - onMarineMargin = .true. - exit - endif - enddo - if (onMarineMargin) then - ! At marine margin, don't let water pressure fall below ocean pressure - ! TODO: Not sure if this should include the water layer thickness term. Leaving it off. - if (waterPressure(iCell) < rhoo * gravity * (config_sea_level - bedTopography(iCell))) then - waterPressure(iCell) = rhoo * gravity * (config_sea_level - bedTopography(iCell)) - endif + onMarineMargin = .false. + do iEdge = 1, nEdgesOnCell(iCell) + if (hydroMarineMarginMask(edgesOnCell(iEdge, iCell)) == 1) then + onMarineMargin = .true. + exit + endif + enddo + if (onMarineMargin) then + ! At marine margin, don't let water pressure fall below ocean pressure + ! TODO: Not sure if this should include the water layer thickness term. Leaving it off. + if (waterPressure(iCell) < rho_water * gravity * (config_sea_level - bedTopography(iCell))) then + waterPressure(iCell) = rho_water * gravity * (config_sea_level - bedTopography(iCell)) endif endif enddo From f71517d73469d362a6cdb6932b5809bf4c710168 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 11 Sep 2023 12:24:15 -0700 Subject: [PATCH 076/529] rearrange margin hydropotential modifications moves argument limited inflow to after argument making 1-sided hydropotential argument at ice margins. Limitation of inflow seems to have been overwritten by 1-sided ice margin argument, whereas now both should apply. --- .../mode_forward/mpas_li_subglacial_hydro.F | 34 +++++++++---------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 309b3bd87b8..9d2b04c12fd 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -919,22 +919,6 @@ subroutine calc_edge_quantities(block, err) waterPressureSlopeNormal(iEdge) = (waterPressureSmooth(cell2) - waterPressureSmooth(cell1)) / dcEdge(iEdge) end do - ! At boundaries of hydro domain, disallow inflow. Allow outflow if hydropotential gradient requires it. - do iEdge = 1, nEdges - if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) .or. & - (hydroMarineMarginMask(iEdge)==1) .or. (hydroTerrestrialMarginMask(iEdge)==1) ) then - cell1 = cellsOnEdge(1, iEdge) - cell2 = cellsOnEdge(2, iEdge) - if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain - hydropotentialBaseSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) - hydropotentialSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) - else ! cell1 is the cell outside the hydro domain - hydropotentialBaseSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) - hydropotentialSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) - endif ! which cell is icefree - endif ! if edge of grounded ice - end do - ! At terrestrial margin, ignore the downslope bed topography gradient. Including it can lead to unrealistically large ! hydropotential gradients and unstable channel growth. ! We also want to do this at marine margins because otherwise the offshore topography can create a barrier to flow, @@ -965,7 +949,23 @@ subroutine calc_edge_quantities(block, err) endif ! if edge of grounded ice end do - ! zero gradients at edges that are marked as no flux. These should be applied at boundaries of the mesh. + ! At boundaries of hydro domain, disallow inflow. Allow outflow if hydropotential gradient requires it. + do iEdge = 1, nEdges + if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) .or. & + (hydroMarineMarginMask(iEdge)==1) .or. (hydroTerrestrialMarginMask(iEdge)==1) ) then + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain + hydropotentialBaseSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) + hydropotentialSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + else ! cell1 is the cell outside the hydro domain + hydropotentialBaseSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) + hydropotentialSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + endif ! which cell is icefree + endif ! if edge of grounded ice + end do + + ! zero gradients at boundaries of the mesh do iEdge = 1, nEdges if (waterFluxMask(iEdge) == 2) then hydropotentialBaseSlopeNormal(iEdge) = 0.0_RKIND From 68832982ff16ff21428e49cd8deffc98209552c0 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 19 Sep 2023 12:51:06 -0700 Subject: [PATCH 077/529] Remove one-sided hydropotential slope at GL Removes one-sided calculations of hydropotentialSlopeNormal and hydropotentialBaseSlopeNormal at the margin margin. Paired with merge in previous commit (zero hydropotential in ocean), this should allow for a more straightforward and accurate calculation of hydropotential slope across the grounding line. This commit also reinstates zero hydropotential slope in cases where inflow is expected across the ice margin --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 9d2b04c12fd..cfa191e26be 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -921,14 +921,10 @@ subroutine calc_edge_quantities(block, err) ! At terrestrial margin, ignore the downslope bed topography gradient. Including it can lead to unrealistically large ! hydropotential gradients and unstable channel growth. - ! We also want to do this at marine margins because otherwise the offshore topography can create a barrier to flow, - ! but that is unrealistic. - ! So for all boundaries of the hydro system where outflow is occuring, - ! the hydropotential at the margin should be determined by the geometry + ! The hydropotential at the terrestrial margin should be determined by the geometry ! at the edge of the cell in a 1-sided sense. do iEdge = 1, nEdges - if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) .or. & - (hydroMarineMarginMask(iEdge)==1)) then + if (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) then cell1 = cellsOnEdge(1, iEdge) cell2 = cellsOnEdge(2, iEdge) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the icefree cell - replace phi there with cell1 Phig @@ -958,9 +954,12 @@ subroutine calc_edge_quantities(block, err) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain hydropotentialBaseSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) hydropotentialSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + else ! cell1 is the cell outside the hydro domain + hydropotentialBaseSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) hydropotentialSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + endif ! which cell is icefree endif ! if edge of grounded ice end do From ff4cc84c32c2566a4594095be36be9ad3c354e6b Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 21 Sep 2023 15:02:57 -0700 Subject: [PATCH 078/529] Fix hydropotentialBase=0 in ocean bug Addresses potential bug tha would have made hydropotentialBase and hydropotential zero on exposed bedrock. Now these terms are only zero under floating ice or in the open ocean --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index cfa191e26be..35d97813828 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1732,7 +1732,7 @@ subroutine calc_pressure_diag_vars(block, err) end where hydropotentialBase = rho_water * gravity * bedTopography + waterPressure - where (.not. (li_mask_is_grounded_ice(cellMask))) + where ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography < 0.0_RKIND)) hydropotentialBase = 0.0_RKIND !zero hydropotential where no grounded ice end where From 41a27df83a2b94595ad11b51486a1c24a5418962 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 21 Sep 2023 15:06:05 -0700 Subject: [PATCH 079/529] remove redundant waterPressure GL alteration removes condition that keeps grounding line waterPressure from dropping below waterPressure in ocean. This is redundant now that ocean waterPressure is zero. THIS COMMIT MAY NEED TO BE REVERTED ONCE WE SETTLE ON TACTIC FOR HANDLING WATER PRESSURES IN OCEAN, BUT I'M COMMITING THIS FOR NOW TO COMPLETE REBASE ON DEVELOP - AOH 5/30/24 --- .../mode_forward/mpas_li_subglacial_hydro.F | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 35d97813828..482815e9bd0 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1636,24 +1636,6 @@ subroutine calc_pressure(block, err) end select waterPressure = max(0.0_RKIND, waterPressure) - waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) - - do iCell = 1, nCells - onMarineMargin = .false. - do iEdge = 1, nEdgesOnCell(iCell) - if (hydroMarineMarginMask(edgesOnCell(iEdge, iCell)) == 1) then - onMarineMargin = .true. - exit - endif - enddo - if (onMarineMargin) then - ! At marine margin, don't let water pressure fall below ocean pressure - ! TODO: Not sure if this should include the water layer thickness term. Leaving it off. - if (waterPressure(iCell) < rho_water * gravity * (config_sea_level - bedTopography(iCell))) then - waterPressure(iCell) = rho_water * gravity * (config_sea_level - bedTopography(iCell)) - endif - endif - enddo waterPressureTendency = (waterPressure - waterPressureOld) / deltatSGH From d7c59edd1926d42f03fdcd7f069b934a11d7f0a6 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 27 Sep 2023 11:41:39 -0700 Subject: [PATCH 080/529] Reinstate limit on inflow at ice margins Reinstates limit on inflow at ice margins, but no longer does this at the grounding line, where it is redundan. Still is likely needed to prevent inflow at other boundaries. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 482815e9bd0..5874a7d29b4 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -947,23 +947,22 @@ subroutine calc_edge_quantities(block, err) ! At boundaries of hydro domain, disallow inflow. Allow outflow if hydropotential gradient requires it. do iEdge = 1, nEdges - if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) .or. & - (hydroMarineMarginMask(iEdge)==1) .or. (hydroTerrestrialMarginMask(iEdge)==1) ) then + if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge)))) then cell1 = cellsOnEdge(1, iEdge) cell2 = cellsOnEdge(2, iEdge) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain hydropotentialBaseSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) hydropotentialSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) - + else ! cell1 is the cell outside the hydro domain - + hydropotentialBaseSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) hydropotentialSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) - + endif ! which cell is icefree endif ! if edge of grounded ice end do - + ! zero gradients at boundaries of the mesh do iEdge = 1, nEdges if (waterFluxMask(iEdge) == 2) then From e4e35cfd472ba0ca34d399e15c0a885f529c4809 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 2 Oct 2023 09:36:35 -0700 Subject: [PATCH 081/529] impose 1 Pa outflowing phi at GL The magnitude of hydropotentialSlopeNormal and hydropotentialBaseSlopeNormal must be at least 1 Pa and directed oceanward along the grounding line to facilitate constant outflow from the glacier. Replaces zeroing out of hydropotentialSlopeNormal and hydropotentialBaseSlopeNormal in cases on inflow. --- .../mode_forward/mpas_li_subglacial_hydro.F | 20 +++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 5874a7d29b4..42d59c6f7ba 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -951,13 +951,25 @@ subroutine calc_edge_quantities(block, err) cell1 = cellsOnEdge(1, iEdge) cell2 = cellsOnEdge(2, iEdge) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain - hydropotentialBaseSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) - hydropotentialSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + if (hydroMarineMarginMask(iEdge) == 1) then + if (hydropotentialBaseSlopeNormal(iEdge) > -1.0_RKIND) then + hydropotentialBaseSlopeNormal(iEdge) = -1.0_RKIND + endif + if (hydropotentialSlopeNormal(iEdge) > -1.0_RKIND) then + hydropotentialSlopeNormal(iEdge) = -1.0_RKIND + endif + endif else ! cell1 is the cell outside the hydro domain - hydropotentialBaseSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) - hydropotentialSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + if (hydroMarineMarginMask(iEdge) == 1) then + if (hydropotentialBaseSlopeNormal(iEdge) < 1.0_RKIND) then + hydropotentialBaseSlopeNormal(iEdge) = 1.0_RKIND + endif + if (hydropotentialSlopeNormal(iEdge) < 1.0_RKIND) then + hydropotentialSlopeNormal(iEdge) = 1.0_RKIND + endif + endif endif ! which cell is icefree endif ! if edge of grounded ice From 3fbff1a1b7fa5781409081e1ab3ce1e70522792c Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 22 May 2024 07:41:13 -0600 Subject: [PATCH 082/529] Replace 1 Pa outflow with MIN_PHISLOPE_GL Replace 1 Pa outflowing hydropotential slopes in previous commit with parameter MIN_PHISLOPE_GL, initially defined here as 1e-10 --- .../mode_forward/mpas_li_subglacial_hydro.F | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 42d59c6f7ba..eac60023c23 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -844,7 +844,7 @@ subroutine calc_edge_quantities(block, err) integer :: i, j, iVertex, iCell real (kind=RKIND) :: velSign integer :: numGroundedCells - real(kind=RKIND), parameter :: SMALL_CONDUC = 1.0e-30_RKIND + real (kind=RKIND), parameter :: MIN_PHISLOPE_GL = 1e-10_RKIND integer :: err_tmp err = 0 @@ -952,22 +952,22 @@ subroutine calc_edge_quantities(block, err) cell2 = cellsOnEdge(2, iEdge) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain if (hydroMarineMarginMask(iEdge) == 1) then - if (hydropotentialBaseSlopeNormal(iEdge) > -1.0_RKIND) then - hydropotentialBaseSlopeNormal(iEdge) = -1.0_RKIND + if (hydropotentialBaseSlopeNormal(iEdge) > -MIN_PHISLOPE_GL) then + hydropotentialBaseSlopeNormal(iEdge) = -MIN_PHISLOPE_GL endif - if (hydropotentialSlopeNormal(iEdge) > -1.0_RKIND) then - hydropotentialSlopeNormal(iEdge) = -1.0_RKIND + if (hydropotentialSlopeNormal(iEdge) > -MIN_PHISLOPE_GL) then + hydropotentialSlopeNormal(iEdge) = -MIN_PHISLOPE_GL endif endif else ! cell1 is the cell outside the hydro domain if (hydroMarineMarginMask(iEdge) == 1) then - if (hydropotentialBaseSlopeNormal(iEdge) < 1.0_RKIND) then - hydropotentialBaseSlopeNormal(iEdge) = 1.0_RKIND + if (hydropotentialBaseSlopeNormal(iEdge) < MIN_PHISLOPE_GL) then + hydropotentialBaseSlopeNormal(iEdge) = MIN_PHISLOPE_GL endif - if (hydropotentialSlopeNormal(iEdge) < 1.0_RKIND) then - hydropotentialSlopeNormal(iEdge) = 1.0_RKIND + if (hydropotentialSlopeNormal(iEdge) < MIN_PHISLOPE_GL) then + hydropotentialSlopeNormal(iEdge) = MIN_PHISLOPE_GL endif endif From 63dc2be25536834db651ee87fc325fca441190f7 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 22 May 2024 08:28:50 -0600 Subject: [PATCH 083/529] Remove low waterFlux condition on channels Removes condition that zeros out channelDischarge and channelArea when waterFluxes are low. Creates issues at grounding line when coupled to ice dynamics. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 7 ------- 1 file changed, 7 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index eac60023c23..25545a8ff5b 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1862,13 +1862,6 @@ subroutine update_channel(block, err) channelDischarge = 0.0_RKIND end where - ! Disable channels from forming if there is no sheet flux - ! TODO: Make a function of sheet dissipation threshold? - where (abs(waterFlux) <= 1e-10_RKIND) - channelArea = 0.0_RKIND - channelDischarge = 0.0_RKIND - end where - channelVelocity = channelDischarge / (channelArea + 1.0e-12_RKIND) ! diffusivity used only to limit channel dt right now From 0d4e3cdf5c929d345a80cf3d0b74ab9f26caa3ff Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 23 May 2024 13:17:50 -0600 Subject: [PATCH 084/529] Address Minor Comments Makes minor changes to the hydro model in response to PR comments. Mostly implifying logic and editing/adding comments to better explain workflow. --- .../mode_forward/mpas_li_subglacial_hydro.F | 49 ++++++++++--------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 25545a8ff5b..22eec5effc2 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -59,6 +59,12 @@ module li_subglacial_hydro ! Minimum gradMagPhiBaseEdge and gradMagPhiEdge allowed before all dependent variables are zeroed out real(kind=RKIND), parameter :: SMALL_GRADPHI = 1.0e-6_RKIND + !Minimum outflowing hydropotential slope applied at grounding line + real(kind=RKIND), parameter :: MIN_PHISLOPE_GL = 1e-10_RKIND + + !Undefined value + real(kind=RKIND), parameter :: UNDEFINED = 9.99e30_RKIND + !*********************************************************************** contains @@ -844,7 +850,6 @@ subroutine calc_edge_quantities(block, err) integer :: i, j, iVertex, iCell real (kind=RKIND) :: velSign integer :: numGroundedCells - real (kind=RKIND), parameter :: MIN_PHISLOPE_GL = 1e-10_RKIND integer :: err_tmp err = 0 @@ -923,6 +928,7 @@ subroutine calc_edge_quantities(block, err) ! hydropotential gradients and unstable channel growth. ! The hydropotential at the terrestrial margin should be determined by the geometry ! at the edge of the cell in a 1-sided sense. + ! This one-sided implementation also creates outflowing conditions at terrestrial boundary do iEdge = 1, nEdges if (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) then cell1 = cellsOnEdge(1, iEdge) @@ -945,37 +951,34 @@ subroutine calc_edge_quantities(block, err) endif ! if edge of grounded ice end do - ! At boundaries of hydro domain, disallow inflow. Allow outflow if hydropotential gradient requires it. + ! Disallow inflow from the marine margin by imposing a minimum outflowing hydropotential gradient at the grounding line. do iEdge = 1, nEdges - if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge)))) then + if ( hydroMarineMarginMask(iEdge) == 1) then cell1 = cellsOnEdge(1, iEdge) cell2 = cellsOnEdge(2, iEdge) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain - if (hydroMarineMarginMask(iEdge) == 1) then - if (hydropotentialBaseSlopeNormal(iEdge) > -MIN_PHISLOPE_GL) then - hydropotentialBaseSlopeNormal(iEdge) = -MIN_PHISLOPE_GL - endif - if (hydropotentialSlopeNormal(iEdge) > -MIN_PHISLOPE_GL) then - hydropotentialSlopeNormal(iEdge) = -MIN_PHISLOPE_GL - endif - endif + + if (hydropotentialBaseSlopeNormal(iEdge) > -MIN_PHISLOPE_GL) then + hydropotentialBaseSlopeNormal(iEdge) = -MIN_PHISLOPE_GL + endif + if (hydropotentialSlopeNormal(iEdge) > -MIN_PHISLOPE_GL) then + hydropotentialSlopeNormal(iEdge) = -MIN_PHISLOPE_GL + endif else ! cell1 is the cell outside the hydro domain - if (hydroMarineMarginMask(iEdge) == 1) then - if (hydropotentialBaseSlopeNormal(iEdge) < MIN_PHISLOPE_GL) then - hydropotentialBaseSlopeNormal(iEdge) = MIN_PHISLOPE_GL - endif - if (hydropotentialSlopeNormal(iEdge) < MIN_PHISLOPE_GL) then - hydropotentialSlopeNormal(iEdge) = MIN_PHISLOPE_GL - endif - endif + if (hydropotentialBaseSlopeNormal(iEdge) < MIN_PHISLOPE_GL) then + hydropotentialBaseSlopeNormal(iEdge) = MIN_PHISLOPE_GL + endif + if (hydropotentialSlopeNormal(iEdge) < MIN_PHISLOPE_GL) then + hydropotentialSlopeNormal(iEdge) = MIN_PHISLOPE_GL + endif endif ! which cell is icefree endif ! if edge of grounded ice end do - ! zero gradients at boundaries of the mesh + ! zero gradients along zero flux boundaries do iEdge = 1, nEdges if (waterFluxMask(iEdge) == 2) then hydropotentialBaseSlopeNormal(iEdge) = 0.0_RKIND @@ -1629,14 +1632,14 @@ subroutine calc_pressure(block, err) where (li_mask_is_grounded_ice(cellMask)) waterPressure = (zeroOrderSum - divergence - divergenceChannel - channelAreaChangeCell) * & elsewhere - waterPressure = 0.0_RKIND ! zero waterPressure where no grounded ice + waterPressure = UNDEFINED ! zero waterPressure where no grounded ice end where case ('overburden') where (li_mask_is_floating_ice(cellMask)) waterPressure = rhoi * gravity * iceThicknessHydro elsewhere (.not. li_mask_is_ice(cellMask)) - waterPressure = 0.0_RKIND + waterPressure = UNDEFINED elsewhere waterPressure = rhoi * gravity * iceThicknessHydro end where @@ -1726,7 +1729,7 @@ subroutine calc_pressure_diag_vars(block, err) hydropotentialBase = rho_water * gravity * bedTopography + waterPressure where ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography < 0.0_RKIND)) - hydropotentialBase = 0.0_RKIND !zero hydropotential where no grounded ice + hydropotentialBase = 0.0_RKIND !zero hydropotential in ocean end where ! hydropotential with water thickness From 0dce9f704c2b20b51616a132c16a72462eca8b8f Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 30 May 2024 10:33:26 -0600 Subject: [PATCH 085/529] Reinsert deleted line Reinserted line that was accidentally deleted during rebase onto develop --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 1 + 1 file changed, 1 insertion(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 22eec5effc2..29e8cd8b10b 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1631,6 +1631,7 @@ subroutine calc_pressure(block, err) where (li_mask_is_grounded_ice(cellMask)) waterPressure = (zeroOrderSum - divergence - divergenceChannel - channelAreaChangeCell) * & + rho_water * gravity * deltatSGH / porosity + waterPressureOld elsewhere waterPressure = UNDEFINED ! zero waterPressure where no grounded ice end where From 049962da86ce080afbedf17058675d0ab9537c75 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 30 May 2024 10:56:38 -0700 Subject: [PATCH 086/529] Reinsert Line Reinsert line accidentally deleted during rebase --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 1 + 1 file changed, 1 insertion(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 29e8cd8b10b..144ecdf2a5a 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -850,6 +850,7 @@ subroutine calc_edge_quantities(block, err) integer :: i, j, iVertex, iCell real (kind=RKIND) :: velSign integer :: numGroundedCells + real(kind=RKIND), parameter :: SMALL_CONDUC = 1.0e-30_RKIND integer :: err_tmp err = 0 From 7c6518c621cc8e6377f637b7a9c1317fc55e3fae Mon Sep 17 00:00:00 2001 From: Carolyn Begeman Date: Sun, 9 Jun 2024 15:22:25 -0500 Subject: [PATCH 087/529] Make land ice frazil off by default --- .../mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml | 2 +- components/mpas-ocean/src/Registry.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index be51b84bf03..96edb45665b 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -375,7 +375,7 @@ .true. .true. -.true. +.false. 3.337e5 1000.0 0.1 diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 7eb4f528dbf..5dd5fb1fff4 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -940,7 +940,7 @@ description="If frazil formation is used, controls if frazil fluxes are computed in the open ocean (as opposed to under land ice)." possible_values=".true. or .false." /> - From 701d8fbef5b78e480da5b9cd7bb4f983f7f2aade Mon Sep 17 00:00:00 2001 From: Carolyn Begeman Date: Sun, 9 Jun 2024 15:24:25 -0500 Subject: [PATCH 088/529] Enable land ice frazil for ISMF cases --- components/mpas-ocean/bld/build-namelist | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index 2a16bef69e3..12390bb4c37 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -761,7 +761,6 @@ add_default($nl, 'config_self_attraction_and_loading_beta'); add_default($nl, 'config_use_frazil_ice_formation'); add_default($nl, 'config_frazil_in_open_ocean'); -add_default($nl, 'config_frazil_under_land_ice'); add_default($nl, 'config_frazil_heat_of_fusion'); add_default($nl, 'config_frazil_ice_density'); add_default($nl, 'config_frazil_fractional_thickness_limit'); @@ -777,12 +776,16 @@ add_default($nl, 'config_frazil_use_surface_pressure'); if ($OCN_ISMF eq 'coupled') { add_default($nl, 'config_land_ice_flux_mode', 'val'=>"coupled"); + add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); } elsif ($OCN_ISMF eq 'internal') { add_default($nl, 'config_land_ice_flux_mode', 'val'=>"standalone"); + add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); } elsif ($OCN_ISMF eq 'data') { add_default($nl, 'config_land_ice_flux_mode', 'val'=>"data"); + add_default($nl, 'config_frazil_under_land_ice'); } else { add_default($nl, 'config_land_ice_flux_mode'); + add_default($nl, 'config_frazil_under_land_ice'); } if ($OCN_TIDAL_MIXING eq 'true') { add_default($nl, 'config_land_ice_flux_tidal_Jourdain_alpha', 'val'=>"0.777"); From 7b4d67c299138d3f350fe1eb44ded668839c49df Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 13 Jun 2024 10:46:49 -0600 Subject: [PATCH 089/529] Change undefined value to zero Previous undefined values of 1e30 was potentially causing a blow up, testing with it set back to zero. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 144ecdf2a5a..4e26189f4ce 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -63,7 +63,7 @@ module li_subglacial_hydro real(kind=RKIND), parameter :: MIN_PHISLOPE_GL = 1e-10_RKIND !Undefined value - real(kind=RKIND), parameter :: UNDEFINED = 9.99e30_RKIND + real(kind=RKIND), parameter :: UNDEFINED = 0.0_RKIND !*********************************************************************** contains From 64a5b920ff75a6c724499878af64e28d4aeac06f Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 17 Jun 2024 21:33:42 +0000 Subject: [PATCH 090/529] committing wip clone that ran on cpu and gpu --- .../machines/cmake_macros/oneapi-ifxgpu.cmake | 6 +++--- cime_config/machines/config_machines.xml | 15 +++++++++------ .../cmake/machine-files/sunspot-pvc.cmake | 18 ++++++++++-------- .../eamxx/src/control/atmosphere_driver.cpp | 2 +- .../atm_process/atmosphere_process_group.cpp | 5 +++-- .../homme/src/share/cxx/SimulationParams.hpp | 2 +- .../cxx/cxx_f90_interface_theta.cpp | 8 +++++++- 7 files changed, 34 insertions(+), 22 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake index c798c53ee8b..a4dc8fc1214 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake @@ -6,9 +6,9 @@ if (compile_threaded) endif() #adding -g here leads to linker internal errors -string(APPEND CMAKE_C_FLAGS_RELEASE " -O2") -string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -fpscomp logicals") -string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2") +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -g -gline-tables-only") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -fpscomp logicals -g -gline-tables-only") +string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2 -g -gline-tables-only") string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -fpscomp logicals -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 1d99b26bd10..2ae5c37aaa5 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3415,12 +3415,12 @@ - spack-pe-gcc/0.6.1-23.275.2 cmake python/3.10.10 + spack-pe-gcc/0.7.0-24.086.0 cmake python/3.10.11 - oneapi/eng-compiler/2023.12.15.002 - mpich/icc-all-pmix-gpu/52.2 + oneapi/eng-compiler/2024.04.15.002 + mpich/icc-all-pmix-gpu/20231026 @@ -3436,12 +3436,15 @@ /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/lib:$ENV{LD_LIBRARY_PATH} + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/bin:$ENV{PATH} list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 1 + 1 level_zero:gpu NO_GPU 0 @@ -3606,12 +3609,12 @@ - spack-pe-gcc/0.6.1-23.275.2 cmake python/3.10.10 + spack-pe-gcc/0.7.0-24.086.0 cmake python/3.10.11 - oneapi/eng-compiler/2023.12.15.002 - mpich/icc-all-pmix-gpu/52.2 + oneapi/eng-compiler/2024.04.15.002 + mpich/icc-all-pmix-gpu/20231026 diff --git a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake index ee984e7a586..f36dc8f473c 100644 --- a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake +++ b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake @@ -31,17 +31,19 @@ set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-func - -set(NETCDF_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_DIR "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") +set(NETCDF_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_DIR "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_C_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_C "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") #this one is for rrtmgp -set(NetCDF_C_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "$ENV{NETCDF_PATH}" CACHE STRING "") -set(PNETCDF_PATH "$ENV{PNETCDF_PATH}" CACHE STRING "") +set(NetCDF_C_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") +set(PNETCDF_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf" CACHE STRING "") + + +set(PNETCDF_DIR "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf" CACHE STRING "") -set(PNETCDF_DIR "$ENV{PNETCDF_PATH}" CACHE STRING "") diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index f76b48e270a..d50469a5e9b 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -103,7 +103,7 @@ AtmosphereDriver(const ekat::Comm& atm_comm, AtmosphereDriver::~AtmosphereDriver () { - finalize(); +// finalize(); } void AtmosphereDriver:: diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp index d13f166d6b8..a975855a14b 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp @@ -439,7 +439,8 @@ std::cout << "OG T field (" <name() << " dt="<name() << " dt="<name() << std::flush; fm->get_field("T_mid").sync_to_host(); @@ -467,7 +468,7 @@ std::cout << "OG proc AFTER RUN " << atm_proc->name() <<"\n"<debug("[EAMxx::run_sequential::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); +// m_atm_logger->debug("[EAMxx::run_sequential::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); #endif std::cout << "OG AFTER mem usage " << atm_proc->name() <<"\n"<(); auto& ff = c.create_if_not_there(); auto& diag = c.create_if_not_there (elems.num_elems(),tracers.num_tracers(), - params.theta_hydrostatic_mode); + (bool)params.theta_hydrostatic_mode); auto& vrm = c.create_if_not_there(elems.num_elems()); auto& fbm = c.create_if_not_there(); From 0c2bca822a020f7b214e1be79f24bc2dea446cbe Mon Sep 17 00:00:00 2001 From: Carolyn Begeman Date: Tue, 18 Jun 2024 20:35:21 -0500 Subject: [PATCH 091/529] Hard-code data ISMF frazil off --- components/mpas-ocean/bld/build-namelist | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index 12390bb4c37..0b66c90c927 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -782,7 +782,7 @@ if ($OCN_ISMF eq 'coupled') { add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); } elsif ($OCN_ISMF eq 'data') { add_default($nl, 'config_land_ice_flux_mode', 'val'=>"data"); - add_default($nl, 'config_frazil_under_land_ice'); + add_default($nl, 'config_frazil_under_land_ice', 'val'=>".false."); } else { add_default($nl, 'config_land_ice_flux_mode'); add_default($nl, 'config_frazil_under_land_ice'); From decd0238ee210219c0c7406c74c24777af919f5a Mon Sep 17 00:00:00 2001 From: Carolyn Begeman Date: Tue, 18 Jun 2024 20:36:58 -0500 Subject: [PATCH 092/529] Duplicate land ice frazil settings in frazil section --- components/mpas-ocean/bld/build-namelist | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index 0b66c90c927..b63f1f3e5d7 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -770,6 +770,16 @@ add_default($nl, 'config_frazil_sea_ice_reference_salinity'); add_default($nl, 'config_frazil_maximum_freezing_temperature'); add_default($nl, 'config_frazil_use_surface_pressure'); +if ($OCN_ISMF eq 'coupled') { + add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); +} elsif ($OCN_ISMF eq 'internal') { + add_default($nl, 'config_frazil_under_land_ice', 'val'=>".true."); +} elsif ($OCN_ISMF eq 'data') { + add_default($nl, 'config_frazil_under_land_ice', 'val'=>".false."); +} else { + add_default($nl, 'config_frazil_under_land_ice'); +} + ################################### # Namelist group: land_ice_fluxes # ################################### From b03d38904244ffb5bf216401f237971e3ba24c87 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 20 Jun 2024 00:30:31 +0000 Subject: [PATCH 093/529] clean up --- .../eamxx/src/control/atmosphere_driver.cpp | 50 ++----------------- .../atm_process/atmosphere_process_group.cpp | 46 +++++++++-------- 2 files changed, 29 insertions(+), 67 deletions(-) diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index d50469a5e9b..c5aa4869914 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -103,7 +103,8 @@ AtmosphereDriver(const ekat::Comm& atm_comm, AtmosphereDriver::~AtmosphereDriver () { -// finalize(); +// std::cout << "OG ------------------ I AM CALLING FINALIZE \n" << std::flush; + finalize(); } void AtmosphereDriver:: @@ -209,39 +210,25 @@ setup_iop () void AtmosphereDriver::create_atm_processes() { - std::cout << "OG cinit 1 \n" << std::flush; - m_atm_logger->info("[EAMxx] create_atm_processes ..."); - std::cout << "OG cinit 2 \n" << std::flush; start_timer("EAMxx::init"); - std::cout << "OG cinit 3 \n" << std::flush; start_timer("EAMxx::create_atm_processes"); - std::cout << "OG cinit 4 \n" << std::flush; // At this point, must have comm and params set. check_ad_status(s_comm_set | s_params_set); - std::cout << "OG cinit 5 \n" << std::flush; // Create the group of processes. This will recursively create the processes // tree, storing also the information regarding parallel execution (if needed). // See AtmosphereProcessGroup class documentation for more details. auto& atm_proc_params = m_atm_params.sublist("atmosphere_processes"); - std::cout << "OG cinit 6 \n" << std::flush; atm_proc_params.rename("EAMxx"); - std::cout << "OG cinit 7 \n" << std::flush; atm_proc_params.set("Logger",m_atm_logger); - std::cout << "OG cinit 8 \n" << std::flush; m_atm_process_group = std::make_shared(m_atm_comm,atm_proc_params); - std::cout << "OG cinit 9 \n" << std::flush; m_ad_status |= s_procs_created; - std::cout << "OG cinit 10 \n" << std::flush; stop_timer("EAMxx::create_atm_processes"); - std::cout << "OG cinit 11 \n" << std::flush; stop_timer("EAMxx::init"); - std::cout << "OG cinit 12 \n" << std::flush; m_atm_logger->info("[EAMxx] create_atm_processes ... done!"); - std::cout << "OG cinit 13 \n" << std::flush; } void AtmosphereDriver::create_grids() @@ -1524,25 +1511,16 @@ initialize_constant_field(const FieldIdentifier& fid, void AtmosphereDriver::initialize_atm_procs () { - std::cout << "OG init 1 \n" << std::flush; m_atm_logger->info("[EAMxx] initialize_atm_procs ..."); start_timer("EAMxx::init"); start_timer("EAMxx::initialize_atm_procs"); - std::cout << "OG init 2 \n" << std::flush; // Initialize memory buffer for all atm processes - std::cout << "OG hhhinit 3 \n" << std::flush; m_memory_buffer = std::make_shared(); - std::cout << "OG init 4 \n" << std::flush; - - m_memory_buffer->request_bytes(m_atm_process_group->requested_buffer_size_in_bytes()); - std::cout << "OG init 5 \n" << std::flush; m_memory_buffer->allocate(); - std::cout << "OG init 6 \n" << std::flush; m_atm_process_group->init_buffers(*m_memory_buffer); - std::cout << "OG init 7 \n" << std::flush; const bool restarted_run = m_case_t0 < m_run_t0; @@ -1551,24 +1529,19 @@ void AtmosphereDriver::initialize_atm_procs () setup_surface_coupling_processes(); } - std::cout << "OG init 8 \n" << std::flush; // Initialize the processes m_atm_process_group->initialize(m_current_ts, restarted_run ? RunType::Restarted : RunType::Initial); - std::cout << "OG init 9 \n" << std::flush; // Create and add energy and mass conservation check to appropriate atm procs setup_column_conservation_checks(); - std::cout << "OG init 10 \n" << std::flush; // If user requests it, we set up NaN checks for all computed fields after each atm proc run if (m_atm_params.sublist("driver_options").get("check_all_computed_fields_for_nans",true)) { m_atm_process_group->add_postcondition_nan_checks(); } - std::cout << "OG init 11 \n" << std::flush; // Add additional column data fields to pre/postcondition checks (if they exist) add_additional_column_data_to_property_checks(); - std::cout << "OG init 12 \n" << std::flush; if (fvphyshack) { // [CGLL ICs in pg2] See related notes in atmosphere_dynamics.cpp. @@ -1577,14 +1550,12 @@ void AtmosphereDriver::initialize_atm_procs () m_field_mgrs.erase(gn); } - std::cout << "OG init 13 \n" << std::flush; m_ad_status |= s_procs_inited; stop_timer("EAMxx::initialize_atm_procs"); stop_timer("EAMxx::init"); m_atm_logger->info("[EAMxx] initialize_atm_procs ... done!"); - std::cout << "OG init 14 \n" << std::flush; report_res_dep_memory_footprint (); } @@ -1622,30 +1593,21 @@ initialize (const ekat::Comm& atm_comm, void AtmosphereDriver::run (const int dt) { start_timer("EAMxx::run"); - std::cout << "IN DRIVER 1 \n"; - - // Make sure the end of the time step is after the current start_time EKAT_REQUIRE_MSG (dt>0, "Error! Input time step must be positive.\n"); - - std::cout << "IN DRIVER 2 \n"; - // Print current timestamp information m_atm_logger->log(ekat::logger::LogLevel::info, "Atmosphere step = " + std::to_string(m_current_ts.get_num_steps()) + "\n" + " model start-of-step time = " + m_current_ts.get_date_string() + " " + m_current_ts.get_time_string() + "\n"); - - std::cout << "IN DRIVER 3 \n"; // Reset accum fields to 0 // Note: at the 1st timestep this is redundant, since we did it at init, // to ensure t=0 INSTANT output was correct. However, it's not a // very expensive operation, so it's not worth the effort of the // nano-opt of removing the call for the 1st timestep. reset_accumulated_fields(); - - std::cout << "IN DRIVER 4 \n" << std::flush; + // Tell the output managers that we're starting a timestep. This is usually // a no-op, but some diags *may* require to do something. E.g., a diag that // computes tendency of an arbitrary quantity may want to store a copy of @@ -1660,7 +1622,6 @@ void AtmosphereDriver::run (const int dt) { // the individual processes, which will be called in the correct order. m_atm_process_group->run(dt); - std::cout << "IN DRIVER 5 \n"<< std::flush; // Some accumulated fields need to be divided by dt at the end of the atm step for (auto fm_it : m_field_mgrs) { const auto& fm = fm_it.second; @@ -1674,20 +1635,15 @@ void AtmosphereDriver::run (const int dt) { } } - std::cout << "IN DRIVER 6 \n"<debug("[EAMxx::run] running output managers..."); for (auto& out_mgr : m_output_managers) { out_mgr.run(m_current_ts); } - #endif #ifdef SCREAM_HAS_MEMORY_USAGE diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp index a975855a14b..bfef71ef3d5 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp @@ -374,15 +374,19 @@ void AtmosphereProcessGroup::add_additional_data_fields_to_property_checks (cons void AtmosphereProcessGroup::initialize_impl (const RunType run_type) { - int mmm = 0; +#undef D1 +#ifdef D1 + int mmm = 0; +#endif for (auto& atm_proc : m_atm_processes) { - mmm++; - std::cout << "process is "<< mmm << "\n" << std::flush; - std::cout << "process name is "<< atm_proc->name() << "\n"<< std::flush; - - m_atm_logger->flush(); +#ifdef D1 + mmm++; + std::cout << "process is "<< mmm << "\n" << std::flush; + std::cout << "process name is "<< atm_proc->name() << "\n"<< std::flush; + m_atm_logger->flush(); +#endif atm_proc->initialize(timestamp(),run_type); #ifdef SCREAM_HAS_MEMORY_USAGE @@ -392,7 +396,7 @@ void AtmosphereProcessGroup::initialize_impl (const RunType run_type) { m_atm_logger->debug("[EAMxx::initialize::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); #endif } - std::cout << "process GROUP is done\n" << std::flush; +// std::cout << "process GROUP is done\n" << std::flush; } void AtmosphereProcessGroup::run_impl (const double dt) { @@ -401,7 +405,7 @@ void AtmosphereProcessGroup::run_impl (const double dt) { } else { run_parallel(dt); } - std::cout << "process GROUP RUN is done\n" << std::flush; +// std::cout << "process GROUP RUN is done\n" << std::flush; } void AtmosphereProcessGroup::run_sequential (const double dt) { @@ -409,6 +413,8 @@ void AtmosphereProcessGroup::run_sequential (const double dt) { auto ts = timestamp(); ts += dt; +#undef D2 +#ifdef D2 auto& c = scream::ScreamContext::singleton(); auto ad = c.getNonConst(); const auto gn = "Physics"; @@ -421,8 +427,9 @@ void AtmosphereProcessGroup::run_sequential (const double dt) { fm->get_field("T_mid").sync_to_host(); auto ff = fm->get_field("T_mid").get_view(); +#endif -#if 0 +#ifdef D2 for (int ii = 0; ii < ncols; ii++) for (int jj = 0; jj < nlevs; jj++){ const auto vv = ff(ii,jj); @@ -439,16 +446,15 @@ std::cout << "OG T field (" <name() << " dt="<name() << std::flush; - +//std::cout << "OG proc begin ------------------------ " << atm_proc->name() << std::flush; +#ifdef D2 fm->get_field("T_mid").sync_to_host(); auto ff = fm->get_field("T_mid").get_view(); - -#if 0 +#endif +#ifdef D2 for (int ii = 0; ii < 5; ii++) - for (int jj = 0; jj < nlevs; jj++){ + for (int jj = 0; jj < 3; jj++){ const auto vv = ff(ii,jj); m_atm_logger->info("OG T field ("+std::to_string(ii)+","+std::to_string(jj)+") = "+std::to_string(vv)); std::cout << "OG T field (" <name() <<"\n"<name() <<"\n"<set_update_time_stamps(do_update); // Run the process atm_proc->run(dt); -std::cout << "OG proc AFTER RUN " << atm_proc->name() <<"\n"<name() <<"\n"<debug("[EAMxx::run_sequential::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); + m_atm_logger->debug("[EAMxx::run_sequential::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); #endif -std::cout << "OG AFTER mem usage " << atm_proc->name() <<"\n"<name() <<"\n"< Date: Fri, 14 Jun 2024 11:30:36 -0600 Subject: [PATCH 094/529] Redefine phi and Pw where no ice Sets more physically correct boundary conditions for hydropotential and waterPressure : Ice-free land: 'hydropotential = rhow * gravity * bedTopography' and 'waterPressure = 0' Ocean: 'hydropotential = 0' and 'waterPressure = rhoo * gravity * (sea_level - bedTopography)' Updates are also made to the one-sided hydropotentialSlope calculations to be consistent with the new formulation on ice-free terrestrial cells. --- .../mode_forward/mpas_li_subglacial_hydro.F | 69 ++++++++++--------- 1 file changed, 37 insertions(+), 32 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 4e26189f4ce..6efd41f2d5b 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -62,9 +62,6 @@ module li_subglacial_hydro !Minimum outflowing hydropotential slope applied at grounding line real(kind=RKIND), parameter :: MIN_PHISLOPE_GL = 1e-10_RKIND - !Undefined value - real(kind=RKIND), parameter :: UNDEFINED = 0.0_RKIND - !*********************************************************************** contains @@ -209,13 +206,17 @@ subroutine li_SGH_init(domain, err) waterPressure = max(0.0_RKIND, waterPressure) waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) - ! set pressure correctly under floating ice and open ocean + + ! set pressure correctly on ice-free land and in ocean call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - where (.not. (li_mask_is_grounded_ice(cellMask))) + ! + where ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography < config_sea_level)) + waterPressure = gravity * rhoo * (config_sea_level - bedTopography) end where - + ! Initialize diagnostic pressure variables call calc_pressure_diag_vars(block, err_tmp) err = ior(err, err_tmp) @@ -826,6 +827,7 @@ subroutine calc_edge_quantities(block, err) real (kind=RKIND), dimension(:), pointer :: waterFluxDiffu real (kind=RKIND), dimension(:), pointer :: waterPressureSmooth integer, dimension(:), pointer :: hydroMarineMarginMask + integer, dimension(:), pointer :: hydroTerrestrialMarginMask integer, dimension(:), pointer :: waterFluxMask integer, dimension(:,:), pointer :: edgeSignOnCell integer, dimension(:), pointer :: cellMask @@ -902,6 +904,7 @@ subroutine calc_edge_quantities(block, err) call mpas_pool_get_array(hydroPool, 'waterFluxDiffu', waterFluxDiffu) call mpas_pool_get_array(hydroPool, 'waterFluxMask', waterFluxMask) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) + call mpas_pool_get_array(hydroPool, 'hydroTerrestrialMarginMask', hydroTerrestrialMarginMask) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) call mpas_pool_get_array(hydroPool, 'waterPressureSmooth', waterPressureSmooth) @@ -928,26 +931,23 @@ subroutine calc_edge_quantities(block, err) ! At terrestrial margin, ignore the downslope bed topography gradient. Including it can lead to unrealistically large ! hydropotential gradients and unstable channel growth. ! The hydropotential at the terrestrial margin should be determined by the geometry - ! at the edge of the cell in a 1-sided sense. + ! at the edge of the cell in a 1-sided sense. For hydropotentialBase = rho*g*Zb + Pw, this means hydropotentialBaseSlopeNormal + ! at the terrestrial margin is equal to Pw/dcEdge. ! This one-sided implementation also creates outflowing conditions at terrestrial boundary do iEdge = 1, nEdges - if (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) then + if (hydroTerrestrialMarginMask(iEdge) == 1) then cell1 = cellsOnEdge(1, iEdge) cell2 = cellsOnEdge(2, iEdge) if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the icefree cell - replace phi there with cell1 Phig - hydropotentialBaseSlopeNormal(iEdge) = (rho_water * gravity * bedTopography(cell1) + & - max(rhoo * gravity * (config_sea_level - bedTopography(cell1)), 0.0_RKIND) - & - hydropotentialBase(cell1)) / dcEdge(iEdge) - hydropotentialSlopeNormal(iEdge) = (rho_water * gravity * bedTopography(cell1) + & - max(rhoo * gravity * (config_sea_level - bedTopography(cell1)), 0.0_RKIND) - & - hydropotential(cell1)) / dcEdge(iEdge) + + hydropotentialBaseSlopeNormal(iEdge) = - waterPressure(cell1) / dcEdge(iEdge) + hydropotentialSlopeNormal(iEdge) = - (rho_water * gravity * waterThickness(cell1) + waterPressure(cell1)) / dcEdge(iEdge) + else ! cell1 is the icefree cell - replace phi there with cell2 Phig - hydropotentialBaseSlopeNormal(iEdge) = (hydropotentialBase(cell2) - & - ( rho_water * gravity * bedTopography(cell2) + & - max(rhoo * gravity * (config_sea_level - bedTopography(cell2)), 0.0_RKIND) ) ) / dcEdge(iEdge) - hydropotentialSlopeNormal(iEdge) = (hydropotential(cell2) - & - ( rho_water * gravity * bedTopography(cell2) + & - max(rhoo * gravity * (config_sea_level - bedTopography(cell2)), 0.0_RKIND) ) ) / dcEdge(iEdge) + + hydropotentialBaseSlopeNormal(iEdge) = waterPressure(cell2) / dcEdge(iEdge) + hydropotentialSlopeNormal(iEdge) = (rho_water * gravity * waterThickness(cell2) + waterPressure(cell2)) / dcEdge(iEdge) + endif ! which cell is icefree endif ! if edge of grounded ice end do @@ -1630,20 +1630,23 @@ subroutine calc_pressure(block, err) select case (trim(config_SGH_pressure_calc)) case ('cavity') - where (li_mask_is_grounded_ice(cellMask)) - waterPressure = (zeroOrderSum - divergence - divergenceChannel - channelAreaChangeCell) * & - rho_water * gravity * deltatSGH / porosity + waterPressureOld - elsewhere - waterPressure = UNDEFINED ! zero waterPressure where no grounded ice - end where + where (li_mask_is_grounded_ice(cellMask)) + waterPressure = (zeroOrderSum - divergence - divergenceChannel - channelAreaChangeCell) * & + rho_water * gravity * deltatSGH / porosity + waterPressureOld + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) + waterPressure = 0.0_RKIND + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography < config_sea_level)) + waterPressure = gravity * rhoo * (config_sea_level - bedTopography) + end where case ('overburden') - where (li_mask_is_floating_ice(cellMask)) - waterPressure = rhoi * gravity * iceThicknessHydro - elsewhere (.not. li_mask_is_ice(cellMask)) - waterPressure = UNDEFINED - elsewhere + + where (li_mask_is_grounded_ice(cellMask)) waterPressure = rhoi * gravity * iceThicknessHydro + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) + waterPressure = 0.0_RKIND + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography < config_sea_level)) + waterPressure = gravity * rhoo * (config_sea_level - bedTopography) end where case default @@ -1730,8 +1733,10 @@ subroutine calc_pressure_diag_vars(block, err) end where hydropotentialBase = rho_water * gravity * bedTopography + waterPressure - where ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography < 0.0_RKIND)) + where ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography < config_sea_level)) hydropotentialBase = 0.0_RKIND !zero hydropotential in ocean + elsewhere ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography > config_sea_level)) + hydropotentialBase = rho_water * gravity * bedTopography ! for completeness, but won't matter with one-side slope calculations on terrestrial boundaries end where ! hydropotential with water thickness From 2881a934003af9a8152c3e258d965e830014096d Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 26 Jun 2024 16:45:25 -0600 Subject: [PATCH 095/529] Revert "remove redundant waterPressure GL alteration" This reverts commit 41a27df83a2b94595ad11b51486a1c24a5418962. --- .../mode_forward/mpas_li_subglacial_hydro.F | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 6efd41f2d5b..64031b98610 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1655,6 +1655,24 @@ subroutine calc_pressure(block, err) end select waterPressure = max(0.0_RKIND, waterPressure) + waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) + + do iCell = 1, nCells + onMarineMargin = .false. + do iEdge = 1, nEdgesOnCell(iCell) + if (hydroMarineMarginMask(edgesOnCell(iEdge, iCell)) == 1) then + onMarineMargin = .true. + exit + endif + enddo + if (onMarineMargin) then + ! At marine margin, don't let water pressure fall below ocean pressure + ! TODO: Not sure if this should include the water layer thickness term. Leaving it off. + if (waterPressure(iCell) < rho_water * gravity * (config_sea_level - bedTopography(iCell))) then + waterPressure(iCell) = rho_water * gravity * (config_sea_level - bedTopography(iCell)) + endif + endif + enddo waterPressureTendency = (waterPressure - waterPressureOld) / deltatSGH From 97f3c403d3531ca7bbd3136be918a963fb395d09 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 27 Jun 2024 11:20:56 -0600 Subject: [PATCH 096/529] No channelDischarge where no water upstream Shuts off channel discharge when waterThicknessEdgeUpwind is zero. Akin to the waterFlux condition that shuts off flow when no water in upwind cell. Done to prevent self-sustaining channel growth when no water in distributed system --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 64031b98610..3b54b71e310 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1823,6 +1823,7 @@ subroutine update_channel(block, err) real (kind=RKIND), dimension(:), pointer :: channelEffectivePressure real (kind=RKIND), dimension(:), pointer :: effectivePressure real (kind=RKIND), dimension(:), pointer :: channelDiffusivity + real (kind=RKIND), dimension(:), pointer :: waterThicknessEdgeUpwind integer, dimension(:), pointer :: waterFluxMask integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:), pointer :: edgeMask @@ -1868,6 +1869,7 @@ subroutine update_channel(block, err) call mpas_pool_get_array(hydroPool, 'waterFluxMask', waterFluxMask) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(hydroPool, 'channelDiffusivity', channelDiffusivity) + call mpas_pool_get_array(hydroPool, 'waterThicknessEdgeUpwind', waterThicknessEdgeUpwind) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) ! Calculate terms needed for opening (melt) rate @@ -1890,6 +1892,12 @@ subroutine update_channel(block, err) channelDischarge = 0.0_RKIND end where + ! Similar to waterFlux, shut of channelDischarge if no water upstream. Prevents self-sustaining channels in the absence of distributed water + where (waterThicknessEdgeUpwind == 0.0_RKIND) + channelArea = 0.0_RKIND + channelDischarge = 0.0_RKIND + end where + channelVelocity = channelDischarge / (channelArea + 1.0e-12_RKIND) ! diffusivity used only to limit channel dt right now From f0274091b5b7fe74e50f99554e2a574137dedb72 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 27 Jun 2024 17:28:46 -0600 Subject: [PATCH 097/529] initialize hydopotential correctly where no ice --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 3b54b71e310..b581dc1d50e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -110,6 +110,7 @@ subroutine li_SGH_init(domain, err) real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro + real (kind=RKIND), dimension(:), pointer :: hydropotential integer, dimension(:), pointer :: cellMask real (kind=RKIND), pointer :: tillMax real (kind=RKIND), pointer :: rhoi, rhoo @@ -202,19 +203,23 @@ subroutine li_SGH_init(domain, err) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) + call mpas_pool_get_array(hydroPool, 'hydropotential', hydropotential) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) waterPressure = max(0.0_RKIND, waterPressure) waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) - ! set pressure correctly on ice-free land and in ocean + ! set pressure and hydropotential correctly on ice-free land and in ocean call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) ! + where ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND + hydropotential = rho_water * gravity * bedTopography elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography < config_sea_level)) waterPressure = gravity * rhoo * (config_sea_level - bedTopography) + hydropotential = 0.0_RKIND end where ! Initialize diagnostic pressure variables From cea4a1ffa88260ab9e2ba7d9418d6e24efabdd18 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 28 Jun 2024 12:55:37 -0600 Subject: [PATCH 098/529] Debug min. limit on waterPressure Enforces rhoi*gravity*iceThicknessHydro as a minimum limit for waterPressure ONLY for cells with grounded ice. Otherwise, waterPressure in open ocean is set to zero, instead of being equal to ocean hydrostatic pressure --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index b581dc1d50e..bbd3edb9852 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -207,7 +207,9 @@ subroutine li_SGH_init(domain, err) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) waterPressure = max(0.0_RKIND, waterPressure) - waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) + where (li_mask_is_grounded_ice(cellMask)) + waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) + end where ! set pressure and hydropotential correctly on ice-free land and in ocean call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) @@ -1660,7 +1662,9 @@ subroutine calc_pressure(block, err) end select waterPressure = max(0.0_RKIND, waterPressure) - waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) + where (li_mask_is_grounded_ice(cellMask)) + waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) + end where do iCell = 1, nCells onMarineMargin = .false. From e7ce959e8b59a0c67e793706beab62e8765f30db Mon Sep 17 00:00:00 2001 From: Stephen Price Date: Tue, 2 Jul 2024 17:58:47 -0500 Subject: [PATCH 099/529] Improve and debug coupler budgets for GLC Update various bits of code needed for completing and testing of glc coupler budgets. Still very much in the testing and debugging phase. --- .../mpas-albany-landice/driver/glc_comp_mct.F | 2 +- driver-mct/main/cime_comp_mod.F90 | 9 +- driver-mct/main/seq_diag_mct.F90 | 124 +++++++++++++----- 3 files changed, 97 insertions(+), 38 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index ac33d17b1f3..0146fc74791 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -1482,7 +1482,7 @@ subroutine glc_export_mct(g2x_g, errorCode) !call route_ice_runoff(0.0_RKIND, & !Recuperate runoff routing switch code (originally in glc_route_ice_runoff module in earlier code), and attach to ice calving flux once present... ! rofi_to_ocn=Fogg_rofi, & ! rofi_to_ice=Figg_rofi) - g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0 !...and remove these placeholders + g2x_g % rAttr(index_g2x_Fogg_rofi,n)=9999.0 !...and remove these placeholders g2x_g % rAttr(index_g2x_Figg_rofi,n)=0.0 !...and remove these placeholders g2x_g % rAttr(index_g2x_Fogg_rofl,n) = 0.0 !Attach to subglacial liquid flux once present diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index 2131d0c8684..77749415af8 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -145,7 +145,8 @@ module cime_comp_mod ! diagnostic routines use seq_diag_mct, only : seq_diag_zero_mct , seq_diag_avect_mct, seq_diag_lnd_mct use seq_diag_mct, only : seq_diag_rof_mct , seq_diag_ocn_mct , seq_diag_atm_mct - use seq_diag_mct, only : seq_diag_ice_mct , seq_diag_accum_mct, seq_diag_print_mct + use seq_diag_mct, only : seq_diag_ice_mct , seq_diag_glc_mct + use seq_diag_mct, only : seq_diag_accum_mct, seq_diag_print_mct use seq_diagBGC_mct, only : seq_diagBGC_zero_mct , seq_diagBGC_avect_mct, seq_diagBGC_lnd_mct use seq_diagBGC_mct, only : seq_diagBGC_rof_mct , seq_diagBGC_ocn_mct , seq_diagBGC_atm_mct use seq_diagBGC_mct, only : seq_diagBGC_ice_mct , seq_diagBGC_accum_mct @@ -4743,6 +4744,9 @@ subroutine cime_run_calc_budgets1(in_cplrun) if (ice_present) then call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_x2i=.true.) endif + if (glc_present) then + call seq_diag_glc_mct(glc(ens1), fractions_ix(ens1), infodata, do_x2g=.true., do_g2x=.true.) + endif if (do_bgc_budgets) then if (rof_present) then call seq_diagBGC_rof_mct(rof(ens1), fractions_rx(ens1), infodata) @@ -4789,6 +4793,9 @@ subroutine cime_run_calc_budgets2(in_cplrun) if (ice_present) then call seq_diagBGC_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true., do_x2i=.true.) endif + if (glc_present) then + call seq_diag_glc_mct(glc(ens1), fractions_ix(ens1), infodata, do_x2g=.true., do_g2x=.true.) + endif if (lnd_present) then call seq_diagBGC_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, do_l2x=.true., do_x2l=.true.) endif diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 8534008f9be..502373fc7a9 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -140,42 +140,45 @@ module seq_diag_mct integer(in),parameter :: f_hsen =10 ! heat : sensible integer(in),parameter :: f_hpolar =11 ! heat : AIS imbalance integer(in),parameter :: f_hh2ot =12 ! heat : water temperature - integer(in),parameter :: f_wfrz =13 ! water: freezing - integer(in),parameter :: f_wmelt =14 ! water: melting - integer(in),parameter :: f_wrain =15 ! water: precip, liquid - integer(in),parameter :: f_wsnow =16 ! water: precip, frozen - integer(in),parameter :: f_wpolar =17 ! water: AIS imbalance - integer(in),parameter :: f_wevap =18 ! water: evaporation - integer(in),parameter :: f_wroff =19 ! water: runoff/flood - integer(in),parameter :: f_wioff =20 ! water: frozen runoff - integer(in),parameter :: f_wirrig =21 ! water: irrigation - integer(in),parameter :: f_wfrz_16O =22 ! water: freezing - integer(in),parameter :: f_wmelt_16O =23 ! water: melting - integer(in),parameter :: f_wrain_16O =24 ! water: precip, liquid - integer(in),parameter :: f_wsnow_16O =25 ! water: precip, frozen - integer(in),parameter :: f_wevap_16O =26 ! water: evaporation - integer(in),parameter :: f_wroff_16O =27 ! water: runoff/flood - integer(in),parameter :: f_wioff_16O =28 ! water: frozen runoff - integer(in),parameter :: f_wfrz_18O =29 ! water: freezing - integer(in),parameter :: f_wmelt_18O =30 ! water: melting - integer(in),parameter :: f_wrain_18O =31 ! water: precip, liquid - integer(in),parameter :: f_wsnow_18O =32 ! water: precip, frozen - integer(in),parameter :: f_wevap_18O =33 ! water: evaporation - integer(in),parameter :: f_wroff_18O =34 ! water: runoff/flood - integer(in),parameter :: f_wioff_18O =35 ! water: frozen runoff - integer(in),parameter :: f_wfrz_HDO =36 ! water: freezing - integer(in),parameter :: f_wmelt_HDO =37 ! water: melting - integer(in),parameter :: f_wrain_HDO =38 ! water: precip, liquid - integer(in),parameter :: f_wsnow_HDO =39 ! water: precip, frozen - integer(in),parameter :: f_wevap_HDO =40 ! water: evaporation - integer(in),parameter :: f_wroff_HDO =41 ! water: runoff/flood - integer(in),parameter :: f_wioff_HDO =42 ! water: frozen runoff + integer(in),parameter :: f_hgsmb =13 ! heat : GIS SMB !SFP added + integer(in),parameter :: f_wfrz =14 ! water: freezing + integer(in),parameter :: f_wmelt =15 ! water: melting + integer(in),parameter :: f_wrain =16 ! water: precip, liquid + integer(in),parameter :: f_wsnow =17 ! water: precip, frozen + integer(in),parameter :: f_wpolar =18 ! water: AIS imbalance + integer(in),parameter :: f_wgsmb =19 ! water: GIS SMB !SFP added + integer(in),parameter :: f_wevap =20 ! water: evaporation + integer(in),parameter :: f_wroff =21 ! water: runoff/flood + integer(in),parameter :: f_wioff =22 ! water: frozen runoff + integer(in),parameter :: f_wirrig =23 ! water: irrigation + integer(in),parameter :: f_wfrz_16O =24 ! water: freezing + integer(in),parameter :: f_wmelt_16O =25 ! water: melting + integer(in),parameter :: f_wrain_16O =26 ! water: precip, liquid + integer(in),parameter :: f_wsnow_16O =27 ! water: precip, frozen + integer(in),parameter :: f_wevap_16O =28 ! water: evaporation + integer(in),parameter :: f_wroff_16O =29 ! water: runoff/flood + integer(in),parameter :: f_wioff_16O =30 ! water: frozen runoff + integer(in),parameter :: f_wfrz_18O =31 ! water: freezing + integer(in),parameter :: f_wmelt_18O =32 ! water: melting + integer(in),parameter :: f_wrain_18O =33 ! water: precip, liquid + integer(in),parameter :: f_wsnow_18O =34 ! water: precip, frozen + integer(in),parameter :: f_wevap_18O =35 ! water: evaporation + integer(in),parameter :: f_wroff_18O =36 ! water: runoff/flood + integer(in),parameter :: f_wioff_18O =37 ! water: frozen runoff + integer(in),parameter :: f_wfrz_HDO =38 ! water: freezing + integer(in),parameter :: f_wmelt_HDO =39 ! water: melting + integer(in),parameter :: f_wrain_HDO =40 ! water: precip, liquid + integer(in),parameter :: f_wsnow_HDO =41 ! water: precip, frozen + integer(in),parameter :: f_wevap_HDO =42 ! water: evaporation + integer(in),parameter :: f_wroff_HDO =43 ! water: runoff/flood + integer(in),parameter :: f_wioff_HDO =44 ! water: frozen runoff integer(in),parameter :: f_size = f_wioff_HDO ! Total array size of all elements integer(in),parameter :: f_a = f_area ! 1st index for area integer(in),parameter :: f_a_end = f_area ! last index for area integer(in),parameter :: f_h = f_hfrz ! 1st index for heat - integer(in),parameter :: f_h_end = f_hh2ot ! Last index for heat + !integer(in),parameter :: f_h_end = f_hh2ot ! Last index for heat + integer(in),parameter :: f_h_end = f_hgsmb ! Last index for heat integer(in),parameter :: f_w = f_wfrz ! 1st index for water integer(in),parameter :: f_w_end = f_wirrig ! Last index for water integer(in),parameter :: f_16O = f_wfrz_16O ! 1st index for 16O water isotope @@ -189,8 +192,10 @@ module seq_diag_mct (/' area',' hfreeze',' hmelt',' hnetsw',' hlwdn', & ' hlwup',' hlatvap',' hlatfus',' hiroff',' hsen', & - ' hpolar',' hh2otemp',' wfreeze',' wmelt',' wrain', & - ' wsnow',' wpolar',' wevap',' wrunoff',' wfrzrof', & +! ' hpolar',' hh2otemp',' wfreeze',' wmelt',' wrain', & + ' hpolar',' hh2otemp',' hgsmb',' wfreeze',' wmelt',' wrain', & +! ' wsnow',' wpolar',' wevap',' wrunoff',' wfrzrof', & + ' wsnow',' wpolar',' wgsmb',' wevap',' wrunoff',' wfrzrof', & ' wirrig', & ' wfreeze_16O',' wmelt_16O',' wrain_16O',' wsnow_16O', & ' wevap_16O',' wrunoff_16O',' wfrzrof_16O', & @@ -262,6 +267,7 @@ module seq_diag_mct integer :: index_l2x_Flrl_irrig integer :: index_l2x_Flrl_wslake + integer :: index_l2x_Flgl_qice(0:10) !SFP added integer :: index_x2l_Faxa_lwdn integer :: index_x2l_Faxa_rainc @@ -338,6 +344,8 @@ module seq_diag_mct integer :: index_g2x_Fogg_rofi integer :: index_g2x_Figg_rofi + integer :: index_x2g_Flgl_qice !SFP added + integer :: index_x2o_Foxx_rofl_16O integer :: index_x2o_Foxx_rofi_16O integer :: index_x2o_Foxx_rofl_18O @@ -874,6 +882,10 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) logical,save :: first_time = .true. logical,save :: flds_wiso_lnd = .false. + character(len=64) :: name !SFP: added this and next 2 + character(len= 2) :: cnum + integer(in) :: num + !----- formats ----- character(*),parameter :: subName = '(seq_diag_lnd_mct) ' @@ -909,6 +921,13 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_irrig = mct_aVect_indexRA(l2x_l,'Flrl_irrig', perrWith='quiet') index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') + do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) + write(cnum,'(i2.2)') num + name = 'Flgl_qice' // cnum + index_l2x_Flgl_qice(num) = mct_avect_indexRA(l2x_l,trim(name)) !SFP added + !index_l2x_Flgl_qice = mct_aVect_indexRA(l2x_l,'Flgl_qice') + end do + index_l2x_Fall_evap_16O = mct_aVect_indexRA(l2x_l,'Fall_evap_16O',perrWith='quiet') if ( index_l2x_Fall_evap_16O /= 0 ) flds_wiso_lnd = .true. if ( flds_wiso_lnd )then @@ -944,6 +963,10 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) end if nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi,n) + do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) + nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flgl_qice(num),n) !SFP added + end do + if ( flds_wiso_lnd )then nf = f_wevap_16O; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + & @@ -976,7 +999,11 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi_HDO,n) end if end do + budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice + + budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice !SFP add + end if if (present(do_x2l)) then @@ -1256,11 +1283,13 @@ end subroutine seq_diag_rof_mct ! ! !INTERFACE: ------------------------------------------------------------------ - subroutine seq_diag_glc_mct( glc, frac_g, infodata) + subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) type(component_type) , intent(in) :: glc ! component type for instance1 type(mct_aVect) , intent(in) :: frac_g ! frac bundle type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in), optional :: do_x2g + logical , intent(in), optional :: do_g2x !EOP @@ -1289,14 +1318,25 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata) g2x_g => component_get_c2x_cx(glc) x2g_g => component_get_x2c_cx(glc) - if (first_time) then +! eventually use the following if constructs to wrap relevant sections below? +! if (present(do_g2x)) then +! end if +! if (present(do_x2g)) then +! end if + +! if (first_time) then + index_g2x_Fogg_rofl = mct_aVect_indexRA(g2x_g,'Fogg_rofl') index_g2x_Fogg_rofi = mct_aVect_indexRA(g2x_g,'Fogg_rofi') index_g2x_Figg_rofi = mct_aVect_indexRA(g2x_g,'Figg_rofi') - end if + + index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') !SFP: might be cleaner to do "x2g" in its own section? + +! end if ip = p_inst ic = c_glc_gs + !ic = c_glc_gr !SFP: should this actually be used here? other sections of this code use"r" for c2x and "s" for x2c kArea = mct_aVect_indexRA(dom_g%data,afldname) lSize = mct_avect_lSize(g2x_g) do n=1,lSize @@ -1307,6 +1347,18 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata) end do budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice + ip = p_inst + !SFP: unclear if next should be 'send' or 'receive' index but for now we think send (because of x2g), + ! but budget results don't seem to be sensitive to this choice (same numbers appear using either). + ic = c_glc_gs ! cpl send + !ic = c_glc_gr ! cpl receive + lSize = mct_avect_lSize(x2g_g) + do n=1,lSize + ca_g = dom_g%data%rAttr(kArea,n) + nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) + end do + budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice + first_time = .false. end subroutine seq_diag_glc_mct From ab7642be9ccece79ae8fe64c80e832c556c2fe9a Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 14 Jul 2024 16:17:32 +0000 Subject: [PATCH 100/529] fix another boolean instance --- components/homme/src/share/control_mod.F90 | 1 + components/homme/src/share/cxx/GllFvRemap.cpp | 4 ++-- components/homme/src/share/cxx/GllFvRemap.hpp | 4 ++-- components/homme/src/share/cxx/GllFvRemapImpl.cpp | 6 +++--- components/homme/src/share/cxx/GllFvRemapImpl.hpp | 5 +++-- components/homme/src/share/gllfvremap_mod.F90 | 14 ++++++++------ components/homme/src/share/namelist_mod.F90 | 6 ++++++ .../src/theta-l_kokkos/cxx/EquationOfState.hpp | 4 ++-- 8 files changed, 27 insertions(+), 17 deletions(-) diff --git a/components/homme/src/share/control_mod.F90 b/components/homme/src/share/control_mod.F90 index 0e9494f5a6c..9c3c599b232 100644 --- a/components/homme/src/share/control_mod.F90 +++ b/components/homme/src/share/control_mod.F90 @@ -43,6 +43,7 @@ module control_mod ! flag used by preqx, theta-l and theta-c models ! should be renamed to "hydrostatic_mode" logical, public :: theta_hydrostatic_mode + integer, public :: theta_hydrostatic_mode_integer integer, public :: tstep_type= 5 ! preqx timestepping options diff --git a/components/homme/src/share/cxx/GllFvRemap.cpp b/components/homme/src/share/cxx/GllFvRemap.cpp index e36dbc14d74..a8f564958d4 100644 --- a/components/homme/src/share/cxx/GllFvRemap.cpp +++ b/components/homme/src/share/cxx/GllFvRemap.cpp @@ -16,7 +16,7 @@ namespace Homme { void init_gllfvremap_c (int nelemd, int np, int nf, int nf_max, - bool theta_hydrostatic_mode, + int theta_hydrostatic_mode, CF90Ptr fv_metdet, CF90Ptr g2f_remapd, CF90Ptr f2g_remapd, CF90Ptr D_f, CF90Ptr Dinv_f) { auto& c = Context::singleton(); @@ -52,7 +52,7 @@ void GllFvRemap::init_boundary_exchanges () { } void GllFvRemap -::init_data (const int nf, const int nf_max, bool theta_hydrostatic_mode, +::init_data (const int nf, const int nf_max, const int theta_hydrostatic_mode, const Real* fv_metdet, const Real* g2f_remapd, const Real* f2g_remapd, const Real* D_f, const Real* Dinv_f) { m_impl->init_data(nf, nf_max, theta_hydrostatic_mode, fv_metdet, diff --git a/components/homme/src/share/cxx/GllFvRemap.hpp b/components/homme/src/share/cxx/GllFvRemap.hpp index 07e4bf58a90..2adff0aeaa9 100644 --- a/components/homme/src/share/cxx/GllFvRemap.hpp +++ b/components/homme/src/share/cxx/GllFvRemap.hpp @@ -40,7 +40,7 @@ class GllFvRemap { typedef Phys2T::const_type CPhys2T; typedef Phys3T::const_type CPhys3T; - void init_data(const int nf, const int nf_max, bool theta_hydrostatic_mode, + void init_data(const int nf, const int nf_max, const int theta_hydrostatic_mode, const Real* fv_metdet, const Real* g2f_remapd, const Real* f2g_remapd, const Real* D_f, const Real* Dinv_f); @@ -81,7 +81,7 @@ class GllFvRemap { extern "C" void init_gllfvremap_c(int nelemd, int np, int nf, int nf_max, - const bool theta_hydrostatic_mode, + const int theta_hydrostatic_mode, CF90Ptr fv_metdet, CF90Ptr g2f_remapd, CF90Ptr f2g_remapd, CF90Ptr D_f, CF90Ptr Dinv_f); diff --git a/components/homme/src/share/cxx/GllFvRemapImpl.cpp b/components/homme/src/share/cxx/GllFvRemapImpl.cpp index ea1a52f5efd..d4ab5c89f51 100644 --- a/components/homme/src/share/cxx/GllFvRemapImpl.cpp +++ b/components/homme/src/share/cxx/GllFvRemapImpl.cpp @@ -131,7 +131,7 @@ void GllFvRemapImpl::init_boundary_exchanges () { template using FV = Kokkos::View; void GllFvRemapImpl -::init_data (const int nf, const int nf_max, const bool theta_hydrostatic_mode, +::init_data (const int nf, const int nf_max, const int theta_hydrostatic_mode, const Real* fv_metdet_r, const Real* g2f_remapd_r, const Real* f2g_remapd_r, const Real* D_f_r, const Real* Dinv_f_r) { using Kokkos::create_mirror_view; @@ -395,7 +395,7 @@ ::run_dyn_to_fv_phys (const int timeidx, const Phys1T& ps, const Phys1T& phis, c const auto hvcoord = m_hvcoord; const bool use_moisture = m_data.use_moisture; - const bool theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; + const int theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; const bool want_dp_fv_out = dp_fv_out_ptr != nullptr; VPhys2T dp_fv_out; @@ -605,7 +605,7 @@ run_fv_phys_to_dyn (const int timeidx, const CPhys2T& Ts, const CPhys3T& uvs, const auto fT = m_forcing.m_ft; const auto hvcoord = m_hvcoord; const auto dp3d = m_state.m_dp3d; - const bool theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; + const int theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; EquationOfState eos; eos.init(theta_hydrostatic_mode, hvcoord); ElementOps ops; ops.init(hvcoord); const auto tu_ne = m_tu_ne; diff --git a/components/homme/src/share/cxx/GllFvRemapImpl.hpp b/components/homme/src/share/cxx/GllFvRemapImpl.hpp index 11738b2bf45..7388fddb123 100644 --- a/components/homme/src/share/cxx/GllFvRemapImpl.hpp +++ b/components/homme/src/share/cxx/GllFvRemapImpl.hpp @@ -60,7 +60,8 @@ struct GllFvRemapImpl { struct Data { int nelemd, qsize, nf2, n_dss_fld; - bool use_moisture, theta_hydrostatic_mode; + bool use_moisture; + int theta_hydrostatic_mode; static constexpr int nbuf1 = 2, nbuf2 = 1; Buf1 buf1[nbuf1]; @@ -107,7 +108,7 @@ struct GllFvRemapImpl { void init_buffers(const FunctorsBuffersManager& fbm); void init_boundary_exchanges(); - void init_data(const int nf, const int nf_max, const bool theta_hydrostatic_mode, + void init_data(const int nf, const int nf_max, const int theta_hydrostatic_mode, const Real* fv_metdet_r, const Real* g2f_remapd_r, const Real* f2g_remapd_r, const Real* D_f_r, const Real* Dinv_f_r); diff --git a/components/homme/src/share/gllfvremap_mod.F90 b/components/homme/src/share/gllfvremap_mod.F90 index 48351259f5c..1628d128602 100644 --- a/components/homme/src/share/gllfvremap_mod.F90 +++ b/components/homme/src/share/gllfvremap_mod.F90 @@ -265,22 +265,24 @@ end subroutine gfr_init subroutine gfr_init_hxx() bind(c) #if KOKKOS_TARGET - use control_mod, only: theta_hydrostatic_mode - use iso_c_binding, only: c_bool + use control_mod, only: theta_hydrostatic_mode_integer + use iso_c_binding, only: c_int interface - subroutine init_gllfvremap_c(nelemd, np, nf, nf_max, theta_hydrostatic_mode, & + subroutine init_gllfvremap_c(nelemd, np, nf, nf_max, theta_hydrostatic_mode_integer, & fv_metdet, g2f_remapd, f2g_remapd, D_f, Dinv_f) bind(c) use iso_c_binding, only: c_bool, c_int, c_double integer (c_int), value, intent(in) :: nelemd, np, nf, nf_max - logical (c_bool), value, intent(in) :: theta_hydrostatic_mode + !logical (c_bool), value, intent(in) :: theta_hydrostatic_mode + integer (c_int), value, intent(in) :: theta_hydrostatic_mode_integer real (c_double), dimension(nf*nf,nelemd), intent(in) :: fv_metdet real (c_double), dimension(np,np,nf_max*nf_max), intent(in) :: g2f_remapd real (c_double), dimension(nf_max*nf_max,np,np), intent(in) :: f2g_remapd real (c_double), dimension(nf*nf,2,2,nelemd), intent(in) :: D_f, Dinv_f end subroutine init_gllfvremap_c end interface - logical (c_bool) :: thm - thm = theta_hydrostatic_mode + integer (c_int) :: thm + !logical (c_bool) :: thm + thm = theta_hydrostatic_mode_integer call init_gllfvremap_c(nelemd, np, gfr%nphys, nphys_max, thm, & gfr%fv_metdet, gfr%g2f_remapd, gfr%f2g_remapd, gfr%D_f, gfr%Dinv_f) #endif diff --git a/components/homme/src/share/namelist_mod.F90 b/components/homme/src/share/namelist_mod.F90 index 1d47090182b..8dcceca6652 100644 --- a/components/homme/src/share/namelist_mod.F90 +++ b/components/homme/src/share/namelist_mod.F90 @@ -41,6 +41,7 @@ module namelist_mod runtype, & integration, & ! integration method theta_hydrostatic_mode, & + theta_hydrostatic_mode_integer, & transport_alg , & ! SE Eulerian, classical SL, cell-integrated SL semi_lagrange_cdr_alg, & ! see control_mod for semi_lagrange_* descriptions semi_lagrange_cdr_check, & @@ -452,8 +453,10 @@ subroutine readnl(par) planar_slice = .false. theta_hydrostatic_mode = .true. ! for preqx, this must be .true. + theta_hydrostatic_mode_integer = 1 ! for preqx, this must be .true. #if ( defined MODEL_THETA_C || defined MODEL_THETA_L ) theta_hydrostatic_mode = .false. ! default NH + theta_hydrostatic_mode_integer = 0 ! default NH #endif @@ -850,7 +853,10 @@ subroutine readnl(par) call MPI_bcast(case_planar_bubble,1,MPIlogical_t,par%root,par%comm,ierr) #endif +if(theta_hydrostatic_mode) theta_hydrostatic_mode_integer = 1 +if(.not. theta_hydrostatic_mode) theta_hydrostatic_mode_integer = 0 call MPI_bcast(theta_hydrostatic_mode ,1,MPIlogical_t,par%root,par%comm,ierr) + call MPI_bcast(theta_hydrostatic_mode_integer ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(transport_alg ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(semi_lagrange_cdr_alg ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(semi_lagrange_cdr_check ,1,MPIlogical_t,par%root,par%comm,ierr) diff --git a/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp b/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp index dd97720f1be..99732ee640a 100644 --- a/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp @@ -23,7 +23,7 @@ class EquationOfState { EquationOfState () = default; - void init (const bool theta_hydrostatic_mode, + void init (const int theta_hydrostatic_mode, const HybridVCoord& hvcoord) { m_theta_hydrostatic_mode = theta_hydrostatic_mode; m_hvcoord = hvcoord; @@ -250,7 +250,7 @@ class EquationOfState { public: - bool m_theta_hydrostatic_mode; + int m_theta_hydrostatic_mode; HybridVCoord m_hvcoord; }; From 8b9716523ecec4ba919160feaf775d32a23134e9 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 14 Jul 2024 21:50:59 +0000 Subject: [PATCH 101/529] add mpi options --- .../oneapi-ifxgpu_sunspot-pvc.cmake | 2 +- cime_config/machines/config_machines.xml | 64 ++++++++++++++----- 2 files changed, 50 insertions(+), 16 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake index 91f65665a14..7f3d9ab5d21 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake @@ -14,7 +14,7 @@ endif() string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off -DCMAKE_CXX_FLAGS='-fsycl-device-code-split=per_kernel'") string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") -set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") +set(SCREAM_MPI_ON_DEVICE ON CACHE STRING "") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 2ae5c37aaa5..6e90e5fc6d8 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3400,7 +3400,7 @@ -np {{ total_tasks }} --label -ppn {{ tasks_per_node }} - --cpu-bind depth -envall + --cpu-bind=list:0-7:8-15:16-23:24-31:32-39:40-47:52-59:60-67:68-75:76-83:84-91:92-99 -envall -d $ENV{OMP_NUM_THREADS} $ENV{GPU_TILE_COMPACT} @@ -3436,27 +3436,61 @@ /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf - /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/lib:$ENV{LD_LIBRARY_PATH} - /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/bin:$ENV{PATH} - list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/lib:$ENV{LD_LIBRARY_PATH} + /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/bin:$ENV{PATH} + + list:0-7:8-15:16-23:24-31:32-39:40-47:52-59:60-67:68-75:76-83:84-91:92-99 1 - + + + + + - 1 - level_zero:gpu - NO_GPU - 0 - disable + 1 + + + + 1 + recursive_doubling + + + + + 1 + 1 + + disable disable - 1 - 4000MB + + + 0 + + 4000MB 0 - /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh - 131072 + + /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh + + 131072 20 - + memhooks + warn + + verbose,granularity=thread,balanced 128M From 226bf95586c93590e434ef445a76408865190ab9 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 16 Jul 2024 21:50:27 +0000 Subject: [PATCH 102/529] turn mmfxx off --- components/eamxx/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 3d59c1010a3..802da033885 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -205,7 +205,7 @@ set(NetCDF_Fortran_PATH ${DEFAULT_NetCDF_Fortran_PATH} CACHE FILEPATH "Path to n set(NetCDF_C_PATH ${DEFAULT_NetCDF_C_PATH} CACHE FILEPATH "Path to netcdf C installation") set(SCREAM_MACHINE ${DEFAULT_SCREAM_MACHINE} CACHE STRING "The CIME/SCREAM name for the current machine") option(SCREAM_MPI_ON_DEVICE "Whether to use device pointers for MPI calls" ON) -option(SCREAM_ENABLE_MAM "Whether to enable MAM aerosol support" ON) +option(SCREAM_ENABLE_MAM "Whether to enable MAM aerosol support" OFF) set(SCREAM_SMALL_KERNELS ${DEFAULT_SMALL_KERNELS} CACHE STRING "Use small, non-monolothic kokkos kernels") if (NOT SCREAM_SMALL_KERNELS) set(EKAT_DISABLE_WORKSPACE_SHARING TRUE CACHE STRING "") From b3fe5d3d407e93118a9aa9625ea56b6c22494cc5 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 16 Jul 2024 21:58:53 +0000 Subject: [PATCH 103/529] update ekat --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index 215d83184dd..7b8e5d883b3 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit 215d83184dddb09891c6de466d9a392b43b283fb +Subproject commit 7b8e5d883b3fef5d9209050f0f65d685de5a86de From 47fd8f881bff8886c2e2f0cc6dbc0ab90b68e948 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 23 Jul 2024 12:41:57 -0700 Subject: [PATCH 104/529] Reassign extrapolated TF back to primary TF field Without this, the extrapolated TF field is not used by the ismip6 melt parameterization. --- .../src/mode_forward/mpas_li_ocean_extrap.F | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index c3dfb396a27..39dd1b195d1 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -234,6 +234,9 @@ subroutine li_ocean_extrap_solve(domain, err) err = ior(err, err_tmp) call mpas_timer_stop("vertical scheme") enddo + + ! Reassign extrapolated TF back to primary TF field + ismip6shelfMelt_3dThermalForcing(:,:) = TFocean(:,:) else ! do nothing call mpas_log_write('ocean data will NOT be extrapolated into the MALI ice draft') From c0f079e10a3c5fc33034db3a095a3f8c873b70bd Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Thu, 15 Aug 2024 14:56:57 -0700 Subject: [PATCH 105/529] Clean up after code review Remove several instances of master-only log writes, as well as a few extraneous error counters. --- .../src/mode_forward/mpas_li_advection.F | 11 ++++------- .../src/mode_forward/mpas_li_time_integration_fe_rk.F | 2 +- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F index f06c8d1a67e..ad3f8f517c5 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F @@ -1161,11 +1161,9 @@ subroutine tracer_setup(& real (kind=RKIND), pointer :: & config_ice_density ! ice density - integer :: iCell, iTracer, k, err, err1, err2 + integer :: iCell, iTracer, k, err err = 0 - err1 = 0 - err2 = 0 ! get dimensions call mpas_pool_get_dimension(meshPool, 'nCells', nCells) @@ -1294,13 +1292,12 @@ subroutine tracer_setup(& ! May need to increase maxTracers in the Registry. if ( (trim(config_tracer_advection) == 'fct') .or. & (trim(config_thickness_advection) == 'fct') ) then - call li_tracer_advection_fct_init(err2) + call li_tracer_advection_fct_init(err) - if (err1 /= 0 .or. err2 /= 0) then - err = 1 + if (err /= 0) then call mpas_log_write( & 'Error encountered during fct tracer advection init', & - MPAS_LOG_ERR, masterOnly=.true.) + MPAS_LOG_ERR) endif endif diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index 52e3dd22844..dca4bc4608e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -289,7 +289,7 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) err = 1 call mpas_log_write( & 'Error encountered during fct tracer advection shared init', & - MPAS_LOG_ERR, masterOnly=.true.) + MPAS_LOG_ERR) endif endif From f984146b24ba32ce8b9a3095a50759ca53bb90f9 Mon Sep 17 00:00:00 2001 From: alexolinhager <131483939+alexolinhager@users.noreply.github.com> Date: Thu, 15 Aug 2024 15:02:26 -0700 Subject: [PATCH 106/529] Apply suggestions from code review Co-authored-by: Matt Hoffman --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index bbd3edb9852..ee6df91a94d 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -219,7 +219,7 @@ subroutine li_SGH_init(domain, err) where ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND hydropotential = rho_water * gravity * bedTopography - elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography < config_sea_level)) + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography <= config_sea_level)) waterPressure = gravity * rhoo * (config_sea_level - bedTopography) hydropotential = 0.0_RKIND end where @@ -1642,7 +1642,7 @@ subroutine calc_pressure(block, err) rho_water * gravity * deltatSGH / porosity + waterPressureOld elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND - elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography < config_sea_level)) + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography <= config_sea_level)) waterPressure = gravity * rhoo * (config_sea_level - bedTopography) end where @@ -1652,7 +1652,7 @@ subroutine calc_pressure(block, err) waterPressure = rhoi * gravity * iceThicknessHydro elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND - elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography < config_sea_level)) + elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography <= config_sea_level)) waterPressure = gravity * rhoo * (config_sea_level - bedTopography) end where @@ -1760,7 +1760,7 @@ subroutine calc_pressure_diag_vars(block, err) end where hydropotentialBase = rho_water * gravity * bedTopography + waterPressure - where ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography < config_sea_level)) + where ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography <= config_sea_level)) hydropotentialBase = 0.0_RKIND !zero hydropotential in ocean elsewhere ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography > config_sea_level)) hydropotentialBase = rho_water * gravity * bedTopography ! for completeness, but won't matter with one-side slope calculations on terrestrial boundaries @@ -1901,7 +1901,7 @@ subroutine update_channel(block, err) channelDischarge = 0.0_RKIND end where - ! Similar to waterFlux, shut of channelDischarge if no water upstream. Prevents self-sustaining channels in the absence of distributed water + ! Similar to waterFlux, shut off channelDischarge if no water upstream. Prevents self-sustaining channels in the absence of distributed water where (waterThicknessEdgeUpwind == 0.0_RKIND) channelArea = 0.0_RKIND channelDischarge = 0.0_RKIND From cf0e1fbd31d8a9e1e75c4d5b1edfe6ace98bec36 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 16 Aug 2024 16:11:39 +0000 Subject: [PATCH 107/529] testmod files for sunspot --- .../testmods_dirs/scream/sunspot_run/shell_commands | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands new file mode 100644 index 00000000000..6ae48c59d4a --- /dev/null +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands @@ -0,0 +1,6 @@ + +$CIMEROOT/../components/eamxx/scripts/atmchange transport_alg=0 -b +$CIMEROOT/../components/eamxx/scripts/atmchange hypervis_subcycle_q=1 -b +$CIMEROOT/../components/eamxx/scripts/atmchange dt_tracer_factor=2 -b +$CIMEROOT/../components/eamxx/scripts/atmchange tstep_type=9 -b +$CIMEROOT/../components/eamxx/scripts/atmchange theta_hydrostatic_mode=False -b From ad78e435a36f27d04fa1095587f7b593b3d1450a Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 16 Aug 2024 17:11:42 +0000 Subject: [PATCH 108/529] flag to avoid default -fast-math for gpu --- cime_config/machines/cmake_macros/oneapi-ifx.cmake | 2 +- cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifx.cmake b/cime_config/machines/cmake_macros/oneapi-ifx.cmake index 5782a126eca..e590456e9f3 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifx.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifx.cmake @@ -6,7 +6,7 @@ if (compile_threaded) endif() string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -gline-tables-only -g") string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -gline-tables-only -g") -string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2 -gline-tables-only -g") +string(APPEND CMAKE_CXX_FLAGS_RELEASE " -fp-model precise -O2 -gline-tables-only -g") string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake index a4dc8fc1214..faf8748217a 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu.cmake @@ -8,7 +8,7 @@ endif() #adding -g here leads to linker internal errors string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -g -gline-tables-only") string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -fpscomp logicals -g -gline-tables-only") -string(APPEND CMAKE_CXX_FLAGS_RELEASE " -O2 -g -gline-tables-only") +string(APPEND CMAKE_CXX_FLAGS_RELEASE " -fp-model precise -O2 -g -gline-tables-only") string(APPEND CMAKE_Fortran_FLAGS_DEBUG " -O0 -g -fpscomp logicals -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created") string(APPEND CMAKE_C_FLAGS_DEBUG " -O0 -g") string(APPEND CMAKE_CXX_FLAGS_DEBUG " -O0 -g") From 91df3960c71e37f2e6ef8c3c8e7a5817f08dff4f Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 17 Aug 2024 20:27:11 +0000 Subject: [PATCH 109/529] start to remove testing setup for caar kernels --- components/homme/src/share/cxx/ErrorDefs.cpp | 2 - .../homme/src/share/cxx/Hommexx_Session.cpp | 11 - .../theta-l_kokkos/cxx/CaarFunctorImpl.hpp | 197 +----------------- 3 files changed, 10 insertions(+), 200 deletions(-) diff --git a/components/homme/src/share/cxx/ErrorDefs.cpp b/components/homme/src/share/cxx/ErrorDefs.cpp index a6eabfa1cf7..ccb4631100d 100644 --- a/components/homme/src/share/cxx/ErrorDefs.cpp +++ b/components/homme/src/share/cxx/ErrorDefs.cpp @@ -45,9 +45,7 @@ void runtime_abort(const std::string& message, int code) { } else { std::cerr << message << std::endl << "Exiting..." << std::endl; finalize_hommexx_session(); -#ifndef TESTER_NOMPI MPI_Abort(MPI_COMM_WORLD, code); -#endif } } diff --git a/components/homme/src/share/cxx/Hommexx_Session.cpp b/components/homme/src/share/cxx/Hommexx_Session.cpp index db50ec27d6c..c93174d2442 100644 --- a/components/homme/src/share/cxx/Hommexx_Session.cpp +++ b/components/homme/src/share/cxx/Hommexx_Session.cpp @@ -7,12 +7,8 @@ #include "Config.hpp" #include "Hommexx_Session.hpp" #include "ExecSpaceDefs.hpp" -#include "Types.hpp" - -#ifndef TESTER_NOMPI #include "profiling.hpp" #include "mpi/Comm.hpp" -#endif #include "Context.hpp" @@ -79,10 +75,7 @@ void initialize_hommexx_session () // If hommexx session is not currently inited, then init it. if (!Session::m_inited) { /* Make certain profiling is only done for code we're working on */ - -#ifndef TESTER_NOMPI profiling_pause(); -#endif /* Set Environment variables to control how many * threads/processors Kokkos uses */ @@ -90,16 +83,12 @@ void initialize_hommexx_session () initialize_kokkos(); } -#ifndef TESTER_NOMPI // Note: at this point, the Comm *should* already be created. const auto& comm = Context::singleton().get(); if (comm.root()) { ExecSpace().print_configuration(std::cout, true); print_homme_config_settings (); } -#else - ExecSpace().print_configuration(std::cout, true); -#endif Session::m_inited = true; } diff --git a/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp index 4a861d5c747..9c31422b519 100644 --- a/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/CaarFunctorImpl.hpp @@ -41,7 +41,7 @@ struct CaarFunctorImpl { struct Buffers { static constexpr int num_3d_scalar_mid_buf = 10; - static constexpr int num_3d_vector_mid_buf = 6; //<-- for vvdp variable + static constexpr int num_3d_vector_mid_buf = 5; static constexpr int num_3d_scalar_int_buf = 6; static constexpr int num_3d_vector_int_buf = 3; @@ -76,9 +76,6 @@ struct CaarFunctorImpl { ExecViewUnmanaged phi_tens; }; - ExecViewUnmanaged vvdp; - //ExecViewUnmanaged vv_tens; - using deriv_type = ReferenceElement::deriv_type; RKStageData m_data; @@ -109,10 +106,6 @@ struct CaarFunctorImpl { struct TagPreExchange {}; struct TagPostExchange {}; -#ifdef TESTER_NOMPI - struct TagPreExchangeTest {}; -#endif - // Policies #ifndef NDEBUG template @@ -124,10 +117,6 @@ struct CaarFunctorImpl { TeamPolicyType m_policy_pre; -#ifdef TESTER_NOMPI - TeamPolicyType m_policy_pre_test; -#endif - Kokkos::RangePolicy m_policy_post; TeamUtils m_tu; @@ -149,9 +138,6 @@ struct CaarFunctorImpl { , m_deriv(ref_FE.get_deriv()) , m_sphere_ops(sphere_ops) , m_policy_pre (Homme::get_default_team_policy(m_num_elems)) -#ifdef TESTER_NOMPI - , m_policy_pre_test (Homme::get_default_team_policy(m_num_elems)) -#endif , m_policy_post (0,m_num_elems*NP*NP) , m_tu(m_policy_pre) { @@ -169,9 +155,6 @@ struct CaarFunctorImpl { , m_theta_advection_form(params.theta_adv_form) , m_pgrad_correction(params.pgrad_correction) , m_policy_pre (Homme::get_default_team_policy(m_num_elems)) -#ifdef TESTER_NOMPI - , m_policy_pre_test (Homme::get_default_team_policy(m_num_elems)) -#endif , m_policy_post (0,num_elems*NP*NP) , m_tu(m_policy_pre) {} @@ -273,10 +256,6 @@ struct CaarFunctorImpl { m_buffers.vdp = decltype(m_buffers.vdp )(mem,nslots); mem += m_buffers.vdp.size(); - - vvdp = decltype(vvdp )(mem,nslots); - mem += vvdp.size(); - m_buffers.v_tens = decltype(m_buffers.v_tens )(mem,nslots); mem += m_buffers.v_tens.size(); @@ -370,16 +349,13 @@ struct CaarFunctorImpl { int nerr; Kokkos::parallel_reduce("caar loop pre-boundary exchange", m_policy_pre, *this, nerr); Kokkos::fence(); -#ifdef TESTER_NOMPI - Kokkos::parallel_for("caar loop pre-boundary test", m_policy_pre_test, *this); - Kokkos::fence(); -#endif GPTLstop("caar compute"); - -#ifndef TESTER_NOMPI if (nerr > 0) check_print_abort_on_bad_elems("CaarFunctorImpl::run TagPreExchange", data.n0); + + + GPTLstart("caar_bexchV"); m_bes[data.np1]->exchange(m_geometry.m_rspheremp); Kokkos::fence(); @@ -393,49 +369,10 @@ struct CaarFunctorImpl { } limiter.run(data.np1); -#endif profiling_pause(); } -#ifdef TESTER_NOMPI - KOKKOS_INLINE_FUNCTION - void operator()(const TagPreExchangeTest&, const TeamMember& team) const { - KernelVariables kv(team, m_tu); - test_dp_tendency(kv); - } -#endif - - -#ifndef TESTER_NOMPI -#define K1 -#define K2 -#define K2a -#define K2b -#define K3 -#define K3b -#define K4 -#define K5 -#define K5a -#define K6 -#define K7 - -#else - -#define K1 -#undef K2 -#undef K2a -#undef K2b -#undef K3 -#undef K3b -#undef K4 -#undef K5 -#undef K5a -#undef K6 -#undef K7 -#endif - - KOKKOS_INLINE_FUNCTION void operator()(const TagPreExchange&, const TeamMember &team, int& nerr) const { // In this body, we use '====' to separate sync epochs (delimited by barriers) @@ -443,76 +380,59 @@ struct CaarFunctorImpl { KernelVariables kv(team, m_tu); -#ifdef K1 + // Kokkos::printf("OG before div_vdp\n"); + // =========== EPOCH 1 =========== // compute_div_vdp(kv); -#endif -#ifdef K2 // =========== EPOCH 2 =========== // kv.team_barrier(); + +// Kokkos::printf("OG before div_vdp\n"); // Computes pi, omega, and phi. const bool ok = compute_scan_quantities(kv); if ( ! ok) nerr = 1; -#endif -#ifdef K2a if (m_rsplit==0 || !m_theta_hydrostatic_mode) { // ============ EPOCH 2.1 =========== // kv.team_barrier(); compute_interface_quantities(kv); +// Kokkos::printf("OG nonhydro \n"); } -#endif -#ifdef K2b if (m_rsplit==0) { // ============= EPOCH 2.2 ============ // kv.team_barrier(); compute_vertical_advection(kv); } -#endif -#ifdef K3 +// Kokkos::printf("OG before accum \n"); // ============= EPOCH 3 ============== // kv.team_barrier(); compute_accumulated_quantities(kv); -#endif -#ifdef K3b // Compute update quantities if (!m_theta_hydrostatic_mode) { compute_w_and_phi_tens (kv); } -#endif -#ifdef K4 compute_dp_and_theta_tens (kv); -#endif -#ifdef K5 // ============= EPOCH 4 =========== // // compute_v_tens reuses some buffers used by compute_dp_and_theta_tens kv.team_barrier(); compute_v_tens (kv); -#endif -#ifdef K5a // Update states if (!m_theta_hydrostatic_mode) { compute_w_and_phi_np1(kv); } -#endif - -#ifdef K6 compute_dp3d_and_theta_np1(kv); -#endif -#ifdef K7 // ============= EPOCH 5 =========== // // v_tens has been computed after last barrier. Need to make sure it's done kv.team_barrier(); compute_v_np1(kv); -#endif } KOKKOS_INLINE_FUNCTION @@ -587,122 +507,25 @@ struct CaarFunctorImpl { const int igp = idx / NP; const int jgp = idx % NP; -//ORIGINAL = subviews + call to div -//do not use vvdp in the !ORIGINAL version -//because it makes caar_ut fail. udp field is probbaly used in other functors, -//reverting to vvdp array will be easy if needed in c1_ut tests. - -#define ORIGINAL -//#undef ORIGINAL - auto u = Homme::subview(m_state.m_v,kv.ie,m_data.n0,0,igp,jgp); auto v = Homme::subview(m_state.m_v,kv.ie,m_data.n0,1,igp,jgp); auto dp3d = Homme::subview(m_state.m_dp3d,kv.ie,m_data.n0,igp,jgp); auto udp = Homme::subview(m_buffers.vdp,kv.team_idx,0,igp,jgp); auto vdp = Homme::subview(m_buffers.vdp,kv.team_idx,1,igp,jgp); - Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV), [&] (const int& ilev) { udp(ilev) = u(ilev)*dp3d(ilev); vdp(ilev) = v(ilev)*dp3d(ilev); - - //version without subviews - //m_buffers.vdp(kv.team_idx,0,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* - // m_state.m_v(kv.ie,m_data.n0,0,igp,jgp,ilev); - //m_buffers.vdp(kv.team_idx,1,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* - // m_state.m_v(kv.ie,m_data.n0,1,igp,jgp,ilev); - - //version with vvdp instead of udp - //vvdp(kv.team_idx,0,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* - // m_state.m_v(kv.ie,m_data.n0,0,igp,jgp,ilev); - //vvdp(kv.team_idx,1,igp,jgp,ilev) = m_state.m_dp3d(kv.ie,m_data.n0,igp,jgp,ilev)* - // m_state.m_v(kv.ie,m_data.n0,1,igp,jgp,ilev); }); }); kv.team_barrier(); // Compute div(vdp) -#ifdef ORIGINAL m_sphere_ops.divergence_sphere(kv, Homme::subview(m_buffers.vdp, kv.team_idx), Homme::subview(m_buffers.div_vdp, kv.team_idx)); -#else - - const Real aa = 1.0, bb=0.0; - - //example of calling _cm - //m_sphere_ops.divergence_sphere_cm(kv, - // Homme::subview(vvdp, kv.team_idx), - // Homme::subview(m_buffers.div_vdp, kv.team_idx), - // aa, bb, NUM_LEV); - -//inlined version of divergence_sphere_cm - const auto& D_inv = Homme::subview(m_sphere_ops.m_dinv, kv.ie); - const auto& metdet = Homme::subview(m_sphere_ops.m_metdet, kv.ie); - ExecViewUnmanaged gv_buf( - Homme::subview(m_sphere_ops.vector_buf_ml,kv.team_idx, 0).data()); - constexpr int np_squared = NP * NP; - Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, np_squared), - [&](const int loop_idx) { - const int igp = loop_idx / NP; - const int jgp = loop_idx % NP; - Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV), [&] (const int& ilev) { - //const auto& v0 = vvdp(kv.team_idx,0, igp, jgp, ilev); - //const auto& v1 = vvdp(kv.team_idx,1, igp, jgp, ilev); - - const auto& v0 = m_buffers.vdp(kv.team_idx,0, igp, jgp, ilev); - const auto& v1 = m_buffers.vdp(kv.team_idx,1, igp, jgp, ilev); - - gv_buf(0,igp,jgp,ilev) = (D_inv(0,0,igp,jgp) * v0 + D_inv(1,0,igp,jgp) * v1) * metdet(igp,jgp); - gv_buf(1,igp,jgp,ilev) = (D_inv(0,1,igp,jgp) * v0 + D_inv(1,1,igp,jgp) * v1) * metdet(igp,jgp); - }); - }); - kv.team_barrier(); - // j, l, i -> i, j, k - constexpr int div_iters = NP * NP; - Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, div_iters), - [&](const int loop_idx) { - const int igp = loop_idx / NP; - const int jgp = loop_idx % NP; - Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV), [&] (const int& ilev) { - Scalar dudx, dvdy; - for (int kgp = 0; kgp < NP; ++kgp) { - dudx += m_sphere_ops.dvv(jgp, kgp) * gv_buf(0, igp, kgp, ilev); - dvdy += m_sphere_ops.dvv(igp, kgp) * gv_buf(1, kgp, jgp, ilev); - } - combine((dudx + dvdy) * (1.0 / metdet(igp, jgp) * m_sphere_ops.m_scale_factor_inv), - m_buffers.div_vdp(kv.team_idx,igp, jgp, ilev), aa, bb); - }); - }); - kv.team_barrier(); - -#endif } - -#ifdef TESTER_NOMPI -// a kernel only for perf c1 test, to put div(vdp) into dp tendency -// to print it on host for verification - KOKKOS_INLINE_FUNCTION - void test_dp_tendency(KernelVariables &kv) const { - // Compute vdp - Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, NP * NP), - [&](const int idx) { - const int igp = idx / NP; - const int jgp = idx % NP; - - auto div_vdp = Homme::subview(m_buffers.div_vdp,kv.team_idx,igp,jgp); - auto dp_np1 = Homme::subview(m_state.m_dp3d,kv.ie,m_data.np1,igp,jgp); - - Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team,NUM_LEV), - [&](const int ilev) { - dp_np1(ilev) += div_vdp(ilev); - }); - }); - } -#endif - - KOKKOS_INLINE_FUNCTION bool compute_scan_quantities (KernelVariables &kv) const { bool ok = true; From 5c908e36d2022ff2fab4623519d008be85d492cb Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 17 Aug 2024 20:57:30 +0000 Subject: [PATCH 110/529] cleanup --- components/eamxx/CMakeLists.txt | 44 ++++++++++++++++----------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index c77294d5720..5e0d8a378b4 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -638,28 +638,28 @@ message ("* Summary of EAMxx config settings *") message ("**************************************************") # Shortcut function, to print a variable -#function (print_var var) -# message ("${var}: ${${var}}") -#endfunction () +function (print_var var) + message ("${var}: ${${var}}") +endfunction () -#print_var(EAMXX_ENABLE_GPU) -#print_var(CUDA_BUILD) -#print_var(HIP_BUILD) -#print_var(SCREAM_MACHINE) -#print_var(SCREAM_DYNAMICS_DYCORE) -#print_var(SCREAM_DOUBLE_PRECISION) -#print_var(SCREAM_MIMIC_GPU) -#print_var(SCREAM_FPE) -#print_var(SCREAM_NUM_VERTICAL_LEV) -#print_var(SCREAM_PACK_SIZE) -#print_var(SCREAM_SMALL_PACK_SIZE) -#print_var(SCREAM_POSSIBLY_NO_PACK_SIZE) -#print_var(SCREAM_LINK_FLAGS) -#print_var(SCREAM_FPMODEL) -#print_var(SCREAM_LIB_ONLY) -#print_var(SCREAM_TPL_LIBRARIES) -#print_var(SCREAM_TEST_MAX_THREADS) -#print_var(SCREAM_TEST_THREAD_INC) -#print_var(SCREAM_TEST_MAX_RANKS) +print_var(EAMXX_ENABLE_GPU) +print_var(CUDA_BUILD) +print_var(HIP_BUILD) +print_var(SCREAM_MACHINE) +print_var(SCREAM_DYNAMICS_DYCORE) +print_var(SCREAM_DOUBLE_PRECISION) +print_var(SCREAM_MIMIC_GPU) +print_var(SCREAM_FPE) +print_var(SCREAM_NUM_VERTICAL_LEV) +print_var(SCREAM_PACK_SIZE) +print_var(SCREAM_SMALL_PACK_SIZE) +print_var(SCREAM_POSSIBLY_NO_PACK_SIZE) +print_var(SCREAM_LINK_FLAGS) +print_var(SCREAM_FPMODEL) +print_var(SCREAM_LIB_ONLY) +print_var(SCREAM_TPL_LIBRARIES) +print_var(SCREAM_TEST_MAX_THREADS) +print_var(SCREAM_TEST_THREAD_INC) +print_var(SCREAM_TEST_MAX_RANKS) message ("**************************************************") From ba7b030c71cb64cf9d4f0eaf432467a682123f68 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 17 Aug 2024 20:58:22 +0000 Subject: [PATCH 111/529] fix for prev cleanup --- components/eamxx/CMakeLists.txt | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 5e0d8a378b4..926f0773de2 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -566,26 +566,6 @@ if (SCREAM_DOUBLE_PRECISION) endif() endif() -#print_var(SCREAM_MACHINE) -#print_var(EAMXX_ENABLE_GPU) -#print_var(CUDA_BUILD) -#print_var(HIP_BUILD) -#print_var(SYCL_BUILD) -#print_var(SCREAM_DOUBLE_PRECISION) -#print_var(SCREAM_MIMIC_GPU) -#print_var(SCREAM_FPE) -#print_var(SCREAM_NUM_VERTICAL_LEV) -#print_var(SCREAM_PACK_SIZE) -#print_var(SCREAM_SMALL_PACK_SIZE) -#print_var(SCREAM_POSSIBLY_NO_PACK_SIZE) -#print_var(SCREAM_LINK_FLAGS) -#print_var(SCREAM_FPMODEL) -#print_var(SCREAM_LIB_ONLY) -#print_var(SCREAM_TPL_LIBRARIES) -#print_var(SCREAM_TEST_MAX_THREADS) -#print_var(SCREAM_TEST_THREAD_INC) -#print_var(SCREAM_TEST_MAX_RANKS) - # This must be done using add_definitions because it is used to determine # whether to include scream_config.h. add_definitions(-DSCREAM_CONFIG_IS_CMAKE) From 237612a3e6f1476ef0ae6049021c02d155ec780e Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 17 Aug 2024 20:59:32 +0000 Subject: [PATCH 112/529] fix qsplit for sunspot EUL tests --- .../testdefs/testmods_dirs/scream/sunspot_run/shell_commands | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands index 6ae48c59d4a..6ca33b486f9 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sunspot_run/shell_commands @@ -1,6 +1,6 @@ $CIMEROOT/../components/eamxx/scripts/atmchange transport_alg=0 -b $CIMEROOT/../components/eamxx/scripts/atmchange hypervis_subcycle_q=1 -b -$CIMEROOT/../components/eamxx/scripts/atmchange dt_tracer_factor=2 -b +$CIMEROOT/../components/eamxx/scripts/atmchange dt_tracer_factor=1 -b $CIMEROOT/../components/eamxx/scripts/atmchange tstep_type=9 -b $CIMEROOT/../components/eamxx/scripts/atmchange theta_hydrostatic_mode=False -b From 2403aa387913561cc081c1f67a12c05ca172705f Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 17 Aug 2024 21:12:52 +0000 Subject: [PATCH 113/529] clean prints --- .../eamxx/src/mct_coupling/atm_comp_mct.F90 | 38 ++----------------- 1 file changed, 4 insertions(+), 34 deletions(-) diff --git a/components/eamxx/src/mct_coupling/atm_comp_mct.F90 b/components/eamxx/src/mct_coupling/atm_comp_mct.F90 index 2471280135f..34bbbedcc5c 100644 --- a/components/eamxx/src/mct_coupling/atm_comp_mct.F90 +++ b/components/eamxx/src/mct_coupling/atm_comp_mct.F90 @@ -35,8 +35,8 @@ module atm_comp_mct integer :: mpicom_atm ! mpi communicator integer(IN) :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001') - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "') + character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer(IN) :: ATM_ID ! mct comp id integer(IN),parameter :: master_task=0 ! task number of master task @@ -97,8 +97,6 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) !------------------------------------------------------------------------------- -print *,'OG a 1' - ! Grab some data from the cdata structure (coming from the coupler) call seq_cdata_setptrs(cdata, & id=ATM_ID, & @@ -106,51 +104,38 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) gsMap=gsmap_atm, & dom=dom_atm, & infodata=infodata) -print *, 'OG a 2' call seq_infodata_getData(infodata, atm_phase=phase, start_type=run_type, & username=username, case_name=caseid, hostname=hostname) -print *, 'OG a 3' - call seq_infodata_PutData(infodata, atm_aero=.true.) -print *, 'OG a 4' + call seq_infodata_PutData(infodata, atm_aero=.true.) call seq_infodata_PutData(infodata, atm_prognostic=.true.) -print *, 'OG a 5' if (phase > 1) RETURN -print *, 'OG a 6' ! Determine instance information inst_name = seq_comm_name(ATM_ID) inst_index = seq_comm_inst(ATM_ID) inst_suffix = seq_comm_suffix(ATM_ID) -print *, 'OG a 7' ! Determine communicator group call mpi_comm_rank(mpicom_atm, my_task, ierr) -print *, 'OG a 8' !---------------------------------------------------------------------------- ! Init atm.log !---------------------------------------------------------------------------- -print *, 'OG a 9' + if (my_task == master_task) then -print *, 'OG a 10' atm_log_unit = shr_file_getUnit() call shr_file_setIO ('atm_modelio.nml'//trim(inst_suffix),atm_log_unit) inquire(unit=atm_log_unit,name=atm_log_fname) endif -print *, 'OG a 11' call mpi_bcast(atm_log_unit,1,MPI_INTEGER,master_task,mpicom_atm,mpi_ierr) -print *, 'OG a 12' if (ierr /= 0) then -print *, 'OG a 13' print *,'[eamxx] ERROR broadcasting atm.log unit' call mpi_abort(mpicom_atm,ierr,mpi_ierr) end if -print *, 'OG a 14' call mpi_bcast(atm_log_fname,256,MPI_CHARACTER,master_task,mpicom_atm,ierr) -print *, 'OG a 15' if (ierr /= 0) then print *,'[eamxx] ERROR broadcasting atm.log file name' call mpi_abort(mpicom_atm,ierr,mpi_ierr) @@ -161,40 +146,29 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) !---------------------------------------------------------------------------- ! Init the AD -print *, 'OG a 16' call seq_timemgr_EClockGetData(EClock, calendar=calendar, & curr_ymd=cur_ymd, curr_tod=cur_tod, & start_ymd=case_start_ymd, start_tod=case_start_tod) -print *, 'OG a 17' call string_f2c(yaml_fname,yaml_fname_c) -print *, 'OG a 18' call string_f2c(calendar,calendar_c) -print *, 'OG a 19' call string_f2c(trim(atm_log_fname),atm_log_fname_c) -print *, 'OG a 20' call scream_create_atm_instance (mpicom_atm, ATM_ID, yaml_fname_c, atm_log_fname_c, & INT(cur_ymd,kind=C_INT), INT(cur_tod,kind=C_INT), & INT(case_start_ymd,kind=C_INT), INT(case_start_tod,kind=C_INT), & calendar_c) -print *, 'OG a 21' ! Init MCT gsMap call atm_Set_gsMap_mct (mpicom_atm, ATM_ID, gsMap_atm) -print *, 'OG a 22' lsize = mct_gsMap_lsize(gsMap_atm, mpicom_atm) -print *, 'OG a 23' ! Init MCT domain structure call atm_domain_mct (lsize, gsMap_atm, dom_atm) -print *, 'OG a 24' ! Init import/export mct attribute vectors call mct_aVect_init(x2a, rList=seq_flds_x2a_fields, lsize=lsize) -print *, 'OG a 25' call mct_aVect_init(a2x, rList=seq_flds_a2x_fields, lsize=lsize) -print *, 'OG a 26' ! Complete AD initialization based on run type if (trim(run_type) == trim(seq_infodata_start_type_start)) then restarted_run = .false. @@ -205,10 +179,8 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) call mpi_abort(mpicom_atm,ierr,mpi_ierr) endif -print *, 'OG a 27' ! Init surface coupling stuff in the AD call scream_set_cpl_indices (x2a, a2x) -print *, 'OG a 28' call scream_setup_surface_coupling (c_loc(import_field_names), c_loc(import_cpl_indices), & c_loc(x2a%rAttr), c_loc(import_vector_components), & @@ -219,13 +191,11 @@ subroutine atm_init_mct( EClock, cdata, x2a, a2x, NLFilename ) c_loc(export_constant_multiple), c_loc(do_export_during_init), & num_cpl_exports, num_scream_exports, export_field_size) -print *, 'OG a 29' call string_f2c(trim(caseid),caseid_c) call string_f2c(trim(username),username_c) call string_f2c(trim(hostname),hostname_c) call scream_init_atm (caseid_c,hostname_c,username_c) -print *, 'OG a 30' end subroutine atm_init_mct !=============================================================================== From f5680ced9a193ce8046ed42af5533da1453db0a6 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 17 Aug 2024 21:21:12 +0000 Subject: [PATCH 114/529] clean AD messages --- .../eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp | 9 --------- 1 file changed, 9 deletions(-) diff --git a/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp b/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp index 83bf5ba8741..0bdf90eeb71 100644 --- a/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp +++ b/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp @@ -210,28 +210,19 @@ void scream_init_atm (const char* caseid, using namespace scream::control; fpe_guard_wrapper([&](){ - - std::cout << "OG s 1 \n" << std::flush; - // Get the ad, then complete initialization auto& ad = get_ad_nonconst(); - std::cout << "OG s 2 \n" << std::flush; // Set provenance info in the driver (will be added to the output files) ad.set_provenance_data (caseid,hostname,username); - std::cout << "OG s 3 \n" << std::flush; // Init all fields, atm processes, and output streams ad.initialize_fields (); - std::cout << "OG s 4 \n" << std::flush; ad.initialize_atm_procs (); - std::cout << "OG s 5 \n" << std::flush; // Do this before init-ing the output managers, // so the fields are valid if outputing at t=0 ad.reset_accumulated_fields(); - std::cout << "OG s 6 \n" << std::flush; ad.initialize_output_managers (); - std::cout << "OG s 7 \n" << std::flush; }); } From 9d0726abcbd50876695461d256ef7630fc2c0adb Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sat, 17 Aug 2024 21:23:37 +0000 Subject: [PATCH 115/529] p3 messages cleanup --- .../physics/p3/eamxx_p3_process_interface.hpp | 27 +------------------ 1 file changed, 1 insertion(+), 26 deletions(-) diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp index 373d2efe7e3..e8abf2b322b 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp @@ -203,17 +203,8 @@ class P3Microphysics : public AtmosphereProcess struct p3_postamble { p3_postamble() = default; // Functor for Kokkos loop to pre-process every run step - - //Kokkos::printf("OG postamble start"); - KOKKOS_INLINE_FUNCTION void operator()(const int icol) const { - -//Kokkos::printf("OG postamble P################3\n"); - -#if 1 -#if 1 - for (int ipack=0;ipack Date: Sun, 18 Aug 2024 19:36:28 +0000 Subject: [PATCH 116/529] clean ad file --- components/eamxx/src/control/atmosphere_driver.cpp | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index d8715f871f8..d1edf8f0dcb 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -103,7 +103,6 @@ AtmosphereDriver(const ekat::Comm& atm_comm, AtmosphereDriver::~AtmosphereDriver () { -// std::cout << "OG ------------------ I AM CALLING FINALIZE \n" << std::flush; finalize(); } @@ -206,7 +205,6 @@ setup_iop () void AtmosphereDriver::create_atm_processes() { - m_atm_logger->info("[EAMxx] create_atm_processes ..."); start_timer("EAMxx::init"); start_timer("EAMxx::create_atm_processes"); @@ -1515,7 +1513,6 @@ void AtmosphereDriver::initialize_atm_procs () // Initialize memory buffer for all atm processes m_memory_buffer = std::make_shared(); - m_memory_buffer->request_bytes(m_atm_process_group->requested_buffer_size_in_bytes()); m_memory_buffer->allocate(); m_atm_process_group->init_buffers(*m_memory_buffer); @@ -1605,7 +1602,7 @@ void AtmosphereDriver::run (const int dt) { // very expensive operation, so it's not worth the effort of the // nano-opt of removing the call for the 1st timestep. reset_accumulated_fields(); - + // Tell the output managers that we're starting a timestep. This is usually // a no-op, but some diags *may* require to do something. E.g., a diag that // computes tendency of an arbitrary quantity may want to store a copy of @@ -1636,13 +1633,11 @@ void AtmosphereDriver::run (const int dt) { // Update current time stamps m_current_ts += dt; -#if 1 // Update output streams m_atm_logger->debug("[EAMxx::run] running output managers..."); for (auto& out_mgr : m_output_managers) { out_mgr.run(m_current_ts); } -#endif #ifdef SCREAM_HAS_MEMORY_USAGE long long my_mem_usage = get_mem_usage(MB); From b8ff0b2f5b7a8ce56d48e34984cd85b8a443c6a2 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 18 Aug 2024 19:37:01 +0000 Subject: [PATCH 117/529] add fpmodel flag to rrtmgp --- components/eamxx/src/physics/rrtmgp/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt index e1b7b094b47..9ef44c78de7 100644 --- a/components/eamxx/src/physics/rrtmgp/CMakeLists.txt +++ b/components/eamxx/src/physics/rrtmgp/CMakeLists.txt @@ -75,7 +75,7 @@ else () ####### SYCL here if (SYCL_BUILD) set(YAKL_ARCH "SYCL") - set(YAKL_SYCL_FLAGS "-DYAKL_ARCH_SYCL -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64") + set(YAKL_SYCL_FLAGS " -fp-model precise -DYAKL_ARCH_SYCL -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64") string (REPLACE " " ";" YAKL_SYCL_FLAGS_LIST ${YAKL_SYCL_FLAGS}) endif() From 2d487f8fbba07c038103a29a9187da162bd6ebd7 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 18 Aug 2024 19:37:36 +0000 Subject: [PATCH 118/529] turn rrtmgp back on --- .../rrtmgp/eamxx_rrtmgp_process_interface.cpp | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp index bafe8648465..1ff3f27b2fc 100644 --- a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp +++ b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp @@ -637,9 +637,6 @@ void RRTMGPRadiation::initialize_impl(const RunType /* run_type */) { VALIDATE_KOKKOS(rrtmgp::cloud_optics_lw, rrtmgp::cloud_optics_lw_k); #endif - - std::cout << "After RRTMGP initialize ------------------------ \n"; - // Set property checks for fields in this process add_invariant_check(get_field_out("T_mid"),m_grid,100.0, 500.0,false); @@ -661,13 +658,6 @@ void RRTMGPRadiation::run_impl (const double dt) { using PC = scream::physics::Constants; using CO = scream::ColumnOps; - - std::cout << "RRTMGP IMPL 1 ------------------------ \n"; - std::cout << std::flush ; - - -#if 0 - // get a host copy of lat/lon auto h_lat = m_lat.get_view(); auto h_lon = m_lon.get_view(); @@ -1773,9 +1763,6 @@ void RRTMGPRadiation::run_impl (const double dt) { }); } -#endif - - } // ========================================================================================= From 2afcd0e18dce155c54d4d3f846712ec1336818fe Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 18 Aug 2024 19:38:13 +0000 Subject: [PATCH 119/529] fix printfs --- .../p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp index 9a728b6c57e..5bd6aff72da 100644 --- a/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp @@ -91,7 +91,7 @@ struct UnitWrap::UnitTest::TestP3SubgridVarianceScaling Spack c_scaling = Functions::subgrid_variance_scaling(relvars,1.0); if ( std::abs(c_scaling[0] - 1) > tol ){ - printf("subgrid_variance_scaling should be 1 for expon=1, but is %e. " + Kokkos::printf("subgrid_variance_scaling should be 1 for expon=1, but is %e. " "Diff = %e, Tol = %e\n",c_scaling[0],c_scaling[0]-1, tol); errors++;} } @@ -109,7 +109,7 @@ struct UnitWrap::UnitTest::TestP3SubgridVarianceScaling Real fact = std::tgamma(5.0); //factorial(n) = gamma(n+1) if ( std::abs(c_scaling[0] - fact) > tol ){ - printf("subgrid_variance_scaling should be factorial(expon) when relvar=1. " + Kokkos::printf("subgrid_variance_scaling should be factorial(expon) when relvar=1. " "For expon=4, should be %f but is=%f\n Diff = %e, Tol = %e\n", fact,c_scaling[0], c_scaling[0] - fact, tol); errors++;} @@ -142,7 +142,7 @@ struct UnitWrap::UnitTest::TestP3SubgridVarianceScaling const Real max_tol = tol*cond_num; if ( std::abs(targ - c_scaling[0]) > max_tol * targ ){ - printf("When expon=3, subgrid_variance_scaling doesn't match analytic expectation. " + Kokkos::printf("When expon=3, subgrid_variance_scaling doesn't match analytic expectation. " "Val = %e, expected = %e, rel diff = %e, tol = %e\n", c_scaling[0],targ, (targ-c_scaling[0]), max_tol*targ ); errors++; From b790179a5a0f07dfc3e6a6641d05eff1cd08ac1e Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 19 Aug 2024 10:35:54 -0600 Subject: [PATCH 120/529] Add catch-all elsewhere clause to waterPressure alteration Changes last elsewhere clause in the water pressure calculation to catch all remaining possibilities, although in reality the only remaining option should be cells without grounded ice and bedTopography below sea level --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index ee6df91a94d..557aa2ca652 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1642,7 +1642,7 @@ subroutine calc_pressure(block, err) rho_water * gravity * deltatSGH / porosity + waterPressureOld elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND - elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography <= config_sea_level)) + elsewhere ! should evaluate to ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography <= config_sea_level)) waterPressure = gravity * rhoo * (config_sea_level - bedTopography) end where @@ -1652,7 +1652,7 @@ subroutine calc_pressure(block, err) waterPressure = rhoi * gravity * iceThicknessHydro elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND - elsewhere ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography <= config_sea_level)) + elsewhere ! should evaluate to ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography <= config_sea_level)) waterPressure = gravity * rhoo * (config_sea_level - bedTopography) end where From 57819a49891a634afed5bd65ad45458aef05e3a3 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 19 Aug 2024 21:46:17 +0000 Subject: [PATCH 121/529] fix for testing po spot --- components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp b/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp index 466467919fc..a8864ca9934 100644 --- a/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp +++ b/components/eamxx/src/physics/rrtmgp/rrtmgp_test_utils.hpp @@ -46,9 +46,9 @@ template ; -using real1dk = typename interface_t::view_t; -using real2dk = typename interface_t::view_t; -using real3dk = typename interface_t::view_t; +using real1dk = typename interface_t::template view_t; +using real2dk = typename interface_t::template view_t; +using real3dk = typename interface_t::template view_t; using MDRP = typename conv::MDRP; static bool all_close(real2dk &arr1, real2dk &arr2, double tolerance) From d647f606e36a2c8ccc3106c8787b7948510625be Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 19 Aug 2024 16:59:32 -0600 Subject: [PATCH 122/529] Time average effectivePressure over subcycle This commit replaces 'effectivePressure' with 'effectivePressureSGH', the version of effective pressure used by the hydrology model. 'effectivePressure' is now defined as effecivePressureSGH time-averaged over the hydrology subcycle, and is what is fed into the dynamics coupler. --- .../src/Registry_subglacial_hydro.xml | 6 +- .../mode_forward/mpas_li_subglacial_hydro.F | 59 ++++++++++++++----- 2 files changed, 47 insertions(+), 18 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 8b3f07d4750..ec00a63d24a 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -178,8 +178,10 @@ - + + domain % blocklist + do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) + call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) + effectivePressure(:) = 0.0_RKIND + deltatSGHaccumulated = 0.0_RKIND + + block => block % next + end do + + ! ============= ! ============= ! ============= @@ -682,7 +697,19 @@ subroutine li_SGH_solve(domain, err) call mpas_dmpar_field_halo_exch(domain, 'waterPressureSmooth') call mpas_timer_stop("halo updates") + !Average effectivePressureSGH over coupling interval for use in dynamics model + block => domain % blocklist + do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) + call mpas_pool_get_array(hydroPool, 'effectivePressureSGH', effectivePressureSGH) + call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) + call mpas_pool_get_array(hydroPool, 'deltatSGH', deltatSGH) + effectivePressure = (effectivePressure * deltatSGHaccumulated + effectivePressureSGH) / (deltatSGHaccumulated + deltatSGH) + deltatSGHaccumulated = deltatSGHaccumulated + deltatSGH + + block => block % next + end do ! ============= ! ============= ! ============= @@ -1536,7 +1563,7 @@ subroutine calc_pressure(block, err) real (kind=RKIND), dimension(:), pointer :: waterPressureOld real (kind=RKIND), dimension(:), pointer :: waterPressureTendency real (kind=RKIND), dimension(:), pointer :: waterThickness - real (kind=RKIND), dimension(:), pointer :: effectivePressure + real (kind=RKIND), dimension(:), pointer :: effectivePressureSGH real (kind=RKIND), dimension(:), pointer :: zeroOrderSum real (kind=RKIND), dimension(:), pointer :: closingRate real (kind=RKIND), dimension(:), pointer :: openingRate @@ -1595,7 +1622,7 @@ subroutine calc_pressure(block, err) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) - call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) + call mpas_pool_get_array(hydroPool, 'effectivePressureSGH', effectivePressureSGH) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) call mpas_pool_get_array(hydroPool, 'waterPressureOld', waterPressureOld) call mpas_pool_get_array(hydroPool, 'waterPressureTendency', waterPressureTendency) @@ -1625,8 +1652,8 @@ subroutine calc_pressure(block, err) openingRate = max(0.0_RKIND, openingRate) closingRate(:) = creepCoeff * flowParamA(nVertLevels, :) * & - effectivePressure(:)**3 * waterThickness(:) -! closingRate(:) = waterThickness(:) * effectivePressure(:) / 1.0e13_RKIND + effectivePressureSGH(:)**3 * waterThickness(:) +! closingRate(:) = waterThickness(:) * effectivePressureSGH(:) / 1.0e13_RKIND ! ! Hewitt 2011 creep closure form. Denominator is ice viscosity zeroOrderSum = closingRate - openingRate + (basalMeltInput + externalWaterInput) / rho_water - & @@ -1729,7 +1756,7 @@ subroutine calc_pressure_diag_vars(block, err) real (kind=RKIND), dimension(:), pointer :: hydropotentialBase real (kind=RKIND), dimension(:), pointer :: waterThickness real (kind=RKIND), dimension(:), pointer :: hydropotential - real (kind=RKIND), dimension(:), pointer :: effectivePressure + real (kind=RKIND), dimension(:), pointer :: effectivePressureSGH real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro integer, dimension(:), pointer :: cellMask real (kind=RKIND), pointer :: config_sea_level @@ -1744,7 +1771,7 @@ subroutine calc_pressure_diag_vars(block, err) call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) call mpas_pool_get_config(liConfigs, 'config_ocean_density', rhoo) - call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) + call mpas_pool_get_array(hydroPool, 'effectivePressureSGH', effectivePressureSGH) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'hydropotentialBase', hydropotentialBase) @@ -1753,12 +1780,12 @@ subroutine calc_pressure_diag_vars(block, err) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) - effectivePressure = rhoi * gravity * iceThicknessHydro - waterPressure + effectivePressureSGH = rhoi * gravity * iceThicknessHydro - waterPressure ! < this should evalute to 0 for floating ice if Pw set correctly there. where (.not. (li_mask_is_grounded_ice(cellMask))) - effectivePressure = 0.0_RKIND ! zero effective pressure where no ice to avoid confusion + effectivePressureSGH = 0.0_RKIND ! zero effective pressure where no ice to avoid confusion end where - + hydropotentialBase = rho_water * gravity * bedTopography + waterPressure where ((.not. li_mask_is_grounded_ice(cellMask)) .and. (bedTopography <= config_sea_level)) hydropotentialBase = 0.0_RKIND !zero hydropotential in ocean @@ -1830,7 +1857,7 @@ subroutine update_channel(block, err) real (kind=RKIND), dimension(:), pointer :: channelChangeRate real (kind=RKIND), dimension(:), pointer :: flowParamAChannel real (kind=RKIND), dimension(:), pointer :: channelEffectivePressure - real (kind=RKIND), dimension(:), pointer :: effectivePressure + real (kind=RKIND), dimension(:), pointer :: effectivePressureSGH real (kind=RKIND), dimension(:), pointer :: channelDiffusivity real (kind=RKIND), dimension(:), pointer :: waterThicknessEdgeUpwind integer, dimension(:), pointer :: waterFluxMask @@ -1874,7 +1901,7 @@ subroutine update_channel(block, err) call mpas_pool_get_array(hydroPool, 'channelEffectivePressure', channelEffectivePressure) call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge) call mpas_pool_get_array(velocityPool, 'flowParamA', flowParamA) - call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) + call mpas_pool_get_array(hydroPool, 'effectivePressureSGH', effectivePressureSGH) call mpas_pool_get_array(hydroPool, 'waterFluxMask', waterFluxMask) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(hydroPool, 'channelDiffusivity', channelDiffusivity) @@ -1938,7 +1965,7 @@ subroutine update_channel(block, err) ! Not sure if these ought to be upwind average, but using centered flowParamAChannel(iEdge) = 0.5_RKIND * (flowParamA(nVertLevels, cell1) + flowParamA(nVertLevels, cell2) ) - channelEffectivePressure(iEdge) = 0.5_RKIND * (effectivePressure(cell1) + effectivePressure(cell2)) + channelEffectivePressure(iEdge) = 0.5_RKIND * (effectivePressureSGH(cell1) + effectivePressureSGH(cell2)) end do channelClosingRate(:) = creep_coeff * channelArea(:) * flowParamAChannel(:) * channelEffectivePressure(:)**3 @@ -2229,7 +2256,7 @@ subroutine ocean_connection_N(domain) type (mpas_pool_type), pointer :: hydroPool type (mpas_pool_type), pointer :: geometryPool real (kind=RKIND), dimension(:), pointer :: bedTopography - real (kind=RKIND), dimension(:), pointer :: effectivePressure + real (kind=RKIND), dimension(:), pointer :: effectivePressureSGH real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), pointer :: rhoi, rhoo @@ -2243,11 +2270,11 @@ subroutine ocean_connection_N(domain) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) + call mpas_pool_get_array(hydroPool, 'effectivePressureSGH', effectivePressureSGH) call mpas_pool_get_array(hydroPool, 'thickness', thickness) - effectivePressure = rhoi * gravity * thickness - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) - effectivePressure = max(effectivePressure, 0.0_RKIND) ! This is just to zero out N in the open ocean to avoid confusion + effectivePressureSGH = rhoi * gravity * thickness - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) + effectivePressureSGH = max(effectivePressureSGH, 0.0_RKIND) ! This is just to zero out N in the open ocean to avoid confusion block => block % next end do From a975404e388db810ee7a2576a32279b93347ac69 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Thu, 11 Apr 2024 19:08:04 -0700 Subject: [PATCH 123/529] Do not update cell, edge, or vertex masks during RK loop Remove calls to li_calculate_mask where possible within the RK loop. Where we need masks for budget calculations, reset masks to their pre-advection states once the necessary calculation is complete. --- .../mpas-albany-landice/src/Registry.xml | 8 +++++ .../src/mode_forward/mpas_li_advection.F | 34 ++++++++++++++++--- .../src/mode_forward/mpas_li_calving.F | 5 ++- .../mpas_li_time_integration_fe_rk.F | 5 ++- 4 files changed, 42 insertions(+), 10 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index e217bbba2ab..06b62535342 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1433,6 +1433,14 @@ is the value of that variable from the *previous* time level! description="temporary copy of cellMask" persistence="scratch" /> + + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F index ad3f8f517c5..ccb5a1a4353 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F @@ -193,6 +193,8 @@ subroutine li_advection_thickness_tracers(& type (field1DInteger), pointer :: & cellMaskTemporaryField, & ! scratch field containing old values of cellMask + edgeMaskTemporaryField, & + vertexMaskTemporaryField, & thermalCellMaskField ! Allocatable arrays need for flux-corrected transport advection @@ -201,6 +203,7 @@ subroutine li_advection_thickness_tracers(& integer, dimension(:), pointer :: & cellMask, & ! integer bitmask for cells edgeMask, & ! integer bitmask for edges + vertexMask, & thermalCellMask integer, dimension(:,:), pointer :: cellsOnEdge @@ -290,6 +293,7 @@ subroutine li_advection_thickness_tracers(& call mpas_pool_get_array(geometryPool, 'layerThicknessEdge', layerThicknessEdge) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) + call mpas_pool_get_array(geometryPool, 'vertexMask', vertexMask, timeLevel=1) call mpas_pool_get_array(geometryPool, 'dynamicThickening', dynamicThickening) call mpas_pool_get_array(geometryPool, 'groundedToFloatingThickness', groundedToFloatingThickness) @@ -356,6 +360,12 @@ subroutine li_advection_thickness_tracers(& call mpas_pool_get_field(geometryPool, 'cellMaskTemporary', cellMaskTemporaryField) call mpas_allocate_scratch_field(cellMaskTemporaryField, .true.) + call mpas_pool_get_field(geometryPool, 'edgeMaskTemporary', edgeMaskTemporaryField) + call mpas_allocate_scratch_field(edgeMaskTemporaryField, .true.) + + call mpas_pool_get_field(geometryPool, 'vertexMaskTemporary', vertexMaskTemporaryField) + call mpas_allocate_scratch_field(vertexMaskTemporaryField, .true.) + call mpas_pool_get_field(scratchPool, 'iceCellMask', thermalCellMaskField) call mpas_allocate_scratch_field(thermalCellMaskField, .true.) thermalCellMask => thermalCellMaskField % array @@ -370,8 +380,14 @@ subroutine li_advection_thickness_tracers(& call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) err = ior(err, err_tmp) - ! save old copycellMask for determining cells changing from grounded to floating and vice versa + ! Save copies of masks because we need to preserve mask + ! states prior to advection for accurate time integration. + ! A mask update is necessary to calculate grounding line flux, + ! after which we will reset the masks to their previous states. cellMaskTemporaryField % array(:) = cellMask(:) + edgeMaskTemporaryField % array(:) = edgeMask(:) + vertexMaskTemporaryField % array(:) = vertexMask(:) + layerThicknessEdgeFlux(:,:) = 0.0_RKIND !----------------------------------------------------------------- @@ -540,10 +556,10 @@ subroutine li_advection_thickness_tracers(& dynamicThickening = (sum(layerThickness, 1) - thickness) / dt * scyr ! units of m/yr - ! Update the thickness and cellMask before applying the mass balance. - ! The update is needed because the SMB and BMB depend on whether ice is present. + ! Update the thickness before applying the mass balance, but + ! do not update masks because mass balance acts on geometry + ! before advection took place. thickness = sum(layerThickness, 1) - call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) @@ -627,6 +643,9 @@ subroutine li_advection_thickness_tracers(& enddo endif + ! We need an updated set of masks to calculate fluxAcrossGroundingLine, + ! but we will reset this to the previous state below for accuracy of the + ! time integration scheme. call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) err = ior(err, err_tmp) @@ -667,6 +686,11 @@ subroutine li_advection_thickness_tracers(& endif enddo ! edges + ! Reset masks to state before advection and mass balance for + ! accuracy of time integration scheme. + cellMask(:) = cellMaskTemporaryField % array(:) + edgeMask(:) = edgeMaskTemporaryField % array(:) + vertexMask(:) = vertexMaskTemporaryField % array(:) ! Remap tracers to the standard vertical sigma coordinate ! Note: If tracers are not being advected, then this subroutine simply restores the @@ -727,6 +751,8 @@ subroutine li_advection_thickness_tracers(& call mpas_deallocate_scratch_field(basalTracersField, .true.) call mpas_deallocate_scratch_field(surfaceTracersField, .true.) call mpas_deallocate_scratch_field(cellMaskTemporaryField, .true.) + call mpas_deallocate_scratch_field(edgeMaskTemporaryField, .true.) + call mpas_deallocate_scratch_field(vertexMaskTemporaryField, .true.) call mpas_deallocate_scratch_field(thermalCellMaskField, .true.) ! === error check diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index a460c3224a0..1637c7d697d 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -3828,9 +3828,8 @@ subroutine li_finalize_damage_after_advection(domain, err) call mpas_pool_get_array(geometryPool, 'damageNye', damageNye) call mpas_pool_get_array(velocityPool, 'stiffnessFactor', stiffnessFactor) - ! make sure masks are up to date. May not be necessary, but safer to do anyway. - call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) - err = ior(err, err_tmp) + ! Note: In order to preserve accuracy of time integration, + ! we do not update masks before finalizing damage. if (config_preserve_damage) then do iCell = 1, nCells diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index b7af7d34210..30142138d0f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -401,9 +401,8 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) layerThickness(:,:) = rkSSPweights(rkStage) * layerThicknessPrev(:,:) + & (1.0_RKIND - rkSSPweights(rkStage)) * layerThickness(:,:) thickness = sum(layerThickness, 1) - ! Calculate masks after updating thickness - call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) - err = ior(err, err_tmp) + ! Do not calculate masks after updating thickness! We need to keep masks + ! constant for now to preserve accuracy of time integration if (trim(config_thermal_solver) .ne. 'none') then do iCell = 1, nCells From f135bdf0d0c1d5ebd0cfa1d18e975c6ee82febef Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Thu, 11 Apr 2024 19:28:52 -0700 Subject: [PATCH 124/529] Remove cellMask from vertical_remap Remove cellMask from vertical_remap, as it is not used in that routine. --- .../src/mode_forward/mpas_li_advection.F | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F index ccb5a1a4353..9e983c4b45a 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F @@ -696,7 +696,7 @@ subroutine li_advection_thickness_tracers(& ! Note: If tracers are not being advected, then this subroutine simply restores the ! layer thickness to sigma coordinate values. - call vertical_remap(thickness, cellMask, meshPool, layerThickness, advectedTracers, err_tmp) + call vertical_remap(thickness, meshPool, layerThickness, advectedTracers, err_tmp) err = ior(err, err_tmp) if (config_print_thickness_advection_info) then @@ -1965,7 +1965,7 @@ end subroutine li_layer_normal_velocity !> OpenMP over either blocks or cells. ! !----------------------------------------------------------------------- - subroutine vertical_remap(thickness, cellMask, meshPool, layerThickness, tracers, err) + subroutine vertical_remap(thickness, meshPool, layerThickness, tracers, err) !----------------------------------------------------------------- ! @@ -1979,9 +1979,6 @@ subroutine vertical_remap(thickness, cellMask, meshPool, layerThickness, tracers real(kind=RKIND), dimension(:), intent(in) :: & thickness !< Input: ice thickness - integer, dimension(:), intent(in) :: & - cellMask !< Input: mask for cells (needed for determining presence/absence of ice) - !----------------------------------------------------------------- ! ! input/output variables From f6a6653f31570f777f2552c4da5552f15580fb60 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Mon, 19 Aug 2024 15:43:06 -0700 Subject: [PATCH 125/529] Update masks before RK loop, but not at start of each advection stage. Update masks before RK loop, but not at start of each advection stage. --- .../src/mode_forward/mpas_li_advection.F | 4 ---- .../src/mode_forward/mpas_li_time_integration_fe_rk.F | 10 +++++++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F index 9e983c4b45a..4cb0f3e132d 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_advection.F @@ -376,10 +376,6 @@ subroutine li_advection_thickness_tracers(& ! given the old thickness, compute the thickness in each layer call li_calculate_layerThickness(meshPool, thickness, layerThickness) - ! update masks - call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) - err = ior(err, err_tmp) - ! Save copies of masks because we need to preserve mask ! states prior to advection for accurate time integration. ! A mask update is necessary to calculate grounding line flux, diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index 30142138d0f..3f695a0b0f3 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -250,8 +250,6 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) err = ior(err, err_tmp) call mpas_timer_stop("face melting for grounded ice") -! *** TODO: Should basal melt rate calculation and column physics go inside RK loop? *** - ! === Basal melting for floating ice =========== call mpas_timer_start("basal melting for floating ice") call li_basal_melt_floating_ice(domain, err_tmp) @@ -364,7 +362,13 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) // ' is not supported with config_rk_order = $i', & intArgs=(/config_rk_order/), messageType=MPAS_LOG_ERR) return - endif + endif + + ! Calculate masks prior to RK loop, but do not update masks within the loop + ! to preserve the accuracy of time integration. + call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) + err = ior(err, err_tmp) + ! *** Start RK loop *** do rkStage = 1, nRKstages call mpas_log_write('beginning rk stage $i of $i', & From e5710f5a2c65149d2c48760a00a5e3ea91f48179 Mon Sep 17 00:00:00 2001 From: Matt Hoffman Date: Mon, 26 Aug 2024 12:47:00 -0600 Subject: [PATCH 126/529] Apply suggestions from code review --- components/mpas-albany-landice/src/Registry.xml | 2 +- .../src/mode_forward/mpas_li_ocean_extrap.F | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 10435fdc94d..6fca396e02d 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1394,7 +1394,7 @@ is the value of that variable from the *previous* time level! /> Date: Mon, 26 Aug 2024 13:16:02 -0600 Subject: [PATCH 127/529] More code review updates * fix whitespace in Registry * add comment about possible performance improvement * Remove an unneeded halo update * add error check to main iteration loop * Remove unneeded else clause * remove/update unneeded debugging statements * add RKIND to real values --- .../mpas-albany-landice/src/Registry.xml | 32 +++++++------- .../src/mode_forward/.DS_Store | Bin 6148 -> 0 bytes .../src/mode_forward/mpas_li_ocean_extrap.F | 39 ++++++++++-------- 3 files changed, 38 insertions(+), 33 deletions(-) delete mode 100644 components/mpas-albany-landice/src/mode_forward/.DS_Store diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 6fca396e02d..f3ff85928be 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -453,22 +453,22 @@ descrption="Apply a uniform linear submarine melt rate at all grounded marine margins. config_mass_bal_grounded must be set to 'uniform'." possible_values="any non-negative value" /> - - - - - + + + + + H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 0) newMaskCountGlobal = 0 GlobalLoopCount = GlobalLoopCount + 1 + if (GlobalLoopCount > 20) then + ! There will only be an additional time through this loop for each sill behind a previous sill + ! so it should not need to alternate very many times + call mpas_log_write("Ocean extrapolation has alternated between horizontal and vertical " // & + "extrapolation more than $i times. Aborting", MPAS_LOG_ERR, intArgs=(/GlobalLoopCount/)) + err = ior(err, 1) + endif ! call the horizontal extrapolation routine call mpas_timer_start("horizontal scheme") call horizontal_extrapolation(domain, availOceanMask, validOceanMask, validOceanMaskOrig, TFocean, err_tmp) @@ -233,13 +236,15 @@ subroutine li_ocean_extrap_solve(domain, err) call vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err_tmp) err = ior(err, err_tmp) call mpas_timer_stop("vertical scheme") + + if (err > 0) then + call mpas_log_write("Ocean extraolation main iteration loop has encountered an error", MPAS_LOG_ERR) + return + endif enddo ! Reassign extrapolated TF back to primary TF field ismip6shelfMelt_3dThermalForcing(:,:) = TFocean(:,:) - else - ! do nothing - call mpas_log_write('ocean data will NOT be extrapolated into the MALI ice draft') endif !-------------------------------------------------------------------- @@ -329,7 +334,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) - !TFoceanOld(:,:) = 1.0 !HH: for now, have the ocean TF field as the field of ones to make it easy to verify the horizonal/vertical averaging. + !TFoceanOld(:,:) = 1.0 ! for debugging, set TF to ones to make it easy to verify the horizonal/vertical averaging ! perform horizontal extrapolation until the validOceanMask is unchanged allocate(validOceanMaskOld(nISMIP6OceanLayers,nCells+1)) validOceanMaskOld(:,:) = validOceanMask(:,:) @@ -352,7 +357,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali do iNeighbor = 1, nEdgesOnCell(iCell) jCell = cellsOnCell(iNeighbor, iCell) if ( validOceanMaskOld(iLayer,jCell) == 1 ) then - if ( TFoceanOld(iLayer,jCell) > 1.0e6) then + if ( TFoceanOld(iLayer,jCell) > 1.0e6_RKIND) then ! raise error if an invalid ocean data value is used call mpas_log_write("ocean data value used for extrapolation is invalid", & MPAS_LOG_ERR) @@ -366,7 +371,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali enddo if ( validOceanMaskOld(iLayer,iCell) == 0 .and. nValidNeighb > 0 ) then ! if current cell is not valid, set its weight to zero - weightCellLocal = 0 + weightCellLocal = 0.0_RKIND validOceanMask(iLayer,iCell) = 1 newValidCount = 1 else @@ -377,9 +382,9 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali TFocean(iLayer,iCell) = TFoceanOld(iLayer,iCell) else TFocean(iLayer,iCell) = ( weightCellLocal * TFoceanOld(iLayer,iCell) * areaCell(iCell) + & - & ((1 - weightCellLocal) * (TFsum / nValidNeighb)) ) / & + & ((1.0_RKIND - weightCellLocal) * (TFsum / nValidNeighb)) ) / & & ( weightCellLocal * areaCell(iCell) + & - & (1 - weightCellLocal) * (areaSum / nValidNeighb) ) + & (1.0_RKIND - weightCellLocal) * (areaSum / nValidNeighb) ) endif ! Accumulate cells added locally until we do the next global reduce newMaskCountLocalAccum = newMaskCountLocalAccum + newValidCount @@ -482,7 +487,7 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas do iLayer = 2, nISMIP6OceanLayers if ( (availOceanMask(iLayer,iCell) == 1) .and. (validOceanMask(iLayer,iCell) == 0) ) then if ( validOceanMask(iLayer-1,iCell) == 1 ) then - if ( TFocean(iLayer-1,iCell) > 1.0e6) then + if (TFocean(iLayer-1,iCell) > 1.0e6_RKIND) then ! raise error if an invalid ocean data value is used call mpas_log_write("ocean data value used for extrapolation is invalid", & MPAS_LOG_ERR) From 87c33c23f3128cd6bf47f13c937ae3aad7dc2d4e Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 26 Aug 2024 13:37:26 -0600 Subject: [PATCH 128/529] Generalize melting point depth dependence The depth difference between layers and freezing point dependence had been hardcoded. This commit calculates the depth difference between layers and uses a constant for the freezing point dependence --- .../src/mode_forward/mpas_li_ocean_extrap.F | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 2202f9b4181..6d0845a8ae2 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -88,7 +88,6 @@ subroutine li_ocean_extrap_solve(domain, err) type (mpas_pool_type), pointer :: scratchPool, geometryPool, meshPool, extrapOceanDataPool real (kind=RKIND) :: layerTop real (kind=RKIND), dimension(:,:), pointer :: TFocean, TFoceanOld - real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography integer, dimension(:), pointer :: origOceanMaskHoriz @@ -181,7 +180,6 @@ subroutine li_ocean_extrap_solve(domain, err) ! make it a 3D mask based on the topography (loop through nISMIP6OceanLayers) call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) - call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) availOceanMask(:,:) = 0 validOceanMask(:,:) = 0 @@ -303,7 +301,6 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali real (kind=RKIND) :: layerTop, TFsum, areaSum, weightCellLocal real (kind=RKIND), pointer :: weightCell integer, dimension(:,:), allocatable :: validOceanMaskOld - real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing real (kind=RKIND), dimension(:,:), pointer :: TFoceanOld real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell @@ -431,6 +428,8 @@ end subroutine horizontal_extrapolation subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMaskCountGlobal, TFocean, err) + use li_constants, only: oceanFreezingTempDepthDependence + !----------------------------------------------------------------- ! input variables !----------------------------------------------------------------- @@ -479,6 +478,7 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) ! initialize the local loop and count for validOceanMask newMaskCountGlobal = 0 @@ -493,7 +493,9 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas MPAS_LOG_ERR) err = ior(err,1) else - TFocean(iLayer,iCell) = (TFocean(iLayer-1,iCell)) + (60 * 0.0008) + TFocean(iLayer,iCell) = TFocean(iLayer-1,iCell) + & + (ismip6shelfMelt_zOcean(iLayer) - ismip6shelfMelt_zOcean(iLayer-1)) * & + oceanFreezingTempDepthDependence endif validOceanMask(iLayer,iCell) = 1 newMaskCountLocalAccum = newMaskCountLocalAccum + 1 From d39f30b3debf941bcd1c33e887d65d06deac9905 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 26 Aug 2024 14:17:24 -0700 Subject: [PATCH 129/529] add package to extrapOceanData var_struct Without this, runs without extrapolation on die with missing dim error --- components/mpas-albany-landice/src/Registry.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index f3ff85928be..d3d166bd64d 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1677,7 +1677,7 @@ is the value of that variable from the *previous* time level! - + From 4a834d4cf19dd54d1b4253eaaccb6c899f703879 Mon Sep 17 00:00:00 2001 From: Matt Hoffman Date: Mon, 26 Aug 2024 15:58:43 -0600 Subject: [PATCH 130/529] Adjust freezing temp depth dependence calc This commit adjusts the sign conventions in the freezing point adjustment with depth for thermal forcing. The result is unchanged. Co-authored-by: Xylar Asay-Davis --- .../src/mode_forward/mpas_li_ocean_extrap.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 6d0845a8ae2..16bc4eddd94 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -493,8 +493,8 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas MPAS_LOG_ERR) err = ior(err,1) else - TFocean(iLayer,iCell) = TFocean(iLayer-1,iCell) + & - (ismip6shelfMelt_zOcean(iLayer) - ismip6shelfMelt_zOcean(iLayer-1)) * & + TFocean(iLayer,iCell) = TFocean(iLayer-1,iCell) - & + (ismip6shelfMelt_zOcean(iLayer-1) - ismip6shelfMelt_zOcean(iLayer)) * & oceanFreezingTempDepthDependence endif validOceanMask(iLayer,iCell) = 1 From 9a55245f502492e6242ef29bfd5d528bf76864f7 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 26 Aug 2024 22:47:15 +0000 Subject: [PATCH 131/529] switch to kokkos radiation --- components/eamxx/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 8f3b9e2aa42..ac04ee6f54d 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -218,8 +218,8 @@ endif() # #cmakedefine RRTMGP_EXPENSIVE_CHECKS option (SCREAM_RRTMGP_DEBUG "Turn on extra debug checks in RRTMGP" ${SCREAM_DEBUG}) -option(SCREAM_RRTMGP_ENABLE_YAKL "Use YAKL under rrtmgp" TRUE) -option(SCREAM_RRTMGP_ENABLE_KOKKOS "Use Kokkos under rrtmgp" FALSE) +option(SCREAM_RRTMGP_ENABLE_YAKL "Use YAKL under rrtmgp" FALSE) +option(SCREAM_RRTMGP_ENABLE_KOKKOS "Use Kokkos under rrtmgp" TRUE) if (SCREAM_RRTMGP_ENABLE_YAKL) add_definitions("-DRRTMGP_ENABLE_YAKL") endif() From c3397060d27b8d57131a7611edfe74b72b583da7 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 26 Aug 2024 22:47:56 +0000 Subject: [PATCH 132/529] clean --- components/eamxx/src/control/atmosphere_driver.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index d1edf8f0dcb..c3da1bacd3f 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -1602,7 +1602,7 @@ void AtmosphereDriver::run (const int dt) { // very expensive operation, so it's not worth the effort of the // nano-opt of removing the call for the 1st timestep. reset_accumulated_fields(); - + // Tell the output managers that we're starting a timestep. This is usually // a no-op, but some diags *may* require to do something. E.g., a diag that // computes tendency of an arbitrary quantity may want to store a copy of From 23fef644629323178ec8add0cbb3bb964e11bd77 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 26 Aug 2024 22:50:48 +0000 Subject: [PATCH 133/529] remove debug --- components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp | 2 -- 1 file changed, 2 deletions(-) diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp index e8abf2b322b..c1f4f853bd1 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp @@ -245,7 +245,6 @@ class P3Microphysics : public AtmosphereProcess diag_eff_radius_qr(icol,ipack) *= 1e6; } // for ipack - //Kokkos::printf("OG postamble 4\n"); // Microphysics can be subcycled together during a single physics timestep, // therefore we must accumulate these fluxes precip_liq_surf_mass(icol) += precip_liq_surf_flux(icol) * PC::RHO_H2O * m_dt; @@ -264,7 +263,6 @@ class P3Microphysics : public AtmosphereProcess heat_flux(icol) = 0.0; } } // operator() - // Local variables int m_ncol, m_npack; double m_dt; From ea26296eaa1e4ecf09b4d581a6ccb8138694062c Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 26 Aug 2024 22:52:42 +0000 Subject: [PATCH 134/529] clean formatting --- .../p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp index 5bd6aff72da..5e0cf401bec 100644 --- a/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_subgrid_variance_scaling_unit_tests.cpp @@ -91,9 +91,9 @@ struct UnitWrap::UnitTest::TestP3SubgridVarianceScaling Spack c_scaling = Functions::subgrid_variance_scaling(relvars,1.0); if ( std::abs(c_scaling[0] - 1) > tol ){ - Kokkos::printf("subgrid_variance_scaling should be 1 for expon=1, but is %e. " + Kokkos::printf("subgrid_variance_scaling should be 1 for expon=1, but is %e. " "Diff = %e, Tol = %e\n",c_scaling[0],c_scaling[0]-1, tol); - errors++;} + errors++;} } //----------------------------------------------------------------- @@ -109,7 +109,7 @@ struct UnitWrap::UnitTest::TestP3SubgridVarianceScaling Real fact = std::tgamma(5.0); //factorial(n) = gamma(n+1) if ( std::abs(c_scaling[0] - fact) > tol ){ - Kokkos::printf("subgrid_variance_scaling should be factorial(expon) when relvar=1. " + Kokkos::printf("subgrid_variance_scaling should be factorial(expon) when relvar=1. " "For expon=4, should be %f but is=%f\n Diff = %e, Tol = %e\n", fact,c_scaling[0], c_scaling[0] - fact, tol); errors++;} @@ -142,7 +142,7 @@ struct UnitWrap::UnitTest::TestP3SubgridVarianceScaling const Real max_tol = tol*cond_num; if ( std::abs(targ - c_scaling[0]) > max_tol * targ ){ - Kokkos::printf("When expon=3, subgrid_variance_scaling doesn't match analytic expectation. " + Kokkos::printf("When expon=3, subgrid_variance_scaling doesn't match analytic expectation. " "Val = %e, expected = %e, rel diff = %e, tol = %e\n", c_scaling[0],targ, (targ-c_scaling[0]), max_tol*targ ); errors++; From 63b03940d8f74361eb708380b0e0c5394edbfbf9 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 26 Aug 2024 22:56:44 +0000 Subject: [PATCH 135/529] clean formatting --- .../eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp index ab61e4239e2..19d897c63d9 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_assumed_pdf_impl.hpp @@ -153,10 +153,10 @@ void Functions::shoc_assumed_pdf( const Smask is_nan_Tl1_1 = isnan(Tl1_1) && active_entries; const Smask is_nan_Tl1_2 = isnan(Tl1_2) && active_entries; if (is_nan_Tl1_1.any() || is_nan_Tl1_2.any()) { - Kokkos::printf("WARNING: NaN Detected in Tl1_1 or Tl1_2!\n"); + Kokkos::printf("WARNING: NaN Detected in Tl1_1 or Tl1_2!\n"); for (int i=0; i Date: Mon, 26 Aug 2024 23:00:45 +0000 Subject: [PATCH 136/529] remove debug in atm_proc_group --- .../atm_process/atmosphere_process_group.cpp | 76 ------------------- 1 file changed, 76 deletions(-) diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp index bfef71ef3d5..9d5ff488929 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_group.cpp @@ -8,14 +8,6 @@ #include - -#include "share/scream_session.hpp" -#include "mct_coupling/ScreamContext.hpp" -#include "control/atmosphere_driver.hpp" -#include -#include "physics/share/physics_constants.hpp" - - namespace scream { AtmosphereProcessGroup:: @@ -373,21 +365,7 @@ void AtmosphereProcessGroup::add_additional_data_fields_to_property_checks (cons } void AtmosphereProcessGroup::initialize_impl (const RunType run_type) { - -#undef D1 -#ifdef D1 - int mmm = 0; -#endif - for (auto& atm_proc : m_atm_processes) { - -#ifdef D1 - mmm++; - std::cout << "process is "<< mmm << "\n" << std::flush; - std::cout << "process name is "<< atm_proc->name() << "\n"<< std::flush; - m_atm_logger->flush(); -#endif - atm_proc->initialize(timestamp(),run_type); #ifdef SCREAM_HAS_MEMORY_USAGE long long my_mem_usage = get_mem_usage(MB); @@ -396,7 +374,6 @@ void AtmosphereProcessGroup::initialize_impl (const RunType run_type) { m_atm_logger->debug("[EAMxx::initialize::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); #endif } -// std::cout << "process GROUP is done\n" << std::flush; } void AtmosphereProcessGroup::run_impl (const double dt) { @@ -405,7 +382,6 @@ void AtmosphereProcessGroup::run_impl (const double dt) { } else { run_parallel(dt); } -// std::cout << "process GROUP RUN is done\n" << std::flush; } void AtmosphereProcessGroup::run_sequential (const double dt) { @@ -413,74 +389,22 @@ void AtmosphereProcessGroup::run_sequential (const double dt) { auto ts = timestamp(); ts += dt; -#undef D2 -#ifdef D2 - auto& c = scream::ScreamContext::singleton(); - auto ad = c.getNonConst(); - const auto gn = "Physics"; - //const auto gn = "Physics GLL"; - const auto& phys_grid = ad.get_grids_manager()->get_grid(gn); - //auto area = phys_grid->get_geometry_data("area").get_view(); - const auto fm = ad.get_field_mgr(gn); - const int ncols = fm->get_grid()->get_num_local_dofs(); - const int nlevs = fm->get_grid()->get_num_vertical_levels(); - - fm->get_field("T_mid").sync_to_host(); - auto ff = fm->get_field("T_mid").get_view(); -#endif - -#ifdef D2 - for (int ii = 0; ii < ncols; ii++) - for (int jj = 0; jj < nlevs; jj++){ - const auto vv = ff(ii,jj); -m_atm_logger->info("OG T field ("+std::to_string(ii)+","+std::to_string(jj)+") = "+std::to_string(vv)); -std::cout << "OG T field (" <name() << std::flush; - -#ifdef D2 - fm->get_field("T_mid").sync_to_host(); - auto ff = fm->get_field("T_mid").get_view(); -#endif -#ifdef D2 - for (int ii = 0; ii < 5; ii++) - for (int jj = 0; jj < 3; jj++){ - const auto vv = ff(ii,jj); -m_atm_logger->info("OG T field ("+std::to_string(ii)+","+std::to_string(jj)+") = "+std::to_string(vv)); -std::cout << "OG T field (" <name() <<"\n"<set_update_time_stamps(do_update); // Run the process atm_proc->run(dt); - -//std::cout << "OG proc AFTER RUN " << atm_proc->name() <<"\n"<debug("[EAMxx::run_sequential::"+atm_proc->name()+"] memory usage: " + std::to_string(max_mem_usage) + "MB"); #endif - -//std::cout << "OG AFTER mem usage " << atm_proc->name() <<"\n"< Date: Mon, 26 Aug 2024 23:06:56 +0000 Subject: [PATCH 137/529] clean up --- components/eamxx/src/share/util/scream_utils.hpp | 2 -- 1 file changed, 2 deletions(-) diff --git a/components/eamxx/src/share/util/scream_utils.hpp b/components/eamxx/src/share/util/scream_utils.hpp index a5a41774b7b..dbb315fc4b9 100644 --- a/components/eamxx/src/share/util/scream_utils.hpp +++ b/components/eamxx/src/share/util/scream_utils.hpp @@ -13,8 +13,6 @@ #include #include -#include - namespace scream { enum MemoryUnits { From 855468acd50031d50340771ab6e01b4cbd53dc9f Mon Sep 17 00:00:00 2001 From: Stephen Price Date: Tue, 27 Aug 2024 13:01:46 -0500 Subject: [PATCH 138/529] Continuation of glc coupler budget development Code additions and debugging for addition of Greenland surface mass balance terms to glc budget code, including temporary lines for debugging and validation. --- .../mpas-albany-landice/driver/glc_comp_mct.F | 3 +- driver-mct/main/cime_comp_mod.F90 | 8 +- driver-mct/main/seq_diag_mct.F90 | 156 +++++++++++++----- 3 files changed, 122 insertions(+), 45 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index 0146fc74791..7bf72556603 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -1482,7 +1482,8 @@ subroutine glc_export_mct(g2x_g, errorCode) !call route_ice_runoff(0.0_RKIND, & !Recuperate runoff routing switch code (originally in glc_route_ice_runoff module in earlier code), and attach to ice calving flux once present... ! rofi_to_ocn=Fogg_rofi, & ! rofi_to_ice=Figg_rofi) - g2x_g % rAttr(index_g2x_Fogg_rofi,n)=9999.0 !...and remove these placeholders + !g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0!...and remove these placeholders + g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0001d0 !SFP: dummy value to see if passes through coupler g2x_g % rAttr(index_g2x_Figg_rofi,n)=0.0 !...and remove these placeholders g2x_g % rAttr(index_g2x_Fogg_rofl,n) = 0.0 !Attach to subglacial liquid flux once present diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index 77749415af8..f9678b3e7c9 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -4745,7 +4745,7 @@ subroutine cime_run_calc_budgets1(in_cplrun) call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_x2i=.true.) endif if (glc_present) then - call seq_diag_glc_mct(glc(ens1), fractions_ix(ens1), infodata, do_x2g=.true., do_g2x=.true.) + !call seq_diag_glc_mct(glc(ens1), fractions_gx(ens1), infodata, do_x2g=.true., do_g2x=.true.) !SFP: comment out for now while debugging endif if (do_bgc_budgets) then if (rof_present) then @@ -4786,6 +4786,9 @@ subroutine cime_run_calc_budgets2(in_cplrun) if (ice_present) then call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true.) endif + if (glc_present) then + call seq_diag_glc_mct(glc(ens1), fractions_gx(ens1), infodata, do_x2g=.true., do_g2x=.true.) + endif if (do_bgc_budgets) then if (atm_present) then call seq_diagBGC_atm_mct(atm(ens1), fractions_ax(ens1), infodata, do_a2x=.true., do_x2a=.true.) @@ -4793,9 +4796,6 @@ subroutine cime_run_calc_budgets2(in_cplrun) if (ice_present) then call seq_diagBGC_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true., do_x2i=.true.) endif - if (glc_present) then - call seq_diag_glc_mct(glc(ens1), fractions_ix(ens1), infodata, do_x2g=.true., do_g2x=.true.) - endif if (lnd_present) then call seq_diagBGC_lnd_mct(lnd(ens1), fractions_lx(ens1), infodata, do_l2x=.true., do_x2l=.true.) endif diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 502373fc7a9..734b375070d 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -963,9 +963,10 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) end if nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi,n) - do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) - nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flgl_qice(num),n) !SFP added - end do +! do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) +! !SFP: this somehow needs to allow for each of the 11 vectors associate w/ each of the 11 elev classes +! nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flgl_qice(num),n) !SFP added +! end do if ( flds_wiso_lnd )then nf = f_wevap_16O; @@ -1000,9 +1001,9 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) end if end do - budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice +! budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice - budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice !SFP add +! budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice !SFP added end if @@ -1286,7 +1287,7 @@ end subroutine seq_diag_rof_mct subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) type(component_type) , intent(in) :: glc ! component type for instance1 - type(mct_aVect) , intent(in) :: frac_g ! frac bundle + type(mct_aVect) , intent(in) :: frac_g ! frac bundle !SFP: does not look like fractions are needed / used here? type(seq_infodata_type) , intent(in) :: infodata logical , intent(in), optional :: do_x2g logical , intent(in), optional :: do_g2x @@ -1303,6 +1304,9 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) real(r8) :: ca_g ! area of a grid cell logical,save :: first_time = .true. + integer,save :: counter,smb_counter,calving_counter !SFP: for debugging + integer,save :: smb_vector_length,calving_vector_length + !----- formats ----- character(*),parameter :: subName = '(seq_diag_glc_mct) ' @@ -1318,46 +1322,118 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) g2x_g => component_get_c2x_cx(glc) x2g_g => component_get_x2c_cx(glc) -! eventually use the following if constructs to wrap relevant sections below? -! if (present(do_g2x)) then -! end if -! if (present(do_x2g)) then -! end if + if( present(do_g2x))then !SPF: glc to coupler -! if (first_time) then + if (first_time) then - index_g2x_Fogg_rofl = mct_aVect_indexRA(g2x_g,'Fogg_rofl') - index_g2x_Fogg_rofi = mct_aVect_indexRA(g2x_g,'Fogg_rofi') - index_g2x_Figg_rofi = mct_aVect_indexRA(g2x_g,'Figg_rofi') + calving_counter=0 + calving_vector_length = 0 - index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') !SFP: might be cleaner to do "x2g" in its own section? + index_g2x_Fogg_rofl = mct_aVect_indexRA(g2x_g,'Fogg_rofl') + index_g2x_Fogg_rofi = mct_aVect_indexRA(g2x_g,'Fogg_rofi') + index_g2x_Figg_rofi = mct_aVect_indexRA(g2x_g,'Figg_rofi') -! end if + !SFP:debug + write(logunit,*) ' ' + write(logunit,*) ' index_g2x_Fogg_rofl = ', index_g2x_Fogg_rofl + write(logunit,*) ' index_g2x_Fogg_rofi = ', index_g2x_Fogg_rofi + write(logunit,*) ' index_g2x_Figg_rofi = ', index_g2x_Figg_rofi + write(logunit,*) ' ' - ip = p_inst - ic = c_glc_gs - !ic = c_glc_gr !SFP: should this actually be used here? other sections of this code use"r" for c2x and "s" for x2c - kArea = mct_aVect_indexRA(dom_g%data,afldname) - lSize = mct_avect_lSize(g2x_g) - do n=1,lSize - ca_g = dom_g%data%rAttr(kArea,n) - nf = f_wroff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_g*g2x_g%rAttr(index_g2x_Fogg_rofl,n) - nf = f_wioff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_g*g2x_g%rAttr(index_g2x_Fogg_rofi,n) & - - ca_g*g2x_g%rAttr(index_g2x_Figg_rofi,n) - end do - budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice + end if - ip = p_inst - !SFP: unclear if next should be 'send' or 'receive' index but for now we think send (because of x2g), - ! but budget results don't seem to be sensitive to this choice (same numbers appear using either). - ic = c_glc_gs ! cpl send - !ic = c_glc_gr ! cpl receive - lSize = mct_avect_lSize(x2g_g) - do n=1,lSize - ca_g = dom_g%data%rAttr(kArea,n) - nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) - end do - budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice + ip = p_inst + !ip = p_day + !ic = c_glc_gs + ic = c_glc_gr !SFP: use recieve here since this is coming from glc to coupler? + kArea = mct_aVect_indexRA(dom_g%data,afldname) + lSize = mct_avect_lSize(g2x_g) + + !SFP:debug + if(calving_counter==0)then !one day at 30 min land/atmos time steps + write(logunit,*) ' ' + write(logunit,*) ' calving vector length (should be 7425) = ', lSize + write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) + write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) + write(logunit,*) ' intial value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) + write(logunit,*) ' calving flux to ocean (Fogg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Fogg_rofi,1) + write(logunit,*) ' calving flux to ice (Figg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Figg_rofi,1) + write(logunit,*) ' calving flux X area to ocean (Fogg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Fogg_rofi,1) + write(logunit,*) ' calving flux X area to ice (Figg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Figg_rofi,1) + end if + + do n=1,lSize + ca_g = dom_g%data%rAttr(kArea,n) + nf = f_wroff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_g*g2x_g%rAttr(index_g2x_Fogg_rofl,n) + nf = f_wioff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_g*g2x_g%rAttr(index_g2x_Fogg_rofi,n) & + - ca_g*g2x_g%rAttr(index_g2x_Figg_rofi,n) + end do + + budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice + + calving_vector_length = calving_vector_length +lSize + calving_counter = calving_counter + 1 + + !SFP:debug + if(calving_counter==48)then !one day at 30 min land/atmos time steps + write(logunit,*) ' calving counter = ', calving_counter + write(logunit,*) ' final value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) + write(logunit,*) ' ' + end if + + endif !SFP: end 'do_g2x' + + if( present(do_x2g))then !SFP: coupler to glc + + if (first_time) then + + smb_counter=0 + smb_vector_length = 0 + + index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') + + !SFP:debug + write(logunit,*) ' ' + write(logunit,*) ' index_x2g_Flgl_qice = ', index_x2g_Flgl_qice + write(logunit,*) ' ' + + end if + + ip = p_inst + !ip = p_day + ic = c_glc_gs ! SFP: use send here since going from coupler to glc? + !ic = c_glc_gr + kArea = mct_aVect_indexRA(dom_g%data,afldname) + lSize = mct_avect_lSize(x2g_g) + + !SFP:debug + if(smb_counter==0)then !one day at 30 min land/atmos time steps + write(logunit,*) ' ' + write(logunit,*) ' smb vector length (should be 7425) = ', lSize + write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) + write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) + write(logunit,*) ' initial value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) + end if + + do n=1,lSize + ca_g = dom_g%data%rAttr(kArea,n) + nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) + end do + + budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice + + smb_vector_length = smb_vector_length +lSize + smb_counter = smb_counter + 1 + + !SFP:debug + if(smb_counter==48)then !one day at 30 min land/atmos time steps + write(logunit,*) ' ' + write(logunit,*) ' smb_counter = ', smb_counter + write(logunit,*) ' final value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) + write(logunit,*) ' ' + end if + + end if !SPF: end do coupler to glc first_time = .false. From 0d7e8e09ac63c5e008b7de529a872c81a888f148 Mon Sep 17 00:00:00 2001 From: Courtney Shafer Date: Mon, 26 Aug 2024 14:54:04 -0600 Subject: [PATCH 139/529] Modified ocean extrapolation routine to take in a 3d ocean cavity mask --- .../mpas-albany-landice/src/Registry.xml | 8 +++++- .../src/mode_forward/mpas_li_ocean_extrap.F | 25 ++++++++++++++++--- 2 files changed, 28 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 9ce37b56fdf..4dac552d19b 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -810,6 +810,7 @@ + - + + @@ -1689,6 +1691,10 @@ is the value of that variable from the *previous* time level! + + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 16bc4eddd94..1ac3b8cb63f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -91,6 +91,7 @@ subroutine li_ocean_extrap_solve(domain, err) real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography integer, dimension(:), pointer :: origOceanMaskHoriz + integer, dimension(:,:), pointer :: orig3dOceanCavityMask ! CAS 8/16/2024 integer, dimension(:,:), pointer :: validOceanMask, validOceanMaskOrig, availOceanMask !masks to pass to flood-fill routine integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit integer, dimension(:), allocatable :: seedOceanMaskHorizOld @@ -127,6 +128,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) call mpas_pool_get_array(extrapOceanDataPool, 'origOceanMaskHoriz', origOceanMaskHoriz) + call mpas_pool_get_array(extrapOceanDataPool, 'orig3dOceanCavityMask', orig3dOceanCavityMask) ! CAS 8/16/2024 call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMaskOrig', validOceanMaskOrig) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) @@ -189,11 +191,25 @@ subroutine li_ocean_extrap_solve(domain, err) if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then availOceanMask(iLayer,iCell) = 1 endif - if ( (origOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then - validOceanMask(iLayer,iCell) = 1 - endif enddo enddo + + ! CAS 8/16/2024 Hijacking Holly's code to test using the 3D SORRM cavity TF field. We set 3d valid ocean mask to original 3d ocean cavity mask. + ! We don't need to loop through the layers if we're using a 3d mask already + validOceanMask(:,:) = orig3dOceanCavityMask(:,:) + + ! if ( (origOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then + ! validOceanMask(iLayer,iCell) = 1 + ! endif + ! enddo + !enddo + + call mpas_log_write('==HH==: updating halos for the avail/valid ocean masks') + ! Update halos + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'availOceanMask') + call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') + call mpas_timer_stop("halo updates") ! save the initial validOceanMask validOceanMaskOrig(:,:) = validOceanMask(:,:) @@ -201,9 +217,10 @@ subroutine li_ocean_extrap_solve(domain, err) ! initialize the TF field TFocean(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) ! initialize the invalid data locations with fill value + ! CAS 8/19/2024 Changed availOceanMask in the if check to validOceanMask. We want to make sure all invalid values outside the validOceanMask are set to the invalid_value_TF do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers - if ( availOceanMask(iLayer,iCell) == 0 ) then + if ( validOceanMask(iLayer,iCell) == 0 ) then TFocean(iLayer,iCell) = invalid_value_TF endif enddo From 93c7ad7843d6339c484a4e8c09dc40f1782fef83 Mon Sep 17 00:00:00 2001 From: Courtney Shafer Date: Mon, 26 Aug 2024 15:02:08 -0600 Subject: [PATCH 140/529] Modified which ocean layers are picked for creating TFocean and added check for invalid TF values --- .../src/mode_forward/mpas_li_iceshelf_melt.F | 33 +++++++++++++++---- 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F index 37d6578dd33..b24683b9aad 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F @@ -1386,6 +1386,7 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & !----------------------------------------------------------------- integer :: iCell, iNeighbor, iEdge, nEmptyNeighbors real (kind=RKIND), pointer :: rhoi + real (kind=RKIND), pointer :: invalid_value_TF ! CAS 8/20/2024 integer, pointer :: nCells, nISMIP6OceanLayers integer, dimension(:,:), pointer :: cellsOnCell, edgesOnCell real (kind=RKIND) :: waterDepth @@ -1402,7 +1403,7 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_deltaT real (kind=RKIND), dimension(:), pointer :: zOcean real (kind=RKIND), dimension(:), pointer :: areaCell - integer, dimension(:), pointer :: cellMask, edgeMask, nEdgesOnCell + integer, dimension(:), pointer :: cellMask, edgeMask, nEdgesOnCell, indexToCellID ! CAS 8/22/2024 real (kind=RKIND), pointer :: aSubglacial ! param A real (kind=RKIND), pointer :: alphaSubglacial ! param alpha real (kind=RKIND), pointer :: B ! param B @@ -1425,6 +1426,7 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & ! Get sea level, bedTopography, ice density call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) call mpas_pool_get_config(liConfigs, 'config_sea_level', seaLevel) + call mpas_pool_get_config(liConfigs, 'config_invalid_value_TF', invalid_value_TF) ! CAS 8/20/2024 ! Get melt parameters call mpas_pool_get_config(liConfigs, 'config_beta_ocean_thermal_forcing', betaTF) @@ -1452,6 +1454,7 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) + call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID) ! CAS 8/22/2024 call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'lowerSurface', lowerSurface) call mpas_pool_get_array(geometryPool, 'faceMeltingThickness', faceMeltingThickness) @@ -1461,6 +1464,8 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & call mpas_pool_get_array(geometryPool, 'dtFaceMeltingCFLratio', dtFaceMeltingCFLratio) if ( config_use_3d_thermal_forcing_for_face_melt ) then + call mpas_log_write("config_use_3d_thermal_forcing_for_face_melt is .true.") + call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', zOcean) @@ -1477,14 +1482,30 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & enddo ! If bed is shallower than first layer, use TF from the first layer. ! If bed is deeper than the bottomg ocean layer, use TF from the bottom layer. - if ( (kk == 1) .or. ( (kk == nISMIP6OceanLayers) .and. (zOcean(kk) >= bedTopography(iCell)) ) ) then - TFocean(iCell) = ismip6shelfMelt_3dThermalForcing(kk, iCell) + ismip6shelfMelt_deltaT(iCell) + !if ( (kk == 1) .or. ( (kk == nISMIP6OceanLayers) .and. (zOcean(kk) >= bedTopography(iCell)) ) ) then + ! TFocean(iCell) = ismip6shelfMelt_3dThermalForcing(kk, iCell) + ismip6shelfMelt_deltaT(iCell) ! For all other bed depths, interpolate linearly between layers above and below bed depth. + !else + ! TFocean(iCell) = ( (zOcean(kk-1) - bedTopography(iCell)) * ismip6shelfMelt_3dThermalForcing(kk, iCell) + & + ! (bedTopography(iCell) - zOcean(kk)) * ismip6shelfMelt_3dThermalForcing(kk-1, iCell) ) / & + ! (zOcean(kk-1) - zOcean(kk)) + ismip6shelfMelt_deltaT(iCell) + !endif + + if ( kk == 1 ) then + TFocean(iCell) = ismip6shelfMelt_3dThermalForcing(kk, iCell) + ismip6shelfMelt_deltaT(iCell) else - TFocean(iCell) = ( (zOcean(kk-1) - bedTopography(iCell)) * ismip6shelfMelt_3dThermalForcing(kk, iCell) + & - (bedTopography(iCell) - zOcean(kk)) * ismip6shelfMelt_3dThermalForcing(kk-1, iCell) ) / & - (zOcean(kk-1) - zOcean(kk)) + ismip6shelfMelt_deltaT(iCell) + TFocean(iCell) = ismip6shelfMelt_3dThermalForcing(kk-1, iCell) + ismip6shelfMelt_deltaT(iCell) endif + + ! check if any invalid TFocean value is used for calculating face melting speed + if ( (TFocean(iCell) == invalid_value_TF) .or. (TFocean(iCell) > 1.0e1) ) then + call mpas_log_write("grounded_face_melt_ismip6: Invalid value for TFocean. " // & + "TFocean(iCell)=$r zOcean(kk)=$r bedTopography(iCell)=$r kk=$i indexToCellID=$i", MPAS_LOG_ERR, & + intArgs=(/kk, indexToCellID(iCell)/), & + realArgs=(/TFocean(iCell), zOcean(kk), bedTopography(iCell)/) ) + err = ior(err, 1) + endif + endif end do endif From 932736e57dd0179afe997cc46b3d682100f6921b Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 28 Aug 2024 10:51:32 -0600 Subject: [PATCH 141/529] Revert "Modified which ocean layers are picked for creating TFocean and added check for invalid TF values" This reverts commit 93c7ad7843d6339c484a4e8c09dc40f1782fef83. --- .../src/mode_forward/mpas_li_iceshelf_melt.F | 33 ++++--------------- 1 file changed, 6 insertions(+), 27 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F index b24683b9aad..37d6578dd33 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F @@ -1386,7 +1386,6 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & !----------------------------------------------------------------- integer :: iCell, iNeighbor, iEdge, nEmptyNeighbors real (kind=RKIND), pointer :: rhoi - real (kind=RKIND), pointer :: invalid_value_TF ! CAS 8/20/2024 integer, pointer :: nCells, nISMIP6OceanLayers integer, dimension(:,:), pointer :: cellsOnCell, edgesOnCell real (kind=RKIND) :: waterDepth @@ -1403,7 +1402,7 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_deltaT real (kind=RKIND), dimension(:), pointer :: zOcean real (kind=RKIND), dimension(:), pointer :: areaCell - integer, dimension(:), pointer :: cellMask, edgeMask, nEdgesOnCell, indexToCellID ! CAS 8/22/2024 + integer, dimension(:), pointer :: cellMask, edgeMask, nEdgesOnCell real (kind=RKIND), pointer :: aSubglacial ! param A real (kind=RKIND), pointer :: alphaSubglacial ! param alpha real (kind=RKIND), pointer :: B ! param B @@ -1426,7 +1425,6 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & ! Get sea level, bedTopography, ice density call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) call mpas_pool_get_config(liConfigs, 'config_sea_level', seaLevel) - call mpas_pool_get_config(liConfigs, 'config_invalid_value_TF', invalid_value_TF) ! CAS 8/20/2024 ! Get melt parameters call mpas_pool_get_config(liConfigs, 'config_beta_ocean_thermal_forcing', betaTF) @@ -1454,7 +1452,6 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) - call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID) ! CAS 8/22/2024 call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'lowerSurface', lowerSurface) call mpas_pool_get_array(geometryPool, 'faceMeltingThickness', faceMeltingThickness) @@ -1464,8 +1461,6 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & call mpas_pool_get_array(geometryPool, 'dtFaceMeltingCFLratio', dtFaceMeltingCFLratio) if ( config_use_3d_thermal_forcing_for_face_melt ) then - call mpas_log_write("config_use_3d_thermal_forcing_for_face_melt is .true.") - call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', zOcean) @@ -1482,30 +1477,14 @@ subroutine grounded_face_melt_ismip6(domain, applyToGrounded, & enddo ! If bed is shallower than first layer, use TF from the first layer. ! If bed is deeper than the bottomg ocean layer, use TF from the bottom layer. - !if ( (kk == 1) .or. ( (kk == nISMIP6OceanLayers) .and. (zOcean(kk) >= bedTopography(iCell)) ) ) then - ! TFocean(iCell) = ismip6shelfMelt_3dThermalForcing(kk, iCell) + ismip6shelfMelt_deltaT(iCell) - ! For all other bed depths, interpolate linearly between layers above and below bed depth. - !else - ! TFocean(iCell) = ( (zOcean(kk-1) - bedTopography(iCell)) * ismip6shelfMelt_3dThermalForcing(kk, iCell) + & - ! (bedTopography(iCell) - zOcean(kk)) * ismip6shelfMelt_3dThermalForcing(kk-1, iCell) ) / & - ! (zOcean(kk-1) - zOcean(kk)) + ismip6shelfMelt_deltaT(iCell) - !endif - - if ( kk == 1 ) then + if ( (kk == 1) .or. ( (kk == nISMIP6OceanLayers) .and. (zOcean(kk) >= bedTopography(iCell)) ) ) then TFocean(iCell) = ismip6shelfMelt_3dThermalForcing(kk, iCell) + ismip6shelfMelt_deltaT(iCell) + ! For all other bed depths, interpolate linearly between layers above and below bed depth. else - TFocean(iCell) = ismip6shelfMelt_3dThermalForcing(kk-1, iCell) + ismip6shelfMelt_deltaT(iCell) + TFocean(iCell) = ( (zOcean(kk-1) - bedTopography(iCell)) * ismip6shelfMelt_3dThermalForcing(kk, iCell) + & + (bedTopography(iCell) - zOcean(kk)) * ismip6shelfMelt_3dThermalForcing(kk-1, iCell) ) / & + (zOcean(kk-1) - zOcean(kk)) + ismip6shelfMelt_deltaT(iCell) endif - - ! check if any invalid TFocean value is used for calculating face melting speed - if ( (TFocean(iCell) == invalid_value_TF) .or. (TFocean(iCell) > 1.0e1) ) then - call mpas_log_write("grounded_face_melt_ismip6: Invalid value for TFocean. " // & - "TFocean(iCell)=$r zOcean(kk)=$r bedTopography(iCell)=$r kk=$i indexToCellID=$i", MPAS_LOG_ERR, & - intArgs=(/kk, indexToCellID(iCell)/), & - realArgs=(/TFocean(iCell), zOcean(kk), bedTopography(iCell)/) ) - err = ior(err, 1) - endif - endif end do endif From 5aa744cb63cc22b4f0ce9fc8be8f0bc3513eea33 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 28 Aug 2024 21:22:02 -0600 Subject: [PATCH 142/529] Handle seafloor and lakes in extrapolation module This commit makes adjustments to how the seafloor and inland seas (locations below sea level not connected to the global ocean) are handled for extraplation. The adjustments are applied primarily to availOceanMask, which is the mask of to where ocean data should be extrapolated. Changes made: * Adjust availOceanMask to extend one layer below the seafloor (needed so that facemelting has a valid value one level below the seafloor for interpolation to the seafloor elevation) * to support this, generate error if ismip6shelfMelt_zBndsOcean is not populated, because that field is needed for the seafloor detection * Adjust availOceanMask to ignore inland seas - we will not attempt to flood fill into areas below sea level that are not connected to the open ocean. * to support this, create mask of marine locations connected to global open ocean * Adjustment to where invalid values are assigned to avoid inserting them in inland seas. This will give inland seas either the value from the ocean data if it exists, or else TF=0 --- .../src/mode_forward/Makefile | 2 +- .../src/mode_forward/mpas_li_ocean_extrap.F | 97 +++++++++++++++---- 2 files changed, 78 insertions(+), 21 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/Makefile b/components/mpas-albany-landice/src/mode_forward/Makefile index 2ca4ce74b36..3c9e0061ec9 100644 --- a/components/mpas-albany-landice/src/mode_forward/Makefile +++ b/components/mpas-albany-landice/src/mode_forward/Makefile @@ -82,7 +82,7 @@ mpas_li_velocity_external.o: Interface_velocity_solver.o mpas_li_bedtopo.o: mpas_li_advection.o -mpas_li_ocean_extrap.o: +mpas_li_ocean_extrap.o: mpas_li_calving.o Interface_velocity_solver.o: diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 1ac3b8cb63f..17e8e57688e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -64,6 +64,7 @@ module li_ocean_extrap !----------------------------------------------------------------------- subroutine li_ocean_extrap_solve(domain, err) + use li_calving, only: li_flood_fill !----------------------------------------------------------------- ! input variables @@ -89,6 +90,7 @@ subroutine li_ocean_extrap_solve(domain, err) real (kind=RKIND) :: layerTop real (kind=RKIND), dimension(:,:), pointer :: TFocean, TFoceanOld real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean + real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography integer, dimension(:), pointer :: origOceanMaskHoriz integer, dimension(:,:), pointer :: orig3dOceanCavityMask ! CAS 8/16/2024 @@ -100,6 +102,9 @@ subroutine li_ocean_extrap_solve(domain, err) integer, dimension(:,:), pointer :: cellsOnCell integer :: iCell, jCell, iLayer, iNeighbor, iter, err_tmp integer :: GlobalLoopCount, newMaskCountGlobal + type (field1dInteger), pointer :: seedMaskField + type (field1dInteger), pointer :: growMaskField + integer, dimension(:), pointer :: connectedMarineMask, growMask !masks to pass to flood-fill routine ! No init is needed. err = 0 @@ -180,36 +185,79 @@ subroutine li_ocean_extrap_solve(domain, err) enddo deallocate(seedOceanMaskHorizOld) + ! Calculate mask of connected ocean + call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool) + call mpas_pool_get_field(scratchPool, 'seedMask', seedMaskField) + call mpas_allocate_scratch_field(seedMaskField, single_block_in = .true.) + connectedMarineMask => seedMaskField % array + connectedmarineMask(:) = 0 + call mpas_pool_get_field(scratchPool, 'growMask', growMaskField) + call mpas_allocate_scratch_field(growMaskField, single_block_in = .true.) + growMask => growMaskField % array + growMask(:) = 0 + + do iCell = 1, nCells + ! seedMask = open ocean cells in contact with the domain boundary + if ((bedTopography(iCell) < config_sea_level) .and. (thickness(iCell) == 0.0_RKIND)) then + do iNeighbor = 1, nEdgesOnCell(iCell) + if (cellsOnCell(iNeighbor, iCell) == nCells + 1) then + connectedMarineMask(iCell) = 1 + exit ! no need to keep checking neighbors + endif + enddo + endif + ! growMask - all marine cells + if (bedTopography(iCell) < config_sea_level) then + growMask(iCell) = 1 + endif + enddo + ! now create mask of all marine locations connected to open ocean - to be used below to screen out lakes + call li_flood_fill(connectedMarineMask, growMask, domain) + ! make it a 3D mask based on the topography (loop through nISMIP6OceanLayers) call mpas_pool_get_dimension(meshPool, 'nISMIP6OceanLayers', nISMIP6OceanLayers) + call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zOcean', ismip6shelfMelt_zOcean) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_zBndsOcean', ismip6shelfMelt_zBndsOcean) + ! check for valid data + do iLayer = 1, nISMIP6OceanLayers + if (ismip6shelfMelt_zOcean(iLayer) >= 0.0_RKIND) then + call mpas_log_write("ismip6shelfMelt_zOcean has invalid value of $r in layer $i", MPAS_LOG_ERR, & + realArgs=(/ismip6shelfMelt_zOcean(iLayer)/), intArgs=(/iLayer/)) + err = ior(err, 1) + endif + if ((ismip6shelfMelt_zBndsOcean(1,iLayer) > 0.0_RKIND) .or. & + (ismip6shelfMelt_zBndsOcean(1,iLayer) < ismip6shelfMelt_zOcean(iLayer))) then + call mpas_log_write("ismip6shelfMelt_zBndsOcean(1,:) has invalid value of $r in layer $i", MPAS_LOG_ERR, & + realArgs=(/ismip6shelfMelt_zBndsOcean(1,iLayer)/), intArgs=(/iLayer/)) + err = ior(err, 1) + endif + if ((ismip6shelfMelt_zBndsOcean(2,iLayer) >= 0.0_RKIND) .or. & + (ismip6shelfMelt_zBndsOcean(2,iLayer) > ismip6shelfMelt_zOcean(iLayer))) then + call mpas_log_write("ismip6shelfMelt_zBndsOcean(2,:) has invalid value of $r in layer $i", MPAS_LOG_ERR, & + realArgs=(/ismip6shelfMelt_zBndsOcean(2,iLayer)/), intArgs=(/iLayer/)) + err = ior(err, 1) + endif + enddo availOceanMask(:,:) = 0 validOceanMask(:,:) = 0 do iCell = 1, nCells do iLayer = 1, nISMIP6OceanLayers layerTop = ismip6shelfMelt_zBndsOcean(1, iLayer) - if ( (seedOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then - availOceanMask(iLayer,iCell) = 1 + if ( (seedOceanMaskHoriz(iCell) == 1) .and. (connectedMarineMask(iCell) == 1)) then + if (bedTopography(iCell) < layerTop) then + availOceanMask(iLayer,iCell) = 1 + else + ! keep the first layer below the seafloor in the region to be filled + ! this ensures linear interpolation from above and below the seafloor is possible + availOceanMask(iLayer,iCell) = 1 + exit ! stop looping over levels after we've included the first level below the seafloor + endif endif enddo enddo - - ! CAS 8/16/2024 Hijacking Holly's code to test using the 3D SORRM cavity TF field. We set 3d valid ocean mask to original 3d ocean cavity mask. - ! We don't need to loop through the layers if we're using a 3d mask already - validOceanMask(:,:) = orig3dOceanCavityMask(:,:) - ! if ( (origOceanMaskHoriz(iCell) == 1) .and. (bedTopography(iCell) < layerTop) ) then - ! validOceanMask(iLayer,iCell) = 1 - ! endif - ! enddo - !enddo - - call mpas_log_write('==HH==: updating halos for the avail/valid ocean masks') - ! Update halos - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'availOceanMask') - call mpas_dmpar_field_halo_exch(domain, 'validOceanMask') - call mpas_timer_stop("halo updates") + ! CAS 8/16/2024 Hijacking Holly's code to test using the 3D SORRM cavity TF field. We set 3d valid ocean mask to original 3d ocean cavity mask. + validOceanMask(:,:) = orig3dOceanCavityMask(:,:) ! save the initial validOceanMask validOceanMaskOrig(:,:) = validOceanMask(:,:) @@ -217,15 +265,24 @@ subroutine li_ocean_extrap_solve(domain, err) ! initialize the TF field TFocean(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) ! initialize the invalid data locations with fill value - ! CAS 8/19/2024 Changed availOceanMask in the if check to validOceanMask. We want to make sure all invalid values outside the validOceanMask are set to the invalid_value_TF do iCell = 1, nCellsSolve do iLayer = 1, nISMIP6OceanLayers - if ( validOceanMask(iLayer,iCell) == 0 ) then + if ((connectedMarineMask(iCell) == 0) .and. (bedTopography(iCell) < config_sea_level)) then + ! Don't assign invalid value to lakes/inland seas disconnected from global ocean + ! Let them retain the existing value: + ! This will take on the valid ocean data value where it exists or + ! zero where valid ocean data does not exist + elseif (validOceanMask(iLayer,iCell) == 0) then + ! everywhere else where valid ocean data does not exist, insert invalid value outside of validOceanMask TFocean(iLayer,iCell) = invalid_value_TF endif enddo enddo + ! deallocate scratch fields used for flood fill + call mpas_deallocate_scratch_field(seedMaskField, single_block_in=.true.) + call mpas_deallocate_scratch_field(growMaskField, single_block_in=.true.) + ! flood-fill the valid ocean mask and TF field through ! horizontal and vertial extrapolation ! get initial 3D valid data based on the original ISMIP6 field From 75c194029391fd607699a96510b81b68a2832b8b Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 28 Aug 2024 21:33:03 -0600 Subject: [PATCH 143/529] Replace verbose per-iteration log message with a summary Eliminates 100s of repetitive log messages per timestep --- .../src/mode_forward/mpas_li_ocean_extrap.F | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 17e8e57688e..0677b9c63c6 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -384,6 +384,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali integer :: iCell, jCell, iLayer, iNeighbor, iter integer :: localLoopCount integer :: nValidNeighb, newValidCount, newMaskCountLocalAccum, newMaskCountGlobal + integer :: newMaskCountTotal err = 0 @@ -413,6 +414,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali ! initialize the local loop and count for validOceanMask localLoopCount = 0 + newMaskCountTotal = 0 newMaskCountGlobal = 1 call mpas_log_write('Weight given to the cell with valid data from extrapolation: $r', realArgs=(/weightCell/)) do while ( newMaskCountGlobal > 0 ) @@ -474,16 +476,17 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali ! update count of cells added to mask globally call mpas_dmpar_sum_int(domain % dminfo, newMaskCountLocalAccum, newMaskCountGlobal) - call mpas_log_write('Horizontal extrap: Added total $i new cells to validOceanMask', intArgs=(/newMaskCountGlobal/)) + newMaskCountTotal = newMaskCountTotal + newMaskCountGlobal + !call mpas_log_write('Horizontal extrap: Added total $i new cells to validOceanMask', intArgs=(/newMaskCountGlobal/)) enddo - call mpas_log_write('Horizontal extrapolation done after $i loops', intArgs=(/localLoopCount/)) + call mpas_log_write('Horizontal extrapolation done after $i iterations. Added total of $i cells across all processors', & + intArgs=(/localLoopCount, newMaskCountTotal/)) deallocate(validOceanMaskOld) - - end subroutine horizontal_extrapolation !----------------------------------------------------------------------- + !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ! ! ! routine vertical_extrapolation From 5385761638e44b68b9e590787eb5dbe9fac53490 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 29 Aug 2024 10:30:36 -0600 Subject: [PATCH 144/529] Apply suggestions/debugging from review Addresses minor bugs and edits that came up in code review --- .../src/Registry_subglacial_hydro.xml | 4 ++-- .../src/mode_forward/mpas_li_subglacial_hydro.F | 14 +++++++++----- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index ec00a63d24a..ac756b6d33f 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -180,8 +180,8 @@ - + domain % blocklist do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) - effectivePressure(:) = 0.0_RKIND + effectivePressure = 0.0_RKIND deltatSGHaccumulated = 0.0_RKIND block => block % next @@ -700,16 +701,19 @@ subroutine li_SGH_solve(domain, err) !Average effectivePressureSGH over coupling interval for use in dynamics model block => domain % blocklist do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_array(hydroPool, 'effectivePressureSGH', effectivePressureSGH) call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) call mpas_pool_get_array(hydroPool, 'deltatSGH', deltatSGH) - effectivePressure = (effectivePressure * deltatSGHaccumulated + effectivePressureSGH) / (deltatSGHaccumulated + deltatSGH) - deltatSGHaccumulated = deltatSGHaccumulated + deltatSGH - + effectivePressure = (effectivePressure * deltatSGHaccumulated + effectivePressureSGH * deltatSGH) / (deltatSGHaccumulated + deltatSGH) + block => block % next end do + + deltatSGHaccumulated = deltatSGHaccumulated + deltatSGH + ! ============= ! ============= ! ============= From 564a80beb817a1089156ee9653df5184295c86d0 Mon Sep 17 00:00:00 2001 From: Stephen Price Date: Thu, 29 Aug 2024 18:30:50 -0500 Subject: [PATCH 145/529] Further work on adding support for and testing of glc budgets for GIS component Given known number of time steps smb flux is accumulated over, x2g_ smb flux term in budget table now agrees with value calculated from mali and cpl hist files (still need to add support for automatically determining number of averaging steps). Similar support on l2x_ side is close (summing product of accumulation fluxes in different MECs w/ area fractions and cell areas) but off in budget tables from cpl calculated values by ~5%. --- driver-mct/main/seq_diag_mct.F90 | 64 +++++++++++++++++++++++--------- 1 file changed, 46 insertions(+), 18 deletions(-) diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 734b375070d..af26aeacfbc 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -48,6 +48,9 @@ module seq_diag_mct use shr_reprosum_mod, only : shr_reprosum_calc use seq_diagBGC_mct, only : seq_diagBGC_preprint_mct, seq_diagBGC_print_mct + use prep_glc_mod, only : prep_glc_get_x2gacc_gx_cnt !SFP: added this and next - unclear which is needed +! use prep_glc_mod, only : prep_glc_get_l2gacc_lx_cnt + implicit none save private @@ -219,6 +222,10 @@ module seq_diag_mct logical :: flds_wiso ! If water isotope fields are active + !--- temporary pointers --- + integer , pointer :: x2gacc_gx_cnt ! SFP added +! integer , pointer :: l2gacc_lx_cnt ! SFP: unclear if this or the above is needed / more relevant + ! !PUBLIC DATA MEMBERS !--- time-averaged (annual?) global budge diagnostics --- @@ -268,6 +275,7 @@ module seq_diag_mct integer :: index_l2x_Flrl_wslake integer :: index_l2x_Flgl_qice(0:10) !SFP added + integer :: index_x2l_Sg_ice_covered(0:10) !SFP added integer :: index_x2l_Faxa_lwdn integer :: index_x2l_Faxa_rainc @@ -882,6 +890,8 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) logical,save :: first_time = .true. logical,save :: flds_wiso_lnd = .false. + real(r8) :: l2x_Flgl_qice_col_sum !SFP: sum of fluxes over no. MECs (cols) + character(len=64) :: name !SFP: added this and next 2 character(len= 2) :: cnum integer(in) :: num @@ -921,11 +931,12 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_irrig = mct_aVect_indexRA(l2x_l,'Flrl_irrig', perrWith='quiet') index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') - do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) + do num=0,10 !SFP: change later to 0,glc_nec_max (no. of elev classes) write(cnum,'(i2.2)') num name = 'Flgl_qice' // cnum index_l2x_Flgl_qice(num) = mct_avect_indexRA(l2x_l,trim(name)) !SFP added - !index_l2x_Flgl_qice = mct_aVect_indexRA(l2x_l,'Flgl_qice') + name = 'Sg_ice_covered' // cnum + index_x2l_Sg_ice_covered(num) = mct_avect_indexRA(x2l_l,trim(name)) !SFP added end do index_l2x_Fall_evap_16O = mct_aVect_indexRA(l2x_l,'Fall_evap_16O',perrWith='quiet') @@ -963,10 +974,12 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) end if nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi,n) -! do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) -! !SFP: this somehow needs to allow for each of the 11 vectors associate w/ each of the 11 elev classes -! nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flgl_qice(num),n) !SFP added -! end do + l2x_Flgl_qice_col_sum = 0.0d0 + do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) + !SFP: this somehow needs to allow for each of the 11 vectors associate w/ each of the 11 elev classes + l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) !SFP added + end do + nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_Flgl_qice_col_sum !SFP added if ( flds_wiso_lnd )then nf = f_wevap_16O; @@ -1003,7 +1016,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) ! budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice -! budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice !SFP added + budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice !SFP added end if @@ -1296,7 +1309,8 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) !----- local ----- type(mct_aVect), pointer :: g2x_g - type(mct_aVect), pointer :: x2g_g +! type(mct_aVect), pointer :: x2g_g + type(mct_aVect), pointer :: x2gacc_g !SFP: replace above w/ vector for accumulated fluxes type(mct_ggrid), pointer :: dom_g integer(in) :: n,ic,nf,ip ! generic index integer(in) :: kArea ! index of area field in aVect @@ -1320,7 +1334,11 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) dom_g => component_get_dom_cx(glc) g2x_g => component_get_c2x_cx(glc) - x2g_g => component_get_x2c_cx(glc) +! x2g_g => component_get_x2c_cx(glc) + x2gacc_g => component_get_x2c_cx(glc) !SFP: use accum fluxes vector + + x2gacc_gx_cnt => prep_glc_get_x2gacc_gx_cnt() !SFP: counter for how many times SMB flux accumulation has occured +! l2gacc_lx_cnt => prep_glc_get l2gacc_lx_cnt() if( present(do_g2x))then !SPF: glc to coupler @@ -1342,8 +1360,8 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) end if - ip = p_inst - !ip = p_day + !ip = p_inst + ip = p_day !ic = c_glc_gs ic = c_glc_gr !SFP: use recieve here since this is coming from glc to coupler? kArea = mct_aVect_indexRA(dom_g%data,afldname) @@ -1352,7 +1370,7 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) !SFP:debug if(calving_counter==0)then !one day at 30 min land/atmos time steps write(logunit,*) ' ' - write(logunit,*) ' calving vector length (should be 7425) = ', lSize + write(logunit,*) ' calving vector length (7425 in coupler) = ', lSize write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) write(logunit,*) ' intial value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) @@ -1390,7 +1408,8 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) smb_counter=0 smb_vector_length = 0 - index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') + !index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') + index_x2g_Flgl_qice = mct_aVect_indexRA(x2gacc_g,'Flgl_qice') !SFP: use accum flux vector !SFP:debug write(logunit,*) ' ' @@ -1399,17 +1418,18 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) end if - ip = p_inst - !ip = p_day + !ip = p_inst + ip = p_day ic = c_glc_gs ! SFP: use send here since going from coupler to glc? !ic = c_glc_gr kArea = mct_aVect_indexRA(dom_g%data,afldname) - lSize = mct_avect_lSize(x2g_g) + !lSize = mct_avect_lSize(x2g_g) + lSize = mct_avect_lSize(x2gacc_g) !SFP: use accum flux vector !SFP:debug if(smb_counter==0)then !one day at 30 min land/atmos time steps write(logunit,*) ' ' - write(logunit,*) ' smb vector length (should be 7425) = ', lSize + write(logunit,*) ' smb vector length (7425 in coupler) = ', lSize write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) write(logunit,*) ' initial value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) @@ -1417,9 +1437,13 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) do n=1,lSize ca_g = dom_g%data%rAttr(kArea,n) - nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) + !nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) + nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2gacc_g%rAttr(index_x2g_Flgl_qice,n) !SFP: use accum flux vector end do + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * 48.0d0 !SFP: hack to see if this recovers actual value from time averaged value + !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * x2gacc_gx_cnt !SFP: ideally use this or something like it to contain actual value + budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice smb_vector_length = smb_vector_length +lSize @@ -1429,6 +1453,10 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) if(smb_counter==48)then !one day at 30 min land/atmos time steps write(logunit,*) ' ' write(logunit,*) ' smb_counter = ', smb_counter + write(logunit,*) ' x2gacc_gx_cnt = ', x2gacc_gx_cnt +! write(logunit,*) ' l2gacc_lx_cnt = ', l2gacc_lx_cnt +! write(logunit,*) ' current value of x2g_ vector = ', x2g_g%rAttr(index_x2g_Flgl_qice,:) +! write(logunit,*) ' current value of x2gacc_ vector = ', x2gacc_g%rAttr(index_x2g_Flgl_qice,:) write(logunit,*) ' final value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) write(logunit,*) ' ' end if From 81c0d02530bd11e01ab3fff6ad27605edc35ecc5 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 3 Sep 2024 12:12:52 -0600 Subject: [PATCH 146/529] Remove effectivePressureSGH from ocean connection Reverts effectivePressureSGH back to effectivePressure in ocean_connection_N --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index cc210b6bc89..06fb2239107 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2260,7 +2260,7 @@ subroutine ocean_connection_N(domain) type (mpas_pool_type), pointer :: hydroPool type (mpas_pool_type), pointer :: geometryPool real (kind=RKIND), dimension(:), pointer :: bedTopography - real (kind=RKIND), dimension(:), pointer :: effectivePressureSGH + real (kind=RKIND), dimension(:), pointer :: effectivePressure real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), pointer :: rhoi, rhoo @@ -2274,11 +2274,11 @@ subroutine ocean_connection_N(domain) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - call mpas_pool_get_array(hydroPool, 'effectivePressureSGH', effectivePressureSGH) + call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) call mpas_pool_get_array(hydroPool, 'thickness', thickness) - effectivePressureSGH = rhoi * gravity * thickness - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) - effectivePressureSGH = max(effectivePressureSGH, 0.0_RKIND) ! This is just to zero out N in the open ocean to avoid confusion + effectivePressure = rhoi * gravity * thickness - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) + effectivePressure = max(effectivePressure, 0.0_RKIND) ! This is just to zero out N in the open ocean to avoid confusion block => block % next end do From 9deaf95a2064666e809fcd40553ceef42d2273ac Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 6 Sep 2024 18:04:40 +0000 Subject: [PATCH 147/529] sync homme files with homme branch --- components/homme/CMakeLists.txt | 13 +- components/homme/cmake/HommeMacros.cmake | 12 +- components/homme/src/prim_main.F90 | 4 +- .../homme/src/share/cxx/ExecSpaceDefs.cpp | 2 +- .../homme/src/share/cxx/ExecSpaceDefs.hpp | 32 ++- .../homme/src/share/cxx/SimulationParams.hpp | 4 +- .../homme/src/share/cxx/SphereOperators.hpp | 215 ------------------ .../src/share/cxx/utilities/BfbUtils.hpp | 4 - components/homme/src/share/gllfvremap_mod.F90 | 25 +- components/homme/src/share/namelist_mod.F90 | 2 +- components/homme/src/share/viscosity_base.F90 | 40 ++-- .../src/test_src/dcmip2016-supercell.F90 | 36 +-- .../src/theta-l_kokkos/config.h.cmake.in | 2 - .../theta-l_kokkos/cxx/CaarFunctorImpl.hpp | 8 - .../theta-l_kokkos/cxx/DirkFunctorImpl.hpp | 6 +- .../theta-l_kokkos/cxx/EquationOfState.hpp | 2 +- .../cxx/HyperviscosityFunctorImpl.cpp | 7 +- .../src/theta-l_kokkos/cxx/LimiterFunctor.hpp | 14 +- .../theta-l_kokkos/cxx/RemapStateProvider.hpp | 117 +--------- .../cxx/cxx_f90_interface_theta.cpp | 29 +-- 20 files changed, 107 insertions(+), 467 deletions(-) diff --git a/components/homme/CMakeLists.txt b/components/homme/CMakeLists.txt index 92f36725118..6fe81180ab5 100644 --- a/components/homme/CMakeLists.txt +++ b/components/homme/CMakeLists.txt @@ -206,7 +206,6 @@ IF (HOMME_USE_KOKKOS) STRING (TOUPPER ${HOMMEXX_EXEC_SPACE} HOMMEXX_EXEC_SPACE_UPPER) - #not user afaik IF (${HOMMEXX_EXEC_SPACE_UPPER} STREQUAL "SYCL") SET (HOMMEXX_SYCL_SPACE ON) ELSEIF (${HOMMEXX_EXEC_SPACE_UPPER} STREQUAL "HIP") @@ -453,11 +452,8 @@ if(HOMME_BUILD_EXECS AND NOT BUILD_HOMME_WITHOUT_PIOLIBRARY) ENDIF () ENDIF () -# If we don't need kokkos we don't need EKAT, and if -# Homme is built in EAMxx EKAT is already built -if("${E3SM_KOKKOS_PATH}" STREQUAL "") -IF (HOMME_USE_KOKKOS AND HOMME_STANDALONE) - # Add ekat's cmake/pkg_build folder to cmake path +IF (HOMME_USE_KOKKOS) + # Add ekat's cmake scripts folders to cmake path set (EKAT_SOURCE_DIR ${CMAKE_CURRENT_SOURCE_DIR}/../../externals/ekat) set (EKAT_CMAKE_PATH ${EKAT_SOURCE_DIR}/cmake) list(APPEND CMAKE_MODULE_PATH @@ -473,11 +469,6 @@ IF (HOMME_USE_KOKKOS AND HOMME_STANDALONE) include (EkatBuildKokkos) endif() ENDIF () -ELSE () - IF (${HOMME_USE_KOKKOS}) - INCLUDE(Kokkos) - ENDIF () -ENDIF () # This folder contains the CMake macro used to build cxx unit tests # Add unit tests for C++ code diff --git a/components/homme/cmake/HommeMacros.cmake b/components/homme/cmake/HommeMacros.cmake index 1a49c27e852..5610947cb29 100644 --- a/components/homme/cmake/HommeMacros.cmake +++ b/components/homme/cmake/HommeMacros.cmake @@ -112,7 +112,13 @@ macro(createTestExec execName execType macroNP macroNC ADD_DEFINITIONS(-DHAVE_CONFIG_H) ADD_EXECUTABLE(${execName} ${EXEC_SOURCES}) - SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE CXX) + + if(SUNSPOT_MACHINE) + SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE CXX) + else() + SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE Fortran) + endif() + IF(BUILD_HOMME_WITHOUT_PIOLIBRARY) TARGET_COMPILE_DEFINITIONS(${execName} PUBLIC HOMME_WITHOUT_PIOLIBRARY) ENDIF() @@ -169,8 +175,8 @@ macro(createTestExec execName execType macroNP macroNC TARGET_LINK_LIBRARIES(${execName} -mkl) ELSE() IF (NOT HOMME_FIND_BLASLAPACK) - #TARGET_LINK_LIBRARIES(${execName} lapack blas) - #ADD_DEPENDENCIES(${execName} blas lapack) + TARGET_LINK_LIBRARIES(${execName} lapack blas) + ADD_DEPENDENCIES(${execName} blas lapack) ENDIF() ENDIF() diff --git a/components/homme/src/prim_main.F90 b/components/homme/src/prim_main.F90 index 1d7f48e95a1..d6901151d36 100644 --- a/components/homme/src/prim_main.F90 +++ b/components/homme/src/prim_main.F90 @@ -20,7 +20,7 @@ program prim_main use element_mod, only: element_t use common_io_mod, only: output_dir, infilenames use common_movie_mod, only: nextoutputstep - use perf_mod, only: t_initf, t_prf, t_finalizef, t_startf, t_stopf,t_disablef, t_enablef ! _EXTERNAL + use perf_mod, only: t_initf, t_prf, t_finalizef, t_startf, t_stopf, t_disablef, t_enablef ! _EXTERNAL use restart_io_mod , only: restartheader_t, writerestart use hybrid_mod, only: hybrid_create #if (defined MODEL_THETA_L && defined ARKODE) @@ -241,7 +241,7 @@ end subroutine finalize_kokkos_f90 nstep = nextoutputstep(tl) do while(tl%nstep= 2) call t_enablef() diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.cpp b/components/homme/src/share/cxx/ExecSpaceDefs.cpp index 3e337b15f38..c9ca8a0ecd9 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.cpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.cpp @@ -177,7 +177,7 @@ team_num_threads_vectors_for_gpu ( } #else return std::make_pair(4,16); -#endif +#endif } } // namespace Parallel diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.hpp b/components/homme/src/share/cxx/ExecSpaceDefs.hpp index efb457a6317..82f5e803801 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.hpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.hpp @@ -8,6 +8,9 @@ #define HOMMEXX_EXEC_SPACE_DEFS_HPP #include +#ifdef HOMMEXX_BFB_TESTING +#include +#endif #include @@ -65,12 +68,6 @@ using Hommexx_Serial = void; # define HOMMEXX_STATIC static #endif - -// a hack to have a cpu build without rebuilding kokkos -//#define HOMMEXX_SERIAL_SPACE - - - // Selecting the execution space. If no specific request, use Kokkos default // exec space #ifdef HOMMEXX_ENABLE_GPU @@ -353,7 +350,7 @@ struct Dispatch { }); // Broadcast result to all threads by doing sum of one thread's // non-0 value and the rest of the 0s. - Kokkos::Impl::CudaTeamMember::vector_reduce( + Kokkos::TeamPolicy::member_type::vector_reduce( Kokkos::Sum(local_tmp)); result = local_tmp; #else @@ -381,6 +378,21 @@ struct Dispatch { lambda, result); } +#ifdef HOMMEXX_BFB_TESTING + // Template for getting the type of the second argument to a lambda + private: + template struct arg2; + + template + struct arg2 + { + using type = typename std::remove_reference< + typename std::tuple_element<1,std::tuple>::type + >::type; + }; + public: +#endif + template static KOKKOS_FORCEINLINE_FUNCTION void parallel_scan ( @@ -393,11 +405,7 @@ struct Dispatch { // serialize parallel scans. // Detect the value type - using value_type = - typename Kokkos::Impl::FunctorAnalysis - < Kokkos::Impl::FunctorPatternInterface::SCAN - , void - , Lambda >::value_type ; + using value_type = typename arg2::type; // All threads init result. value_type accumulator = Kokkos::reduction_identity::sum(); diff --git a/components/homme/src/share/cxx/SimulationParams.hpp b/components/homme/src/share/cxx/SimulationParams.hpp index 63d7a109f44..4f36962b16c 100644 --- a/components/homme/src/share/cxx/SimulationParams.hpp +++ b/components/homme/src/share/cxx/SimulationParams.hpp @@ -42,7 +42,7 @@ struct SimulationParams bool disable_diagnostics; int transport_alg; bool use_cpstar; - int theta_hydrostatic_mode; // Only for theta model + bool theta_hydrostatic_mode; // Only for theta model double dcmip16_mu; // Only for theta model double nu; @@ -105,7 +105,7 @@ inline void SimulationParams::print (std::ostream& out) { out << " use_cpstar: " << (use_cpstar ? "yes" : "no") << "\n"; out << " transport_alg: " << transport_alg << "\n"; out << " disable_diagnostics: " << (disable_diagnostics ? "yes" : "no") << "\n"; - out << " theta_hydrostatic_mode: " << ( (bool)theta_hydrostatic_mode ? "yes" : "no") << "\n"; + out << " theta_hydrostatic_mode: " << (theta_hydrostatic_mode ? "yes" : "no") << "\n"; out << " prescribed_wind: " << (prescribed_wind ? "yes" : "no") << "\n"; out << " nsplit: " << nsplit << "\n"; out << " scale_factor: " << scale_factor << "\n"; diff --git a/components/homme/src/share/cxx/SphereOperators.hpp b/components/homme/src/share/cxx/SphereOperators.hpp index e8571c57f3b..c227d97ea70 100644 --- a/components/homme/src/share/cxx/SphereOperators.hpp +++ b/components/homme/src/share/cxx/SphereOperators.hpp @@ -244,8 +244,6 @@ class SphereOperators kv.team_barrier(); } - - KOKKOS_INLINE_FUNCTION void divergence_sphere_wk_sl (const KernelVariables &kv, const ExecViewUnmanaged& v, @@ -298,102 +296,6 @@ class SphereOperators } // end of divergence_sphere_wk_sl - - - - -#if 0 - KOKKOS_INLINE_FUNCTION void - divergence_sphere_wk_sl (const KernelVariables &kv, - const ExecViewUnmanaged& v, - const ExecViewUnmanaged< Real [NP][NP]>& div_v) const - { - // Make sure the buffers have been created - assert (vector_buf_sl.size()>0); - - const auto& D_inv = Homme::subview(m_dinv,kv.ie); - const auto& spheremp = Homme::subview(m_spheremp,kv.ie); - const auto& gv_buf = Homme::subview(vector_buf_sl,kv.team_idx,0); - - // copied from strong divergence as is but without metdet - // conversion to contravariant - - double * ggv = &gv_buf(0,0,0); - - const int s1 = &v(1,0,0)-&v(0,0,0); - const int s2 = &v(0,1,0)-&v(0,0,0); - const int s3 = &v(0,0,1)-&v(0,0,0); - - //not sure we can reuse strides above, so using new ones - const int d1 = &D_inv(1,0,0,0)-&D_inv(0,0,0,0); - const int d2 = &D_inv(0,1,0,0)-&D_inv(0,0,0,0); - const int d3 = &D_inv(0,0,1,0)-&D_inv(0,0,0,0); - const int d4 = &D_inv(0,0,0,1)-&D_inv(0,0,0,0); - - constexpr int np_squared = NP * NP; - Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, np_squared), - [&](const int loop_idx) { - const int igp = loop_idx / NP; - const int jgp = loop_idx % NP; - - int linind1 = s1 * 0 + s2 * igp + s3 * jgp; - const auto& vv0 = (&v(0,0,0) + linind1); - int linind2 = s1 * 1 + s2 * igp + s3 * jgp; - const auto& vv1 = (&v(0,0,0) + linind2); - - int linind3 = d1 * 0 + d2 * 0 + d3 * igp + d4 * jgp; - int linind4 = d1 * 1 + d2 * 0 + d3 * igp + d4 * jgp; - *(&gv_buf(0,0,0)+linind1) = *(&D_inv(0,0,0,0)+linind3) * (*vv0) + *(&D_inv(0,0,0,0)+linind4) * (*vv1); - - linind3 = d1 * 0 + d2 * 1 + d3 * igp + d4 * jgp; - linind4 = d1 * 1 + d2 * 1 + d3 * igp + d4 * jgp; - *(&gv_buf(0,0,0)+linind2) = *(&D_inv(0,0,0,0)+linind3) * (*vv0) + *(&D_inv(0,0,0,0)+linind4) * (*vv1); - - }); - kv.team_barrier(); - - // in strong div - // kgp = i in strong code, jgp=j, igp=l - // in weak div, n is like j in strong div, - // n(weak)=j(strong)=jgp - // m(weak)=l(strong)=igp - // j(weak)=i(strong)=kgp - constexpr int div_iters = NP * NP; - // keeping indices' names as in F - - //gv_buf strides are as before, s1 s2 s3 - //dvv, div_v, and spheremp should have the same strides - const int f1 = &dvv(1,0)-&dvv(0,0); - const int f2 = &dvv(0,1)-&dvv(0,0); - - Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, div_iters), - [&](const int loop_idx) { - // Note: for this one time, it is better if m strides faster, due to - // the way the views are accessed. - const int mgp = loop_idx % NP; - const int ngp = loop_idx / NP; - Real dd = 0.0; - for (int jgp = 0; jgp < NP; ++jgp) { - int linind1 = s1 * 0 + s2 * ngp + s3 * jgp; - int linind2 = s1 * 1 + s2 * jgp + s3 * mgp; - - int l1 = f1 * ngp + f2 * jgp; - int l2 = f1 * jgp + f2 * mgp; - int l3 = f1 * jgp + f2 * ngp; - - dd -= ( *(&spheremp(0,0)+l1) * *(&gv_buf(0,0,0)+linind1) * *(&dvv(0,0)+l2) + - *(&spheremp(0,0)+l2) * *(&gv_buf(0,0,0)+linind2) * *(&dvv(0,0)+l3)) * - m_scale_factor_inv; - } - int l1 = f1 * ngp + f2 * mgp; - *(&div_v(0,0)+l1) = dd; - }); - kv.team_barrier(); - - } // end of divergence_sphere_wk_sl -#endif - - // Note that divergence_sphere requires scratch space of 3 x NP x NP Reals // This must be called from the device space KOKKOS_INLINE_FUNCTION void @@ -813,116 +715,6 @@ class SphereOperators vorticity_sphere(kv, v, vort, NUM_LEV_REQUEST); } - - - -#if 0 - - template - KOKKOS_INLINE_FUNCTION void - divergence_sphere_wk (const KernelVariables &kv, - // On input, a field whose divergence is sought; on - // output, the view's data are invalid. - const ExecViewUnmanaged& v, - const ExecViewUnmanaged& div_v, - const int NUM_LEV_REQUEST) const - { - assert(NUM_LEV_REQUEST>=0); - assert(NUM_LEV_REQUEST<=NUM_LEV_IN); - assert(NUM_LEV_REQUEST<=NUM_LEV_OUT); - - // Make sure the buffers have been created - assert (vector_buf_ml.size()>0); - - const auto& D_inv = Homme::subview(m_dinv, kv.ie); - const auto& spheremp = Homme::subview(m_spheremp, kv.ie); - constexpr int np_squared = NP * NP; - - const int s1 = &v(1,0,0,0)[0]-&v(0,0,0,0)[0]; - const int s2 = &v(0,1,0,0)[0]-&v(0,0,0,0)[0]; - const int s3 = &v(0,0,1,0)[0]-&v(0,0,0,0)[0]; - const int s4 = &v(0,0,0,1)[0]-&v(0,0,0,0)[0]; - - const int d1 = &D_inv(1,0,0,0)-&D_inv(0,0,0,0); - const int d2 = &D_inv(0,1,0,0)-&D_inv(0,0,0,0); - const int d3 = &D_inv(0,0,1,0)-&D_inv(0,0,0,0); - const int d4 = &D_inv(0,0,0,1)-&D_inv(0,0,0,0); - - Real * const vv = &v(0,0,0,0)[0]; - const Real * const dd = &D_inv(0,0,0,0); - - Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, np_squared), - [&](const int loop_idx) { - const int igp = loop_idx / NP; - const int jgp = loop_idx % NP; - Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV_REQUEST), [&] (const int& ilev) { - - const int l1 = s1*0 + s2*igp + s3*jgp + s4*ilev; - const int l2 = s1*1 + l1; - const Real v0old = vv[l1]; - const Real v1old = vv[l2]; - - int l3 = d1*0 + d2*0 + d3*igp + d4*jgp; - int l4 = d1*1 + d2*0 + d3*igp + d4*jgp; - - vv[l1] = dd[l3] * v0old + dd[l4] * v1old; - - l3 = d1*0 + d2*1 + d3*igp + d4*jgp; - l4 = d1*1 + d2*1 + d3*igp + d4*jgp; - - vv[l2] = dd[l3] * v0old + dd[l4] * v1old; - - }); - }); - kv.team_barrier(); - - const int f1 = &dvv(1,0)-&dvv(0,0); - const int f2 = &dvv(0,1)-&dvv(0,0); - - const Real * const ss = &spheremp(0,0); - const Real * const ddv = &dvv(0,0); - - const int k1 = &div_v(1,0,0)[0]-&div_v(0,0,0)[0]; - const int k2 = &div_v(0,1,0)[0]-&div_v(0,0,0)[0]; - const int k3 = &div_v(0,0,1)[0]-&div_v(0,0,0)[0]; - - constexpr int div_iters = NP * NP; - Kokkos::parallel_for(Kokkos::TeamThreadRange(kv.team, div_iters), - [&](const int loop_idx) { - // Note: for this one time, it is better if m strides faster, due to - // the way the views are accessed. - const int mgp = loop_idx % NP; - const int ngp = loop_idx / NP; - Kokkos::parallel_for(Kokkos::ThreadVectorRange(kv.team, NUM_LEV_REQUEST), [&] (const int& ilev) { - Real dd = 0.0; - // TODO: move multiplication by scale_factor_inv outside the loop - for (int jgp = 0; jgp < NP; ++jgp) { - // Here, v is the temporary buffer, aliased on the input v. - - const int l1 = s1*0 + s2*ngp + s3*jgp + s4*ilev; - const int l2 = s1*1 + s2*jgp + s3*mgp + s4*ilev; - - const int x1 = f1 * ngp + f2 * jgp; - const int x2 = f1 * jgp + f2 * mgp; - const int x3 = f1 * jgp + f2 * ngp; - - dd -= (ss[x1] * vv[l1] * ddv[x2] + - ss[x2] * vv[l2] * ddv[x3]) * - m_scale_factor_inv; - } - //div_v(ngp, mgp, ilev) = dd; - const int l1 = k1 * ngp + k2 * mgp + k3 * ilev; - *(&div_v(0,0,0)[0]+l1) = dd; - }); - }); - kv.team_barrier(); - - }//end of divergence_sphere_wk - -#else - - - template KOKKOS_INLINE_FUNCTION void divergence_sphere_wk (const KernelVariables &kv, @@ -978,13 +770,6 @@ class SphereOperators }//end of divergence_sphere_wk - -#endif - - - - - template KOKKOS_INLINE_FUNCTION void divergence_sphere_wk (const KernelVariables &kv, diff --git a/components/homme/src/share/cxx/utilities/BfbUtils.hpp b/components/homme/src/share/cxx/utilities/BfbUtils.hpp index 2d85109e2a2..7fb4d042f7f 100644 --- a/components/homme/src/share/cxx/utilities/BfbUtils.hpp +++ b/components/homme/src/share/cxx/utilities/BfbUtils.hpp @@ -64,11 +64,7 @@ KOKKOS_INLINE_FUNCTION ScalarType int_pow (ScalarType val, int k) { constexpr int max_shift = 30; if (k<0) { -#ifdef KOKKOS_ENABLE_SYCL Kokkos::printf ("k = %d\n",k); -#else - printf ("k = %d\n",k); -#endif Kokkos::abort("int_pow implemented only for k>=0.\n"); } diff --git a/components/homme/src/share/gllfvremap_mod.F90 b/components/homme/src/share/gllfvremap_mod.F90 index 1628d128602..e927f04aba0 100644 --- a/components/homme/src/share/gllfvremap_mod.F90 +++ b/components/homme/src/share/gllfvremap_mod.F90 @@ -270,9 +270,8 @@ subroutine gfr_init_hxx() bind(c) interface subroutine init_gllfvremap_c(nelemd, np, nf, nf_max, theta_hydrostatic_mode_integer, & fv_metdet, g2f_remapd, f2g_remapd, D_f, Dinv_f) bind(c) - use iso_c_binding, only: c_bool, c_int, c_double + use iso_c_binding, only: c_int, c_double integer (c_int), value, intent(in) :: nelemd, np, nf, nf_max - !logical (c_bool), value, intent(in) :: theta_hydrostatic_mode integer (c_int), value, intent(in) :: theta_hydrostatic_mode_integer real (c_double), dimension(nf*nf,nelemd), intent(in) :: fv_metdet real (c_double), dimension(np,np,nf_max*nf_max), intent(in) :: g2f_remapd @@ -281,7 +280,6 @@ subroutine init_gllfvremap_c(nelemd, np, nf, nf_max, theta_hydrostatic_mode_inte end subroutine init_gllfvremap_c end interface integer (c_int) :: thm - !logical (c_bool) :: thm thm = theta_hydrostatic_mode_integer call init_gllfvremap_c(nelemd, np, gfr%nphys, nphys_max, thm, & gfr%fv_metdet, gfr%g2f_remapd, gfr%f2g_remapd, gfr%D_f, gfr%Dinv_f) @@ -995,7 +993,7 @@ subroutine gfr_init_R(np, nphys, w_gg, M_gf, R, tau) end do end do end do -! call dgeqrf(np*np, nphys*nphys, R, size(R,1), tau, wrk, np*np*nphys*nphys, info) + call dgeqrf(np*np, nphys*nphys, R, size(R,1), tau, wrk, np*np*nphys*nphys, info) end subroutine gfr_init_R subroutine gfr_init_interp_matrix(npsrc, interp) @@ -1077,13 +1075,12 @@ subroutine gfr_f2g_remapd_op(gfr, R, tau, f, g) ! g = inv(M_sgsg) M_sgf inv(S) M_ff f wrk = reshape(gfr%w_ff(:nf2), (/nf,nf/))*f(:nf,:nf) if (nf == npi) then - -! call dtrsm('l', 'u', 't', 'n', nf2, 1, one, R, size(R,1), wrk, nf2) -! call dormqr('l', 'n', nf2, 1, nf2, R, size(R,1), tau, wrk, nf2, wr, np2, info) + call dtrsm('L', 'U', 'T', 'N', nf2, 1, one, R, size(R,1), wrk, nf2) + call dormqr('L', 'N', nf2, 1, nf2, R, size(R,1), tau, wrk, nf2, wr, np2, info) g(:npi,:npi) = wrk else -! call dtrtrs('u', 't', 'n', nf2, 1, R, size(R,1), wrk, nf2, info) -! call dtrtrs('u', 'n', 'n', nf2, 1, R, size(R,1), wrk, nf2, info) + call dtrtrs('U', 'T', 'N', nf2, 1, R, size(R,1), wrk, nf2, info) + call dtrtrs('U', 'N', 'N', nf2, 1, R, size(R,1), wrk, nf2, info) g(:npi,:npi) = zero do fj = 1,nf do fi = 1,nf @@ -1652,7 +1649,7 @@ subroutine gfr_pg1_init(gfr) n = np*np -! call dpotrf('u', n, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), info) + call dpotrf('U', n, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), info) if (info /= 0) print *, 'gfr ERROR> dpotrf returned', info do i = 1,n @@ -1663,8 +1660,8 @@ subroutine gfr_pg1_init(gfr) gfr%pg1sd%s = reshape(gfr%w_gg(:np,:np), (/np*np/)) ! Form R's = c -! call dtrtrs('u', 't', 'n', n, 1, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), & -! gfr%pg1sd%s, np*np, info) + call dtrtrs('U', 'T', 'N', n, 1, gfr%pg1sd%Achol, size(gfr%pg1sd%Achol,1), & + gfr%pg1sd%s, np*np, info) if (info /= 0) print *, 'gfr ERROR> dtrtrs returned', info gfr%pg1sd%sts = sum(gfr%pg1sd%s*gfr%pg1sd%s) end subroutine gfr_pg1_init @@ -1697,11 +1694,11 @@ subroutine gfr_pg1_solve(gfr, s, g) mass = sum(gfr%w_gg*g) ! Solve R'z = b. -! call dtrtrs('u', 't', 'n', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) + call dtrtrs('U', 'T', 'N', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) ! Assemble z + (d - s'z)/(s's) s. x(:n) = x(:n) + ((mass - sum(s%s(:n)*x(:n)))/s%sts)*s%s(:n) ! Solve R x = z + (d - s'z)/(s's) s. -! call dtrtrs('u', 'n', 'n', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) + call dtrtrs('U', 'N', 'N', n, 1, s%Achol, size(s%Achol,1), x, np*np, info) ! Extract g(I). g = reshape(x(:n), (/np,np/)) diff --git a/components/homme/src/share/namelist_mod.F90 b/components/homme/src/share/namelist_mod.F90 index 8dcceca6652..a3edaa07e23 100644 --- a/components/homme/src/share/namelist_mod.F90 +++ b/components/homme/src/share/namelist_mod.F90 @@ -41,7 +41,7 @@ module namelist_mod runtype, & integration, & ! integration method theta_hydrostatic_mode, & - theta_hydrostatic_mode_integer, & + theta_hydrostatic_mode_integer, & transport_alg , & ! SE Eulerian, classical SL, cell-integrated SL semi_lagrange_cdr_alg, & ! see control_mod for semi_lagrange_* descriptions semi_lagrange_cdr_check, & diff --git a/components/homme/src/share/viscosity_base.F90 b/components/homme/src/share/viscosity_base.F90 index 968e3e63c01..9c42f57158f 100644 --- a/components/homme/src/share/viscosity_base.F90 +++ b/components/homme/src/share/viscosity_base.F90 @@ -582,6 +582,8 @@ subroutine smooth_phis(phis,elem,hybrid,deriv,nets,nete,minf,numcycle,p2filt,xgl real (kind=real_kind), dimension(nets:nete) :: pmin,pmax real (kind=real_kind) :: phis4(np) integer :: nt,ie,ic,i,j + integer :: minmax_halo =-1 ! -1 = disabled. + ! 0 = recompute each time if (p2filt>=1 .and. np/=4) then call abortmp('ERROR: topo smoothing p2 filter option only supported with np==4') @@ -593,34 +595,42 @@ subroutine smooth_phis(phis,elem,hybrid,deriv,nets,nete,minf,numcycle,p2filt,xgl ! compute local element neighbor min/max do ie=nets,nete - pstens(:,:,ie)=minval(phis(:,:,ie)) - call edgeVpack(edgebuf,pstens(:,:,ie),1,0,ie) + pmin(ie)=minval(phis(:,:,ie)) + pmax(ie)=maxval(phis(:,:,ie)) enddo - call t_startf('smooth_phis_bexchV1') + do ic=1,minmax_halo ! take the min/max over three element halo + do ie=nets,nete + pstens(:,:,ie)=pmin(ie) + call edgeVpack(edgebuf,pstens(:,:,ie),1,0,ie) + enddo call bndry_exchangeV(hybrid,edgebuf) - call t_stopf('smooth_phis_bexchV1') - do ie=nets,nete call edgeVunpackMin(edgebuf, pstens(:,:,ie), 1, 0, ie) pmin(ie)=minval(pstens(:,:,ie)) enddo + do ie=nets,nete - pstens(:,:,ie)=maxval(phis(:,:,ie)) + pstens(:,:,ie)=pmax(ie) call edgeVpack(edgebuf,pstens(:,:,ie),1,0,ie) enddo - - call t_startf('smooth_phis_bexchV2') call bndry_exchangeV(hybrid,edgebuf) - call t_stopf('smooth_phis_bexchV2') - do ie=nets,nete call edgeVunpackMax(edgebuf, pstens(:,:,ie), 1, 0, ie) pmax(ie)=maxval(pstens(:,:,ie)) enddo + enddo + do ic=1,numcycle + ! recompute halo each step? + !if (minmax_halo==0) then + ! do ie=nets,nete + ! pmin(ie)=minval(phis(:,:,ie)) + ! pmax(ie)=maxval(phis(:,:,ie)) + ! enddo + !endif if (p2filt>=1) then ! apply p2 filter before laplace do ie=nets,nete @@ -652,16 +662,16 @@ subroutine smooth_phis(phis,elem,hybrid,deriv,nets,nete,minf,numcycle,p2filt,xgl smooth_phis_nudt*pstens(:,:,ie)/elem(ie)%spheremp(:,:) -#if 0 + if (minmax_halo>=0) then ! remove new extrema. could use conservative reconstruction from advection ! but no reason to conserve mean PHI. do i=1,np do j=1,np - if (phis(i,j,ie)>mx) phis(i,j,ie)=pmax(ie) - if (phis(i,j,ie)pmax(ie)) phis(i,j,ie)=pmax(ie) + if (phis(i,j,ie) 0) check_print_abort_on_bad_elems("CaarFunctorImpl::run TagPreExchange", data.n0); - - - GPTLstart("caar_bexchV"); m_bes[data.np1]->exchange(m_geometry.m_rspheremp); Kokkos::fence(); @@ -380,15 +377,12 @@ struct CaarFunctorImpl { KernelVariables kv(team, m_tu); - // Kokkos::printf("OG before div_vdp\n"); - // =========== EPOCH 1 =========== // compute_div_vdp(kv); // =========== EPOCH 2 =========== // kv.team_barrier(); -// Kokkos::printf("OG before div_vdp\n"); // Computes pi, omega, and phi. const bool ok = compute_scan_quantities(kv); if ( ! ok) nerr = 1; @@ -397,7 +391,6 @@ struct CaarFunctorImpl { // ============ EPOCH 2.1 =========== // kv.team_barrier(); compute_interface_quantities(kv); -// Kokkos::printf("OG nonhydro \n"); } if (m_rsplit==0) { @@ -406,7 +399,6 @@ struct CaarFunctorImpl { compute_vertical_advection(kv); } -// Kokkos::printf("OG before accum \n"); // ============= EPOCH 3 ============== // kv.team_barrier(); compute_accumulated_quantities(kv); diff --git a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp index 44a8af7fb70..d1676907972 100644 --- a/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/DirkFunctorImpl.hpp @@ -382,12 +382,8 @@ struct DirkFunctorImpl { kv.team_barrier(); if (it >= maxiter) { -#ifdef KOKKOS_ENABLE_SYCL Kokkos::printf("[DIRK] WARNING! Newton reached max iteration count," -#else - printf("[DIRK] WARNING! Newton reached max iteration count," -#endif - " with deltaerr = %3.17f\n", deltaerr); + " with deltaerr = %3.17f\n", deltaerr); nerr = 1; } diff --git a/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp b/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp index 99732ee640a..a50a28d58f5 100644 --- a/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp @@ -250,7 +250,7 @@ class EquationOfState { public: - int m_theta_hydrostatic_mode; + int m_theta_hydrostatic_mode; HybridVCoord m_hvcoord; }; diff --git a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp index 24750a570a9..ecde17b5b8d 100644 --- a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp @@ -120,12 +120,7 @@ void HyperviscosityFunctorImpl::init_params(const SimulationParams& params) #ifdef HOMMEXX_BFB_TESTING m_process_nh_vars = 1; #else - //m_process_nh_vars = !params.theta_hydrostatic_mode; - if (params.theta_hydrostatic_mode){ - m_process_nh_vars = 0; - }else{ - m_process_nh_vars = 1; - } + m_process_nh_vars = static_cast (not params.theta_hydrostatic_mode); #endif } diff --git a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp index 3e3f8c15d25..7914c0a60e3 100644 --- a/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/LimiterFunctor.hpp @@ -141,12 +141,8 @@ struct LimiterFunctor { [&](const int k,Real& result) { #ifndef HOMMEXX_BFB_TESTING if(diff_as_real(k) < 0){ -#ifdef KOKKOS_ENABLE_SYCL Kokkos::printf("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", -#else - printf("WARNING:CAAR: dp3d too small. k=%d, dp3d(k)=%f, dp0=%f \n", -#endif - k+1,dp_as_real(k),dp0_as_real(k)); + k+1,dp_as_real(k),dp0_as_real(k)); } #endif result = result<=diff_as_real(k) ? result : diff_as_real(k); @@ -206,12 +202,8 @@ struct LimiterFunctor { for (int ivec=0; ivec>>>>>>>>>>> m_process_nh_vars " << m_process_nh_vars << " \n"; - std::cout << ">>>>>>>>>>>> m_process_nh_vars_bool " << m_process_nh_vars_bool << " \n"; -if(m_process_nh_vars){ - std::cout << "hey m_process_nh_vars is true \n"; -}else{ - std::cout << "hey m_process_nh_vars is false \n"; -} - -if(m_process_nh_vars_bool){ - std::cout << "hey m_process_nh_vars_bool is true \n"; -}else{ - std::cout << "hey m_process_nh_vars_bool is false \n"; -} - -////////////////////////// put abort if bool assignment failed - - -//if(params.theta_hydrostatic_mode && m_process_nh_vars_bool) -//Kokkos::abort("BOOL assignment failed, (params.theta_hydrostatic_mode && m_process_nh_vars_bool) == TRUE.\n"); - - - - - if (m_process_nh_vars) { - -std::cout << "INSIDE w phi assignment m_process_nh_vars is true \n"; - m_delta_w = decltype(m_delta_w) ("w_i increments",elements.num_elems()); m_delta_phinh = decltype(m_delta_phinh) ("phinh_i increments",elements.num_elems()); } -if(m_process_nh_vars){ - std::cout << "2hey m_process_nh_vars is true \n"; -}else -{ - std::cout << "2hey m_process_nh_vars is false \n"; -} - m_hvcoord = Context::singleton().get(); assert (m_hvcoord.m_inited); -if(m_process_nh_vars){ - std::cout << "3hey m_process_nh_vars is true \n"; -}else -{ - std::cout << "3hey m_process_nh_vars is false \n"; -} - m_eos.init(params.theta_hydrostatic_mode,m_hvcoord); m_elem_ops.init(m_hvcoord); - - if(m_process_nh_vars){ - std::cout << "4hey m_process_nh_vars is true \n"; -}else -{ - std::cout << "4hey m_process_nh_vars is false \n"; -} - - } + } int requested_buffer_size (int num_teams) const { - -if(m_process_nh_vars){ - std::cout << "IN REQUESTED hey m_process_nh_vars is true \n"; -}else -{ - std::cout << "IN REQUESTED hey m_process_nh_vars is false \n"; -} - if (!m_process_nh_vars) { - //if (m_process_nh_vars==0) { return 0; } @@ -169,18 +81,8 @@ if(m_process_nh_vars){ } void init_buffers(const FunctorsBuffersManager& fbm, int num_teams) { - -if(m_process_nh_vars){ - std::cout << "IN BUFFERS hey m_process_nh_vars is true \n"; -}else -{ - std::cout << "IN BUFFERS hey m_process_nh_vars is false \n"; -} - if (!m_process_nh_vars) { - - std::cout << "hey we should be returning from init_buffers \n"; - return; + return; } Scalar* mem = reinterpret_cast(fbm.get_memory()); @@ -193,20 +95,17 @@ if(m_process_nh_vars){ KOKKOS_INLINE_FUNCTION int num_states_remap() const { - //return (m_process_nh_vars ? 5 : 3); - return ( (m_process_nh_vars) ? 5 : 3); + return (m_process_nh_vars ? 5 : 3); } KOKKOS_INLINE_FUNCTION int num_states_preprocess() const { - //return (m_process_nh_vars ? 2 : 0); - return ( (m_process_nh_vars) ? 2 : 0); + return (m_process_nh_vars ? 2 : 0); } KOKKOS_INLINE_FUNCTION int num_states_postprocess() const { - //return (m_process_nh_vars ? 2 : 0); - return ((m_process_nh_vars) ? 2 : 0); + return (m_process_nh_vars ? 2 : 0); } KOKKOS_INLINE_FUNCTION diff --git a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp index de51e52a793..40c4ae64dc9 100644 --- a/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/cxx_f90_interface_theta.cpp @@ -50,17 +50,7 @@ void init_simulation_params_c (const int& remap_alg, const int& limiter_option, const double& dp3d_thresh, const double& vtheta_thresh, const int& internal_diagnostics_level) { - std::cout << "In transfer routine theta_hydrostatic_mode =" << theta_hydrostatic_mode << "\n"; - - -if(theta_hydrostatic_mode){ - std::cout << " HEEEEEEEEEEEtheta_hydrostatic_mode =TRUE \n"; -}else -{ - std::cout << " HEEEEEEEEEEEtheta_hydrostatic_mode =FALSE \n"; -} - - // Check that the simulation options are supported. This helps us in the future, since we + // Check that the simulation options are supported. This helps us in the future, since we // are currently 'assuming' some option have/not have certain values. As we support for more // options in the C++ build, we will remove some checks Errors::check_option("init_simulation_params_c","vert_remap_q_alg",remap_alg,{1,3,10}); @@ -80,7 +70,6 @@ if(theta_hydrostatic_mode){ Errors::check_option("init_simulation_params_c","vtheta_thresh",vtheta_thresh,0.0,Errors::ComparisonOp::GT); Errors::check_option("init_simulation_params_c","nu_div",nu_div,0.0,Errors::ComparisonOp::GT); Errors::check_option("init_simulation_params_c","theta_advection_form",theta_adv_form,{0,1}); - Errors::check_option("init_simulation_params_c","theta_hydrostatic_mode",theta_hydrostatic_mode,{0,1}); #ifndef SCREAM Errors::check_option("init_simulation_params_c","nsplit",nsplit,1,Errors::ComparisonOp::GE); #else @@ -105,13 +94,6 @@ if(theta_hydrostatic_mode){ params.theta_adv_form = AdvectionForm::NonConservative; } -// if (theta_hydrostatic_mode==0) { -// params.theta_hydrostatic_mode = false; -// } else { -// params.theta_hydrostatic_mode = true; -// } - - params.limiter_option = limiter_option; params.rsplit = rsplit; params.qsplit = qsplit; @@ -134,7 +116,7 @@ if(theta_hydrostatic_mode){ params.use_moisture = (bool)use_moisture; params.use_cpstar = (bool)use_cpstar; params.transport_alg = transport_alg; - params.theta_hydrostatic_mode = theta_hydrostatic_mode; + params.theta_hydrostatic_mode = (bool)theta_hydrostatic_mode; params.dcmip16_mu = dcmip16_mu; params.nsplit = nsplit; params.scale_factor = scale_factor; @@ -144,11 +126,6 @@ if(theta_hydrostatic_mode){ params.vtheta_thresh = vtheta_thresh; params.internal_diagnostics_level = internal_diagnostics_level; - - std::cout << "In transfer routine AFTER ASSIGNMENT params.theta_hydrostatic_mode =" << params.theta_hydrostatic_mode << "\n"; - - - if (time_step_type==5) { //5 stage, 3rd order, explicit params.time_step_type = TimeStepType::ttype5; @@ -383,7 +360,7 @@ void init_functors_c (const int& allocate_buffer) auto& hvf = c.create_if_not_there(); auto& ff = c.create_if_not_there(); auto& diag = c.create_if_not_there (elems.num_elems(),tracers.num_tracers(), - (bool)params.theta_hydrostatic_mode); + params.theta_hydrostatic_mode); auto& vrm = c.create_if_not_there(elems.num_elems()); auto& fbm = c.create_if_not_there(); From 0de86a2b3118400f1b5bf782dde4f751e5408624 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 8 Sep 2024 20:38:52 +0000 Subject: [PATCH 148/529] partially working switch to flare on aurora --- cime_config/machines/config_batch.xml | 4 +- cime_config/machines/config_machines.xml | 48 +++++++++---------- .../eamxx/cmake/machine-files/aurora.cmake | 14 +++--- .../eamxx/cmake/machine-files/auroracpu.cmake | 22 +++------ 4 files changed, 40 insertions(+), 48 deletions(-) diff --git a/cime_config/machines/config_batch.xml b/cime_config/machines/config_batch.xml index b0a4e8ee692..3abac928ac2 100644 --- a/cime_config/machines/config_batch.xml +++ b/cime_config/machines/config_batch.xml @@ -586,7 +586,7 @@ - /lus/gecko/projects/CSC249ADSE15_CNDA/tools/qsub/throttle + /lus/flare/projects/CSC249ADSE15_CNDA/tools/qsub/throttle EarlyAppAccess workq-route @@ -595,7 +595,7 @@ - /lus/gecko/projects/CSC249ADSE15_CNDA/tools/qsub/throttle + /lus/flare/projects/CSC249ADSE15_CNDA/tools/qsub/throttle EarlyAppAccess workq-route diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index a77c1671b08..dc26bafc0a5 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3753,14 +3753,14 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors oneapi-ifx,oneapi-ifxgpu,gnu mpich CSC249ADSE15_CNDA - /lus/gecko/projects/CSC249ADSE15_CNDA/performance_archive + /lus/flare/projects/CSC249ADSE15_CNDA/performance_archive .* - /lus/gecko/projects/CSC249ADSE15_CNDA/$USER/scratch - /lus/gecko/projects/CSC249ADSE15_CNDA/inputdata - /lus/gecko/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 + /lus/flare/projects/CSC249ADSE15_CNDA/$USER/scratch + /lus/flare/projects/CSC249ADSE15_CNDA/inputdata + /lus/flare/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE - /lus/gecko/projects/CSC249ADSE15_CNDA/baselines/$COMPILER - /lus/gecko/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc + /lus/flare/projects/CSC249ADSE15_CNDA/baselines/$COMPILER + /lus/flare/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc 16 e3sm_developer 4 @@ -3783,7 +3783,7 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors - /lus/gecko/projects/CSC249ADSE15_CNDA/modules/lmod.sh + /lus/flare/projects/CSC249ADSE15_CNDA/modules/lmod.sh /soft/sunspot_migrate/soft/packaging/lmod/lmod/init/csh /soft/sunspot_migrate/soft/packaging/lmod/lmod/init/env_modules_python.py module @@ -3811,11 +3811,11 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld - /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 - /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 - /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 - /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} - /opt/cray/pe/python/3.9.13.1/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} + /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 + /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 + /lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 + /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} + /opt/cray/pe/python/3.9.13.1/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 @@ -3864,14 +3864,14 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors oneapi-ifx mpich CSC249ADSE15_CNDA - /lus/gecko/projects/CSC249ADSE15_CNDA/performance_archive + /lus/flare/projects/CSC249ADSE15_CNDA/performance_archive .* - /lus/gecko/projects/CSC249ADSE15_CNDA/$USER/scratch - /lus/gecko/projects/CSC249ADSE15_CNDA/inputdata - /lus/gecko/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 + /lus/flare/projects/CSC249ADSE15_CNDA/$USER/scratch + /lus/flare/projects/CSC249ADSE15_CNDA/inputdata + /lus/flare/projects/CSC249ADSE15_CNDA/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE - /lus/gecko/projects/CSC249ADSE15_CNDA/baselines/$COMPILER - /lus/gecko/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc + /lus/flare/projects/CSC249ADSE15_CNDA/baselines/$COMPILER + /lus/flare/projects/CSC249ADSE15_CNDA/tools/cprnc/cprnc 16 e3sm_developer 4 @@ -3892,7 +3892,7 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors - /lus/gecko/projects/CSC249ADSE15_CNDA/modules/lmod.sh + /lus/flare/projects/CSC249ADSE15_CNDA/modules/lmod.sh /soft/sunspot_migrate/soft/packaging/lmod/lmod/init/csh /soft/sunspot_migrate/soft/packaging/lmod/lmod/init/env_modules_python.py module @@ -3916,11 +3916,11 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld - /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 - /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 - /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 - /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} - /opt/cray/pe/python/3.9.13.1/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} + /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 + /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 + /lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 + /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} + /opt/cray/pe/python/3.9.13.1/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 diff --git a/components/eamxx/cmake/machine-files/aurora.cmake b/components/eamxx/cmake/machine-files/aurora.cmake index cdebb0500a6..c06c82dcbcb 100644 --- a/components/eamxx/cmake/machine-files/aurora.cmake +++ b/components/eamxx/cmake/machine-files/aurora.cmake @@ -22,13 +22,13 @@ set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-func #this is needed for cime builds! -set(NETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(NETCDF_DIR "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(NETCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") -set(NETCDF_C "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") +set(NETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_DIR "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") +set(NETCDF_C "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") #this one is for rrtmgp -set(NetCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(PNETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007") +set(NetCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(PNETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007") diff --git a/components/eamxx/cmake/machine-files/auroracpu.cmake b/components/eamxx/cmake/machine-files/auroracpu.cmake index 1d8f246f63f..d620dcb3a0d 100644 --- a/components/eamxx/cmake/machine-files/auroracpu.cmake +++ b/components/eamxx/cmake/machine-files/auroracpu.cmake @@ -17,23 +17,15 @@ set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -mlong-double-64 -DNDEBUG -fortlib" CACHE STRING "" FORCE) #set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) - - -# -# /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 -# /lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 -# /lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 - - #this is needed for cime builds! -set(NETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(NETCDF_DIR "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(NETCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") -set(NETCDF_C "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") +set(NETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_DIR "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(NETCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") +set(NETCDF_C "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") #this one is for rrtmgp -set(NetCDF_C_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(PNETCDF_PATH "/lus/gecko/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007") +set(NetCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") +set(PNETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007") From 9ddec8c232a53c5f53ab4ea4761d1cf5a8238b9c Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Sun, 8 Sep 2024 21:57:10 +0000 Subject: [PATCH 149/529] attempt to use new oneapi --- cime_config/machines/config_machines.xml | 16 ++++++---------- .../eamxx/cmake/machine-files/aurora.cmake | 14 +++++++------- 2 files changed, 13 insertions(+), 17 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index dc26bafc0a5..981a1b3161b 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3797,11 +3797,7 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors python/3.10.10 - oneapi/release/2023.12.15.001 - - - spack-pe-gcc cmake - gcc/11.2.0 + oneapi/eng-compiler/2024.04.15.002 cray-pals/1.3.3 @@ -3811,11 +3807,11 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld - /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007 - /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007 - /lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007 - /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/lib:$ENV{LD_LIBRARY_PATH} - /opt/cray/pe/python/3.9.13.1/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007/bin:$ENV{PATH} + /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2024.04.15.002 + /lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2024.04.15.002 + /lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2024.04.15.002 + /opt/cray/pe/gcc-libs:/opt/cray/pe/python/3.9.13.1/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2024.04.15.002/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2024.04.15.002/lib:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2024.04.15.002/lib:$ENV{LD_LIBRARY_PATH} + /opt/cray/pe/python/3.9.13.1/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2024.04.15.002/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2024.04.15.002/bin:/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2024.04.15.002/bin:$ENV{PATH} list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 diff --git a/components/eamxx/cmake/machine-files/aurora.cmake b/components/eamxx/cmake/machine-files/aurora.cmake index c06c82dcbcb..c0a62e3cd20 100644 --- a/components/eamxx/cmake/machine-files/aurora.cmake +++ b/components/eamxx/cmake/machine-files/aurora.cmake @@ -22,13 +22,13 @@ set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-func #this is needed for cime builds! -set(NETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(NETCDF_DIR "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(NETCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") -set(NETCDF_C "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007") +set(NETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2024.04.15.002") +set(NETCDF_DIR "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2024.04.15.002") +set(NETCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2024.04.15.002") +set(NETCDF_C "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2024.04.15.002") #this one is for rrtmgp -set(NetCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2023.05.15.007" CACHE STRING "") -set(NETCDF_FORTRAN_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2023.05.15.007") -set(PNETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2023.05.15.007") +set(NetCDF_C_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-c/4.9.2/oneapi.eng.2024.04.15.002" CACHE STRING "") +set(NETCDF_FORTRAN_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/netcdf-fortran/4.6.1/oneapi.eng.2024.04.15.002") +set(PNETCDF_PATH "/lus/flare/projects/CSC249ADSE15_CNDA/software/pnetcdf/1.12.3/oneapi.eng.2024.04.15.002") From 55cfe5485f7c1d0c79630665a4c547c293db7f55 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 10 Sep 2024 19:27:22 +0000 Subject: [PATCH 150/529] sync with homme branch --- components/homme/cmake/HommeMacros.cmake | 7 ------ .../homme/src/preqx_kokkos/cxx/CamForcing.cpp | 6 ++--- .../cxx/cxx_f90_interface_preqx.cpp | 4 +-- .../src/preqx_kokkos/cxx/prim_advance_exp.cpp | 2 +- .../homme/src/share/compose/cedr_kokkos.hpp | 2 +- .../src/share/compose/compose_slmm_siqk.cpp | 2 ++ components/homme/src/share/control_mod.F90 | 1 - components/homme/src/share/cxx/GllFvRemap.cpp | 6 ++--- components/homme/src/share/cxx/GllFvRemap.hpp | 2 +- .../homme/src/share/cxx/GllFvRemapImpl.cpp | 6 ++--- .../homme/src/share/cxx/GllFvRemapImpl.hpp | 5 ++-- .../homme/src/share/cxx/HommexxEnums.hpp | 5 ---- components/homme/src/share/gllfvremap_mod.F90 | 9 ++++--- components/homme/src/share/namelist_mod.F90 | 6 ----- .../theta-l_kokkos/cxx/EquationOfState.hpp | 4 +-- .../cxx/HyperviscosityFunctorImpl.cpp | 2 +- .../cxx/HyperviscosityFunctorImpl.hpp | 2 +- .../src/theta-l_kokkos/prim_driver_mod.F90 | 25 +++++++++---------- components/homme/test_execs/CMakeLists.txt | 3 +++ .../test_execs/share_kokkos_ut/CMakeLists.txt | 4 +-- .../thetal_kokkos_ut/CMakeLists.txt | 3 +++ .../thetal_kokkos_ut/forcing_ut.cpp | 8 +++--- .../thetal_kokkos_ut/gllfvremap_ut.cpp | 4 +-- 23 files changed, 53 insertions(+), 65 deletions(-) diff --git a/components/homme/cmake/HommeMacros.cmake b/components/homme/cmake/HommeMacros.cmake index 5610947cb29..b553a8668eb 100644 --- a/components/homme/cmake/HommeMacros.cmake +++ b/components/homme/cmake/HommeMacros.cmake @@ -112,13 +112,6 @@ macro(createTestExec execName execType macroNP macroNC ADD_DEFINITIONS(-DHAVE_CONFIG_H) ADD_EXECUTABLE(${execName} ${EXEC_SOURCES}) - - if(SUNSPOT_MACHINE) - SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE CXX) - else() - SET_TARGET_PROPERTIES(${execName} PROPERTIES LINKER_LANGUAGE Fortran) - endif() - IF(BUILD_HOMME_WITHOUT_PIOLIBRARY) TARGET_COMPILE_DEFINITIONS(${execName} PUBLIC HOMME_WITHOUT_PIOLIBRARY) ENDIF() diff --git a/components/homme/src/preqx_kokkos/cxx/CamForcing.cpp b/components/homme/src/preqx_kokkos/cxx/CamForcing.cpp index 2b1e6514389..36ca5f4a95f 100644 --- a/components/homme/src/preqx_kokkos/cxx/CamForcing.cpp +++ b/components/homme/src/preqx_kokkos/cxx/CamForcing.cpp @@ -51,7 +51,7 @@ void state_forcing( void tracer_forcing( const ExecViewUnmanaged &f_q, const HybridVCoord &hvcoord, const TimeLevel &tl, const int &num_q, - const MoistDry &moisture, const double &dt, + const bool &use_moisture, const double &dt, const ExecViewManaged &ps_v, const ExecViewManaged< Scalar * [Q_NUM_TIME_LEVELS][QSIZE_D][NP][NP][NUM_LEV]> &qdp, @@ -61,7 +61,7 @@ void tracer_forcing( const int np1 = tl.n0; const int np1_qdp = tl.n0_qdp; - if (moisture == MoistDry::MOIST) { + if (use_moisture) { // Remove the m_fq_ps_v buffer since it's not actually needed. // Instead apply the forcing to m_ps_v directly // Bonus - one less parallel reduce in dry cases! @@ -161,7 +161,7 @@ void apply_cam_forcing(const Real &dt) { tracers.fq = decltype(tracers.fq)("fq", elems.num_elems(),tracers.num_tracers()); } tracer_forcing(tracers.fq, hvcoord, tl, tracers.num_tracers(), - sim_params.moisture, dt, elems.m_state.m_ps_v, tracers.qdp, tracers.Q); + sim_params.use_moisture, dt, elems.m_state.m_ps_v, tracers.qdp, tracers.Q); GPTLstop("ApplyCAMForcing"); } diff --git a/components/homme/src/preqx_kokkos/cxx/cxx_f90_interface_preqx.cpp b/components/homme/src/preqx_kokkos/cxx/cxx_f90_interface_preqx.cpp index c75143a9836..b433a48c2ab 100644 --- a/components/homme/src/preqx_kokkos/cxx/cxx_f90_interface_preqx.cpp +++ b/components/homme/src/preqx_kokkos/cxx/cxx_f90_interface_preqx.cpp @@ -37,7 +37,7 @@ void init_simulation_params_c (const int& remap_alg, const int& limiter_option, const int& time_step_type, const int& qsize, const int& state_frequency, const Real& nu, const Real& nu_p, const Real& nu_q, const Real& nu_s, const Real& nu_div, const Real& nu_top, const int& hypervis_order, const int& hypervis_subcycle, const double& hypervis_scaling, - const int& ftype, const bool& prescribed_wind, const bool& moisture, const bool& disable_diagnostics, + const int& ftype, const bool& prescribed_wind, const bool& use_moisture, const bool& disable_diagnostics, const bool& use_cpstar, const int& transport_alg, const int& dt_remap_factor, const int& dt_tracer_factor, const double& scale_factor, const double& laplacian_rigid_factor) @@ -90,7 +90,7 @@ void init_simulation_params_c (const int& remap_alg, const int& limiter_option, params.hypervis_subcycle = hypervis_subcycle; params.hypervis_scaling = hypervis_scaling; params.disable_diagnostics = disable_diagnostics; - params.moisture = (moisture ? MoistDry::MOIST : MoistDry::DRY); + params.use_moisture = use_moisture; params.use_cpstar = use_cpstar; params.transport_alg = transport_alg; // SphereOperators parameters; preqx supports only the sphere. diff --git a/components/homme/src/preqx_kokkos/cxx/prim_advance_exp.cpp b/components/homme/src/preqx_kokkos/cxx/prim_advance_exp.cpp index f7c7600aab8..58e58f0160b 100644 --- a/components/homme/src/preqx_kokkos/cxx/prim_advance_exp.cpp +++ b/components/homme/src/preqx_kokkos/cxx/prim_advance_exp.cpp @@ -34,7 +34,7 @@ void prim_advance_exp (TimeLevel& tl, const Real dt, const bool compute_diagnost // Determine the tracers time level tl.n0_qdp= -1; - if (params.moisture == MoistDry::MOIST) { + if (params.use_moisture) { tl.update_tracers_levels(params.qsplit); } diff --git a/components/homme/src/share/compose/cedr_kokkos.hpp b/components/homme/src/share/compose/cedr_kokkos.hpp index 42e423e2913..758f4148a9a 100644 --- a/components/homme/src/share/compose/cedr_kokkos.hpp +++ b/components/homme/src/share/compose/cedr_kokkos.hpp @@ -18,7 +18,7 @@ typedef Kokkos::Experimental::HIPSpace CedrGpuSpace; # endif # if defined KOKKOS_ENABLE_SYCL typedef Kokkos::Experimental::SYCL CedrGpuExeSpace; -typedef Kokkos::Experimental::SYCL> CedrGpuSpace; +typedef Kokkos::Experimental::SYCL CedrGpuSpace; # endif #endif diff --git a/components/homme/src/share/compose/compose_slmm_siqk.cpp b/components/homme/src/share/compose/compose_slmm_siqk.cpp index 628c023090c..56564b0b8ca 100644 --- a/components/homme/src/share/compose/compose_slmm_siqk.cpp +++ b/components/homme/src/share/compose/compose_slmm_siqk.cpp @@ -60,8 +60,10 @@ class TestSphereToRefKernel { // tol is on dx, not (a,b), so adjust slightly. if ( ! info.success || err > 1e4*tol_) { jinfo.nfails++; +#ifndef KOKKOS_ENABLE_SYCL printf("calc_sphere_to_ref ei %d i %d j %d: nits %d re %1.1e\n", ei, i, j, info.n_iterations, err); +#endif } jinfo.sum_nits += info.n_iterations; jinfo.max_nits = max(jinfo.max_nits, info.n_iterations); diff --git a/components/homme/src/share/control_mod.F90 b/components/homme/src/share/control_mod.F90 index 9c3c599b232..0e9494f5a6c 100644 --- a/components/homme/src/share/control_mod.F90 +++ b/components/homme/src/share/control_mod.F90 @@ -43,7 +43,6 @@ module control_mod ! flag used by preqx, theta-l and theta-c models ! should be renamed to "hydrostatic_mode" logical, public :: theta_hydrostatic_mode - integer, public :: theta_hydrostatic_mode_integer integer, public :: tstep_type= 5 ! preqx timestepping options diff --git a/components/homme/src/share/cxx/GllFvRemap.cpp b/components/homme/src/share/cxx/GllFvRemap.cpp index a8f564958d4..7b0400427f3 100644 --- a/components/homme/src/share/cxx/GllFvRemap.cpp +++ b/components/homme/src/share/cxx/GllFvRemap.cpp @@ -21,8 +21,8 @@ void init_gllfvremap_c (int nelemd, int np, int nf, int nf_max, CF90Ptr f2g_remapd, CF90Ptr D_f, CF90Ptr Dinv_f) { auto& c = Context::singleton(); auto& g = c.get(); - g.init_data(nf, nf_max, theta_hydrostatic_mode, fv_metdet, g2f_remapd, - f2g_remapd, D_f, Dinv_f); + const bool thm = static_cast(theta_hydrostatic_mode); + g.init_data(nf, nf_max, thm, fv_metdet, g2f_remapd, f2g_remapd, D_f, Dinv_f); } GllFvRemap::GllFvRemap () { @@ -52,7 +52,7 @@ void GllFvRemap::init_boundary_exchanges () { } void GllFvRemap -::init_data (const int nf, const int nf_max, const int theta_hydrostatic_mode, +::init_data (const int nf, const int nf_max, const bool theta_hydrostatic_mode, const Real* fv_metdet, const Real* g2f_remapd, const Real* f2g_remapd, const Real* D_f, const Real* Dinv_f) { m_impl->init_data(nf, nf_max, theta_hydrostatic_mode, fv_metdet, diff --git a/components/homme/src/share/cxx/GllFvRemap.hpp b/components/homme/src/share/cxx/GllFvRemap.hpp index 2adff0aeaa9..7ebf5a82b71 100644 --- a/components/homme/src/share/cxx/GllFvRemap.hpp +++ b/components/homme/src/share/cxx/GllFvRemap.hpp @@ -40,7 +40,7 @@ class GllFvRemap { typedef Phys2T::const_type CPhys2T; typedef Phys3T::const_type CPhys3T; - void init_data(const int nf, const int nf_max, const int theta_hydrostatic_mode, + void init_data(const int nf, const int nf_max, const bool theta_hydrostatic_mode, const Real* fv_metdet, const Real* g2f_remapd, const Real* f2g_remapd, const Real* D_f, const Real* Dinv_f); diff --git a/components/homme/src/share/cxx/GllFvRemapImpl.cpp b/components/homme/src/share/cxx/GllFvRemapImpl.cpp index d4ab5c89f51..ea1a52f5efd 100644 --- a/components/homme/src/share/cxx/GllFvRemapImpl.cpp +++ b/components/homme/src/share/cxx/GllFvRemapImpl.cpp @@ -131,7 +131,7 @@ void GllFvRemapImpl::init_boundary_exchanges () { template using FV = Kokkos::View; void GllFvRemapImpl -::init_data (const int nf, const int nf_max, const int theta_hydrostatic_mode, +::init_data (const int nf, const int nf_max, const bool theta_hydrostatic_mode, const Real* fv_metdet_r, const Real* g2f_remapd_r, const Real* f2g_remapd_r, const Real* D_f_r, const Real* Dinv_f_r) { using Kokkos::create_mirror_view; @@ -395,7 +395,7 @@ ::run_dyn_to_fv_phys (const int timeidx, const Phys1T& ps, const Phys1T& phis, c const auto hvcoord = m_hvcoord; const bool use_moisture = m_data.use_moisture; - const int theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; + const bool theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; const bool want_dp_fv_out = dp_fv_out_ptr != nullptr; VPhys2T dp_fv_out; @@ -605,7 +605,7 @@ run_fv_phys_to_dyn (const int timeidx, const CPhys2T& Ts, const CPhys3T& uvs, const auto fT = m_forcing.m_ft; const auto hvcoord = m_hvcoord; const auto dp3d = m_state.m_dp3d; - const int theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; + const bool theta_hydrostatic_mode = m_data.theta_hydrostatic_mode; EquationOfState eos; eos.init(theta_hydrostatic_mode, hvcoord); ElementOps ops; ops.init(hvcoord); const auto tu_ne = m_tu_ne; diff --git a/components/homme/src/share/cxx/GllFvRemapImpl.hpp b/components/homme/src/share/cxx/GllFvRemapImpl.hpp index 7388fddb123..11738b2bf45 100644 --- a/components/homme/src/share/cxx/GllFvRemapImpl.hpp +++ b/components/homme/src/share/cxx/GllFvRemapImpl.hpp @@ -60,8 +60,7 @@ struct GllFvRemapImpl { struct Data { int nelemd, qsize, nf2, n_dss_fld; - bool use_moisture; - int theta_hydrostatic_mode; + bool use_moisture, theta_hydrostatic_mode; static constexpr int nbuf1 = 2, nbuf2 = 1; Buf1 buf1[nbuf1]; @@ -108,7 +107,7 @@ struct GllFvRemapImpl { void init_buffers(const FunctorsBuffersManager& fbm); void init_boundary_exchanges(); - void init_data(const int nf, const int nf_max, const int theta_hydrostatic_mode, + void init_data(const int nf, const int nf_max, const bool theta_hydrostatic_mode, const Real* fv_metdet_r, const Real* g2f_remapd_r, const Real* f2g_remapd_r, const Real* D_f_r, const Real* Dinv_f_r); diff --git a/components/homme/src/share/cxx/HommexxEnums.hpp b/components/homme/src/share/cxx/HommexxEnums.hpp index 59c8f3c9652..06abbf35adb 100644 --- a/components/homme/src/share/cxx/HommexxEnums.hpp +++ b/components/homme/src/share/cxx/HommexxEnums.hpp @@ -47,11 +47,6 @@ enum class ForcingAlg : int { FORCING_2 = 2, // TODO: Rename FORCING_1 and FORCING_2 to something more descriptive }; -enum class MoistDry { - MOIST, - DRY -}; - enum class AdvectionForm { Conservative, NonConservative diff --git a/components/homme/src/share/gllfvremap_mod.F90 b/components/homme/src/share/gllfvremap_mod.F90 index e927f04aba0..a5f9b3033c9 100644 --- a/components/homme/src/share/gllfvremap_mod.F90 +++ b/components/homme/src/share/gllfvremap_mod.F90 @@ -265,14 +265,14 @@ end subroutine gfr_init subroutine gfr_init_hxx() bind(c) #if KOKKOS_TARGET - use control_mod, only: theta_hydrostatic_mode_integer + use control_mod, only: theta_hydrostatic_mode use iso_c_binding, only: c_int interface - subroutine init_gllfvremap_c(nelemd, np, nf, nf_max, theta_hydrostatic_mode_integer, & + subroutine init_gllfvremap_c(nelemd, np, nf, nf_max, theta_hydrostatic_mode, & fv_metdet, g2f_remapd, f2g_remapd, D_f, Dinv_f) bind(c) use iso_c_binding, only: c_int, c_double integer (c_int), value, intent(in) :: nelemd, np, nf, nf_max - integer (c_int), value, intent(in) :: theta_hydrostatic_mode_integer + integer (c_int), value, intent(in) :: theta_hydrostatic_mode real (c_double), dimension(nf*nf,nelemd), intent(in) :: fv_metdet real (c_double), dimension(np,np,nf_max*nf_max), intent(in) :: g2f_remapd real (c_double), dimension(nf_max*nf_max,np,np), intent(in) :: f2g_remapd @@ -280,7 +280,8 @@ subroutine init_gllfvremap_c(nelemd, np, nf, nf_max, theta_hydrostatic_mode_inte end subroutine init_gllfvremap_c end interface integer (c_int) :: thm - thm = theta_hydrostatic_mode_integer + thm = 0 + if (theta_hydrostatic_mode) thm = 1 call init_gllfvremap_c(nelemd, np, gfr%nphys, nphys_max, thm, & gfr%fv_metdet, gfr%g2f_remapd, gfr%f2g_remapd, gfr%D_f, gfr%Dinv_f) #endif diff --git a/components/homme/src/share/namelist_mod.F90 b/components/homme/src/share/namelist_mod.F90 index a3edaa07e23..1d47090182b 100644 --- a/components/homme/src/share/namelist_mod.F90 +++ b/components/homme/src/share/namelist_mod.F90 @@ -41,7 +41,6 @@ module namelist_mod runtype, & integration, & ! integration method theta_hydrostatic_mode, & - theta_hydrostatic_mode_integer, & transport_alg , & ! SE Eulerian, classical SL, cell-integrated SL semi_lagrange_cdr_alg, & ! see control_mod for semi_lagrange_* descriptions semi_lagrange_cdr_check, & @@ -453,10 +452,8 @@ subroutine readnl(par) planar_slice = .false. theta_hydrostatic_mode = .true. ! for preqx, this must be .true. - theta_hydrostatic_mode_integer = 1 ! for preqx, this must be .true. #if ( defined MODEL_THETA_C || defined MODEL_THETA_L ) theta_hydrostatic_mode = .false. ! default NH - theta_hydrostatic_mode_integer = 0 ! default NH #endif @@ -853,10 +850,7 @@ subroutine readnl(par) call MPI_bcast(case_planar_bubble,1,MPIlogical_t,par%root,par%comm,ierr) #endif -if(theta_hydrostatic_mode) theta_hydrostatic_mode_integer = 1 -if(.not. theta_hydrostatic_mode) theta_hydrostatic_mode_integer = 0 call MPI_bcast(theta_hydrostatic_mode ,1,MPIlogical_t,par%root,par%comm,ierr) - call MPI_bcast(theta_hydrostatic_mode_integer ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(transport_alg ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(semi_lagrange_cdr_alg ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(semi_lagrange_cdr_check ,1,MPIlogical_t,par%root,par%comm,ierr) diff --git a/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp b/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp index a50a28d58f5..dd97720f1be 100644 --- a/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/EquationOfState.hpp @@ -23,7 +23,7 @@ class EquationOfState { EquationOfState () = default; - void init (const int theta_hydrostatic_mode, + void init (const bool theta_hydrostatic_mode, const HybridVCoord& hvcoord) { m_theta_hydrostatic_mode = theta_hydrostatic_mode; m_hvcoord = hvcoord; @@ -250,7 +250,7 @@ class EquationOfState { public: - int m_theta_hydrostatic_mode; + bool m_theta_hydrostatic_mode; HybridVCoord m_hvcoord; }; diff --git a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp index ecde17b5b8d..d160e114475 100644 --- a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.cpp @@ -120,7 +120,7 @@ void HyperviscosityFunctorImpl::init_params(const SimulationParams& params) #ifdef HOMMEXX_BFB_TESTING m_process_nh_vars = 1; #else - m_process_nh_vars = static_cast (not params.theta_hydrostatic_mode); + m_process_nh_vars = not params.theta_hydrostatic_mode; #endif } diff --git a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp index 993d525422f..a55ecbb365f 100644 --- a/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp +++ b/components/homme/src/theta-l_kokkos/cxx/HyperviscosityFunctorImpl.hpp @@ -397,7 +397,7 @@ class HyperviscosityFunctorImpl Buffers m_buffers; HybridVCoord m_hvcoord; - int m_process_nh_vars; + bool m_process_nh_vars; // Policies Kokkos::TeamPolicy m_policy_update_states; diff --git a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 index 262ba19f4b7..eae8544ca86 100644 --- a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 +++ b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 @@ -103,12 +103,12 @@ subroutine prim_create_c_data_structures (tl, hvcoord, mp) ! Fill the simulation params structures in C++ test_name = TRIM(test_case) // C_NULL_CHAR - if (disable_diagnostics) disable_diagnostics_int=1 - if (.not.disable_diagnostics) disable_diagnostics_int=0 - if (use_moisture) use_moisture_int=1 - if (.not.use_moisture) use_moisture_int=0 - if(theta_hydrostatic_mode) theta_hydrostatic_mode_int=1 - if(.not.theta_hydrostatic_mode) theta_hydrostatic_mode_int=0 + disable_diagnostics_int = 0 + if (disable_diagnostics) disable_diagnostics_int = 1 + use_moisture_int = 0 + if (use_moisture) use_moisture_int = 1 + theta_hydrostatic_mode_int = 0 + if (theta_hydrostatic_mode) theta_hydrostatic_mode_int = 1 call init_simulation_params_c (vert_remap_q_alg, limiter_option, rsplit, qsplit, tstep_type, & qsize, statefreq, nu, nu_p, nu_q, nu_s, nu_div, nu_top, & @@ -358,17 +358,16 @@ subroutine prim_init_kokkos_functors (allocate_buffer) ! ! Optional Input ! - integer, intent(in), optional :: allocate_buffer ! Whether functor memory buffer should be allocated internally - integer(kind=c_int) :: dummy + logical, intent(in), optional :: allocate_buffer ! Whether functor memory buffer should be allocated internally + integer(kind=c_int) :: ab ! Initialize the C++ functors in the C++ context ! If no argument allocate_buffer is present, ! let Homme internally allocate buffers + ab = 1 if (present(allocate_buffer)) then - call init_functors_c (allocate_buffer) - else - dummy=1; - call init_functors_c (dummy) - endif + if (.not. allocate_buffer) ab = 0 + end if + call init_functors_c (ab) ! Initialize boundary exchange structure in C++ call init_boundary_exchanges_c () diff --git a/components/homme/test_execs/CMakeLists.txt b/components/homme/test_execs/CMakeLists.txt index a3113921b02..a007a5532b6 100644 --- a/components/homme/test_execs/CMakeLists.txt +++ b/components/homme/test_execs/CMakeLists.txt @@ -142,8 +142,11 @@ ADD_CUSTOM_TARGET(test-execs) ADD_CUSTOM_TARGET(check COMMAND ${CMAKE_CTEST_COMMAND} "--output-on-failure") +if(NOT BUILD_HOMME_WITHOUT_PIOLIBRARY) # Force cprnc to be built when make check is run ADD_DEPENDENCIES(check cprnc) +endif() + # Create a target for making the reference data ADD_CUSTOM_TARGET(baseline diff --git a/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt b/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt index 3fbeff9f6f2..bc788462ce6 100644 --- a/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt +++ b/components/homme/test_execs/share_kokkos_ut/CMakeLists.txt @@ -10,7 +10,7 @@ SET(UTILS_TIMING_DIRS ${UTILS_TIMING_SRC_DIR} ${UTILS_TIMING_BIN_DIR}) # Note: need CUDA_BUILD and HOMMEXX_BFB_TESTING here, since the share # unit tests do not include a config.h file SET (COMMON_DEFINITIONS NP=4 NC=4) -IF (CUDA_BUILD OR HIP_BUILD) +IF (CUDA_BUILD OR HIP_BUILD OR SYCL_BUILD) SET(COMMON_DEFINITIONS ${COMMON_DEFINITIONS} HOMMEXX_ENABLE_GPU_F90) ENDIF() IF (HOMMEXX_BFB_TESTING) @@ -158,7 +158,7 @@ ELSE() SET (NUM_CPUS 1) ENDIF() cxx_unit_test (sphere_op_ut "${SPHERE_OP_UT_F90_SRCS}" "${SPHERE_OP_UT_CXX_SRCS}" "${SPHERE_OP_UT_INCLUDE_DIRS}" "${CONFIG_DEFINES}" ${NUM_CPUS}) -endif () +endif () #BFB ### Limiters unit test ### diff --git a/components/homme/test_execs/thetal_kokkos_ut/CMakeLists.txt b/components/homme/test_execs/thetal_kokkos_ut/CMakeLists.txt index 205635e918c..e8bf5e20bd0 100644 --- a/components/homme/test_execs/thetal_kokkos_ut/CMakeLists.txt +++ b/components/homme/test_execs/thetal_kokkos_ut/CMakeLists.txt @@ -11,6 +11,8 @@ SET(UTILS_TIMING_BIN_DIR ${HOMME_BINARY_DIR}/utils/cime/CIME/non_py/src/timing) THETAL_KOKKOS_SETUP() # This is needed to compile the lib and test executables with the correct options +#these vars shared between all targets, so changing one var +#for one test only won't work, config is built once and for the last test SET(THIS_CONFIG_IN ${HOMME_SOURCE_DIR}/src/theta-l_kokkos/config.h.cmake.in) SET(THIS_CONFIG_HC ${CMAKE_CURRENT_BINARY_DIR}/config.h.c) SET(THIS_CONFIG_H ${CMAKE_CURRENT_BINARY_DIR}/config.h) @@ -18,6 +20,7 @@ SET (NUM_POINTS 4) SET (NUM_PLEV 12) SET (QSIZE_D 4) SET (PIO_INTERP TRUE) + HommeConfigFile (${THIS_CONFIG_IN} ${THIS_CONFIG_HC} ${THIS_CONFIG_H} ) ADD_LIBRARY(thetal_kokkos_ut_lib diff --git a/components/homme/test_execs/thetal_kokkos_ut/forcing_ut.cpp b/components/homme/test_execs/thetal_kokkos_ut/forcing_ut.cpp index 5e4c51c7ca1..fb301166f42 100644 --- a/components/homme/test_execs/thetal_kokkos_ut/forcing_ut.cpp +++ b/components/homme/test_execs/thetal_kokkos_ut/forcing_ut.cpp @@ -160,8 +160,8 @@ TEST_CASE("forcing", "forcing") { std::cout << "Testing tracers forcing.\n"; for (const bool hydrostatic : {true,false}) { std::cout << " -> hydrostatic mode: " << (hydrostatic ? "true" : "false") << "\n"; - for (const MoistDry moisture : {MoistDry::DRY,MoistDry::MOIST}) { - std::cout << " -> moisture: " << (moisture==MoistDry::MOIST ? "moist" : "dry") << "\n"; + for (const bool use_moisture: {false,true}) { + std::cout << " -> moisture: " << (use_moisture ? "moist" : "dry") << "\n"; for (const bool adjustment : {true,false}) { std::cout << " -> adjustment: " << (adjustment ? "true" : "false") << "\n"; @@ -200,8 +200,8 @@ TEST_CASE("forcing", "forcing") { ff.init_buffers(fbm); // Run tracers forcing (cxx and f90) - ff.tracers_forcing(dt,np1,np1_qdp,adjustment,moisture); - tracers_forcing_f90(dt,np1+1,np1_qdp+1,hydrostatic,moisture==MoistDry::MOIST,adjustment); + ff.tracers_forcing(dt,np1,np1_qdp,adjustment,use_moisture); + tracers_forcing_f90(dt,np1+1,np1_qdp+1,hydrostatic,use_moisture,adjustment); // Compare answers Kokkos::deep_copy(h_dp,state.m_dp3d); diff --git a/components/homme/test_execs/thetal_kokkos_ut/gllfvremap_ut.cpp b/components/homme/test_execs/thetal_kokkos_ut/gllfvremap_ut.cpp index 0f14b0c3e55..cf9db941ea1 100644 --- a/components/homme/test_execs/thetal_kokkos_ut/gllfvremap_ut.cpp +++ b/components/homme/test_execs/thetal_kokkos_ut/gllfvremap_ut.cpp @@ -183,7 +183,7 @@ struct Session { p.qsize = qsize; p.hypervis_scaling = 0; p.transport_alg = 0; - p.moisture = MoistDry::MOIST; + p.use_moisture = true; p.theta_hydrostatic_mode = false; p.scale_factor = is_sphere ? PhysicalConstants::rearth0 : 1; p.laplacian_rigid_factor = is_sphere ? 1/p.scale_factor : 0; @@ -725,7 +725,7 @@ static void test_get_temperature (Session& s) { const auto& sp = c.get(); EquationOfState eos; eos.init(theta_hydrostatic_mode, s.h); ElementOps ops; ops.init(s.h); - const bool use_moisture = sp.moisture == MoistDry::MOIST; + const bool use_moisture = sp.use_moisture; const auto state = c.get(); const auto tracers = c.get(); const auto dp3d = state.m_dp3d; From 7b3460900ee33d293f24e173f0ccc00fcea0c233 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 11 Sep 2024 15:35:38 +0000 Subject: [PATCH 151/529] make consistent change --- .../eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 b/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 index 3ce903b611d..aa6e537baa4 100644 --- a/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 +++ b/components/eamxx/src/dynamics/homme/interface/homme_driver_mod.F90 @@ -192,7 +192,7 @@ subroutine prim_init_model_f90 () bind(c) elem, hybrid, hvcoord, deriv, tl ! Local variable - integer, parameter :: allocate_buffer = 0 + logical, parameter :: allocate_buffer = 0 if (.not. is_data_structures_inited) then call abortmp ("Error! 'prim_init_data_structures_f90' has not been called yet.\n") From 08a386020a7b9664e79e88fda406a64fd0797c1e Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 17 Sep 2024 14:43:34 +0000 Subject: [PATCH 152/529] sync with homme branch --- .../homme/src/share/cxx/ExecSpaceDefs.cpp | 2 +- .../share/cxx/utilities/scream_tridiag.hpp | 21 +++++++++++++++++-- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.cpp b/components/homme/src/share/cxx/ExecSpaceDefs.cpp index c9ca8a0ecd9..4f3d97135fe 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.cpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.cpp @@ -176,7 +176,7 @@ team_num_threads_vectors_for_gpu ( num_vectors ); } #else - return std::make_pair(4,16); + return std::make_pair(16,8); #endif } diff --git a/components/homme/src/share/cxx/utilities/scream_tridiag.hpp b/components/homme/src/share/cxx/utilities/scream_tridiag.hpp index e18bbc4e7e2..26221db3955 100644 --- a/components/homme/src/share/cxx/utilities/scream_tridiag.hpp +++ b/components/homme/src/share/cxx/utilities/scream_tridiag.hpp @@ -128,6 +128,10 @@ int get_thread_id_within_team_gpu (const TeamMember& team) { // Can't use team.team_rank() here because vector direction also uses physical // threads but TeamMember types don't expose that information. return blockDim.x * threadIdx.y + threadIdx.x; +#elif defined(__SYCL_DEVICE_ONLY__) + auto item = team.item(); + return static_cast(item.get_local_range(1) * item.get_local_id(0) + + item.get_local_id(1)); #else assert(0); return -1; @@ -138,6 +142,9 @@ template KOKKOS_FORCEINLINE_FUNCTION int get_team_nthr_gpu (const TeamMember& team) { #if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ return blockDim.x * blockDim.y; +#elif defined __SYCL_DEVICE_ONLY__ + auto item = team.item(); + return static_cast(item.get_local_range(0) * item.get_local_range(1)); #else assert(0); return -1; @@ -161,6 +168,16 @@ KOKKOS_FORCEINLINE_FUNCTION int get_team_nthr (const Kokkos::Impl::HIPTeamMember& team) { return get_team_nthr_gpu(team); } #endif // KOKKOS_ENABLE_HIP + +#ifdef KOKKOS_ENABLE_SYCL +KOKKOS_FORCEINLINE_FUNCTION +int get_thread_id_within_team (const Kokkos::Impl::SYCLTeamMember& team) +{ return get_thread_id_within_team_gpu(team); } +KOKKOS_FORCEINLINE_FUNCTION +int get_team_nthr (const Kokkos::Impl::SYCLTeamMember& team) +{ return get_team_nthr_gpu(team); } +#endif // KOKKOS_ENABLE_SYCL + template KOKKOS_INLINE_FUNCTION const T& min (const T& a, const T& b) { return a < b ? a : b; } @@ -634,7 +651,7 @@ void bfb (const TeamMember& team, const auto f = [&] (const int& j) { impl::bfb_thomas_solve(dl, d, du, Kokkos::subview(X , Kokkos::ALL(), j)); }; - Kokkos::parallel_for(Kokkos::TeamThreadRange(team, nrhs), f); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nrhs), f); } template @@ -664,7 +681,7 @@ void bfb (const TeamMember& team, subview(du, ALL(), j), subview(X , ALL(), j)); }; - Kokkos::parallel_for(Kokkos::TeamThreadRange(team, nrhs), f); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nrhs), f); } } // namespace tridiag From b9062f11f7717ba1f335a32701dd45f77c9159c0 Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Fri, 9 Jun 2023 13:56:52 -0500 Subject: [PATCH 153/529] Add RK4 stage time evaluation factors --- components/mpas-ocean/src/Registry.xml | 4 ++++ .../mpas_ocn_time_integration_rk4.F | 19 ++++++++++++++++++- .../mpas_ocn_time_integration_si.F | 7 +++++++ .../mpas_ocn_time_integration_split.F | 7 +++++++ 4 files changed, 36 insertions(+), 1 deletion(-) diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 2a21e22f40d..382344585d8 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -4130,6 +4130,10 @@ description="Multiplication factors to smooth ssh at coastlines for SAL caculation" packages="tidalPotentialForcingPKG" /> + domain % blocklist do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool) + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', forcingTimeIncrement) + forcingTimeIncrement = forcingTimeIncrementRK4(rk_step) + call ocn_time_integrator_rk4_compute_vel_tends(domain, block, dt, rk_substep_weights(rk_step), domain % dminfo, err ) call ocn_time_integrator_rk4_compute_thick_tends( block, dt, rk_substep_weights(rk_step), err ) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_si.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_si.F index 9529fbdc6ea..103dadda752 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_si.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_si.F @@ -380,6 +380,8 @@ subroutine ocn_time_integrator_si(domain, dt)!{{{ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracersNew + real (kind=RKIND), pointer :: forcingTimeIncrement + ! Remap variables real (kind=RKIND), dimension(:,:), pointer :: & layerThicknessLagNew @@ -507,6 +509,11 @@ subroutine ocn_time_integrator_si(domain, dt)!{{{ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracersNew, 2) + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', & + forcingTimeIncrement) + + forcingTimeIncrement = 0.0_RKIND + allocate(bottomDepthEdge(nEdgesAll+1)) if (config_transport_tests_flow_id > 0) then diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_split.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_split.F index 653d8819813..d60098a8aea 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_split.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_split.F @@ -280,6 +280,8 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracersNew + real (kind=RKIND), pointer :: forcingTimeIncrement + ! Remap variables real (kind=RKIND), dimension(:,:), pointer :: & layerThicknessLagNew @@ -398,6 +400,11 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{ allocate(baroclinicThickness(nEdgesAll+1)) + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', & + forcingTimeIncrement) + + forcingTimeIncrement = 0.0_RKIND + if (config_transport_tests_flow_id > 0) then ! This is a transport test. Write advection velocity from prescribed ! flow field. From 1d28e130341918889166811231d911e58ca8bfaa Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Fri, 9 Jun 2023 13:58:47 -0500 Subject: [PATCH 154/529] Add RK4 stage time evaluation to manufactured solution --- .../shared/mpas_ocn_manufactured_solution.F | 26 ++++++++++++++++--- .../mpas-ocean/src/shared/mpas_ocn_tendency.F | 6 +++-- 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F index e9ad6786103..32efb9bf8a8 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F @@ -76,7 +76,13 @@ module ocn_manufactured_solution ! !----------------------------------------------------------------------- - subroutine ocn_manufactured_solution_tend_thick(tend, err)!{{{ + subroutine ocn_manufactured_solution_tend_thick(forcingPool, tend, err)!{{{ + + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + + type (mpas_pool_type), intent(in) :: forcingPool !----------------------------------------------------------------- ! input/output variables @@ -97,6 +103,7 @@ subroutine ocn_manufactured_solution_tend_thick(tend, err)!{{{ integer :: iCell, kmin, kmax, k real (kind=RKIND) :: phase, time + real (kind=RKIND), pointer :: forcingTimeIncrement ! End preamble !------------- @@ -104,7 +111,9 @@ subroutine ocn_manufactured_solution_tend_thick(tend, err)!{{{ if (.not. config_use_manufactured_solution) return - time = daysSinceStartOfSim*86400.0_RKIND + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', forcingTimeIncrement) + + time = daysSinceStartOfSim*86400.0_RKIND + forcingTimeIncrement do iCell = 1,nCellsOwned @@ -137,7 +146,13 @@ end subroutine ocn_manufactured_solution_tend_thick!}}} !> This routine computes the velocity tendency for the manufactured solution ! !----------------------------------------------------------------------- - subroutine ocn_manufactured_solution_tend_vel(tend, err)!{{{ + subroutine ocn_manufactured_solution_tend_vel(forcingPool, tend, err)!{{{ + + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + + type (mpas_pool_type), intent(in) :: forcingPool !----------------------------------------------------------------- ! input/output variables @@ -158,6 +173,7 @@ subroutine ocn_manufactured_solution_tend_vel(tend, err)!{{{ integer :: iEdge, kmin, kmax, k real (kind=RKIND) :: phase, u, v, time + real (kind=RKIND), pointer :: forcingTimeIncrement ! End preamble !----------------------------------------------------------------- @@ -165,7 +181,9 @@ subroutine ocn_manufactured_solution_tend_vel(tend, err)!{{{ if (.not. config_use_manufactured_solution) return - time = daysSinceStartOfSim*86400.0_RKIND + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', forcingTimeIncrement) + + time = daysSinceStartOfSim*86400.0_RKIND + forcingTimeIncrement do iEdge = 1, nEdgesOwned diff --git a/components/mpas-ocean/src/shared/mpas_ocn_tendency.F b/components/mpas-ocean/src/shared/mpas_ocn_tendency.F index f85427913b0..e1c1509a1cd 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_tendency.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_tendency.F @@ -264,7 +264,8 @@ subroutine ocn_tend_thick(tendPool, forcingPool)!{{{ tendThick, err) ! Compute thickness tendency to manufactured solution - call ocn_manufactured_solution_tend_thick(tendThick, err) + call ocn_manufactured_solution_tend_thick(forcingPool, & + tendThick, err) #ifdef MPAS_OPENACC !$acc exit data copyout(tendThick, surfaceThicknessFlux, surfaceThicknessFluxRunoff, & @@ -493,7 +494,8 @@ subroutine ocn_tend_vel(domain, tendPool, statePool, forcingPool, & layerThickEdgeMean, tendVel, err) ! Compute tendency term for manufactured solution - call ocn_manufactured_solution_tend_vel(tendVel, err) + call ocn_manufactured_solution_tend_vel(forcingPool, & + tendVel, err) ! vertical mixing treated implicitly in a later routine ! adjust total velocity tendency based on wetting/drying From 4039c01f6b88a2027f0711c40bb6c160a8102668 Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Fri, 9 Jun 2023 13:59:45 -0500 Subject: [PATCH 155/529] Add RK stage time evaluation to tidal potential --- .../mpas-ocean/src/shared/mpas_ocn_vel_tidal_potential.F | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_vel_tidal_potential.F b/components/mpas-ocean/src/shared/mpas_ocn_vel_tidal_potential.F index 211538ac0a7..4eba6e2c0b4 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_vel_tidal_potential.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_vel_tidal_potential.F @@ -80,6 +80,8 @@ module ocn_vel_tidal_potential tidalConstituentAstronomical, &! tidalConstituentNodalPhase ! + real (kind=RKIND), pointer :: forcingTimeIncrement + real (kind=RKIND), dimension(:,:), pointer :: & latitudeFunction @@ -273,8 +275,8 @@ subroutine ocn_compute_tidal_potential_forcing(err)!{{{ err = 0 if (tidalPotentialOff) return - ramp = tanh((2.0_RKIND*daysSinceStartOfSim)/tidalPotRamp) - t = daysSinceStartOfSim*86400.0_RKIND + t = daysSinceStartOfSim*86400.0_RKIND + forcingTimeIncrement + ramp = tanh((2.0_RKIND*t/86400.0_RKIND)/tidalPotRamp) do iCell = 1, nCellsAll tidalPotEta(iCell) = 0.0_RKIND @@ -416,6 +418,9 @@ subroutine ocn_vel_tidal_potential_init(domain,err)!{{{ call mpas_pool_get_array(forcingPool, & 'tidalPotentialLatitudeFunction', & latitudeFunction) + call mpas_pool_get_array(forcingPool, & + 'forcingTimeIncrement', & + forcingTimeIncrement) call mpas_set_time(refTime, & dateTimeString=config_tidal_potential_reference_time) From 710a36914a98f2d96960a3a0486345b7f026854c Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Fri, 9 Jun 2023 16:52:17 -0500 Subject: [PATCH 156/529] Add RK4 stage time evaluation to time varying forcing --- .../src/framework/mpas_forcing.F | 46 ++++++++++-- .../src/mode_forward/mpas_ocn_forward_mode.F | 18 ++++- .../mode_forward/mpas_ocn_time_integration.F | 6 +- .../mpas_ocn_time_integration_rk4.F | 3 + .../shared/mpas_ocn_time_varying_forcing.F | 72 ++++++++++++++++--- 5 files changed, 124 insertions(+), 21 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_forcing.F b/components/mpas-framework/src/framework/mpas_forcing.F index 950b103604c..0983e1db890 100644 --- a/components/mpas-framework/src/framework/mpas_forcing.F +++ b/components/mpas-framework/src/framework/mpas_forcing.F @@ -35,7 +35,8 @@ module mpas_forcing mpas_forcing_init_field_data, & mpas_forcing_get_forcing, & mpas_forcing_get_forcing_time, & - mpas_forcing_write_restart_times + mpas_forcing_write_restart_times, & + mpas_advance_forcing_clock contains @@ -1193,7 +1194,7 @@ subroutine mpas_forcing_get_forcing(&!{{{ if (trim(forcingGroup % forcingGroupName) == trim(forcingGroupName)) then ! advance the forcing time - call advance_forcing_clock(forcingGroup, dt) + call mpas_advance_forcing_clock(forcingGroup, dt) ! cycle the forcing clock if (forcingGroup % forcingCycleUse) then @@ -1230,7 +1231,7 @@ end subroutine mpas_forcing_get_forcing!}}} !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ! -! advance_forcing_clock +! mpas_advance_forcing_clock ! !> \brief set the forcing clock !> \author Adrian K. Turner, LANL @@ -1241,7 +1242,7 @@ end subroutine mpas_forcing_get_forcing!}}} ! !----------------------------------------------------------------------- - subroutine advance_forcing_clock(&!{{{ + subroutine mpas_advance_forcing_clock(&!{{{ forcingGroup, & dt) @@ -1254,11 +1255,44 @@ subroutine advance_forcing_clock(&!{{{ type(MPAS_TimeInterval_type) :: & timeStep ! time step interval + ! assuming it is not possible to give dts of months or years + integer :: DD, H, M, S, S_n, S_d, foundNumAndDen, powerOfTen + + real(kind=RKIND) :: factor + + DD = dt / 86400_RKIND + H = dt / 3600_RKIND + M = dt / 60_RKIND + S = dt + S_n = 0 + S_d = 0 + if (abs(real(S) - dt) > 1.e-10) then !the time step has decimals + S = 0 + foundNumAndDen = 0 + powerOfTen = 1 + factor = 10_RKIND + S_n = abs(dt) * factor + S_d = factor + do while (foundNumAndDen == 0 .and. powerOfTen < 11) + if (abs(real(S_n)/real(S_d) - abs(dt)) < 1.e-10) then + foundNumAndDen = 1 + else + powerOfTen = powerOfTen + 1 + factor = 10_RKIND ** powerOfTen + S_n = abs(dt) * factor + S_d = factor + end if + end do + if (dt < 0.0_RKIND) then + S_n = - S_n + end if + end if + ! increment clock with timestep - call mpas_set_timeInterval(timeStep, dt=dt) + call mpas_set_timeInterval(timeStep, DD=DD, H=H, M=M, S=S, S_n=S_n, S_d=S_d) call mpas_advance_clock(forcingGroup % forcingClock, timeStep) - end subroutine advance_forcing_clock!}}} + end subroutine mpas_advance_forcing_clock!}}} !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ! diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F index d5ba6b08eb6..b69bd8190fb 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F @@ -26,6 +26,7 @@ module ocn_forward_mode use mpas_stream_manager use mpas_timekeeping use mpas_dmpar + use mpas_forcing use mpas_timer use mpas_log use mpas_decomp @@ -94,6 +95,7 @@ module ocn_forward_mode use ocn_forcing use ocn_time_varying_forcing + use ocn_framework_forcing use ocn_constants use ocn_config @@ -664,7 +666,12 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{ ! initialize time-varying forcing call ocn_time_varying_forcing_init(domain) - call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) + + ! if not using RK4, calculate time varying forcing terms once per + ! time-step as opposed at each RK substage as implemented in RK4 + if (timeIntegratorChoice /= 4) then + call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) + endif ! During integration, time level 1 stores the model state at the beginning of the ! time step, and time level 2 stores the state advanced dt in time by timestep(...) @@ -834,7 +841,14 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{ endif ! read in next time level data required for time-varying forcing - call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) + if (timeIntegratorChoice /= 4) then + ! if not using RK4, calculate time varying forcing terms once per + ! time-step as opposed at each RK substage as implemented in RK4 + call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) + else + ! increment forcing clock to next time-step + call mpas_advance_forcing_clock(forcingGroupHead, dt) + endif ! Validate that the state is OK to run with for the next timestep. call ocn_validate_state(domain, timeLevel=1) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F index 68edc933535..46142b6e4d7 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F @@ -48,6 +48,9 @@ module ocn_time_integration ! !-------------------------------------------------------------------- + ! Enum for selecting different time integrators + integer, public :: timeIntegratorChoice + !-------------------------------------------------------------------- ! ! Public member functions @@ -63,9 +66,6 @@ module ocn_time_integration ! !-------------------------------------------------------------------- - ! Enum for selecting different time integrators - integer :: timeIntegratorChoice - integer, parameter :: & timeIntUnknown = 0, &! unknown or undefined timeIntSplitExplicit = 1, &! split-explicit diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F index c52c40d6ea3..04633f943c8 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F @@ -43,6 +43,7 @@ module ocn_time_integration_rk4 use ocn_effective_density_in_land_ice use ocn_surface_land_ice_fluxes use ocn_transport_tests + use ocn_time_varying_forcing use ocn_subgrid @@ -492,6 +493,8 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ ! which is the same as k_j / h. call mpas_timer_start("RK4 vel/thick tendency computations") + call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) + block => domain % blocklist do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F b/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F index 8e64618a27a..4fbd83b3c30 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F @@ -258,13 +258,21 @@ subroutine atmospheric_forcing(streamManager, domain, simulationClock)!{{{ character(len=StrKIND) :: timeStamp - real (kind=RKIND) :: dtSim + real (kind=RKIND) :: dtSim, dtSimReverse + + real (kind=RKIND), pointer :: forcingTimeIncrement + + type (mpas_pool_type), pointer :: forcingPool integer :: err + call mpas_pool_get_subpool(domain % blocklist % structs, 'forcing', forcingPool) + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', forcingTimeIncrement) + ! convert config_dt to real call mpas_set_timeInterval(timeStepESMF, timeString=config_dt,ierr=err) - call mpas_get_timeInterval(timeStepESMF, dt=dtSim) + dtSim = forcingTimeIncrement + dtSimReverse = -dtSim ! use the forcing layer to get data call MPAS_forcing_get_forcing(& @@ -277,8 +285,18 @@ subroutine atmospheric_forcing(streamManager, domain, simulationClock)!{{{ forcingGroupHead, & ! forcingGroupHead "ocn_atmospheric_forcing", & ! forcingGroupName currentForcingTime) ! forcingTime - !call mpas_get_time(curr_time=currentForcingTime, dateTimeString=timeStamp, ierr=err) - !call mpas_log_write('Forcing time ' // trim(timeStamp)) + call mpas_get_time(curr_time=currentForcingTime, dateTimeString=timeStamp, ierr=err) + call mpas_log_write('Forcing time for atmospheric forcing' // trim(timeStamp)) + + call mpas_advance_forcing_clock(forcingGroupHead, dtSimReverse) + + call MPAS_forcing_get_forcing_time(& + forcingGroupHead, & ! forcingGroupHead + "ocn_atmospheric_forcing", & ! forcingGroupName + currentForcingTime) ! forcingTime + + call mpas_get_time(curr_time=currentForcingTime, dateTimeString=timeStamp, ierr=err) + call mpas_log_write('Forcing time reversed for atmospheric forcing' // trim(timeStamp)) ! perform post forcing block => domain % blocklist @@ -332,7 +350,10 @@ subroutine post_atmospheric_forcing(block)!{{{ windStressCoefficient, & rhoAir, & ramp, & - windStressCoefficientLimit + windStressCoefficientLimit, & + t + + real(kind=RKIND), pointer :: forcingTimeIncrement integer, pointer :: & nCells @@ -354,12 +375,14 @@ subroutine post_atmospheric_forcing(block)!{{{ call MPAS_pool_get_array(timeVaryingForcingPool, "atmosPressure", atmosPressure) call MPAS_pool_get_array(forcingPool, "atmosphericPressure", atmosphericPressure) + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', forcingTimeIncrement) rhoAir = 1.225_RKIND windStressCoefficientLimit = 0.0035_RKIND if (daysSinceStartOfSim >= config_time_varying_atmospheric_forcing_ramp_delay) then - ramp = tanh((2.0_RKIND*(daysSinceStartOfSim-config_time_varying_atmospheric_forcing_ramp_delay)) & + t = (daysSinceStartOfSim*86400_RKIND + forcingTimeIncrement)/86400.0_RKIND + ramp = tanh((2.0_RKIND*(t-config_time_varying_atmospheric_forcing_ramp_delay)) & /config_time_varying_atmospheric_forcing_ramp) else ramp = 0.0_RKIND @@ -483,11 +506,13 @@ subroutine land_ice_forcing(streamManager, domain, simulationClock)!{{{ type (block_type), pointer :: block -! character(len=StrKIND), pointer :: config_dt + character(len=StrKIND) :: timeStamp type (MPAS_timeInterval_type) :: timeStepESMF - real (kind=RKIND) :: dtSim + real (kind=RKIND) :: dtSim, dtSimReverse + + real (kind=RKIND), pointer :: forcingTimeIncrement integer :: err @@ -512,14 +537,41 @@ subroutine land_ice_forcing(streamManager, domain, simulationClock)!{{{ integer :: & iCell + call mpas_pool_get_subpool(domain % blocklist % structs, 'forcing', forcingPool) + call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', forcingTimeIncrement) + ! convert config_dt to real call mpas_set_timeInterval(timeStepESMF, timeString=config_dt,ierr=err) call mpas_get_timeInterval(timeStepESMF, dt=dtSim) + dtSim = forcingTimeIncrement + dtSimReverse = -dtSim + ! use the forcing layer to get data - call mpas_forcing_get_forcing(forcingGroupHead, "ocn_land_ice_forcing", streamManager, dtSim) + call MPAS_forcing_get_forcing(& + forcingGroupHead, & ! forcingGroupHead + "ocn_land_ice_forcing", & ! forcingGroupName + streamManager, & ! streamManager + dtSim) ! dt + + call MPAS_forcing_get_forcing_time(& + forcingGroupHead, & ! forcingGroupHead + "ocn_land_ice_forcing", & ! forcingGroupName + currentForcingTime) ! forcingTime + + call mpas_get_time(curr_time=currentForcingTime, dateTimeString=timeStamp, ierr=err) + call mpas_log_write('Forcing time for land ice forcing' // trim(timeStamp)) + + + call mpas_advance_forcing_clock(forcingGroupHead, dtSimReverse) + + call MPAS_forcing_get_forcing_time(& + forcingGroupHead, & ! forcingGroupHead + "ocn_land_ice_forcing", & ! forcingGroupName + currentForcingTime) ! forcingTime - call mpas_forcing_get_forcing_time(forcingGroupHead, "ocn_land_ice_forcing", currentForcingTime) + call mpas_get_time(curr_time=currentForcingTime, dateTimeString=timeStamp, ierr=err) + call mpas_log_write('Forcing time reversed for land ice forcing' // trim(timeStamp)) block => domain % blocklist do while (associated(block)) From 645682682cb170379fbc0d6f6a44d293e8a09232 Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Tue, 13 Jun 2023 10:43:58 -0500 Subject: [PATCH 157/529] Fix unassociated forcingHead when time varying forcing is off --- .../mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F index b69bd8190fb..7fa5a3e7b15 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F @@ -846,8 +846,11 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{ ! time-step as opposed at each RK substage as implemented in RK4 call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) else - ! increment forcing clock to next time-step - call mpas_advance_forcing_clock(forcingGroupHead, dt) + if (config_use_time_varying_atmospheric_forcing .or. & + config_use_time_varying_land_ice_forcing) then + ! increment forcing clock to next time-step + call mpas_advance_forcing_clock(forcingGroupHead, dt) + endif endif ! Validate that the state is OK to run with for the next timestep. From e6630901209d2e7910deee188c822317411e858c Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Thu, 22 Jun 2023 10:24:46 -0500 Subject: [PATCH 158/529] Fix ordering of RK4 time varying forcing call --- .../src/mode_forward/mpas_ocn_time_integration_rk4.F | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F index 04633f943c8..eaae3771e8d 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F @@ -493,16 +493,19 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ ! which is the same as k_j / h. call mpas_timer_start("RK4 vel/thick tendency computations") - call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) - block => domain % blocklist do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool) call mpas_pool_get_array(forcingPool, 'forcingTimeIncrement', forcingTimeIncrement) forcingTimeIncrement = forcingTimeIncrementRK4(rk_step) - - call ocn_time_integrator_rk4_compute_vel_tends(domain, block, dt, rk_substep_weights(rk_step), domain % dminfo, err ) + block => block % next + end do + call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) + + block => domain % blocklist + do while (associated(block)) + call ocn_time_integrator_rk4_compute_vel_tends(domain, block, dt, rk_substep_weights(rk_step), domain % dminfo, err ) call ocn_time_integrator_rk4_compute_thick_tends( block, dt, rk_substep_weights(rk_step), err ) block => block % next end do From 3b91be07a8c523a591bcfe14e446d36e0ee8a54c Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Mon, 3 Jul 2023 10:14:51 -0500 Subject: [PATCH 159/529] Apply fix in mpas_set_timeInterval for negative fractional timesteps --- .../src/framework/mpas_forcing.F | 73 ++++++++++--------- .../src/framework/mpas_timekeeping.F | 8 ++ .../shared/mpas_ocn_time_varying_forcing.F | 4 +- 3 files changed, 49 insertions(+), 36 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_forcing.F b/components/mpas-framework/src/framework/mpas_forcing.F index 0983e1db890..67829b5126b 100644 --- a/components/mpas-framework/src/framework/mpas_forcing.F +++ b/components/mpas-framework/src/framework/mpas_forcing.F @@ -1255,41 +1255,44 @@ subroutine mpas_advance_forcing_clock(&!{{{ type(MPAS_TimeInterval_type) :: & timeStep ! time step interval - ! assuming it is not possible to give dts of months or years - integer :: DD, H, M, S, S_n, S_d, foundNumAndDen, powerOfTen - - real(kind=RKIND) :: factor - - DD = dt / 86400_RKIND - H = dt / 3600_RKIND - M = dt / 60_RKIND - S = dt - S_n = 0 - S_d = 0 - if (abs(real(S) - dt) > 1.e-10) then !the time step has decimals - S = 0 - foundNumAndDen = 0 - powerOfTen = 1 - factor = 10_RKIND - S_n = abs(dt) * factor - S_d = factor - do while (foundNumAndDen == 0 .and. powerOfTen < 11) - if (abs(real(S_n)/real(S_d) - abs(dt)) < 1.e-10) then - foundNumAndDen = 1 - else - powerOfTen = powerOfTen + 1 - factor = 10_RKIND ** powerOfTen - S_n = abs(dt) * factor - S_d = factor - end if - end do - if (dt < 0.0_RKIND) then - S_n = - S_n - end if - end if + !! assuming it is not possible to give dts of months or years + !integer :: DD, H, M, S, S_n, S_d, foundNumAndDen, powerOfTen + + !real(kind=RKIND) :: factor + + !DD = dt / 86400_RKIND + !H = dt / 3600_RKIND + !M = dt / 60_RKIND + !S = dt + !S_n = 0 + !S_d = 0 + !if (abs(real(S) - dt) > 1.e-10) then !the time step has decimals + ! S = 0 + ! foundNumAndDen = 0 + ! powerOfTen = 1 + ! factor = 10_RKIND + ! S_n = abs(dt) * factor + ! S_d = factor + ! do while (foundNumAndDen == 0 .and. powerOfTen < 11) + ! if (abs(real(S_n)/real(S_d) - abs(dt)) < 1.e-10) then + ! foundNumAndDen = 1 + ! else + ! powerOfTen = powerOfTen + 1 + ! factor = 10_RKIND ** powerOfTen + ! S_n = abs(dt) * factor + ! S_d = factor + ! end if + ! end do + ! if (dt < 0.0_RKIND) then + ! S_n = - S_n + ! end if + !end if ! increment clock with timestep - call mpas_set_timeInterval(timeStep, DD=DD, H=H, M=M, S=S, S_n=S_n, S_d=S_d) + ! call mpas_set_timeInterval(timeStep, DD=DD, H=H, M=M, S=S, S_n=S_n, S_d=S_d) + call mpas_set_timeInterval(timeStep, dt=dt) + !call mpas_log_write('jl time step $i $i $i', intArgs=(/S, S_n, S_d /)) + !call mpas_log_write('time step $i $i $i', intArgs=(/int(timeStep%ti%basetime%S), int(timeStep%ti%basetime%Sn), int(timeStep%ti%basetime%Sd) /)) call mpas_advance_clock(forcingGroup % forcingClock, timeStep) end subroutine mpas_advance_forcing_clock!}}} @@ -1631,8 +1634,10 @@ subroutine get_interpolants_linear(interpolants, forcingStream, currentTime)!{{{ call mpas_get_timeInterval(diff1, forcingStream % forcingTimes(1), dt=diffr1) call mpas_get_timeInterval(diff2, currentTime, dt=diffr2) + !call mpas_log_write('diffr2 $r, diffr, $r', realArgs=(/ diffr2, diffr /)) interpolants(1) = diffr2 / diffr interpolants(2) = 1.0_RKIND - interpolants(1) !diffr1 / diffr + end subroutine get_interpolants_linear!}}} @@ -1646,7 +1651,7 @@ end subroutine get_interpolants_linear!}}} !> \details !> Given the current time and forcing times calculate the correct !> interpolants with piecewise constant interpolation -! + !----------------------------------------------------------------------- subroutine get_interpolants_constant(interpolants, forcingStream, currentTime)!{{{ diff --git a/components/mpas-framework/src/framework/mpas_timekeeping.F b/components/mpas-framework/src/framework/mpas_timekeeping.F index 37a24d77358..57d9651335a 100644 --- a/components/mpas-framework/src/framework/mpas_timekeeping.F +++ b/components/mpas-framework/src/framework/mpas_timekeeping.F @@ -1427,6 +1427,8 @@ subroutine mpas_set_timeInterval(interval, YY, MM, DD, H, M, S, S_n, S_d, S_i8, timeString_ = timeString end if + !call mpas_log_write('timeString_ '//trim(timeString_)) + numerator = 0 denominator = 1 @@ -1519,6 +1521,12 @@ subroutine mpas_set_timeInterval(interval, YY, MM, DD, H, M, S, S_n, S_d, S_i8, return end if + if (sec < 0) then + numerator = -numerator + end if + + !call mpas_log_write('sec $i, num $i, denom $i', intArgs=(/int(sec),numerator,denominator/)) + call ESMF_TimeIntervalSet(interval % ti, YY=year, MM=month, D=day, H=hour, M=min, S_i8=sec, Sn=numerator, Sd=denominator, rc=ierr) else diff --git a/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F b/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F index 4fbd83b3c30..2afa3064050 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_time_varying_forcing.F @@ -286,7 +286,7 @@ subroutine atmospheric_forcing(streamManager, domain, simulationClock)!{{{ "ocn_atmospheric_forcing", & ! forcingGroupName currentForcingTime) ! forcingTime call mpas_get_time(curr_time=currentForcingTime, dateTimeString=timeStamp, ierr=err) - call mpas_log_write('Forcing time for atmospheric forcing' // trim(timeStamp)) + !call mpas_log_write('Forcing time for atmospheric forcing' // trim(timeStamp)) call mpas_advance_forcing_clock(forcingGroupHead, dtSimReverse) @@ -296,7 +296,7 @@ subroutine atmospheric_forcing(streamManager, domain, simulationClock)!{{{ currentForcingTime) ! forcingTime call mpas_get_time(curr_time=currentForcingTime, dateTimeString=timeStamp, ierr=err) - call mpas_log_write('Forcing time reversed for atmospheric forcing' // trim(timeStamp)) + !call mpas_log_write('Forcing time reversed for atmospheric forcing' // trim(timeStamp)) ! perform post forcing block => domain % blocklist From 4a5c621d6aeed5b333671545ad20286994477298 Mon Sep 17 00:00:00 2001 From: Chloe Date: Wed, 18 Sep 2024 10:03:19 -0700 Subject: [PATCH 160/529] remove conditional if (create_glacier_mec_landunit) then to include ELM/GLC SMB QICE fields - makes QICE fields in h0 by default --- .../elm/src/data_types/ColumnDataType.F90 | 30 +++++++++---------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/components/elm/src/data_types/ColumnDataType.F90 b/components/elm/src/data_types/ColumnDataType.F90 index 724cefb5cfd..3cec1d2d303 100644 --- a/components/elm/src/data_types/ColumnDataType.F90 +++ b/components/elm/src/data_types/ColumnDataType.F90 @@ -5843,22 +5843,20 @@ subroutine col_wf_init(this, begc, endc) avgflag='A', long_name='column-integrated snow freezing rate', & ptr_col=this%qflx_snofrz, set_lake=spval, c2l_scale_type='urbanf', default='inactive') - if (create_glacier_mec_landunit) then - this%qflx_glcice(begc:endc) = spval - call hist_addfld1d (fname='QICE', units='mm/s', & - avgflag='A', long_name='ice growth/melt', & - ptr_col=this%qflx_glcice, l2g_scale_type='ice') - - this%qflx_glcice_frz(begc:endc) = spval - call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & - avgflag='A', long_name='ice growth', & - ptr_col=this%qflx_glcice_frz, l2g_scale_type='ice') - - this%qflx_glcice_melt(begc:endc) = spval - call hist_addfld1d (fname='QICE_MELT', units='mm/s', & - avgflag='A', long_name='ice melt', & - ptr_col=this%qflx_glcice_melt, l2g_scale_type='ice') - endif + this%qflx_glcice(begc:endc) = spval + call hist_addfld1d (fname='QICE', units='mm/s', & + avgflag='A', long_name='ice growth/melt', & + ptr_col=this%qflx_glcice, l2g_scale_type='ice') + + this%qflx_glcice_frz(begc:endc) = spval + call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & + avgflag='A', long_name='ice growth', & + ptr_col=this%qflx_glcice_frz, l2g_scale_type='ice') + + this%qflx_glcice_melt(begc:endc) = spval + call hist_addfld1d (fname='QICE_MELT', units='mm/s', & + avgflag='A', long_name='ice melt', & + ptr_col=this%qflx_glcice_melt, l2g_scale_type='ice') ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at any ! given time step but only if there is at least one snow layer (for all landunits From 0909a5af22474285c26e828a37f216d5f882336a Mon Sep 17 00:00:00 2001 From: Stephen Price Date: Thu, 19 Sep 2024 12:46:05 -0500 Subject: [PATCH 161/529] Checkpoint of working changes with debugging included. Checkpointing changes to coupler budget code that accounts for l2x_ and g2x_ Greenland surface mass balance fluxes, with various lines supporting debugging outputs included. Cleaned up code without debug lines to follow. --- .../mpas-albany-landice/driver/glc_comp_mct.F | 4 +- driver-mct/main/seq_diag_mct.F90 | 184 +++++++++--------- 2 files changed, 98 insertions(+), 90 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index 7bf72556603..51e874c2e20 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -1482,8 +1482,8 @@ subroutine glc_export_mct(g2x_g, errorCode) !call route_ice_runoff(0.0_RKIND, & !Recuperate runoff routing switch code (originally in glc_route_ice_runoff module in earlier code), and attach to ice calving flux once present... ! rofi_to_ocn=Fogg_rofi, & ! rofi_to_ice=Figg_rofi) - !g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0!...and remove these placeholders - g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0001d0 !SFP: dummy value to see if passes through coupler + g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0!...and remove these placeholders + !g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0001d0 ! dummy value to allow tracking through coupler g2x_g % rAttr(index_g2x_Figg_rofi,n)=0.0 !...and remove these placeholders g2x_g % rAttr(index_g2x_Fogg_rofl,n) = 0.0 !Attach to subglacial liquid flux once present diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index af26aeacfbc..556beae6175 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -48,9 +48,9 @@ module seq_diag_mct use shr_reprosum_mod, only : shr_reprosum_calc use seq_diagBGC_mct, only : seq_diagBGC_preprint_mct, seq_diagBGC_print_mct - use prep_glc_mod, only : prep_glc_get_x2gacc_gx_cnt !SFP: added this and next - unclear which is needed -! use prep_glc_mod, only : prep_glc_get_l2gacc_lx_cnt - + use prep_glc_mod, only : prep_glc_get_x2gacc_gx_cnt !SFP: added this and next + use glc_elevclass_mod, only: glc_get_num_elevation_classes + implicit none save private @@ -222,10 +222,6 @@ module seq_diag_mct logical :: flds_wiso ! If water isotope fields are active - !--- temporary pointers --- - integer , pointer :: x2gacc_gx_cnt ! SFP added -! integer , pointer :: l2gacc_lx_cnt ! SFP: unclear if this or the above is needed / more relevant - ! !PUBLIC DATA MEMBERS !--- time-averaged (annual?) global budge diagnostics --- @@ -274,8 +270,8 @@ module seq_diag_mct integer :: index_l2x_Flrl_irrig integer :: index_l2x_Flrl_wslake - integer :: index_l2x_Flgl_qice(0:10) !SFP added - integer :: index_x2l_Sg_ice_covered(0:10) !SFP added + integer, allocatable :: index_l2x_Flgl_qice(:) !SFP: added this and next; unclear if this is the best way to treat these + integer, allocatable :: index_x2l_Sg_ice_covered(:) integer :: index_x2l_Faxa_lwdn integer :: index_x2l_Faxa_rainc @@ -450,6 +446,9 @@ module seq_diag_mct integer :: index_x2i_Faxa_snow_18O integer :: index_x2i_Faxa_snow_HDO + integer :: glc_nec !SFP: added + integer :: x2gacc_gx_cnt ! SFP added (maybe not needed) + !=============================================================================== contains !=============================================================================== @@ -892,7 +891,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) real(r8) :: l2x_Flgl_qice_col_sum !SFP: sum of fluxes over no. MECs (cols) - character(len=64) :: name !SFP: added this and next 2 + character(len=64) :: name !SFP: added this and next 2 for support of working w/ data in MECs character(len= 2) :: cnum integer(in) :: num @@ -916,6 +915,13 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) kArea = mct_aVect_indexRA(dom_l%data,afldname) kl = mct_aVect_indexRA(frac_l,lfrinname) + ! get number of elevation classes and allocate relevant sets of indices + glc_nec = glc_get_num_elevation_classes() + if (first_time) then + allocate(index_l2x_Flgl_qice(0:glc_nec)) + allocate(index_x2l_Sg_ice_covered(0:glc_nec)) + end if + if (present(do_l2x)) then if (first_time) then index_l2x_Fall_swnet = mct_aVect_indexRA(l2x_l,'Fall_swnet') @@ -931,12 +937,13 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_irrig = mct_aVect_indexRA(l2x_l,'Flrl_irrig', perrWith='quiet') index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') - do num=0,10 !SFP: change later to 0,glc_nec_max (no. of elev classes) + !SFP: added this loop + do num=0,glc_nec write(cnum,'(i2.2)') num name = 'Flgl_qice' // cnum - index_l2x_Flgl_qice(num) = mct_avect_indexRA(l2x_l,trim(name)) !SFP added + index_l2x_Flgl_qice(num) = mct_avect_indexRA(l2x_l,trim(name)) name = 'Sg_ice_covered' // cnum - index_x2l_Sg_ice_covered(num) = mct_avect_indexRA(x2l_l,trim(name)) !SFP added + index_x2l_Sg_ice_covered(num) = mct_avect_indexRA(x2l_l,trim(name)) end do index_l2x_Fall_evap_16O = mct_aVect_indexRA(l2x_l,'Fall_evap_16O',perrWith='quiet') @@ -975,11 +982,12 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi,n) l2x_Flgl_qice_col_sum = 0.0d0 - do num=0,10 !SFP: change later to 0,glc_nec_max (no elev classes) - !SFP: this somehow needs to allow for each of the 11 vectors associate w/ each of the 11 elev classes - l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) !SFP added + do num=0,glc_nec + !SFP: this should sum the contributions from each of the n vectors in the total no. of MECs + !SFP: product on RHS is the SMB flux times the fraction of area in that particular elevation class times the land cell area + l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) * ca_l !SFP added end do - nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_Flgl_qice_col_sum !SFP added + nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - l2x_Flgl_qice_col_sum !SFP added if ( flds_wiso_lnd )then nf = f_wevap_16O; @@ -1014,10 +1022,14 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) end if end do -! budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice +! budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice !SFP: waiting for this to contain actual non-zero values budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice !SFP added + ! SFP: are these needed? Currently not sure how / if / when to deallocate these ... + !deallocate(index_l2x_Flgl_qice(0:glc_nec)) + !deallocate(index_x2l_Sg_ice_covered(0:glc_nec)) + end if if (present(do_x2l)) then @@ -1309,16 +1321,15 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) !----- local ----- type(mct_aVect), pointer :: g2x_g -! type(mct_aVect), pointer :: x2g_g - type(mct_aVect), pointer :: x2gacc_g !SFP: replace above w/ vector for accumulated fluxes + type(mct_aVect), pointer :: x2gacc_g type(mct_ggrid), pointer :: dom_g integer(in) :: n,ic,nf,ip ! generic index - integer(in) :: kArea ! index of area field in aVect - integer(in) :: lSize ! size of aVect - real(r8) :: ca_g ! area of a grid cell + integer(in) :: kArea ! index of area field in aVect + integer(in) :: lSize ! size of aVect + real(r8) :: ca_g ! area of a grid cell logical,save :: first_time = .true. - integer,save :: counter,smb_counter,calving_counter !SFP: for debugging + integer,save :: counter,smb_counter,calving_counter !SFP: added (mostly for debugging) integer,save :: smb_vector_length,calving_vector_length !----- formats ----- @@ -1334,11 +1345,7 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) dom_g => component_get_dom_cx(glc) g2x_g => component_get_c2x_cx(glc) -! x2g_g => component_get_x2c_cx(glc) - x2gacc_g => component_get_x2c_cx(glc) !SFP: use accum fluxes vector - - x2gacc_gx_cnt => prep_glc_get_x2gacc_gx_cnt() !SFP: counter for how many times SMB flux accumulation has occured -! l2gacc_lx_cnt => prep_glc_get l2gacc_lx_cnt() + x2gacc_g => component_get_x2c_cx(glc) if( present(do_g2x))then !SPF: glc to coupler @@ -1352,33 +1359,32 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) index_g2x_Figg_rofi = mct_aVect_indexRA(g2x_g,'Figg_rofi') !SFP:debug - write(logunit,*) ' ' - write(logunit,*) ' index_g2x_Fogg_rofl = ', index_g2x_Fogg_rofl - write(logunit,*) ' index_g2x_Fogg_rofi = ', index_g2x_Fogg_rofi - write(logunit,*) ' index_g2x_Figg_rofi = ', index_g2x_Figg_rofi - write(logunit,*) ' ' + !write(logunit,*) ' ' + !write(logunit,*) ' index_g2x_Fogg_rofl = ', index_g2x_Fogg_rofl + !write(logunit,*) ' index_g2x_Fogg_rofi = ', index_g2x_Fogg_rofi + !write(logunit,*) ' index_g2x_Figg_rofi = ', index_g2x_Figg_rofi + !write(logunit,*) ' ' end if - !ip = p_inst + !ip = p_inst !SFP: this value, day or inst, does not change anything here ip = p_day - !ic = c_glc_gs - ic = c_glc_gr !SFP: use recieve here since this is coming from glc to coupler? + ic = c_glc_gr !SFP: use recieve here ("_gr") since this is coming from glc to coupler? kArea = mct_aVect_indexRA(dom_g%data,afldname) lSize = mct_avect_lSize(g2x_g) !SFP:debug - if(calving_counter==0)then !one day at 30 min land/atmos time steps - write(logunit,*) ' ' - write(logunit,*) ' calving vector length (7425 in coupler) = ', lSize - write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) - write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) - write(logunit,*) ' intial value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) - write(logunit,*) ' calving flux to ocean (Fogg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Fogg_rofi,1) - write(logunit,*) ' calving flux to ice (Figg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Figg_rofi,1) - write(logunit,*) ' calving flux X area to ocean (Fogg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Fogg_rofi,1) - write(logunit,*) ' calving flux X area to ice (Figg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Figg_rofi,1) - end if + !if(calving_counter==0)then + !write(logunit,*) ' ' + !write(logunit,*) ' calving vector length (7425 in coupler) = ', lSize + !write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) + !write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) + !write(logunit,*) ' intial value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) + !write(logunit,*) ' calving flux to ocean (Fogg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Fogg_rofi,1) + !write(logunit,*) ' calving flux to ice (Figg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Figg_rofi,1) + !write(logunit,*) ' calving flux X area to ocean (Fogg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Fogg_rofi,1) + !write(logunit,*) ' calving flux X area to ice (Figg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Figg_rofi,1) + !end if do n=1,lSize ca_g = dom_g%data%rAttr(kArea,n) @@ -1389,60 +1395,63 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice - calving_vector_length = calving_vector_length +lSize - calving_counter = calving_counter + 1 + !SFP: only needed for debugging + !calving_vector_length = calving_vector_length +lSize + !calving_counter = calving_counter + 1 !SFP:debug - if(calving_counter==48)then !one day at 30 min land/atmos time steps - write(logunit,*) ' calving counter = ', calving_counter - write(logunit,*) ' final value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) - write(logunit,*) ' ' - end if + !if(calving_counter==48)then !one day at 30 min land/atmos time steps + !write(logunit,*) ' calving counter = ', calving_counter + !write(logunit,*) ' final value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) + !write(logunit,*) ' ' + !end if endif !SFP: end 'do_g2x' if( present(do_x2g))then !SFP: coupler to glc + x2gacc_gx_cnt = prep_glc_get_x2gacc_gx_cnt() !SFP: counter for how many times SMB flux accumulation has occured + ! note that this would be useful below but does not seem to work currently + ! (being reset to zero before being called here?) if (first_time) then - smb_counter=0 - smb_vector_length = 0 + smb_counter=0 !SFP: this may be needed in order to turn average flux into accumulated flux (by multiplying average by no of lnd coupling intervals) - !index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') - index_x2g_Flgl_qice = mct_aVect_indexRA(x2gacc_g,'Flgl_qice') !SFP: use accum flux vector + !smb_vector_length = 0 !SFP: debugging only + + index_x2g_Flgl_qice = mct_aVect_indexRA(x2gacc_g,'Flgl_qice') !SFP:debug - write(logunit,*) ' ' - write(logunit,*) ' index_x2g_Flgl_qice = ', index_x2g_Flgl_qice - write(logunit,*) ' ' + !write(logunit,*) ' ' + !write(logunit,*) ' index_x2g_Flgl_qice = ', index_x2g_Flgl_qice + !write(logunit,*) ' ' end if - !ip = p_inst + !ip = p_inst !SFP: as above, day vs. inst. does not seem to matter here ip = p_day - ic = c_glc_gs ! SFP: use send here since going from coupler to glc? - !ic = c_glc_gr + ic = c_glc_gs ! SFP: use send here ("_gs") since going from coupler to glc? kArea = mct_aVect_indexRA(dom_g%data,afldname) - !lSize = mct_avect_lSize(x2g_g) - lSize = mct_avect_lSize(x2gacc_g) !SFP: use accum flux vector + lSize = mct_avect_lSize(x2gacc_g) !SFP:debug - if(smb_counter==0)then !one day at 30 min land/atmos time steps - write(logunit,*) ' ' - write(logunit,*) ' smb vector length (7425 in coupler) = ', lSize - write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) - write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) - write(logunit,*) ' initial value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) - end if + !if(smb_counter==0)then !one day at 30 min land/atmos time steps + !write(logunit,*) ' ' + !write(logunit,*) ' smb vector length (7425 in coupler) = ', lSize + !write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) + !write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) + !write(logunit,*) ' initial value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) + !end if do n=1,lSize ca_g = dom_g%data%rAttr(kArea,n) - !nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) - nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2gacc_g%rAttr(index_x2g_Flgl_qice,n) !SFP: use accum flux vector + nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2gacc_g%rAttr(index_x2g_Flgl_qice,n) end do - budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * 48.0d0 !SFP: hack to see if this recovers actual value from time averaged value - !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * x2gacc_gx_cnt !SFP: ideally use this or something like it to contain actual value + !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * 48.0d0 !SFP: hack to see if this recovers actual value from time averaged value + !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * x2gacc_gx_cnt !SFP: ideally use this ... but always zero (zeroed before called?) + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * smb_counter !SFP: this works but smb_counter seems like sloppy way to recover no. of lnd steps per glc coupling step + ! would be nicer to use value of x2gacc_gx_cnt (but always 0 as currently called) budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice @@ -1450,16 +1459,15 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) smb_counter = smb_counter + 1 !SFP:debug - if(smb_counter==48)then !one day at 30 min land/atmos time steps - write(logunit,*) ' ' - write(logunit,*) ' smb_counter = ', smb_counter - write(logunit,*) ' x2gacc_gx_cnt = ', x2gacc_gx_cnt -! write(logunit,*) ' l2gacc_lx_cnt = ', l2gacc_lx_cnt -! write(logunit,*) ' current value of x2g_ vector = ', x2g_g%rAttr(index_x2g_Flgl_qice,:) -! write(logunit,*) ' current value of x2gacc_ vector = ', x2gacc_g%rAttr(index_x2g_Flgl_qice,:) - write(logunit,*) ' final value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) - write(logunit,*) ' ' - end if + !if(smb_counter==48)then !one day at 30 min land/atmos time steps + !write(logunit,*) ' ' + !write(logunit,*) ' smb_counter = ', smb_counter + !write(logunit,*) ' x2gacc_gx_cnt = ', x2gacc_gx_cnt + !write(logunit,*) ' current value of x2g_ vector = ', x2g_g%rAttr(index_x2g_Flgl_qice,:) + !write(logunit,*) ' current value of x2gacc_ vector = ', x2gacc_g%rAttr(index_x2g_Flgl_qice,:) + !write(logunit,*) ' final value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) + !write(logunit,*) ' ' + !end if end if !SPF: end do coupler to glc From f14d71a51425acd47dde73e7732eb76d7a4d0caa Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 22 Apr 2024 23:49:57 -0500 Subject: [PATCH 162/529] Create avgThermalForcing300m coupling field in MPAS-Ocean This commits adds a new field to MPAS-Ocean called avgThermalForcing300m. It is calculated as the thermal forcing (difference between ocean temperature local freezing temperature) at 300 m depth. It uses the temperature of the layer shallower than 300 m. This could be replaced with vertical interpolation to get the value exactly at 300 m. The TF at 300 m is time averaged over the ocean coupling interval. --- components/mpas-ocean/src/Registry.xml | 3 + .../shared/mpas_ocn_time_average_coupled.F | 57 ++++++++++++++++++- 2 files changed, 58 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 2a21e22f40d..fea5c17b956 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -4010,6 +4010,9 @@ description="The time-averaged effective ocean density within ice shelves based on Archimedes' principle." packages="landIceCouplingPKG" /> + 300.0_RKIND) then + iLevel0300 = iLevel-1 + exit + end if + end do + !$omp parallel + !$omp do schedule(runtime) + ! calculate thermal forcing at identified level for each cell + do iCell = 1, nCells + ! ignore cells that are too shallow + if (iLevel0300 <= maxLevelCell(iCell)) then + ! this uses the level shallower than the reference level. could interpolate instead + ! note: assuming no LandIce cavity, but we may want to support that + freezingTemp = ocn_freezing_temperature(salinity=activeTracers(indexSalinity, iLevel0300, iCell), & + pressure=pressure(iLevel0300, iCell), inLandIceCavity=.false.) + avgThermalForcing300m(iCell) = ( avgThermalForcing300m(iCell) * nAccumulatedCoupled & + + activeTracers(indexTemperature, iLevel0300, iCell) - freezingTemp ) / ( nAccumulatedCoupled + 1) + end if + end do + !$omp end do + !$omp end parallel + ! accumulate BGC coupling fields if necessary if (config_use_ecosysTracers) then From 2abf17a24323f10358d079f5cc3d819f5264e30c Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 23 Apr 2024 00:02:17 -0500 Subject: [PATCH 163/529] Define coupler fields for TF at 300 m and connect to OCN and GLC This commit adds the So_tf300 coupler field for passing thermal forcing at 300m through the coupler. It also passes the avgThermalForcing300m added to MPAS-Ocean in the previous commit to this coupler field, and send it to the ismip6_2dThermalForcing field in MALI as the destination. Note that a new list of coupler fields called x2g_tf_states_from_ocn has been added to seq_flds_mod to differentiate this coupling field from the iceshelf OCN/GLC coupling, which is handled differently. --- .../mpas-albany-landice/driver/glc_comp_mct.F | 5 ++++- .../mpas-albany-landice/driver/glc_cpl_indices.F | 2 ++ components/mpas-ocean/driver/mpaso_cpl_indices.F | 2 ++ components/mpas-ocean/driver/ocn_comp_mct.F | 6 +++++- driver-mct/shr/seq_flds_mod.F90 | 14 ++++++++++++++ 5 files changed, 27 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index ac33d17b1f3..8bc9fc255d1 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -1383,7 +1383,8 @@ subroutine glc_import_mct(x2g_g, errorCode) floatingBasalMassBal,& surfaceTemperature,& basalOceanHeatflx,& - OceanDensity + OceanDensity, & + ismip6_2dThermalForcing errorCode = 0 @@ -1401,6 +1402,7 @@ subroutine glc_import_mct(x2g_g, errorCode) call mpas_pool_get_array(geometryPool, 'sfcMassBal', sfcMassBal) call mpas_pool_get_array(geometryPool, 'floatingBasalMassBal',floatingBasalMassBal) call mpas_pool_get_array(thermalPool, 'surfaceTemperature',surfaceTemperature) + call mpas_pool_get_array(geometryPool, 'ismip6_2dThermalForcing', ismip6_2dThermalForcing) ! call mpas_pool_get_array(thermalPool, 'basalOceanHeatflx',basalOceanHeatflx) !call mpas_pool_get_array(geometryPool, 'OceanDensity',OceanDensity) @@ -1408,6 +1410,7 @@ subroutine glc_import_mct(x2g_g, errorCode) n = n + 1 sfcMassBal(i) = x2g_g % rAttr(index_x2g_Flgl_qice, n) floatingBasalMassBal(i) = x2g_g % rAttr(index_x2g_Fogx_qiceli, n) + ismip6_2dThermalForcing(i) = x2g_g % rAttr(index_x2g_So_tf300, n) ! surfaceTemperature(i) = x2g_g % rAttr(index_x2g_Sl_tsrf, n) !JW basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogo_qiceh, n) ! basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogx_qicehi, n) diff --git a/components/mpas-albany-landice/driver/glc_cpl_indices.F b/components/mpas-albany-landice/driver/glc_cpl_indices.F index 123185225f8..e84ac9174b1 100644 --- a/components/mpas-albany-landice/driver/glc_cpl_indices.F +++ b/components/mpas-albany-landice/driver/glc_cpl_indices.F @@ -22,6 +22,7 @@ module glc_cpl_indices integer, public :: index_x2g_So_htv = 0 !Ice shelf ocean heat transfer velocity integer, public :: index_x2g_So_stv = 0 !Ice shelf ocean salinity transfer velocity integer, public :: index_x2g_So_rhoeff = 0 !Ocean effective pressure + integer, public :: index_x2g_So_tf300 = 0 !Ocean thermal forcing at 300m integer, public :: index_x2g_Fogx_qiceli = 0 !Subshelf mass flux integer, public :: index_x2g_Fogx_qicehi = 0 !Subshelf heat flux for the ice sheet @@ -70,6 +71,7 @@ subroutine glc_cpl_indices_set( ) index_x2g_Fogx_qiceli = mct_avect_indexra(x2g,'Fogx_qiceli',perrwith='quiet') index_x2g_Fogx_qicehi = mct_avect_indexra(x2g,'Fogx_qicehi',perrwith='quiet') index_x2g_So_rhoeff = mct_avect_indexra(x2g,'So_rhoeff',perrwith='quiet') + index_x2g_So_tf300 = mct_avect_indexra(x2g,'So_tf300',perrwith='quiet') !Following block of x2g/g2x vectors are used internally within coupler for subshelf melt flux !calculations (and so do not have directly-related export-side arrays) diff --git a/components/mpas-ocean/driver/mpaso_cpl_indices.F b/components/mpas-ocean/driver/mpaso_cpl_indices.F index f099cf8ea46..c51aa68bf5b 100644 --- a/components/mpas-ocean/driver/mpaso_cpl_indices.F +++ b/components/mpas-ocean/driver/mpaso_cpl_indices.F @@ -37,6 +37,7 @@ module mpaso_cpl_indices integer :: index_o2x_So_htv !ocean heat-transfer velocity integer :: index_o2x_So_stv !ocean salt-transfer velocity integer :: index_o2x_So_rhoeff !ocean effective density + integer :: index_o2x_So_tf300 !ocean thermal forcing at 300m ! ocn -> drv (BGC) @@ -208,6 +209,7 @@ subroutine mpaso_cpl_indices_set( ) index_o2x_So_htv = mct_avect_indexra(o2x,'So_htv') index_o2x_So_stv = mct_avect_indexra(o2x,'So_stv') index_o2x_So_rhoeff = mct_avect_indexra(o2x,'So_rhoeff') + index_o2x_So_tf300 = mct_avect_indexra(o2x,'So_tf300') index_o2x_So_algae1 = mct_avect_indexra(o2x,'So_algae1',perrWith='quiet') index_o2x_So_algae2 = mct_avect_indexra(o2x,'So_algae2',perrWith='quiet') diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index d1b140563bb..3132847ecc8 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -2689,7 +2689,8 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ avgRemovedRiverRunoffFlux, & avgRemovedIceRunoffFlux, & avgLandIceHeatFlux, & - avgRemovedIceRunoffHeatFlux + avgRemovedIceRunoffHeatFlux, & + avgThermalForcing300m real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & avgSSHGradient, avgOceanSurfacePhytoC, & @@ -2753,6 +2754,7 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity) call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient) call mpas_pool_get_array(forcingPool, 'avgTotalFreshWaterTemperatureFlux', avgTotalFreshWaterTemperatureFlux) + call mpas_pool_get_array(forcingPool, 'avgThermalForcing300m', avgThermalForcing300m) if ( frazilIceActive ) then call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy) @@ -2933,6 +2935,8 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ o2x_o % rAttr(index_o2x_So_stv, n) = landIceTracerTransferVelocities(indexSaltTrans,i) o2x_o % rAttr(index_o2x_So_rhoeff, n) = 0.0_RKIND endif + o2x_o % rAttr(index_o2x_So_tf300, n) = avgThermalForcing300m(i) + !Fyke: test !write(stderrUnit,*) 'n=',n diff --git a/driver-mct/shr/seq_flds_mod.F90 b/driver-mct/shr/seq_flds_mod.F90 index dbfba0889d0..6ecdd5598fc 100644 --- a/driver-mct/shr/seq_flds_mod.F90 +++ b/driver-mct/shr/seq_flds_mod.F90 @@ -213,6 +213,7 @@ module seq_flds_mod character(CXX) :: seq_flds_x2g_states character(CXX) :: seq_flds_x2g_states_from_lnd character(CXX) :: seq_flds_x2g_states_from_ocn + character(CXX) :: seq_flds_x2g_tf_states_from_ocn character(CXX) :: seq_flds_x2g_fluxes character(CXX) :: seq_flds_x2g_fluxes_from_lnd @@ -348,6 +349,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) character(CXX) :: x2g_states = '' character(CXX) :: x2g_states_from_lnd = '' character(CXX) :: x2g_states_from_ocn = '' + character(CXX) :: x2g_tf_states_from_ocn = '' character(CXX) :: x2g_fluxes = '' character(CXX) :: x2g_fluxes_from_lnd = '' character(CXX) :: xao_albedo = '' @@ -2985,6 +2987,16 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'So_rhoeff' call metadata_set(attname, longname, stdname, units) + name = 'So_tf300' + call seq_flds_add(o2x_states,trim(name)) + call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_tf_states_from_ocn,trim(name)) + longname = 'ocean thermal forcing at 300 m depth' + stdname = 'ocean_thermal_forcing_at_300m' + units = 'C' + attname = name + call metadata_set(attname, longname, stdname, units) + name = 'Fogx_qicelo' call seq_flds_add(g2x_fluxes,trim(name)) call seq_flds_add(x2o_fluxes,trim(name)) @@ -3937,6 +3949,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) seq_flds_x2g_states = trim(x2g_states) seq_flds_x2g_states_from_lnd = trim(x2g_states_from_lnd) seq_flds_x2g_states_from_ocn = trim(x2g_states_from_ocn) + seq_flds_x2g_tf_states_from_ocn = trim(x2g_tf_states_from_ocn) seq_flds_xao_states = trim(xao_states) seq_flds_xao_albedo = trim(xao_albedo) seq_flds_xao_diurnl = trim(xao_diurnl) @@ -4004,6 +4017,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) write(logunit,*) subname//': seq_flds_x2g_states_from_lnd= ',trim(seq_flds_x2g_states_from_lnd) write(logunit,*) subname//': seq_flds_l2x_states_to_glc= ',trim(seq_flds_l2x_states_to_glc) write(logunit,*) subname//': seq_flds_x2g_states_from_ocn= ',trim(seq_flds_x2g_states_from_ocn) + write(logunit,*) subname//': seq_flds_x2g_tf_states_from_ocn= ',trim(seq_flds_x2g_tf_states_from_ocn) write(logunit,*) subname//': seq_flds_x2g_fluxes= ',trim(seq_flds_x2g_fluxes) write(logunit,*) subname//': seq_flds_x2g_fluxes_from_lnd= ',trim(seq_flds_x2g_fluxes_from_lnd) write(logunit,*) subname//': seq_flds_l2x_fluxes_to_glc= ',trim(seq_flds_l2x_fluxes_to_glc) From 4c18c452806d37aaaf842c3e4cbdf0aa05bbf4b0 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 23 Apr 2024 00:10:46 -0500 Subject: [PATCH 164/529] Update MALI config to use new TF field This commit enables facemelting in MALI so that the new TF field will be used to calculate a melt rate. This is safe to enable in general, because for situations where thermal forcing is not calculated or not applicable, it will be zero and facemelting will in turn be zero. This commit also updates the MALI output stream to write out the TF and facemelting fields. Note that this commit also changes the MALI output stream interval to daily. While that might not be the ideal long-term production solution, it is likely the desired frequency for model development for the forseeable future. --- .../bld/namelist_files/namelist_defaults_mali.xml | 2 +- components/mpas-albany-landice/cime_config/buildnml | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml index 0450eb44f11..1b0a9b19195 100644 --- a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml +++ b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml @@ -98,7 +98,7 @@ 1.0 0.0 0.25 -'none' +'ismip6' .false. 1.18 0.0 diff --git a/components/mpas-albany-landice/cime_config/buildnml b/components/mpas-albany-landice/cime_config/buildnml index 9489b6dfa8f..8dcafdac1c7 100755 --- a/components/mpas-albany-landice/cime_config/buildnml +++ b/components/mpas-albany-landice/cime_config/buildnml @@ -247,6 +247,9 @@ def buildnml(case, caseroot, compname): lines.append(' ') lines.append(' ') lines.append(' ') + lines.append(' ') + lines.append(' ') + lines.append(' ') lines.append(' ') lines.append(' ') lines.append(' ') From babbf3dd4bbccf3210fc3d5a74639a3712692987 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 23 Apr 2024 00:29:50 -0500 Subject: [PATCH 165/529] Define ocn2glc mapping for TF This commits defines the mapping for thermal forcing from ocean to glc. It defines a special mapper for thermal forcing state (ocn2glc_tf_smap) in CIME and MCT xml files. It also declares and allocates mapper_So2g_tf in prep_glc_mod but does not initialize or use it yet. The mapping file requires some special treatment: * it needs to use nearest neighbor mapping (which differs from most state remapping) * it needs to include grid_imask in the ocean scrip file to only consider ocean cells valid if they are deeper than 300m --- cime_config/config_grids.xml | 1 + driver-mct/cime_config/config_component.xml | 18 +++++++++++ .../cime_config/namelist_definition_drv.xml | 30 +++++++++++++++++++ driver-mct/main/prep_glc_mod.F90 | 2 ++ 4 files changed, 51 insertions(+) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 0f1c3512ec8..ee5931ee03b 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -5569,6 +5569,7 @@ cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfaave.20240403.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfbilin.20240403.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfneareststod.20240422.deeperThan300m.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc diff --git a/driver-mct/cime_config/config_component.xml b/driver-mct/cime_config/config_component.xml index 8cddad0abf8..666b2de17f2 100644 --- a/driver-mct/cime_config/config_component.xml +++ b/driver-mct/cime_config/config_component.xml @@ -1934,6 +1934,24 @@ ocn2glc state mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + ocn2glc state mapping file for thermal forcing - the default value idmap_ignore, if set, will be ignored by buildnml and + will generate a runtime error if in fact a file is required for the given compset + + + + char + X,Y + Y + run_domain + env_run.xml + ocn2glc state mapping file decomp type + + char idmap diff --git a/driver-mct/cime_config/namelist_definition_drv.xml b/driver-mct/cime_config/namelist_definition_drv.xml index 7fbf83688c8..5aabbe8bb98 100644 --- a/driver-mct/cime_config/namelist_definition_drv.xml +++ b/driver-mct/cime_config/namelist_definition_drv.xml @@ -4590,6 +4590,36 @@ + + char + mapping + abs + seq_maps + + ocn to glc state mapping file for thermal forcing state fields + + + $OCN2GLC_TF_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $OCN2GLC_TF_SMAPTYPE + X + + + char mapping diff --git a/driver-mct/main/prep_glc_mod.F90 b/driver-mct/main/prep_glc_mod.F90 index 07aeb9890bd..4534319e53e 100644 --- a/driver-mct/main/prep_glc_mod.F90 +++ b/driver-mct/main/prep_glc_mod.F90 @@ -77,6 +77,7 @@ module prep_glc_mod type(seq_map), pointer :: mapper_Sl2g type(seq_map), pointer :: mapper_Fl2g type(seq_map), pointer :: mapper_So2g + type(seq_map), pointer :: mapper_So2g_tf type(seq_map), pointer :: mapper_Fo2g type(seq_map), pointer :: mapper_Fg2l @@ -179,6 +180,7 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) allocate(mapper_Sl2g) allocate(mapper_Fl2g) allocate(mapper_So2g) + allocate(mapper_So2g_tf) allocate(mapper_Fo2g) allocate(mapper_Fg2l) From 8c10e45a5d1bf7c6aec482c4ac2b5d5574ca580a Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 23 Apr 2024 22:07:51 -0500 Subject: [PATCH 166/529] Implement new ocn2glc TF coupling 1. Differnetiate new ocn2glc TF coupling from existing ocn2glcshelf coupling Create ocn_c2_glc logical in cime_comp_mod. This controls the new ocn2glc TF (thermal forcing) coupling separately from the existing ocn2glcshelf coupling, which has its own ocn_c2_glcshelf flag already. The new TF coupling will be active whenever ocn is present and glc is prognostic. These flags are used to initialize different mappers independent of each other in prep_glc_init. Those flags are also now passed to prep_glc_calc_o2x_gx to control which mapping actually occurs. 2. Implement prep_glc_mrg_ocn The existing ocn2glcshelf coupling handled a number of operations in unusual ways because the fluxes themselves are calculated in the coupler, so it was missing some of the standard operations for simply passing fields between components. As such, adding the new TF coupling requires creating a prep_glc_mrg_ocn routine, which is responsible for transferring fields from o2x_g to x2g_g arrays. This routine was copied closely from the existing prep_glc_mrg_lnd routine. With this commit, the ocean TF field is successfully passed to MALI. --- driver-mct/main/cime_comp_mod.F90 | 25 +++- driver-mct/main/prep_glc_mod.F90 | 191 ++++++++++++++++++++++++++++-- 2 files changed, 201 insertions(+), 15 deletions(-) diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index 2131d0c8684..5b4d487aa0c 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -433,6 +433,7 @@ module cime_comp_mod logical :: lnd_c2_rof ! .true. => lnd to rof coupling on logical :: lnd_c2_glc ! .true. => lnd to glc coupling on logical :: ocn_c2_atm ! .true. => ocn to atm coupling on + logical :: ocn_c2_glc ! .true. => ocn to glc coupling on logical :: ocn_c2_ice ! .true. => ocn to ice coupling on logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on @@ -1731,6 +1732,7 @@ subroutine cime_init() lnd_c2_rof = .false. lnd_c2_glc = .false. ocn_c2_atm = .false. + ocn_c2_glc = .false. ocn_c2_ice = .false. ocn_c2_wav = .false. ocn_c2_rof = .false. @@ -1768,6 +1770,7 @@ subroutine cime_init() if (ocn_present) then if (atm_prognostic) ocn_c2_atm = .true. if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm + if (glc_prognostic) ocn_c2_glc = .true. if (ice_prognostic) ocn_c2_ice = .true. if (wav_prognostic) ocn_c2_wav = .true. if (rofocn_prognostic) ocn_c2_rof = .true. @@ -1867,6 +1870,7 @@ subroutine cime_init() write(logunit,F0L)'lnd_c2_rof = ',lnd_c2_rof write(logunit,F0L)'lnd_c2_glc = ',lnd_c2_glc write(logunit,F0L)'ocn_c2_atm = ',ocn_c2_atm + write(logunit,F0L)'ocn_c2_glc = ',ocn_c2_glc write(logunit,F0L)'ocn_c2_ice = ',ocn_c2_ice write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_wav = ',ocn_c2_wav @@ -1953,7 +1957,7 @@ subroutine cime_init() endif if ((ocn_c2_glcshelf .and. .not. glcshelf_c2_ocn) .or. (glcshelf_c2_ocn .and. .not. ocn_c2_glcshelf)) then ! Current logic will not allow this to be true, but future changes could make it so, which may be nonsensical - call shr_sys_abort(subname//' ERROR: if glc_c2_ocn must also have ocn_c2_glc and vice versa. '//& + call shr_sys_abort(subname//' ERROR: if glcshelf_c2_ocn must also have ocn_c2_glcshelf and vice versa. '//& 'Boundary layer fluxes calculated in coupler require input from both components.') endif if (rofice_present .and. .not.rof_present) then @@ -2022,7 +2026,7 @@ subroutine cime_init() call prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) - call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) + call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) call prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav) @@ -4210,12 +4214,16 @@ subroutine cime_run_ocnglc_coupling() if (glc_present) then + ! create o2x_gx for either ocn-glc coupling or ocn-glc shelf coupling + if (ocn_c2_glc .or. (ocn_c2_glcshelf .and. glcshelf_c2_ocn)) then + call prep_glc_calc_o2x_gx(ocn_c2_glc, ocn_c2_glcshelf, timer='CPL:glcprep_ocn2glc') !remap ocean fields to o2x_g at ocean couping interval + endif + + ! if ice-shelf coupling is on, now proceed to handle those calculations here in the coupler if (ocn_c2_glcshelf .and. glcshelf_c2_ocn) then ! the boundary flux calculations done in the coupler require inputs from both GLC and OCN, ! so they will only be valid if both OCN->GLC and GLC->OCN - call prep_glc_calc_o2x_gx(timer='CPL:glcprep_ocn2glc') !remap ocean fields to o2x_g at ocean couping interval - call prep_glc_calculate_subshelf_boundary_fluxes ! this is actual boundary layer flux calculation !this outputs !x2g_g/g2x_g, where latter is going @@ -4342,7 +4350,7 @@ subroutine cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_call if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) ! NOTE - only create appropriate input to glc if the avg_alarm is on - if (lnd_c2_glc .or. ocn_c2_glcshelf) then + if (lnd_c2_glc .or. ocn_c2_glc .or. ocn_c2_glcshelf) then if (glcrun_avg_alarm) then call prep_glc_accum_avg(timer='CPL:glcprep_avg', & lnd2glc_averaged_now=lnd2glc_averaged_now) @@ -4355,6 +4363,13 @@ subroutine cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_call call prep_glc_mrg_lnd(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') endif + if (ocn_c2_glc) then + ! note: o2x_gx is handled in prep_glc_calc_o2x_gx, which is called + ! from cime_run_ocnglc_coupling in this module + call prep_glc_mrg_ocn(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgocnx2g') + endif + + call component_diag(infodata, glc, flow='x2c', comment='send glc', & info_debug=info_debug, timer_diag='CPL:glcprep_diagav') diff --git a/driver-mct/main/prep_glc_mod.F90 b/driver-mct/main/prep_glc_mod.F90 index 4534319e53e..5ed81f4c65e 100644 --- a/driver-mct/main/prep_glc_mod.F90 +++ b/driver-mct/main/prep_glc_mod.F90 @@ -31,6 +31,7 @@ module prep_glc_mod public :: prep_glc_init public :: prep_glc_mrg_lnd + public :: prep_glc_mrg_ocn public :: prep_glc_accum_lnd public :: prep_glc_accum_ocn @@ -136,7 +137,7 @@ module prep_glc_mod !================================================================================================ - subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) + subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) !--------------------------------------------------------------- ! Description @@ -145,7 +146,8 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) ! Arguments type (seq_infodata_type) , intent(inout) :: infodata logical , intent(in) :: lnd_c2_glc ! .true. => lnd to glc coupling on - logical , intent(in) :: ocn_c2_glcshelf ! .true. => ocn to glc coupling on + logical , intent(in) :: ocn_c2_glc ! .true. => ocn to glc coupling on + logical , intent(in) :: ocn_c2_glcshelf ! .true. => ocn to glc shelf coupling on ! ! Local Variables integer :: eli, egi, eoi @@ -251,8 +253,8 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) end if - if (glc_present .and. ocn_c2_glcshelf) then - + ! setup needed for either kind of ocn2glc coupling + if (glc_present .and. (ocn_c2_glc .or. ocn_c2_glcshelf)) then call seq_comm_getData(CPLID, & mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) @@ -277,6 +279,21 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) x2gacc_gx_cnt = 0 samegrid_go = .true. if (trim(ocn_gnam) /= trim(glc_gnam)) samegrid_go = .false. + end if + + ! setup needed for ocn2glc (TF) coupling + if (glc_present .and. ocn_c2_glc) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_So2g_tf' + end if + call seq_map_init_rcfile(mapper_So2g_tf, ocn(1), glc(1), & + 'seq_maps.rc','ocn2glc_tf_smapname:','ocn2glc_tf_smaptype:',samegrid_go, & + 'mapper_So2g_tf initialization',esmf_map_flag) + end if + + ! setup needed for ocn2glcshelf coupling + if (glc_present .and. ocn_c2_glcshelf) then if (iamroot_CPLID) then write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_So2g' @@ -291,7 +308,6 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) call seq_map_init_rcfile(mapper_Fo2g, ocn(1), glc(1), & 'seq_maps.rc','ocn2glc_fmapname:','ocn2glc_fmaptype:',samegrid_go, & 'mapper_Fo2g initialization',esmf_map_flag) - !Initialize module-level arrays associated with compute_melt_fluxes allocate(oceanTemperature(lsize_g)) allocate(oceanSalinity(lsize_g)) @@ -309,10 +325,9 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) ! TODO: Can we allocate these only while used or are we worried about performance hit? ! TODO: add deallocates! - call shr_sys_flush(logunit) - end if + call shr_sys_flush(logunit) end subroutine prep_glc_init @@ -523,6 +538,154 @@ subroutine prep_glc_accum_avg(timer, lnd2glc_averaged_now) end subroutine prep_glc_accum_avg + !================================================================================================ + + subroutine prep_glc_mrg_ocn(infodata, fractions_gx, timer_mrg) + + !--------------------------------------------------------------- + ! Description + ! Merge glc inputs + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + type(mct_aVect) , intent(in) :: fractions_gx(:) + character(len=*) , intent(in) :: timer_mrg + ! + ! Local Variables + integer :: egi, eoi, efi + type(mct_avect), pointer :: x2g_gx + character(*), parameter :: subname = '(prep_glc_mrg_ocn)' + !--------------------------------------------------------------- + + call t_drvstartf (trim(timer_mrg),barrier=mpicom_CPLID) + do egi = 1,num_inst_glc + ! Use fortran mod to address ensembles in merge + eoi = mod((egi-1),num_inst_ocn) + 1 + efi = mod((egi-1),num_inst_frc) + 1 + + x2g_gx => component_get_x2c_cx(glc(egi)) + call prep_glc_merge_ocn_forcing(o2x_gx(eoi), fractions_gx(efi), x2g_gx) + enddo + call t_drvstopf (trim(timer_mrg)) + + end subroutine prep_glc_mrg_ocn + + !================================================================================================ + + subroutine prep_glc_merge_ocn_forcing( o2x_g, fractions_g, x2g_g ) + + !----------------------------------------------------------------------- + ! Description + ! "Merge" ocean forcing for glc input. + ! + ! State fields are copied directly, meaning that averages are taken just over the + ! ocean-covered portion of the glc domain. + ! + ! Flux fields are downweighted by landfrac, which effectively sends a 0 flux from the + ! non-ocean-covered portion of the glc domain. + ! + ! Arguments + type(mct_aVect), intent(inout) :: o2x_g ! input + type(mct_aVect), intent(in) :: fractions_g + type(mct_aVect), intent(inout) :: x2g_g ! output + !----------------------------------------------------------------------- + + integer :: num_flux_fields + integer :: num_state_fields + integer :: nflds + integer :: i,n + integer :: mrgstr_index + integer :: index_o2x + integer :: index_x2g + integer :: index_ofrac + integer :: lsize + logical :: iamroot + logical, save :: first_time = .true. + character(CL),allocatable :: mrgstr(:) ! temporary string + character(CL) :: field ! string converted to char + character(*), parameter :: subname = '(prep_glc_merge_ocn_forcing) ' + + !----------------------------------------------------------------------- + + call seq_comm_getdata(CPLID, iamroot=iamroot) + lsize = mct_aVect_lsize(x2g_g) + + !num_flux_fields = shr_string_listGetNum(trim(seq_flds_x2g_fluxes_from_ocn)) + num_flux_fields = 0 + num_state_fields = shr_string_listGetNum(trim(seq_flds_x2g_tf_states_from_ocn)) + + if (first_time) then + nflds = num_flux_fields + num_state_fields + allocate(mrgstr(nflds)) + end if + + mrgstr_index = 1 + + do i = 1, num_state_fields + call seq_flds_getField(field, i, seq_flds_x2g_tf_states_from_ocn) + index_o2x = mct_aVect_indexRA(o2x_g, trim(field)) + index_x2g = mct_aVect_indexRA(x2g_g, trim(field)) + + if (first_time) then + mrgstr(mrgstr_index) = subname//'x2g%'//trim(field)//' =' // & + ' = o2x%'//trim(field) + end if + + do n = 1, lsize + x2g_g%rAttr(index_x2g,n) = o2x_g%rAttr(index_o2x,n) + end do + + mrgstr_index = mrgstr_index + 1 + enddo + + !index_lfrac = mct_aVect_indexRA(fractions_g,"lfrac") + !do i = 1, num_flux_fields + + ! call seq_flds_getField(field, i, seq_flds_x2g_fluxes_from_lnd) + ! index_l2x = mct_aVect_indexRA(l2x_g, trim(field)) + ! index_x2g = mct_aVect_indexRA(x2g_g, trim(field)) + + ! if (trim(field) == qice_fieldname) then + + ! if (first_time) then + ! mrgstr(mrgstr_index) = subname//'x2g%'//trim(field)//' =' // & + ! ' = l2x%'//trim(field) + ! end if + + ! ! treat qice as if it were a state variable, with a simple copy. + ! do n = 1, lsize + ! x2g_g%rAttr(index_x2g,n) = l2x_g%rAttr(index_l2x,n) + ! end do + + ! else + ! write(logunit,*) subname,' ERROR: Flux fields other than ', & + ! qice_fieldname, ' currently are not handled in lnd2glc remapping.' + ! write(logunit,*) '(Attempt to handle flux field <', trim(field), '>.)' + ! write(logunit,*) 'Substantial thought is needed to determine how to remap other fluxes' + ! write(logunit,*) 'in a smooth, conservative manner.' + ! call shr_sys_abort(subname//& + ! ' ERROR: Flux fields other than qice currently are not handled in lnd2glc remapping.') + ! endif ! qice_fieldname + + ! mrgstr_index = mrgstr_index + 1 + + !end do + + if (first_time) then + if (iamroot) then + write(logunit,'(A)') subname//' Summary:' + do i = 1,nflds + write(logunit,'(A)') trim(mrgstr(i)) + enddo + endif + deallocate(mrgstr) + endif + + first_time = .false. + + end subroutine prep_glc_merge_ocn_forcing + + !================================================================================================ subroutine prep_glc_mrg_lnd(infodata, fractions_gx, timer_mrg) @@ -606,7 +769,7 @@ subroutine prep_glc_merge_lnd_forcing( l2x_g, fractions_g, x2g_g ) mrgstr_index = 1 do i = 1, num_state_fields - call seq_flds_getField(field, i, seq_flds_x2g_states) + call seq_flds_getField(field, i, seq_flds_x2g_states_from_lnd) index_l2x = mct_aVect_indexRA(l2x_g, trim(field)) index_x2g = mct_aVect_indexRA(x2g_g, trim(field)) @@ -670,13 +833,15 @@ subroutine prep_glc_merge_lnd_forcing( l2x_g, fractions_g, x2g_g ) end subroutine prep_glc_merge_lnd_forcing - subroutine prep_glc_calc_o2x_gx(timer) + subroutine prep_glc_calc_o2x_gx(ocn_c2_glc, ocn_c2_glcshelf, timer) !--------------------------------------------------------------- ! Description ! Create o2x_gx ! Arguments character(len=*), intent(in) :: timer + logical, intent(in) :: ocn_c2_glc + logical, intent(in) :: ocn_c2_glcshelf character(*), parameter :: subname = '(prep_glc_calc_o2x_gx)' ! Local Variables @@ -686,8 +851,14 @@ subroutine prep_glc_calc_o2x_gx(timer) call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do eoi = 1,num_inst_ocn o2x_ox => component_get_c2x_cx(ocn(eoi)) - call seq_map_map(mapper_So2g, o2x_ox, o2x_gx(eoi), & + if (ocn_c2_glc) then + call seq_map_map(mapper_So2g_tf, o2x_ox, o2x_gx(eoi), & + fldlist=seq_flds_x2g_tf_states_from_ocn,norm=.true.) + end if + if (ocn_c2_glcshelf) then + call seq_map_map(mapper_So2g, o2x_ox, o2x_gx(eoi), & fldlist=seq_flds_x2g_states_from_ocn,norm=.true.) + end if enddo call t_drvstopf (trim(timer)) From ffb207e2e8935f70bdf8089abc6bc5f142daf73a Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Sat, 11 May 2024 15:29:18 -0500 Subject: [PATCH 167/529] Make depth at which to calc TF namelist-configurable --- .../mpas-albany-landice/driver/glc_comp_mct.F | 2 +- .../driver/glc_cpl_indices.F | 4 +-- .../mpas-ocean/driver/mpaso_cpl_indices.F | 4 +-- components/mpas-ocean/driver/ocn_comp_mct.F | 6 ++-- components/mpas-ocean/src/Registry.xml | 8 +++-- .../shared/mpas_ocn_time_average_coupled.F | 32 ++++++++++--------- driver-mct/shr/seq_flds_mod.F90 | 6 ++-- 7 files changed, 34 insertions(+), 28 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index 8bc9fc255d1..ba1043e52e7 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -1410,7 +1410,7 @@ subroutine glc_import_mct(x2g_g, errorCode) n = n + 1 sfcMassBal(i) = x2g_g % rAttr(index_x2g_Flgl_qice, n) floatingBasalMassBal(i) = x2g_g % rAttr(index_x2g_Fogx_qiceli, n) - ismip6_2dThermalForcing(i) = x2g_g % rAttr(index_x2g_So_tf300, n) + ismip6_2dThermalForcing(i) = x2g_g % rAttr(index_x2g_So_tf2d, n) ! surfaceTemperature(i) = x2g_g % rAttr(index_x2g_Sl_tsrf, n) !JW basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogo_qiceh, n) ! basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogx_qicehi, n) diff --git a/components/mpas-albany-landice/driver/glc_cpl_indices.F b/components/mpas-albany-landice/driver/glc_cpl_indices.F index e84ac9174b1..459b534a7e0 100644 --- a/components/mpas-albany-landice/driver/glc_cpl_indices.F +++ b/components/mpas-albany-landice/driver/glc_cpl_indices.F @@ -22,7 +22,7 @@ module glc_cpl_indices integer, public :: index_x2g_So_htv = 0 !Ice shelf ocean heat transfer velocity integer, public :: index_x2g_So_stv = 0 !Ice shelf ocean salinity transfer velocity integer, public :: index_x2g_So_rhoeff = 0 !Ocean effective pressure - integer, public :: index_x2g_So_tf300 = 0 !Ocean thermal forcing at 300m + integer, public :: index_x2g_So_tf2d = 0 !Ocean thermal forcing at predefined critical depth integer, public :: index_x2g_Fogx_qiceli = 0 !Subshelf mass flux integer, public :: index_x2g_Fogx_qicehi = 0 !Subshelf heat flux for the ice sheet @@ -71,7 +71,7 @@ subroutine glc_cpl_indices_set( ) index_x2g_Fogx_qiceli = mct_avect_indexra(x2g,'Fogx_qiceli',perrwith='quiet') index_x2g_Fogx_qicehi = mct_avect_indexra(x2g,'Fogx_qicehi',perrwith='quiet') index_x2g_So_rhoeff = mct_avect_indexra(x2g,'So_rhoeff',perrwith='quiet') - index_x2g_So_tf300 = mct_avect_indexra(x2g,'So_tf300',perrwith='quiet') + index_x2g_So_tf2d = mct_avect_indexra(x2g,'So_tf2d',perrwith='quiet') !Following block of x2g/g2x vectors are used internally within coupler for subshelf melt flux !calculations (and so do not have directly-related export-side arrays) diff --git a/components/mpas-ocean/driver/mpaso_cpl_indices.F b/components/mpas-ocean/driver/mpaso_cpl_indices.F index c51aa68bf5b..c5e84d2509d 100644 --- a/components/mpas-ocean/driver/mpaso_cpl_indices.F +++ b/components/mpas-ocean/driver/mpaso_cpl_indices.F @@ -37,7 +37,7 @@ module mpaso_cpl_indices integer :: index_o2x_So_htv !ocean heat-transfer velocity integer :: index_o2x_So_stv !ocean salt-transfer velocity integer :: index_o2x_So_rhoeff !ocean effective density - integer :: index_o2x_So_tf300 !ocean thermal forcing at 300m + integer :: index_o2x_So_tf2d !ocean thermal forcing at predefined critical depth ! ocn -> drv (BGC) @@ -209,7 +209,7 @@ subroutine mpaso_cpl_indices_set( ) index_o2x_So_htv = mct_avect_indexra(o2x,'So_htv') index_o2x_So_stv = mct_avect_indexra(o2x,'So_stv') index_o2x_So_rhoeff = mct_avect_indexra(o2x,'So_rhoeff') - index_o2x_So_tf300 = mct_avect_indexra(o2x,'So_tf300') + index_o2x_So_tf2d = mct_avect_indexra(o2x,'So_tf2d') index_o2x_So_algae1 = mct_avect_indexra(o2x,'So_algae1',perrWith='quiet') index_o2x_So_algae2 = mct_avect_indexra(o2x,'So_algae2',perrWith='quiet') diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 3132847ecc8..d4f597db228 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -2690,7 +2690,7 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ avgRemovedIceRunoffFlux, & avgLandIceHeatFlux, & avgRemovedIceRunoffHeatFlux, & - avgThermalForcing300m + avgThermalForcingAtCritDepth real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & avgSSHGradient, avgOceanSurfacePhytoC, & @@ -2754,7 +2754,7 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity) call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient) call mpas_pool_get_array(forcingPool, 'avgTotalFreshWaterTemperatureFlux', avgTotalFreshWaterTemperatureFlux) - call mpas_pool_get_array(forcingPool, 'avgThermalForcing300m', avgThermalForcing300m) + call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtCritDepth', avgThermalForcingAtCritDepth) if ( frazilIceActive ) then call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy) @@ -2935,7 +2935,7 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ o2x_o % rAttr(index_o2x_So_stv, n) = landIceTracerTransferVelocities(indexSaltTrans,i) o2x_o % rAttr(index_o2x_So_rhoeff, n) = 0.0_RKIND endif - o2x_o % rAttr(index_o2x_So_tf300, n) = avgThermalForcing300m(i) + o2x_o % rAttr(index_o2x_So_tf2d, n) = avgThermalForcingAtCritDepth(i) !Fyke: test diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index fea5c17b956..83af3163379 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -807,6 +807,10 @@ description="If true, solid runoff from the Antarctic Ice Sheet (below 60S latitude) coming from the coupled is zeroed in the coupler import routines. To be used with data iceberg fluxes coming from the sea ice model." possible_values=".true. or .false." /> + - 300.0_RKIND) then - iLevel0300 = iLevel-1 + if(refBottomDepth(iLevel) > config_2d_thermal_forcing_depth) then + iLevelCritDepth = iLevel-1 exit end if end do @@ -457,13 +459,13 @@ subroutine ocn_time_average_coupled_accumulate(statePool, forcingPool, timeLevel ! calculate thermal forcing at identified level for each cell do iCell = 1, nCells ! ignore cells that are too shallow - if (iLevel0300 <= maxLevelCell(iCell)) then + if (iLevelCritDepth <= maxLevelCell(iCell)) then ! this uses the level shallower than the reference level. could interpolate instead ! note: assuming no LandIce cavity, but we may want to support that - freezingTemp = ocn_freezing_temperature(salinity=activeTracers(indexSalinity, iLevel0300, iCell), & - pressure=pressure(iLevel0300, iCell), inLandIceCavity=.false.) - avgThermalForcing300m(iCell) = ( avgThermalForcing300m(iCell) * nAccumulatedCoupled & - + activeTracers(indexTemperature, iLevel0300, iCell) - freezingTemp ) / ( nAccumulatedCoupled + 1) + freezingTemp = ocn_freezing_temperature(salinity=activeTracers(indexSalinity, iLevelCritDepth, iCell), & + pressure=pressure(iLevelCritDepth, iCell), inLandIceCavity=.false.) + avgThermalForcingAtCritDepth(iCell) = ( avgThermalForcingAtCritDepth(iCell) * nAccumulatedCoupled & + + activeTracers(indexTemperature, iLevelCritDepth, iCell) - freezingTemp ) / ( nAccumulatedCoupled + 1) end if end do !$omp end do diff --git a/driver-mct/shr/seq_flds_mod.F90 b/driver-mct/shr/seq_flds_mod.F90 index 6ecdd5598fc..8d7404b8a85 100644 --- a/driver-mct/shr/seq_flds_mod.F90 +++ b/driver-mct/shr/seq_flds_mod.F90 @@ -2987,12 +2987,12 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'So_rhoeff' call metadata_set(attname, longname, stdname, units) - name = 'So_tf300' + name = 'So_tf2d' call seq_flds_add(o2x_states,trim(name)) call seq_flds_add(x2g_states,trim(name)) call seq_flds_add(x2g_tf_states_from_ocn,trim(name)) - longname = 'ocean thermal forcing at 300 m depth' - stdname = 'ocean_thermal_forcing_at_300m' + longname = 'ocean thermal forcing at predefined critical depth' + stdname = 'ocean_thermal_forcing_at_critical_depth' units = 'C' attname = name call metadata_set(attname, longname, stdname, units) From 3257d65f4ed24d84140616e9e481573a86a14a69 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 13 May 2024 14:41:53 -0500 Subject: [PATCH 168/529] Better differentiate ocn->glc coupling for shelf and tf The entirety of existing ocn->glc coupling was for the ice-shelf coupling. To better differentiate the coupling in this branch based on thermal forcing, this commit ensures there is either a 'shelf' or 'tf' suffix on all ocn-glc coupling variables. --- cime_config/config_grids.xml | 48 ++++++------- driver-mct/cime_config/config_component.xml | 18 ++--- .../cime_config/namelist_definition_drv.xml | 20 +++--- driver-mct/main/cime_comp_mod.F90 | 19 +++--- driver-mct/main/prep_glc_mod.F90 | 68 +++++++++---------- driver-mct/shr/seq_flds_mod.F90 | 18 ++--- 6 files changed, 96 insertions(+), 95 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index ee5931ee03b..58a2d7c7a8b 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -5503,15 +5503,15 @@ - cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.aisgis20km_aave.190403.nc - cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.aisgis20km_bilin.190403.nc + cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.aisgis20km_aave.190403.nc + cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.aisgis20km_bilin.190403.nc cpl/gridmaps/mpas.aisgis20km/map_mpas.aisgis20km_to_oEC60to30v3_aave.190403.nc cpl/gridmaps/mpas.aisgis20km/map_mpas.aisgis20km_to_oEC60to30v3_bilin.190403.nc - cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_to_mpas.aisgis20km_aave.190713.nc - cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_to_mpas.aisgis20km_bilin.190713.nc + cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_to_mpas.aisgis20km_aave.190713.nc + cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_to_mpas.aisgis20km_bilin.190713.nc cpl/gridmaps/mpas.aisgis20km/map_mpas.aisgis20km_to_oEC60to30v3wLI_aave.190713.nc cpl/gridmaps/mpas.aisgis20km/map_mpas.aisgis20km_to_oEC60to30v3wLI_bilin.190713.nc @@ -5528,8 +5528,8 @@ - cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.gis20km_aave.181115.nc - cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.gis20km_bilin.181115.nc + cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.gis20km_aave.181115.nc + cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_mpas.gis20km_bilin.181115.nc cpl/gridmaps/mpas.gis20km/map_mpas.gis20km_to_oEC60to30v3_aave.181115.nc cpl/gridmaps/mpas.gis20km/map_mpas.gis20km_to_oEC60to30v3_aave.181115.nc @@ -5556,8 +5556,8 @@ - cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis20km_aave.230510.nc - cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis20km_bilin.230510.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis20km_aave.230510.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis20km_bilin.230510.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_EC30to60E2r2_aave.230510.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_EC30to60E2r2_aave.230510.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_EC30to60E2r2_aave.230510.nc @@ -5567,8 +5567,8 @@ - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfaave.20240403.nc - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfbilin.20240403.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfaave.20240403.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfbilin.20240403.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis20km_esmfneareststod.20240422.deeperThan300m.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis20km/map_gis20km_to_IcoswISC30E3r5_esmfaave.20240403.nc @@ -5604,8 +5604,8 @@ - cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_gis1to10km_aave.200602.nc - cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_gis1to10km_bilin.200602.nc + cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_gis1to10km_aave.200602.nc + cpl/gridmaps/oEC60to30v3/map_oEC60to30v3_to_gis1to10km_bilin.200602.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_oEC60to30v3_aave.200602.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_oEC60to30v3_aave.200602.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_oEC60to30v3_aave.200602.nc @@ -5615,8 +5615,8 @@ - cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10km_aave.210304.nc - cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10km_bilin.210304.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10km_aave.210304.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10km_bilin.210304.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10km_to_EC30to60E2r2_aave.210304.nc @@ -5651,8 +5651,8 @@ - cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10r02_aave.230725.nc - cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10r02_bilin.230725.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10r02_aave.230725.nc + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis1to10r02_bilin.230725.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10r02_to_EC30to60E2r2_aave.230725.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10r02_to_EC30to60E2r2_aave.230725.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10r02_to_EC30to60E2r2_aave.230725.nc @@ -5662,8 +5662,8 @@ - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfaave.20240403.nc - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfbilin.20240403.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfaave.20240403.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfbilin.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc @@ -5878,11 +5878,11 @@ cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU240_aave.151209.nc - cpl/gridmaps/oQU240/map_oQU240_to_ais20km_aave.151209.nc + cpl/gridmaps/oQU240/map_oQU240_to_ais20km_aave.151209.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU240_nearestdtos.151209.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU240_nearestdtos.151209.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU240_nearestdtos.151209.nc - cpl/gridmaps/oQU240/map_oQU240_to_ais20km_nearestdtos.151209.nc + cpl/gridmaps/oQU240/map_oQU240_to_ais20km_nearestdtos.151209.nc @@ -5892,8 +5892,8 @@ cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_nearestdtos.160331.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_nearestdtos.160331.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_nearestdtos.160331.nc - cpl/gridmaps/oQU120/map_oQU120_to_ais20km_aave.160331.nc - cpl/gridmaps/oQU120/map_oQU120_to_ais20km_neareststod.160331.nc + cpl/gridmaps/oQU120/map_oQU120_to_ais20km_aave.160331.nc + cpl/gridmaps/oQU120/map_oQU120_to_ais20km_neareststod.160331.nc @@ -5903,8 +5903,8 @@ cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_nearestdtos.190207.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_nearestdtos.190207.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_nearestdtos.190207.nc - cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_nomask_to_ais20km_aave.190207.nc - cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_nomask_to_ais20km_neareststod.190207.nc + cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_nomask_to_ais20km_aave.190207.nc + cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_nomask_to_ais20km_neareststod.190207.nc diff --git a/driver-mct/cime_config/config_component.xml b/driver-mct/cime_config/config_component.xml index 666b2de17f2..6fb75609e5a 100644 --- a/driver-mct/cime_config/config_component.xml +++ b/driver-mct/cime_config/config_component.xml @@ -1898,40 +1898,40 @@ glc2ocn runoff mapping file decomp type for ice runoff - + char idmap_ignore run_domain env_run.xml - ocn2glc flux mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + ocn2glc shelf flux mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and will generate a runtime error if in fact a file is required for the given compset - + char X,Y Y run_domain env_run.xml - ocn2glc flux mapping file decomp type + ocn2glc shelf flux mapping file decomp type - + char idmap_ignore run_domain env_run.xml - ocn2glc state mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + ocn2glc shelf state mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and will generate a runtime error if in fact a file is required for the given compset - + char X,Y Y run_domain env_run.xml - ocn2glc state mapping file decomp type + ocn2glc shelf state mapping file decomp type @@ -1949,7 +1949,7 @@ Y run_domain env_run.xml - ocn2glc state mapping file decomp type + ocn2glc thermal forcing state mapping file decomp type diff --git a/driver-mct/cime_config/namelist_definition_drv.xml b/driver-mct/cime_config/namelist_definition_drv.xml index 5aabbe8bb98..316f24a0f58 100644 --- a/driver-mct/cime_config/namelist_definition_drv.xml +++ b/driver-mct/cime_config/namelist_definition_drv.xml @@ -4530,20 +4530,20 @@ - + char mapping abs seq_maps - ocn to glc flux mapping file for fluxes + ocn to glc shelf mapping file for fluxes - $OCN2GLC_FMAPNAME + $OCN2GLC_SHELF_FMAPNAME - + char mapping seq_maps @@ -4555,25 +4555,25 @@ grid. - $OCN2GLC_FMAPTYPE + $OCN2GLC_SHELF_FMAPTYPE X - + char mapping abs seq_maps - ocn to glc state mapping file for states + ocn to glc shelf mapping file for states - $OCN2GLC_SMAPNAME + $OCN2GLC_SHELF_SMAPNAME - + char mapping seq_maps @@ -4585,7 +4585,7 @@ grid. - $OCN2GLC_SMAPTYPE + $OCN2GLC_SHELF_SMAPTYPE X diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index 5b4d487aa0c..fc69cc4c2cb 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -433,8 +433,8 @@ module cime_comp_mod logical :: lnd_c2_rof ! .true. => lnd to rof coupling on logical :: lnd_c2_glc ! .true. => lnd to glc coupling on logical :: ocn_c2_atm ! .true. => ocn to atm coupling on - logical :: ocn_c2_glc ! .true. => ocn to glc coupling on logical :: ocn_c2_ice ! .true. => ocn to ice coupling on + logical :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on logical :: ocn_c2_rof ! .true. => ocn to rof coupling on @@ -1732,8 +1732,9 @@ subroutine cime_init() lnd_c2_rof = .false. lnd_c2_glc = .false. ocn_c2_atm = .false. - ocn_c2_glc = .false. ocn_c2_ice = .false. + ocn_c2_glctf = .false. + ocn_c2_glcshelf = .false. ocn_c2_wav = .false. ocn_c2_rof = .false. ice_c2_atm = .false. @@ -1770,7 +1771,7 @@ subroutine cime_init() if (ocn_present) then if (atm_prognostic) ocn_c2_atm = .true. if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm - if (glc_prognostic) ocn_c2_glc = .true. + if (glc_prognostic) ocn_c2_glctf = .true. if (ice_prognostic) ocn_c2_ice = .true. if (wav_prognostic) ocn_c2_wav = .true. if (rofocn_prognostic) ocn_c2_rof = .true. @@ -1870,7 +1871,7 @@ subroutine cime_init() write(logunit,F0L)'lnd_c2_rof = ',lnd_c2_rof write(logunit,F0L)'lnd_c2_glc = ',lnd_c2_glc write(logunit,F0L)'ocn_c2_atm = ',ocn_c2_atm - write(logunit,F0L)'ocn_c2_glc = ',ocn_c2_glc + write(logunit,F0L)'ocn_c2_glctf = ',ocn_c2_glctf write(logunit,F0L)'ocn_c2_ice = ',ocn_c2_ice write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_wav = ',ocn_c2_wav @@ -2026,7 +2027,7 @@ subroutine cime_init() call prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) - call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) + call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glctf, ocn_c2_glcshelf) call prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav) @@ -4215,8 +4216,8 @@ subroutine cime_run_ocnglc_coupling() if (glc_present) then ! create o2x_gx for either ocn-glc coupling or ocn-glc shelf coupling - if (ocn_c2_glc .or. (ocn_c2_glcshelf .and. glcshelf_c2_ocn)) then - call prep_glc_calc_o2x_gx(ocn_c2_glc, ocn_c2_glcshelf, timer='CPL:glcprep_ocn2glc') !remap ocean fields to o2x_g at ocean couping interval + if (ocn_c2_glctf .or. (ocn_c2_glcshelf .and. glcshelf_c2_ocn)) then + call prep_glc_calc_o2x_gx(ocn_c2_glctf, ocn_c2_glcshelf, timer='CPL:glcprep_ocn2glc') !remap ocean fields to o2x_g at ocean couping interval endif ! if ice-shelf coupling is on, now proceed to handle those calculations here in the coupler @@ -4350,7 +4351,7 @@ subroutine cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_call if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) ! NOTE - only create appropriate input to glc if the avg_alarm is on - if (lnd_c2_glc .or. ocn_c2_glc .or. ocn_c2_glcshelf) then + if (lnd_c2_glc .or. ocn_c2_glctf .or. ocn_c2_glcshelf) then if (glcrun_avg_alarm) then call prep_glc_accum_avg(timer='CPL:glcprep_avg', & lnd2glc_averaged_now=lnd2glc_averaged_now) @@ -4363,7 +4364,7 @@ subroutine cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_call call prep_glc_mrg_lnd(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') endif - if (ocn_c2_glc) then + if (ocn_c2_glctf) then ! note: o2x_gx is handled in prep_glc_calc_o2x_gx, which is called ! from cime_run_ocnglc_coupling in this module call prep_glc_mrg_ocn(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgocnx2g') diff --git a/driver-mct/main/prep_glc_mod.F90 b/driver-mct/main/prep_glc_mod.F90 index 5ed81f4c65e..6ce136305d0 100644 --- a/driver-mct/main/prep_glc_mod.F90 +++ b/driver-mct/main/prep_glc_mod.F90 @@ -54,8 +54,8 @@ module prep_glc_mod public :: prep_glc_get_mapper_Sl2g public :: prep_glc_get_mapper_Fl2g - public :: prep_glc_get_mapper_So2g - public :: prep_glc_get_mapper_Fo2g + public :: prep_glc_get_mapper_So2g_shelf + public :: prep_glc_get_mapper_Fo2g_shelf public :: prep_glc_calculate_subshelf_boundary_fluxes @@ -77,9 +77,9 @@ module prep_glc_mod ! mappers type(seq_map), pointer :: mapper_Sl2g type(seq_map), pointer :: mapper_Fl2g - type(seq_map), pointer :: mapper_So2g + type(seq_map), pointer :: mapper_So2g_shelf + type(seq_map), pointer :: mapper_Fo2g_shelf type(seq_map), pointer :: mapper_So2g_tf - type(seq_map), pointer :: mapper_Fo2g type(seq_map), pointer :: mapper_Fg2l ! attribute vectors @@ -137,7 +137,7 @@ module prep_glc_mod !================================================================================================ - subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) + subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glctf, ocn_c2_glcshelf) !--------------------------------------------------------------- ! Description @@ -146,7 +146,7 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) ! Arguments type (seq_infodata_type) , intent(inout) :: infodata logical , intent(in) :: lnd_c2_glc ! .true. => lnd to glc coupling on - logical , intent(in) :: ocn_c2_glc ! .true. => ocn to glc coupling on + logical , intent(in) :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on logical , intent(in) :: ocn_c2_glcshelf ! .true. => ocn to glc shelf coupling on ! ! Local Variables @@ -181,9 +181,9 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) allocate(mapper_Sl2g) allocate(mapper_Fl2g) - allocate(mapper_So2g) + allocate(mapper_So2g_shelf) allocate(mapper_So2g_tf) - allocate(mapper_Fo2g) + allocate(mapper_Fo2g_shelf) allocate(mapper_Fg2l) smb_renormalize = prep_glc_do_renormalize_smb(infodata) @@ -254,7 +254,7 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) end if ! setup needed for either kind of ocn2glc coupling - if (glc_present .and. (ocn_c2_glc .or. ocn_c2_glcshelf)) then + if (glc_present .and. (ocn_c2_glctf .or. ocn_c2_glcshelf)) then call seq_comm_getData(CPLID, & mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) @@ -281,8 +281,8 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) if (trim(ocn_gnam) /= trim(glc_gnam)) samegrid_go = .false. end if - ! setup needed for ocn2glc (TF) coupling - if (glc_present .and. ocn_c2_glc) then + ! setup needed for ocn2glc TF coupling + if (glc_present .and. ocn_c2_glctf) then if (iamroot_CPLID) then write(logunit,*) ' ' write(logunit,F00) 'Initializing mapper_So2g_tf' @@ -296,18 +296,18 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glc, ocn_c2_glcshelf) if (glc_present .and. ocn_c2_glcshelf) then if (iamroot_CPLID) then write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_So2g' + write(logunit,F00) 'Initializing mapper_So2g_shelf' end if - call seq_map_init_rcfile(mapper_So2g, ocn(1), glc(1), & - 'seq_maps.rc','ocn2glc_smapname:','ocn2glc_smaptype:',samegrid_go, & - 'mapper_So2g initialization',esmf_map_flag) + call seq_map_init_rcfile(mapper_So2g_shelf, ocn(1), glc(1), & + 'seq_maps.rc','ocn2glc_shelf_smapname:','ocn2glc_shelf_smaptype:',samegrid_go, & + 'mapper_So2g_shelf initialization',esmf_map_flag) if (iamroot_CPLID) then write(logunit,*) ' ' - write(logunit,F00) 'Initializing mapper_Fo2g' + write(logunit,F00) 'Initializing mapper_Fo2g_shelf' end if - call seq_map_init_rcfile(mapper_Fo2g, ocn(1), glc(1), & - 'seq_maps.rc','ocn2glc_fmapname:','ocn2glc_fmaptype:',samegrid_go, & - 'mapper_Fo2g initialization',esmf_map_flag) + call seq_map_init_rcfile(mapper_Fo2g_shelf, ocn(1), glc(1), & + 'seq_maps.rc','ocn2glc_shelf_fmapname:','ocn2glc_shelf_fmaptype:',samegrid_go, & + 'mapper_Fo2g_shelf initialization',esmf_map_flag) !Initialize module-level arrays associated with compute_melt_fluxes allocate(oceanTemperature(lsize_g)) allocate(oceanSalinity(lsize_g)) @@ -833,14 +833,14 @@ subroutine prep_glc_merge_lnd_forcing( l2x_g, fractions_g, x2g_g ) end subroutine prep_glc_merge_lnd_forcing - subroutine prep_glc_calc_o2x_gx(ocn_c2_glc, ocn_c2_glcshelf, timer) + subroutine prep_glc_calc_o2x_gx(ocn_c2_glctf, ocn_c2_glcshelf, timer) !--------------------------------------------------------------- ! Description ! Create o2x_gx ! Arguments character(len=*), intent(in) :: timer - logical, intent(in) :: ocn_c2_glc + logical, intent(in) :: ocn_c2_glctf logical, intent(in) :: ocn_c2_glcshelf character(*), parameter :: subname = '(prep_glc_calc_o2x_gx)' @@ -851,13 +851,13 @@ subroutine prep_glc_calc_o2x_gx(ocn_c2_glc, ocn_c2_glcshelf, timer) call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do eoi = 1,num_inst_ocn o2x_ox => component_get_c2x_cx(ocn(eoi)) - if (ocn_c2_glc) then + if (ocn_c2_glctf) then call seq_map_map(mapper_So2g_tf, o2x_ox, o2x_gx(eoi), & fldlist=seq_flds_x2g_tf_states_from_ocn,norm=.true.) end if if (ocn_c2_glcshelf) then - call seq_map_map(mapper_So2g, o2x_ox, o2x_gx(eoi), & - fldlist=seq_flds_x2g_states_from_ocn,norm=.true.) + call seq_map_map(mapper_So2g_shelf, o2x_ox, o2x_gx(eoi), & + fldlist=seq_flds_x2g_shelf_states_from_ocn,norm=.true.) end if enddo @@ -1023,8 +1023,8 @@ subroutine prep_glc_calculate_subshelf_boundary_fluxes !Done here instead of in glc-frequency mapping so it happens within ocean coupling interval. ! Also could map o2x_ox->o2x_gx(1) but using x2g_gx as destination allows us to see ! these fields on the GLC grid of the coupler history file, which helps with debugging. - call seq_map_map(mapper_So2g, o2x_ox, x2g_gx, & - fldlist=seq_flds_x2g_states_from_ocn,norm=.true.) + call seq_map_map(mapper_So2g_shelf, o2x_ox, x2g_gx, & + fldlist=seq_flds_x2g_shelf_states_from_ocn,norm=.true.) ! inputs to melt flux calculation index_x2g_So_blt = mct_avect_indexra(x2g_gx,'So_blt',perrwith='quiet') @@ -1622,15 +1622,15 @@ function prep_glc_get_mapper_Fl2g() prep_glc_get_mapper_Fl2g => mapper_Fl2g end function prep_glc_get_mapper_Fl2g - function prep_glc_get_mapper_So2g() - type(seq_map), pointer :: prep_glc_get_mapper_So2g - prep_glc_get_mapper_So2g=> mapper_So2g - end function prep_glc_get_mapper_So2g + function prep_glc_get_mapper_So2g_shelf() + type(seq_map), pointer :: prep_glc_get_mapper_So2g_shelf + prep_glc_get_mapper_So2g_shelf=> mapper_So2g_shelf + end function prep_glc_get_mapper_So2g_shelf - function prep_glc_get_mapper_Fo2g() - type(seq_map), pointer :: prep_glc_get_mapper_Fo2g - prep_glc_get_mapper_Fo2g=> mapper_Fo2g - end function prep_glc_get_mapper_Fo2g + function prep_glc_get_mapper_Fo2g_shelf() + type(seq_map), pointer :: prep_glc_get_mapper_Fo2g_shelf + prep_glc_get_mapper_Fo2g_shelf=> mapper_Fo2g_shelf + end function prep_glc_get_mapper_Fo2g_shelf !*********************************************************************** ! diff --git a/driver-mct/shr/seq_flds_mod.F90 b/driver-mct/shr/seq_flds_mod.F90 index 8d7404b8a85..4fb616b9cec 100644 --- a/driver-mct/shr/seq_flds_mod.F90 +++ b/driver-mct/shr/seq_flds_mod.F90 @@ -212,7 +212,7 @@ module seq_flds_mod character(CXX) :: seq_flds_g2o_ice_fluxes character(CXX) :: seq_flds_x2g_states character(CXX) :: seq_flds_x2g_states_from_lnd - character(CXX) :: seq_flds_x2g_states_from_ocn + character(CXX) :: seq_flds_x2g_shelf_states_from_ocn character(CXX) :: seq_flds_x2g_tf_states_from_ocn character(CXX) :: seq_flds_x2g_fluxes character(CXX) :: seq_flds_x2g_fluxes_from_lnd @@ -348,7 +348,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) character(CXX) :: g2o_ice_fluxes = '' character(CXX) :: x2g_states = '' character(CXX) :: x2g_states_from_lnd = '' - character(CXX) :: x2g_states_from_ocn = '' + character(CXX) :: x2g_shelf_states_from_ocn = '' character(CXX) :: x2g_tf_states_from_ocn = '' character(CXX) :: x2g_fluxes = '' character(CXX) :: x2g_fluxes_from_lnd = '' @@ -2940,7 +2940,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) name = 'So_blt' call seq_flds_add(o2x_states,trim(name)) call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_states_from_ocn,trim(name)) + call seq_flds_add(x2g_shelf_states_from_ocn,trim(name)) longname = 'Ice shelf boundary layer ocean temperature' stdname = 'Ice_shelf_boundary_layer_ocean_temperature' units = 'C' @@ -2950,7 +2950,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) name = 'So_bls' call seq_flds_add(o2x_states,trim(name)) call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_states_from_ocn,trim(name)) + call seq_flds_add(x2g_shelf_states_from_ocn,trim(name)) longname = 'Ice shelf boundary layer ocean salinity' stdname = 'Ice_shelf_boundary_layer_ocean_salinity' units = 'psu' @@ -2960,7 +2960,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) name = 'So_htv' call seq_flds_add(o2x_states,trim(name)) call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_states_from_ocn,trim(name)) + call seq_flds_add(x2g_shelf_states_from_ocn,trim(name)) longname = 'Ice shelf ocean heat transfer velocity' stdname = 'Ice_shelf_ocean_heat_transfer_velocity' units = 'm/s' @@ -2970,7 +2970,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) name = 'So_stv' call seq_flds_add(o2x_states,trim(name)) call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_states_from_ocn,trim(name)) + call seq_flds_add(x2g_shelf_states_from_ocn,trim(name)) longname = 'Ice shelf ocean salinity transfer velocity' stdname = 'Ice_shelf_ocean_salinity_transfer_velocity' units = 'm/s' @@ -2980,7 +2980,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) name = 'So_rhoeff' call seq_flds_add(o2x_states,trim(name)) call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_states_from_ocn,trim(name)) + call seq_flds_add(x2g_shelf_states_from_ocn,trim(name)) longname = 'Ocean effective pressure' stdname = 'Ocean_effective_pressure' units = 'Pa' @@ -3948,7 +3948,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) seq_flds_g2x_states_to_lnd = trim(g2x_states_to_lnd) seq_flds_x2g_states = trim(x2g_states) seq_flds_x2g_states_from_lnd = trim(x2g_states_from_lnd) - seq_flds_x2g_states_from_ocn = trim(x2g_states_from_ocn) + seq_flds_x2g_shelf_states_from_ocn = trim(x2g_shelf_states_from_ocn) seq_flds_x2g_tf_states_from_ocn = trim(x2g_tf_states_from_ocn) seq_flds_xao_states = trim(xao_states) seq_flds_xao_albedo = trim(xao_albedo) @@ -4016,7 +4016,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) write(logunit,*) subname//': seq_flds_x2g_states= ',trim(seq_flds_x2g_states) write(logunit,*) subname//': seq_flds_x2g_states_from_lnd= ',trim(seq_flds_x2g_states_from_lnd) write(logunit,*) subname//': seq_flds_l2x_states_to_glc= ',trim(seq_flds_l2x_states_to_glc) - write(logunit,*) subname//': seq_flds_x2g_states_from_ocn= ',trim(seq_flds_x2g_states_from_ocn) + write(logunit,*) subname//': seq_flds_x2g_shelf_states_from_ocn= ',trim(seq_flds_x2g_shelf_states_from_ocn) write(logunit,*) subname//': seq_flds_x2g_tf_states_from_ocn= ',trim(seq_flds_x2g_tf_states_from_ocn) write(logunit,*) subname//': seq_flds_x2g_fluxes= ',trim(seq_flds_x2g_fluxes) write(logunit,*) subname//': seq_flds_x2g_fluxes_from_lnd= ',trim(seq_flds_x2g_fluxes_from_lnd) From ccc0416cfa1725487e176b91726387b3f9e4add7 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 13 May 2024 16:08:27 -0500 Subject: [PATCH 169/529] Add TL319_IcoswISC30E3r5_gis1to10kmR2 grid specification This allows testing with a MALI mesh where fjords are resolved. --- cime_config/config_grids.xml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 58a2d7c7a8b..e1727e58ae3 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -1909,6 +1909,16 @@ IcoswISC30E3r5 + + TL319 + TL319 + IcoswISC30E3r5 + JRA025 + mpas.gis1to10kmR2 + null + IcoswISC30E3r5 + + ne30np4.pg2 r05 @@ -5664,6 +5674,7 @@ cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfaave.20240403.nc cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfbilin.20240403.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_gis1to10kmR2_esmfneareststod.20240422.deeperThan300m.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc cpl/gridmaps/mpas.gis1to10km/map_gis1to10kmR2_to_IcoswISC30E3r5_esmfaave.20240403.nc From 90c1a1d386ba80b023aa24436379ac93f6563c5d Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 13 May 2024 20:51:46 -0500 Subject: [PATCH 170/529] Update mpas.gis1to10kmR2 mesh to include subglacial runoff field The facemelting parameterization requires a subglacial runoff field as an input. Eventually, we may have this calculated prognostically in E3SM from MALI and/or ELM, but that is not planned for the near-term. Until then, a reasonable approximation is to use a constant historical climatological field. This commit updates the mpas.gis1to10kmR2 input file to include a ismip6Runoff field provided by ISMIP6. The field used is a 1995-2014 mean from the MIROC5 model, which was bias-corrected to match MAR over that period. See www.the-cryosphere.net/14/985/2020/ Fig. 2 and related text for details. --- components/mpas-albany-landice/cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/cime_config/buildnml b/components/mpas-albany-landice/cime_config/buildnml index 8dcafdac1c7..4256df0f283 100755 --- a/components/mpas-albany-landice/cime_config/buildnml +++ b/components/mpas-albany-landice/cime_config/buildnml @@ -88,7 +88,7 @@ def buildnml(case, caseroot, compname): decomp_date += '051920' decomp_prefix += 'mpasli.graph.info.' elif glc_grid == 'mpas.gis1to10kmR2': - grid_date += '20230202' + grid_date += '20240513' grid_prefix += 'gis_1to10km_r02' decomp_date += '020223' decomp_prefix += 'mpasli.graph.info.' From 5c03d4039c758adf7df139e87f475cd62574c7d4 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 19 Aug 2024 23:00:09 -0500 Subject: [PATCH 171/529] Correct indexing for critical depth This uses the layer that the desired depth is in, rather than the layer above it. Co-authored-by: Xylar Asay-Davis --- .../mpas-ocean/src/shared/mpas_ocn_time_average_coupled.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_time_average_coupled.F b/components/mpas-ocean/src/shared/mpas_ocn_time_average_coupled.F index 8a731990bb4..746784f7409 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_time_average_coupled.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_time_average_coupled.F @@ -447,10 +447,10 @@ subroutine ocn_time_average_coupled_accumulate(statePool, forcingPool, timeLevel ! find vertical level that is just above the critical depth reference level ! this does not account for depression due to ice shelf cavities or sea ice - iLevelCritDepth = 1 + iLevelCritDepth = nVertLevels ! default to deepest layer if we don't find the desired depth do iLevel = 1, nVertLevels if(refBottomDepth(iLevel) > config_2d_thermal_forcing_depth) then - iLevelCritDepth = iLevel-1 + iLevelCritDepth = iLevel exit end if end do From 3f2615d31b8901a9978e8bb53534a42cadddcc93 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 10 Sep 2024 16:12:26 -0500 Subject: [PATCH 172/529] Add config_2d_thermal_forcing_depth to namelist system --- components/mpas-ocean/bld/build-namelist | 1 + components/mpas-ocean/bld/build-namelist-section | 1 + .../bld/namelist_files/namelist_defaults_mpaso.xml | 1 + .../bld/namelist_files/namelist_definition_mpaso.xml | 8 ++++++++ 4 files changed, 11 insertions(+) diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index 460b9ecda42..011396d879f 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -731,6 +731,7 @@ if (($OCN_ICEBERG eq 'true') && ($OCN_FORCING eq 'active_atm')) { } else { add_default($nl, 'config_remove_ais_ice_runoff', 'val'=>".false."); } +add_default($nl, 'config_2d_thermal_forcing_depth'); ###################################### # Namelist group: shortwaveRadiation # diff --git a/components/mpas-ocean/bld/build-namelist-section b/components/mpas-ocean/bld/build-namelist-section index c5dad5d935a..115bd09c96a 100644 --- a/components/mpas-ocean/bld/build-namelist-section +++ b/components/mpas-ocean/bld/build-namelist-section @@ -239,6 +239,7 @@ add_default($nl, 'config_sgr_salinity_prescribed'); add_default($nl, 'config_remove_ais_river_runoff'); add_default($nl, 'config_remove_ais_ice_runoff'); +add_default($nl, 'config_2d_thermal_forcing_depth'); ###################################### # Namelist group: shortwaveRadiation # diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index fd278561665..12a97836035 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -354,6 +354,7 @@ .false. .false. +300.0 'jerlov' diff --git a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml index bea1e98d9de..45e4caf798a 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml @@ -1271,6 +1271,14 @@ Valid values: .true. or .false. Default: Defined in namelist_defaults.xml + +Depth at which to pass 2d thermal forcing to the coupler for use in the GLC component. Note that mapping files for this field must be created with a mask to exclude ocean grid cells shallower than this value and thus must be regenerated if this value is changed. + +Valid values: any non-negative value +Default: Defined in namelist_defaults.xml + + From b6e410046f468f8faff395295b1b3b93dbf7c1a0 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 11 Sep 2024 16:42:32 -0500 Subject: [PATCH 173/529] Add config_glc_thermal_forcing_coupling_mode option This commit adds an MPAS-Ocean namelist option for activating the OCN-GLC TF coupling. This option controls if E3SM should enable the OCN-GLC TF coupling and also makes the associated TF calculations conditional on the option being active. The option defaults to false and there currently are not any compsets that activate it, so it can only be enabled with a namelist usermod at present. --- components/mpas-ocean/driver/ocn_comp_mct.F | 22 ++++- components/mpas-ocean/src/Registry.xml | 4 + .../shared/mpas_ocn_time_average_coupled.F | 84 ++++++++++--------- driver-mct/main/cime_comp_mod.F90 | 1 - 4 files changed, 68 insertions(+), 43 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index d4f597db228..54cae42dab2 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -223,6 +223,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ logical, pointer :: config_use_activeTracers_surface_restoring logical, pointer :: config_use_surface_salinity_monthly_restoring character (len=StrKIND), pointer :: config_land_ice_flux_mode + character (len=StrKIND), pointer :: config_glc_thermal_forcing_coupling_mode ! ssh coupling interval initialization integer, pointer :: index_avgZonalSSHGradient, index_avgMeridionalSSHGradient @@ -878,6 +879,16 @@ end subroutine xml_stream_get_attributes call mpas_log_write('ERROR: unknown land_ice_flux_mode: ' // trim(config_land_ice_flux_mode), MPAS_LOG_CRIT) end if + call mpas_pool_get_config(domain % configs, 'config_glc_thermal_forcing_coupling_mode', config_glc_thermal_forcing_coupling_mode) + if ( trim(config_glc_thermal_forcing_coupling_mode) == 'off' ) then + call seq_infodata_PutData(infodata, ocn_c2_glctf=.false.) + else if ( trim(config_glc_thermal_forcing_coupling_mode) == '2d' ) then + call seq_infodata_PutData(infodata, ocn_c2_glctf=.true.) + else + call mpas_log_write('ERROR: unknown config_glc_thermal_forcing_coupling_mode: ' // & + trim(config_glc_thermal_forcing_coupling_mode), MPAS_LOG_CRIT) + end if + !----------------------------------------------------------------------- ! ! get initial state from driver @@ -2709,6 +2720,7 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ config_use_MacroMoleculesTracers_sea_ice_coupling character (len=StrKIND), pointer :: config_land_ice_flux_mode + character (len=StrKIND), pointer :: config_glc_thermal_forcing_coupling_mode logical :: keepFrazil @@ -2719,6 +2731,8 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ call mpas_pool_get_config(domain % configs, 'config_land_ice_flux_mode', config_land_ice_flux_mode) call mpas_pool_get_config(domain % configs, 'config_remove_ais_river_runoff', config_remove_ais_river_runoff) call mpas_pool_get_config(domain % configs, 'config_remove_ais_ice_runoff', config_remove_ais_ice_runoff) + call mpas_pool_get_config(domain % configs, 'config_glc_thermal_forcing_coupling_mode', & + config_glc_thermal_forcing_coupling_mode) call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers', config_use_DMSTracers) call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers', config_use_MacroMoleculesTracers) call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers_sea_ice_coupling', & @@ -2754,7 +2768,6 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity) call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient) call mpas_pool_get_array(forcingPool, 'avgTotalFreshWaterTemperatureFlux', avgTotalFreshWaterTemperatureFlux) - call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtCritDepth', avgThermalForcingAtCritDepth) if ( frazilIceActive ) then call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy) @@ -2774,6 +2787,9 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffFlux', avgRemovedIceRunoffFlux) call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffHeatFlux', avgRemovedIceRunoffHeatFlux) endif + if (trim(config_glc_thermal_forcing_coupling_mode) == '2d') then + call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtCritDepth', avgThermalForcingAtCritDepth) + endif ! BGC fields if (config_use_ecosysTracers) then @@ -2935,7 +2951,9 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ o2x_o % rAttr(index_o2x_So_stv, n) = landIceTracerTransferVelocities(indexSaltTrans,i) o2x_o % rAttr(index_o2x_So_rhoeff, n) = 0.0_RKIND endif - o2x_o % rAttr(index_o2x_So_tf2d, n) = avgThermalForcingAtCritDepth(i) + if (trim(config_glc_thermal_forcing_coupling_mode) == '2d') then + o2x_o % rAttr(index_o2x_So_tf2d, n) = avgThermalForcingAtCritDepth(i) + endif !Fyke: test diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 83af3163379..d4cd8cbac5a 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -807,6 +807,10 @@ description="If true, solid runoff from the Antarctic Ice Sheet (below 60S latitude) coming from the coupled is zeroed in the coupler import routines. To be used with data iceberg fluxes coming from the sea ice model." possible_values=".true. or .false." /> + config_2d_thermal_forcing_depth) then - iLevelCritDepth = iLevel - exit - end if - end do - !$omp parallel - !$omp do schedule(runtime) - ! calculate thermal forcing at identified level for each cell - do iCell = 1, nCells - ! ignore cells that are too shallow - if (iLevelCritDepth <= maxLevelCell(iCell)) then - ! this uses the level shallower than the reference level. could interpolate instead - ! note: assuming no LandIce cavity, but we may want to support that - freezingTemp = ocn_freezing_temperature(salinity=activeTracers(indexSalinity, iLevelCritDepth, iCell), & - pressure=pressure(iLevelCritDepth, iCell), inLandIceCavity=.false.) - avgThermalForcingAtCritDepth(iCell) = ( avgThermalForcingAtCritDepth(iCell) * nAccumulatedCoupled & - + activeTracers(indexTemperature, iLevelCritDepth, iCell) - freezingTemp ) / ( nAccumulatedCoupled + 1) - end if - end do - !$omp end do - !$omp end parallel + if (trim(config_glc_thermal_forcing_coupling_mode) == '2d') then + call mpas_pool_get_array(forcingPool, 'avgThermalForcingAtCritDepth', avgThermalForcingAtCritDepth) + call mpas_pool_get_subpool(statePool, 'tracers', tracersPool) + call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 2) + call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature) + call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity) + + + ! find vertical level that is just above the critical depth reference level + ! this does not account for depression due to ice shelf cavities or sea ice + iLevelCritDepth = nVertLevels ! default to deepest layer if we don't find the desired depth + do iLevel = 1, nVertLevels + if(refBottomDepth(iLevel) > config_2d_thermal_forcing_depth) then + iLevelCritDepth = iLevel + exit + end if + end do + !$omp parallel + !$omp do schedule(runtime) + ! calculate thermal forcing at identified level for each cell + do iCell = 1, nCells + ! ignore cells that are too shallow + if (iLevelCritDepth <= maxLevelCell(iCell)) then + ! this uses the level shallower than the reference level. could interpolate instead + ! note: assuming no LandIce cavity, but we may want to support that + freezingTemp = ocn_freezing_temperature(salinity=activeTracers(indexSalinity, iLevelCritDepth, iCell), & + pressure=pressure(iLevelCritDepth, iCell), inLandIceCavity=.false.) + avgThermalForcingAtCritDepth(iCell) = ( avgThermalForcingAtCritDepth(iCell) * nAccumulatedCoupled & + + activeTracers(indexTemperature, iLevelCritDepth, iCell) - freezingTemp ) / ( nAccumulatedCoupled + 1) + end if + end do + !$omp end do + !$omp end parallel + endif ! accumulate BGC coupling fields if necessary if (config_use_ecosysTracers) then diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index fc69cc4c2cb..f582f7bd5aa 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -1771,7 +1771,6 @@ subroutine cime_init() if (ocn_present) then if (atm_prognostic) ocn_c2_atm = .true. if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm - if (glc_prognostic) ocn_c2_glctf = .true. if (ice_prognostic) ocn_c2_ice = .true. if (wav_prognostic) ocn_c2_wav = .true. if (rofocn_prognostic) ocn_c2_rof = .true. From b8c3864a59e86c587ff404d295fb11a76c83173a Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 11 Sep 2024 22:11:42 -0500 Subject: [PATCH 174/529] add ocn_c2_glctf to seq_infodata_PutData_explicit and getData --- driver-mct/shr/seq_infodata_mod.F90 | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/driver-mct/shr/seq_infodata_mod.F90 b/driver-mct/shr/seq_infodata_mod.F90 index fcc6a21eef1..01ff3c98880 100644 --- a/driver-mct/shr/seq_infodata_mod.F90 +++ b/driver-mct/shr/seq_infodata_mod.F90 @@ -203,6 +203,7 @@ MODULE seq_infodata_mod logical :: ocn_prognostic ! does component model need input data from driver logical :: ocnrof_prognostic ! does component need rof data logical :: ocn_c2_glcshelf ! will ocn component send data for ice shelf fluxes in driver + logical :: ocn_c2_glctf ! will ocn component send data for thermal forcing in driver logical :: ice_present ! does component model exist logical :: ice_prognostic ! does component model need input data from driver logical :: iceberg_prognostic ! does the ice model support icebergs @@ -765,6 +766,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%ocn_prognostic = .false. infodata%ocnrof_prognostic = .false. infodata%ocn_c2_glcshelf = .false. + infodata%ocn_c2_glctf = .false. infodata%ice_prognostic = .false. infodata%glc_prognostic = .false. ! It's safest to assume glc_coupled_fluxes = .true. if it's not set elsewhere, @@ -1004,7 +1006,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, rofocn_prognostic, & - ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & + ocn_present, ocn_prognostic, ocnrof_prognostic, & + ocn_c2_glcshelf, ocn_c2_glctf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & iac_present, iac_prognostic, & @@ -1179,6 +1182,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: ocn_prognostic logical, optional, intent(OUT) :: ocnrof_prognostic logical, optional, intent(OUT) :: ocn_c2_glcshelf + logical, optional, intent(OUT) :: ocn_c2_glctf logical, optional, intent(OUT) :: ice_present logical, optional, intent(OUT) :: ice_prognostic logical, optional, intent(OUT) :: iceberg_prognostic @@ -1365,6 +1369,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(ocn_prognostic) ) ocn_prognostic = infodata%ocn_prognostic if ( present(ocnrof_prognostic) ) ocnrof_prognostic = infodata%ocnrof_prognostic if ( present(ocn_c2_glcshelf) ) ocn_c2_glcshelf = infodata%ocn_c2_glcshelf + if ( present(ocn_c2_glctf) ) ocn_c2_glctf = infodata%ocn_c2_glctf if ( present(ice_present) ) ice_present = infodata%ice_present if ( present(ice_prognostic) ) ice_prognostic = infodata%ice_prognostic if ( present(iceberg_prognostic)) iceberg_prognostic = infodata%iceberg_prognostic @@ -1557,7 +1562,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, rofocn_prognostic, & - ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & + ocn_present, ocn_prognostic, ocnrof_prognostic, & + ocn_c2_glcshelf, ocn_c2_glctf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & glc_coupled_fluxes, & @@ -1732,6 +1738,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: ocn_prognostic logical, optional, intent(IN) :: ocnrof_prognostic logical, optional, intent(IN) :: ocn_c2_glcshelf + logical, optional, intent(IN) :: ocn_c2_glctf logical, optional, intent(IN) :: ice_present logical, optional, intent(IN) :: ice_prognostic logical, optional, intent(IN) :: iceberg_prognostic @@ -1917,6 +1924,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(ocn_prognostic) ) infodata%ocn_prognostic = ocn_prognostic if ( present(ocnrof_prognostic)) infodata%ocnrof_prognostic = ocnrof_prognostic if ( present(ocn_c2_glcshelf)) infodata%ocn_c2_glcshelf = ocn_c2_glcshelf + if ( present(ocn_c2_glctf)) infodata%ocn_c2_glctf = ocn_c2_glctf if ( present(ice_present) ) infodata%ice_present = ice_present if ( present(ice_prognostic) ) infodata%ice_prognostic = ice_prognostic if ( present(iceberg_prognostic)) infodata%iceberg_prognostic = iceberg_prognostic @@ -2229,6 +2237,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom) call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom) + call shr_mpi_bcast(infodata%ocn_c2_glctf, mpicom) call shr_mpi_bcast(infodata%ice_present, mpicom) call shr_mpi_bcast(infodata%ice_prognostic, mpicom) call shr_mpi_bcast(infodata%iceberg_prognostic, mpicom) @@ -2515,6 +2524,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%ocn_c2_glctf, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_ny, mpicom, pebcast=cmppe) ! dead_comps is true if it's ever set to true @@ -2591,6 +2601,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%ocn_c2_glctf, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ice_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ice_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%iceberg_prognostic, mpicom, pebcast=cplpe) @@ -2948,6 +2959,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'ocn_prognostic = ', infodata%ocn_prognostic write(logunit,F0L) subname,'ocnrof_prognostic = ', infodata%ocnrof_prognostic write(logunit,F0L) subname,'ocn_c2_glcshelf = ', infodata%ocn_c2_glcshelf + write(logunit,F0L) subname,'ocn_c2_glctf = ', infodata%ocn_c2_glctf write(logunit,F0L) subname,'ice_present = ', infodata%ice_present write(logunit,F0L) subname,'ice_prognostic = ', infodata%ice_prognostic write(logunit,F0L) subname,'iceberg_prognostic = ', infodata%iceberg_prognostic From 114c89e0185b518d5f5e832ad02e07077a1d3282 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 11 Sep 2024 16:51:58 -0500 Subject: [PATCH 175/529] Add config_glc_thermal_forcing_coupling_mode to nl system Eventually, when we have compsets that require this mode, it should be controlled analogously to MPASO_ISMF. --- components/mpas-ocean/bld/build-namelist | 1 + components/mpas-ocean/bld/build-namelist-section | 1 + .../bld/namelist_files/namelist_defaults_mpaso.xml | 1 + .../bld/namelist_files/namelist_definition_mpaso.xml | 8 ++++++++ 4 files changed, 11 insertions(+) diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index 011396d879f..e492acc89ad 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -731,6 +731,7 @@ if (($OCN_ICEBERG eq 'true') && ($OCN_FORCING eq 'active_atm')) { } else { add_default($nl, 'config_remove_ais_ice_runoff', 'val'=>".false."); } +add_default($nl, 'config_glc_thermal_forcing_coupling_mode'); add_default($nl, 'config_2d_thermal_forcing_depth'); ###################################### diff --git a/components/mpas-ocean/bld/build-namelist-section b/components/mpas-ocean/bld/build-namelist-section index 115bd09c96a..88e81ab2509 100644 --- a/components/mpas-ocean/bld/build-namelist-section +++ b/components/mpas-ocean/bld/build-namelist-section @@ -239,6 +239,7 @@ add_default($nl, 'config_sgr_salinity_prescribed'); add_default($nl, 'config_remove_ais_river_runoff'); add_default($nl, 'config_remove_ais_ice_runoff'); +add_default($nl, 'config_glc_thermal_forcing_coupling_mode'); add_default($nl, 'config_2d_thermal_forcing_depth'); ###################################### diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index 12a97836035..09965cb8ac8 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -354,6 +354,7 @@ .false. .false. +'off' 300.0 diff --git a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml index 45e4caf798a..e2498597aa3 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml @@ -1271,6 +1271,14 @@ Valid values: .true. or .false. Default: Defined in namelist_defaults.xml + +If and how MPAS-Ocean sends thermal forcing to GLC (MALI) in E3SM. This is used for ocean coupling with a melt parameterization for grounded marine ice-cliffs in MALI. This is primarily relevant to the Greenland Ice Sheet, but also relevant to the Antarctic Ice Sheet. 'none' means no coupling of thermal forcing. '2d' means thermal forcing at a prescribed depth is passed to GLC. That depth is controlled by 'config_2d_thermal_forcing_depth', and the resulting thermal forcing field is calculated in the field 'avgThermalForcingAtCritDepth'. + +Valid values: 'off' or '2d' +Default: Defined in namelist_defaults.xml + + Depth at which to pass 2d thermal forcing to the coupler for use in the GLC component. Note that mapping files for this field must be created with a mask to exclude ocean grid cells shallower than this value and thus must be regenerated if this value is changed. From 28a25ddffecc08781756c201fa56d765be5c8f53 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 11 Sep 2024 17:10:14 -0500 Subject: [PATCH 176/529] Create testmod and test for TF coupling feature --- cime_config/tests.py | 1 + .../testmods_dirs/mpaso/ocn_glc_tf_coupling/README | 12 ++++++++++++ .../mpaso/ocn_glc_tf_coupling/shell_commands | 4 ++++ .../mpaso/ocn_glc_tf_coupling/user_nl_mpaso | 1 + 4 files changed, 18 insertions(+) create mode 100644 components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/README create mode 100644 components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/shell_commands create mode 100644 components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/user_nl_mpaso diff --git a/cime_config/tests.py b/cime_config/tests.py index 1cbf28b8397..80f5f8140a7 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -305,6 +305,7 @@ "ERS_Ld5.T62_oQU120.CMPASO-NYF", "ERS.f09_g16_g.MALISIA", "ERS_Ld5.TL319_oQU240wLI_ais8to30.MPAS_LISIO_JRA1p5.mpaso-ocn_glcshelf", + "ERS_Ld5.TL319_IcoswISC30E3r5_gis20.MPAS_LISIO_JRA1p5.mpaso-ocn_glc_tf_coupling", "SMS_P12x2.ne4pg2_oQU480.WCYCL1850NS.allactive-mach_mods", "ERS_Ln9.ne4pg2_ne4pg2.F2010-MMF1.eam-mmf_crmout", ) diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/README b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/README new file mode 100644 index 00000000000..bd801c44f8a --- /dev/null +++ b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/README @@ -0,0 +1,12 @@ +This testdef is used to test a stealth feature that enables coupling between +OCN and GLC for Greenland, which passes ocean thermal forcing from OCN to GLC +and uses that in a parameterization for marine melting of grounded vertical +cliffs. + +It changes one mpaso namelist variable, + config_glc_thermal_forcing_coupling_mode +from its default value to '2d'. +This tests the ocn/glc TF coupling. + +It also specified that DATM forcing should be restricted to 1958. +This allows JRA1p5 forcing to be used without a large input data requirement. diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/shell_commands b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/shell_commands new file mode 100644 index 00000000000..1d43ad8c5ba --- /dev/null +++ b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/shell_commands @@ -0,0 +1,4 @@ +./xmlchange DATM_CLMNCEP_YR_START=1958 +./xmlchange DATM_CLMNCEP_YR_END=1958 +./xmlchange DROF_STRM_YR_START=1958 +./xmlchange DROF_STRM_YR_END=1958 diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/user_nl_mpaso b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/user_nl_mpaso new file mode 100644 index 00000000000..0e137862083 --- /dev/null +++ b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/ocn_glc_tf_coupling/user_nl_mpaso @@ -0,0 +1 @@ +config_glc_thermal_forcing_coupling_mode = '2d' From 97b7fc0e3ea8a7a4c8cb617aa83907131d6a6459 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Fri, 20 Sep 2024 11:26:20 -0500 Subject: [PATCH 177/529] Add TL319_oQU240wLI_gis20 configuration --- cime_config/config_grids.xml | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index e1727e58ae3..6240d4e320b 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -1899,6 +1899,16 @@ IcoswISC30E3r5 + + TL319 + TL319 + oQU240wLI + JRA025 + mpas.gis20km + null + oQU240wLI + + TL319 TL319 @@ -5565,6 +5575,18 @@ cpl/gridmaps/mpas.gis20km/map_gis20km_to_TL319_traave.20240404.nc + + cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis20km_esmfaave.20240919.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis20km_esmfbilin.20240919.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI_to_gis20km_esmfneareststod.20240919.deeperThan300m.nc + cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc + cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc + cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc + cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc + cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc + cpl/gridmaps/mpas.gis20km/map_gis20km_to_oQU240wLI_esmfaave.20240919.nc + + cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis20km_aave.230510.nc cpl/gridmaps/EC30to60E2r2/map_EC30to60E2r2_to_gis20km_bilin.230510.nc From dccd2056009331446b501b7fd1643af2430d8041 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 20 Sep 2024 12:48:09 -0500 Subject: [PATCH 178/529] Update test to use oQU240wLI and move to e3sm_ocnice_stealth_features --- cime_config/tests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/tests.py b/cime_config/tests.py index 80f5f8140a7..5205d226998 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -266,6 +266,7 @@ "SMS_D_Ld1.T62_oQU240wLI.GMPAS-IAF-PISMF.mpaso-impl_top_drag", "SMS_D_Ld1.T62_oQU240.GMPAS-IAF.mpaso-harmonic_mean_drag", "SMS_D_Ld1.T62_oQU240.GMPAS-IAF.mpaso-upwind_advection", + "ERS_Ld5.TL319_oQU240wLI_gis20.MPAS_LISIO_JRA1p5.mpaso-ocn_glc_tf_coupling", ) }, @@ -305,7 +306,6 @@ "ERS_Ld5.T62_oQU120.CMPASO-NYF", "ERS.f09_g16_g.MALISIA", "ERS_Ld5.TL319_oQU240wLI_ais8to30.MPAS_LISIO_JRA1p5.mpaso-ocn_glcshelf", - "ERS_Ld5.TL319_IcoswISC30E3r5_gis20.MPAS_LISIO_JRA1p5.mpaso-ocn_glc_tf_coupling", "SMS_P12x2.ne4pg2_oQU480.WCYCL1850NS.allactive-mach_mods", "ERS_Ln9.ne4pg2_ne4pg2.F2010-MMF1.eam-mmf_crmout", ) From 8968cf34c28fde45a4f443a116f9c293c6f9c189 Mon Sep 17 00:00:00 2001 From: Stephen Price Date: Fri, 20 Sep 2024 13:58:43 -0500 Subject: [PATCH 179/529] Update glc copuler budgets for Grenland Clean up commenting and debugging lines, leaving bare minimum needed to make draft PR understandable. --- driver-mct/main/seq_diag_mct.F90 | 138 +++++++++---------------------- 1 file changed, 39 insertions(+), 99 deletions(-) diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 556beae6175..94446a3a349 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -48,7 +48,7 @@ module seq_diag_mct use shr_reprosum_mod, only : shr_reprosum_calc use seq_diagBGC_mct, only : seq_diagBGC_preprint_mct, seq_diagBGC_print_mct - use prep_glc_mod, only : prep_glc_get_x2gacc_gx_cnt !SFP: added this and next + use prep_glc_mod, only : prep_glc_get_x2gacc_gx_cnt use glc_elevclass_mod, only: glc_get_num_elevation_classes implicit none @@ -143,13 +143,13 @@ module seq_diag_mct integer(in),parameter :: f_hsen =10 ! heat : sensible integer(in),parameter :: f_hpolar =11 ! heat : AIS imbalance integer(in),parameter :: f_hh2ot =12 ! heat : water temperature - integer(in),parameter :: f_hgsmb =13 ! heat : GIS SMB !SFP added + integer(in),parameter :: f_hgsmb =13 ! heat : Greenland ice sheet surface mass balance integer(in),parameter :: f_wfrz =14 ! water: freezing integer(in),parameter :: f_wmelt =15 ! water: melting integer(in),parameter :: f_wrain =16 ! water: precip, liquid integer(in),parameter :: f_wsnow =17 ! water: precip, frozen integer(in),parameter :: f_wpolar =18 ! water: AIS imbalance - integer(in),parameter :: f_wgsmb =19 ! water: GIS SMB !SFP added + integer(in),parameter :: f_wgsmb =19 ! water: Greenland ice sheet surface mass balance integer(in),parameter :: f_wevap =20 ! water: evaporation integer(in),parameter :: f_wroff =21 ! water: runoff/flood integer(in),parameter :: f_wioff =22 ! water: frozen runoff @@ -270,7 +270,7 @@ module seq_diag_mct integer :: index_l2x_Flrl_irrig integer :: index_l2x_Flrl_wslake - integer, allocatable :: index_l2x_Flgl_qice(:) !SFP: added this and next; unclear if this is the best way to treat these + integer, allocatable :: index_l2x_Flgl_qice(:) integer, allocatable :: index_x2l_Sg_ice_covered(:) integer :: index_x2l_Faxa_lwdn @@ -348,7 +348,7 @@ module seq_diag_mct integer :: index_g2x_Fogg_rofi integer :: index_g2x_Figg_rofi - integer :: index_x2g_Flgl_qice !SFP added + integer :: index_x2g_Flgl_qice integer :: index_x2o_Foxx_rofl_16O integer :: index_x2o_Foxx_rofi_16O @@ -446,8 +446,8 @@ module seq_diag_mct integer :: index_x2i_Faxa_snow_18O integer :: index_x2i_Faxa_snow_HDO - integer :: glc_nec !SFP: added - integer :: x2gacc_gx_cnt ! SFP added (maybe not needed) + integer :: glc_nec + integer :: x2gacc_gx_cnt !=============================================================================== contains @@ -881,7 +881,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) type(mct_aVect), pointer :: l2x_l ! model to drv bundle type(mct_aVect), pointer :: x2l_l ! drv to model bundle type(mct_ggrid), pointer :: dom_l - integer(in) :: n,ic,nf,ip ! generic index + integer(in) :: n,ic,nf,ip ! generic index integer(in) :: kArea ! index of area field in aVect integer(in) :: kl ! fraction indices integer(in) :: lSize ! size of aVect @@ -889,9 +889,9 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) logical,save :: first_time = .true. logical,save :: flds_wiso_lnd = .false. - real(r8) :: l2x_Flgl_qice_col_sum !SFP: sum of fluxes over no. MECs (cols) + real(r8) :: l2x_Flgl_qice_col_sum ! for summing fluxes over no. of elev. classes - character(len=64) :: name !SFP: added this and next 2 for support of working w/ data in MECs + character(len=64) :: name character(len= 2) :: cnum integer(in) :: num @@ -937,7 +937,6 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_irrig = mct_aVect_indexRA(l2x_l,'Flrl_irrig', perrWith='quiet') index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') - !SFP: added this loop do num=0,glc_nec write(cnum,'(i2.2)') num name = 'Flgl_qice' // cnum @@ -979,15 +978,15 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) if (index_l2x_Flrl_irrig /= 0) then nf = f_wroff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_irrig,n) end if - nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi,n) + nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi,n) ! contribution from land ice calving currently zero l2x_Flgl_qice_col_sum = 0.0d0 do num=0,glc_nec - !SFP: this should sum the contributions from each of the n vectors in the total no. of MECs - !SFP: product on RHS is the SMB flux times the fraction of area in that particular elevation class times the land cell area - l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) * ca_l !SFP added + ! sums the contributions from fluxes in each set of elevation classes + ! RHS product is flux times fraction of area in specific elevation class times land cell area + l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) * ca_l end do - nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - l2x_Flgl_qice_col_sum !SFP added + nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - l2x_Flgl_qice_col_sum if ( flds_wiso_lnd )then nf = f_wevap_16O; @@ -1022,11 +1021,10 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) end if end do -! budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice !SFP: waiting for this to contain actual non-zero values - - budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice !SFP added + budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice ! contribution from land ice calving currently zero + budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice - ! SFP: are these needed? Currently not sure how / if / when to deallocate these ... + ! Nneeded? Not sure if / when these should be deallocated !deallocate(index_l2x_Flgl_qice(0:glc_nec)) !deallocate(index_x2l_Sg_ice_covered(0:glc_nec)) @@ -1305,14 +1303,14 @@ end subroutine seq_diag_rof_mct ! Compute global glc input/output flux diagnostics ! ! !REVISION HISTORY: - ! 2008-jul-10 - T. Craig - update + ! 2024-Sept. - S. Price - update ! ! !INTERFACE: ------------------------------------------------------------------ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) type(component_type) , intent(in) :: glc ! component type for instance1 - type(mct_aVect) , intent(in) :: frac_g ! frac bundle !SFP: does not look like fractions are needed / used here? + type(mct_aVect) , intent(in) :: frac_g ! frac bundle (may not be used / needed here) type(seq_infodata_type) , intent(in) :: infodata logical , intent(in), optional :: do_x2g logical , intent(in), optional :: do_g2x @@ -1329,7 +1327,7 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) real(r8) :: ca_g ! area of a grid cell logical,save :: first_time = .true. - integer,save :: counter,smb_counter,calving_counter !SFP: added (mostly for debugging) + integer,save :: counter,smb_counter,calving_counter ! SFP: Debugging integer,save :: smb_vector_length,calving_vector_length !----- formats ----- @@ -1347,7 +1345,9 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) g2x_g => component_get_c2x_cx(glc) x2gacc_g => component_get_x2c_cx(glc) - if( present(do_g2x))then !SPF: glc to coupler + ip = p_inst + + if( present(do_g2x))then ! do fields from glc to coupler (g2x_) if (first_time) then @@ -1358,34 +1358,12 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) index_g2x_Fogg_rofi = mct_aVect_indexRA(g2x_g,'Fogg_rofi') index_g2x_Figg_rofi = mct_aVect_indexRA(g2x_g,'Figg_rofi') - !SFP:debug - !write(logunit,*) ' ' - !write(logunit,*) ' index_g2x_Fogg_rofl = ', index_g2x_Fogg_rofl - !write(logunit,*) ' index_g2x_Fogg_rofi = ', index_g2x_Fogg_rofi - !write(logunit,*) ' index_g2x_Figg_rofi = ', index_g2x_Figg_rofi - !write(logunit,*) ' ' - end if - !ip = p_inst !SFP: this value, day or inst, does not change anything here - ip = p_day - ic = c_glc_gr !SFP: use recieve here ("_gr") since this is coming from glc to coupler? + ic = c_glc_gr kArea = mct_aVect_indexRA(dom_g%data,afldname) lSize = mct_avect_lSize(g2x_g) - !SFP:debug - !if(calving_counter==0)then - !write(logunit,*) ' ' - !write(logunit,*) ' calving vector length (7425 in coupler) = ', lSize - !write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) - !write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) - !write(logunit,*) ' intial value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) - !write(logunit,*) ' calving flux to ocean (Fogg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Fogg_rofi,1) - !write(logunit,*) ' calving flux to ice (Figg_rofi) in one cell = ', g2x_g%rAttr(index_g2x_Figg_rofi,1) - !write(logunit,*) ' calving flux X area to ocean (Fogg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Fogg_rofi,1) - !write(logunit,*) ' calving flux X area to ice (Figg_rofi) in one cell = ', dom_g%data%rAttr(kArea,1)*g2x_g%rAttr(index_g2x_Figg_rofi,1) - !end if - do n=1,lSize ca_g = dom_g%data%rAttr(kArea,n) nf = f_wroff; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_g*g2x_g%rAttr(index_g2x_Fogg_rofl,n) @@ -1395,81 +1373,43 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice - !SFP: only needed for debugging - !calving_vector_length = calving_vector_length +lSize - !calving_counter = calving_counter + 1 + endif ! end do fields from glc to coupler (g2x_) - !SFP:debug - !if(calving_counter==48)then !one day at 30 min land/atmos time steps - !write(logunit,*) ' calving counter = ', calving_counter - !write(logunit,*) ' final value of calving flux sum vector = ', budg_dataL(f_wioff,ic,ip) - !write(logunit,*) ' ' - !end if + if( present(do_x2g))then ! do fields from coupler to glc (x2g_) - endif !SFP: end 'do_g2x' - - if( present(do_x2g))then !SFP: coupler to glc - - x2gacc_gx_cnt = prep_glc_get_x2gacc_gx_cnt() !SFP: counter for how many times SMB flux accumulation has occured + x2gacc_gx_cnt = prep_glc_get_x2gacc_gx_cnt() ! counter for how many times SMB flux accumulation has occured ! note that this would be useful below but does not seem to work currently ! (being reset to zero before being called here?) if (first_time) then - smb_counter=0 !SFP: this may be needed in order to turn average flux into accumulated flux (by multiplying average by no of lnd coupling intervals) - - !smb_vector_length = 0 !SFP: debugging only - - index_x2g_Flgl_qice = mct_aVect_indexRA(x2gacc_g,'Flgl_qice') - - !SFP:debug - !write(logunit,*) ' ' - !write(logunit,*) ' index_x2g_Flgl_qice = ', index_x2g_Flgl_qice - !write(logunit,*) ' ' + smb_counter=0 ! something like this (or above) needed to turn average flux + ! into accumulated flux (i.e., multiply average flux by no. of lnd coupling intervals) + index_x2g_Flgl_qice = mct_aVect_indexRA(x2gacc_g,'Flgl_qice') ! While name suggests this holds accumulated flux, + ! it appears to actually be the average flux (e.g. see + ! subroutine 'prep_glc_accum_avg' in prep_glc_mod.f90. + ! (also note that this same value gets copied to x2g_) end if - !ip = p_inst !SFP: as above, day vs. inst. does not seem to matter here - ip = p_day - ic = c_glc_gs ! SFP: use send here ("_gs") since going from coupler to glc? + ic = c_glc_gs kArea = mct_aVect_indexRA(dom_g%data,afldname) lSize = mct_avect_lSize(x2gacc_g) - !SFP:debug - !if(smb_counter==0)then !one day at 30 min land/atmos time steps - !write(logunit,*) ' ' - !write(logunit,*) ' smb vector length (7425 in coupler) = ', lSize - !write(logunit,*) ' kArea(1) = ', dom_g%data%rAttr(kArea,1) - !write(logunit,*) ' kArea(50) = ', dom_g%data%rAttr(kArea,50) - !write(logunit,*) ' initial value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) - !end if - do n=1,lSize ca_g = dom_g%data%rAttr(kArea,n) nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2gacc_g%rAttr(index_x2g_Flgl_qice,n) end do - !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * 48.0d0 !SFP: hack to see if this recovers actual value from time averaged value - !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * x2gacc_gx_cnt !SFP: ideally use this ... but always zero (zeroed before called?) - budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * smb_counter !SFP: this works but smb_counter seems like sloppy way to recover no. of lnd steps per glc coupling step - ! would be nicer to use value of x2gacc_gx_cnt (but always 0 as currently called) + !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * x2gacc_gx_cnt ! ideally use something like this for multiplying average flux + ! to get accumulated flux (but currently always zero) + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * smb_counter ! works for now, but sloppy and only works for a 1 day run budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice smb_vector_length = smb_vector_length +lSize smb_counter = smb_counter + 1 - !SFP:debug - !if(smb_counter==48)then !one day at 30 min land/atmos time steps - !write(logunit,*) ' ' - !write(logunit,*) ' smb_counter = ', smb_counter - !write(logunit,*) ' x2gacc_gx_cnt = ', x2gacc_gx_cnt - !write(logunit,*) ' current value of x2g_ vector = ', x2g_g%rAttr(index_x2g_Flgl_qice,:) - !write(logunit,*) ' current value of x2gacc_ vector = ', x2gacc_g%rAttr(index_x2g_Flgl_qice,:) - !write(logunit,*) ' final value of smb sum vector = ', budg_dataL(f_wgsmb,ic,ip) - !write(logunit,*) ' ' - !end if - - end if !SPF: end do coupler to glc + end if ! end do fields from coupler to glc (x2g_) first_time = .false. From 43f686d5db6cb61aeaf30cfc48c22c434909b80b Mon Sep 17 00:00:00 2001 From: Chloe Date: Wed, 2 Oct 2024 13:11:36 -0700 Subject: [PATCH 180/529] mods to QICE field calcs, added conditional to include land types isice --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 2 +- components/elm/src/biogeophys/SoilTemperatureMod.F90 | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index 850b7eedac5..b4fb3f4fe95 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -222,7 +222,7 @@ subroutine HydrologyDrainage(bounds, & g = col_pp%gridcell(c) ! In the following, we convert glc_snow_persistence_max_days to r8 to avoid overflow if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & - .or. lun_pp%itype(l) == istice_mec) then + .or. lun_pp%itype(l) == istice_mec .or. lun_pp%itype(l) == istice) then qflx_glcice_frz(c) = qflx_snwcp_ice(c) qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index d4a1074bf4a..d4b4753246f 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1643,8 +1643,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & ! as computed in HydrologyDrainageMod.F90. l = col_pp%landunit(c) - if (lun_pp%itype(l)==istice_mec) then - + if ( (lun_pp%itype(l)==istice) .or. (lun_pp%itype(l)==istice_mec) ) then if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater ! melting corresponds to a negative ice flux qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime From d27d7f4bae14847d62794bb851bf288bd22c52ce Mon Sep 17 00:00:00 2001 From: Chloe Date: Wed, 2 Oct 2024 14:49:34 -0700 Subject: [PATCH 181/529] QICE h0 chnages -- not b4b --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 2 +- components/elm/src/biogeophys/SoilTemperatureMod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index b4fb3f4fe95..a62c5c87ab9 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -47,7 +47,7 @@ subroutine HydrologyDrainage(bounds, & ! ! !USES: !$acc routine seq - use landunit_varcon , only : istice, istwet, istsoil, istice_mec, istcrop + use landunit_varcon , only : istice, istwet, istsoil, istice_mec, istcrop, istice use column_varcon , only : icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall, icol_shadewall use elm_varcon , only : denh2o, denice, secspday use elm_varctl , only : glc_snow_persistence_max_days, use_vichydro, use_betr diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index d4b4753246f..9ed41f2afa7 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1316,7 +1316,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & use elm_varctl , only : iulog use elm_varcon , only : tfrz, hfus, grav use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv - use landunit_varcon , only : istsoil, istcrop, istice_mec + use landunit_varcon , only : istsoil, istcrop, istice_mec,istice ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds From 2af43e39e2fd3998c36396de10748e7e649a72f3 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 2 Oct 2024 20:57:15 -0600 Subject: [PATCH 182/529] add new guide for supporting a new grid --- .../add-grid-config.md | 174 ++++++++++++++++++ 1 file changed, 174 insertions(+) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index f46a84afa76..a795bff771c 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -1,3 +1,177 @@ # Add New Grid Configuration to E3SM +In addition to generating input data to support a new grid, several code modifications are required before E3SM can run with the grid. However, the specific changes will depend on how the grid will be used. The intendend model configuration for the new grid will change which files need to be modified. For instance, a grid intended for aquaplanet experiments does not require as many changes as a historical AMIP-style run. + +The guidelines here are meant to outline various possible changes the user should consider when adding support for a new grid. This document cannot be exhaustive, and it is important that the user understands the changes they are making. It is often useful to use a pre-existing grid configuration as a template. Note that the guidelines here are only relevant for "horizontal" grids. Similar considerations are needed to support a new vertical grid. + +When setting up a new grid you will need to edit some or all of these files: + +- `cime_config/config_grids.xml` +- `components/eam/bld/config_files/horiz_grid.xml` +- `components/eam/bld/namelist_files/namelist_defaults_eam.xml` +- `components/eam/bld/namelist_files/namelist_definition.xml` +- `components/elm/bld/namelist_files/namelist_definition.xml` +- `components/elm/bld/namelist_files/namelist_defaults.xml` + +## Mono-Grid vs Bi-Grid vs Tri-Grid + +The mono-bi-tri grid options in E3SM can be confusing, but it's important to understand what these terms mean when adding a new grid to E3SM. At the surface these terms mean that the whole model either using a single grid for all componennt models, or a combination of 2 or 3 grids shared among the component models. Note that mono-grid and bi-grid terms often ignore that the river model needs to be on i/ts own regular lat-lon grid (for now). + +Historically, climate models would use a single grid for all components (i.e. mono-grid), but this is often not the case anymore. In E3SM the ocean and sea-ice components often use targeted regional refinement with special consideration of ocean mesoscale eddies, whereas the atmosphere will generally use a globally homogenous grid. In practice, the main difference between "bi" and "tri" grids often comes down to whether the land surface model shares a grid with the atmosphere or not. The component coupler is in charge of facilitating communication between component models, primarily through fluxes, and so mapping files are needed to support a combination of different grids. E3SMv3 uses a tri-grid configuration for production simulations. + +## Grid Naming Conventions + +The atmosphere grid name should always indicate the "ne" value and add "pg2" to indicate that the physgrid is being used. For a regionally refined mesh (RRM) the grid name should always start with `ne0` followed a descriptive string that includes the region being refined and the degree of refinement. + +**Example**: `ne0np4_northamericax4v1` + +Note that the example indicates a `4x` refinement, but does indicate the base resolution, which is useful to know. A better grid name would be `ne0np4_northamerica30x4v1`, because this tells us that the grid is consistent with `ne30` in the unrefined regions. + +For a rectilinear lat-lon grid used by the land and/or river models the grid name should start with "r" and typically use spacing less than one degree, so they indicate the nominal grid spacing, starting with "0" and omitting the decimal. + +**Examples**: `r05` is 0.5 degree spacing and `r0125` is 1/8 or 0.125 degree spacing. + +For a mono-grid, which can only be used for idealized simulations such as aqua planet and RCE, the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. + +**Example**: `ne30pg2_ne30pg2` + +Bi-grid options should indicate two different grids used for atmosphere/land and ocean/sea-ice models. + +**Example**: `ne30pg2_IcoswISC30E3r5` + +Tri-grid options should indicate three different grids used for atmosphere, land, and ocean/sea-ice models, with the land grid appearing in the middle. + +**Example**: `ne30pg2_r05_IcoswISC30E3r5` + +## Grid Definition + +### Adding a New Grid Alias + +Grid aliases are defined in specified in `cime_config/config_grids.xml` and are used to specify the grid for a case when calling `create_newcase` via the `--res` argument. Below is an example grid alias for the `ne30pg2_r05_IcoswISC30E3r5` grid used in E3SMv3 production simulations. + +``` + + ne30np4.pg2 + r05 + IcoswISC30E3r5 + r05 + null + null + IcoswISC30E3r5 + +``` + +### Domain Files + +Domain files are needed for each grid and are specified in the `` section of `cime_config/config_grids.xml`. The default domain files are grouped by the atmosphere grid. The section for the typical `ne30pg2` grid looks as follows: + +``` + + 21600 + 1 + ... + $DIN_LOC_ROOT/share/domains/domain.lnd.ne30pg2_IcoswISC30E3r5.231121.nc + $DIN_LOC_ROOT/share/domains/domain.ocn.ne30pg2_IcoswISC30E3r5.231121.nc + ... + ne30np4.pg2 is Spectral Elem 1-deg grid w/ 2x2 FV physics grid per element: + +``` + +Notice where I've used ellipses `...` to omit all entires except the lines relevant to the `ne30pg2_r05_IcoswISC30E3r5` grid. Also, note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. See [Generating Domain Files](/generate_domain_files/) for information about creating domain files. + +### Coupler Mapping Files + +The mapping files used by the component coupler to communicate fluxes between the component models must be specified in the `` section of `cime_config/config_grids.xml`. these are organized for specific pairs of grids, such that tri-grids will require multiple sections. The entries relevant for `ne30pg2_r05_IcoswISC30E3r5` are shown below. + +``` + + cpl/gridmaps/ne30pg2/map_ne30pg2_to_IcoswISC30E3r5_traave.20231121.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_IcoswISC30E3r5_trbilin.20231121.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_IcoswISC30E3r5-nomask_trbilin.20231121.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_ne30pg2_traave.20231121.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5_to_ne30pg2_traave.20231121.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_IcoswISC30E3r5_trfvnp2.20231121.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_IcoswISC30E3r5_trfvnp2.20231121.nc + +``` + +``` + + cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_traave.20231130.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_trfvnp2.230516.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_trbilin.20231130.nc + cpl/gridmaps/ne30pg2/map_r05_to_ne30pg2_traave.20231130.nc + cpl/gridmaps/ne30pg2/map_r05_to_ne30pg2_traave.20231130.nc + +``` + +``` + + cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_traave.20231130.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_trfvnp2.230516.nc + cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_trbilin.20231130.nc + +``` + +Note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. + +### Defining a New Atmosphere Grid + +When defining a new atmosphere grid, information needs to be provided on how the grid is constructed. + +To define a new atmosphere grid a line must be added to `components/eam/bld/config_files/horiz_grid.xml` that indicates the numebr of elements and physics columns. In the lines below for `ne30np4` (without the physgrid) and `ne30pg2` (with the physgrid) you can see the value of `ne` is the same (number of elements along a cube edge), but the number of physics columns is different. + +``` + + +``` + +An explanation of how to calculate the number of physics columns can be found here: [Atmosphere Grid Overview](../../../EAM/tech-guide/atmosphere-grid-overview.md). + +For a grid with regional refinement, follow the conventions of other grids in this file. There is no formula to calculate the number of columns for RRM grids, but the value can be obtained from the grid files used for mapping. + +``` + +``` + +### Defining a New Land Grid + +If you are creating a new grid that will be used by the land model the grid name needs to be added to the list `valid_values` associated with the `res` entry in the file `components/elm/bld/namelist_files/namelist_definition.xml` that holds the definition of namelist variables used by the land model. + +``` + +Horizontal resolutions +Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools + +``` + +Simply add the name of your new grid to the list of `valid_values`. + + +## Namelist Variable Defaults + +Each new grid will likely need various new default parameter values to be specified. These parameters can be set for individual simulations by editing the `user_nl_*` files in the case directory, but for these to become defaults any time the grid is used then new defaults need to be specified. + +The lists below show namelist parameters that may need to be specified for a new grid. The creator of a new grid is responsible for understanding these parameters and deciding when new defaults are appropriate. + +### Atmosphere Namelist Parameters + +- `drydep_srf_file` - Data file for surface aerosol deposition +- `bnd_topo` - Surface topography (smoothed for target grid) +- `mesh_file` - HOMME np4 mesh file (exodus format) +- `se_tstep` - HOMME time step [seconds] +- `dt_remap_factor` - HOMME vertical remap factor +- `dt_tracer_factor` - HOMME tracer advection factor +- `hypervis_subcycle_q` - HOMME tracer hyperviscosity factor + +### Land Namelist Parameters + +- `fsurdat` - Surface data file +- `finidat` - Land model initial condition file +- `flanduse_timeseries` - Time-evolving land-use data file + + Back to step-by-step guide for [Adding Support for New Grids](../adding-grid-support-step-by-step-guide.md) From 7428ca71cfab06eb1d845f41137456a60c6c9ed4 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 2 Oct 2024 21:05:01 -0600 Subject: [PATCH 183/529] linter fixes --- .../add-grid-config.md | 40 +++++++++---------- 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index a795bff771c..271b1ef63fd 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -2,7 +2,7 @@ In addition to generating input data to support a new grid, several code modifications are required before E3SM can run with the grid. However, the specific changes will depend on how the grid will be used. The intendend model configuration for the new grid will change which files need to be modified. For instance, a grid intended for aquaplanet experiments does not require as many changes as a historical AMIP-style run. -The guidelines here are meant to outline various possible changes the user should consider when adding support for a new grid. This document cannot be exhaustive, and it is important that the user understands the changes they are making. It is often useful to use a pre-existing grid configuration as a template. Note that the guidelines here are only relevant for "horizontal" grids. Similar considerations are needed to support a new vertical grid. +The guidelines here are meant to outline various possible changes the user should consider when adding support for a new grid. This document cannot be exhaustive, and it is important that the user understands the changes they are making. It is often useful to use a pre-existing grid configuration as a template. Note that the guidelines here are only relevant for "horizontal" grids. Similar considerations are needed to support a new vertical grid. When setting up a new grid you will need to edit some or all of these files: @@ -21,25 +21,25 @@ Historically, climate models would use a single grid for all components (i.e. mo ## Grid Naming Conventions -The atmosphere grid name should always indicate the "ne" value and add "pg2" to indicate that the physgrid is being used. For a regionally refined mesh (RRM) the grid name should always start with `ne0` followed a descriptive string that includes the region being refined and the degree of refinement. +The atmosphere grid name should always indicate the "ne" value and add "pg2" to indicate that the physgrid is being used. For a regionally refined mesh (RRM) the grid name should always start with `ne0` followed a descriptive string that includes the region being refined and the degree of refinement. -**Example**: `ne0np4_northamericax4v1` +**Example**: `ne0np4_northamericax4v1` Note that the example indicates a `4x` refinement, but does indicate the base resolution, which is useful to know. A better grid name would be `ne0np4_northamerica30x4v1`, because this tells us that the grid is consistent with `ne30` in the unrefined regions. -For a rectilinear lat-lon grid used by the land and/or river models the grid name should start with "r" and typically use spacing less than one degree, so they indicate the nominal grid spacing, starting with "0" and omitting the decimal. +For a rectilinear lat-lon grid used by the land and/or river models the grid name should start with "r" and typically use spacing less than one degree, so they indicate the nominal grid spacing, starting with "0" and omitting the decimal. **Examples**: `r05` is 0.5 degree spacing and `r0125` is 1/8 or 0.125 degree spacing. -For a mono-grid, which can only be used for idealized simulations such as aqua planet and RCE, the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. +For a mono-grid, which can only be used for idealized simulations such as aqua planet and RCE, the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. **Example**: `ne30pg2_ne30pg2` -Bi-grid options should indicate two different grids used for atmosphere/land and ocean/sea-ice models. +Bi-grid options should indicate two different grids used for atmosphere/land and ocean/sea-ice models. **Example**: `ne30pg2_IcoswISC30E3r5` -Tri-grid options should indicate three different grids used for atmosphere, land, and ocean/sea-ice models, with the land grid appearing in the middle. +Tri-grid options should indicate three different grids used for atmosphere, land, and ocean/sea-ice models, with the land grid appearing in the middle. **Example**: `ne30pg2_r05_IcoswISC30E3r5` @@ -49,7 +49,7 @@ Tri-grid options should indicate three different grids used for atmosphere, land Grid aliases are defined in specified in `cime_config/config_grids.xml` and are used to specify the grid for a case when calling `create_newcase` via the `--res` argument. Below is an example grid alias for the `ne30pg2_r05_IcoswISC30E3r5` grid used in E3SMv3 production simulations. -``` +```xml ne30np4.pg2 r05 @@ -65,7 +65,7 @@ Grid aliases are defined in specified in `cime_config/config_grids.xml` and are Domain files are needed for each grid and are specified in the `` section of `cime_config/config_grids.xml`. The default domain files are grouped by the atmosphere grid. The section for the typical `ne30pg2` grid looks as follows: -``` +```xml 21600 1 @@ -83,7 +83,7 @@ Notice where I've used ellipses `...` to omit all entires except the lines relev The mapping files used by the component coupler to communicate fluxes between the component models must be specified in the `` section of `cime_config/config_grids.xml`. these are organized for specific pairs of grids, such that tri-grids will require multiple sections. The entries relevant for `ne30pg2_r05_IcoswISC30E3r5` are shown below. -``` +```xml cpl/gridmaps/ne30pg2/map_ne30pg2_to_IcoswISC30E3r5_traave.20231121.nc cpl/gridmaps/ne30pg2/map_ne30pg2_to_IcoswISC30E3r5_trbilin.20231121.nc @@ -95,7 +95,7 @@ The mapping files used by the component coupler to communicate fluxes between th ``` -``` +```xml cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_traave.20231130.nc cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_trfvnp2.230516.nc @@ -105,7 +105,7 @@ The mapping files used by the component coupler to communicate fluxes between th ``` -``` +```xml cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_traave.20231130.nc cpl/gridmaps/ne30pg2/map_ne30pg2_to_r05_trfvnp2.230516.nc @@ -117,28 +117,28 @@ Note that all of these paths are relative to the input data path set as `DIN_LOC ### Defining a New Atmosphere Grid -When defining a new atmosphere grid, information needs to be provided on how the grid is constructed. +When defining a new atmosphere grid, information needs to be provided on how the grid is constructed. -To define a new atmosphere grid a line must be added to `components/eam/bld/config_files/horiz_grid.xml` that indicates the numebr of elements and physics columns. In the lines below for `ne30np4` (without the physgrid) and `ne30pg2` (with the physgrid) you can see the value of `ne` is the same (number of elements along a cube edge), but the number of physics columns is different. +To define a new atmosphere grid a line must be added to `components/eam/bld/config_files/horiz_grid.xml` that indicates the numebr of elements and physics columns. In the lines below for `ne30np4` (without the physgrid) and `ne30pg2` (with the physgrid) you can see the value of `ne` is the same (number of elements along a cube edge), but the number of physics columns is different. -``` +```xml ``` -An explanation of how to calculate the number of physics columns can be found here: [Atmosphere Grid Overview](../../../EAM/tech-guide/atmosphere-grid-overview.md). +An explanation of how to calculate the number of physics columns can be found here: [Atmosphere Grid Overview](../../../EAM/tech-guide/atmosphere-grid-overview.md). For a grid with regional refinement, follow the conventions of other grids in this file. There is no formula to calculate the number of columns for RRM grids, but the value can be obtained from the grid files used for mapping. -``` +```xml ``` ### Defining a New Land Grid -If you are creating a new grid that will be used by the land model the grid name needs to be added to the list `valid_values` associated with the `res` entry in the file `components/elm/bld/namelist_files/namelist_definition.xml` that holds the definition of namelist variables used by the land model. +If you are creating a new grid that will be used by the land model the grid name needs to be added to the list `valid_values` associated with the `res` entry in the file `components/elm/bld/namelist_files/namelist_definition.xml` that holds the definition of namelist variables used by the land model. -``` +```xml Date: Thu, 3 Oct 2024 13:15:40 -0700 Subject: [PATCH 184/529] added conditionals to calc SMB (QICE vars) even for non MEC runs - these changes should be b4b and just add additional SMB output of what would be passed to mali if we had an active GLC --- .../elm/src/biogeophys/HydrologyDrainageMod.F90 | 8 +++++++- components/elm/src/biogeophys/SoilTemperatureMod.F90 | 12 +++++++++++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index a62c5c87ab9..05b5f09622e 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -222,11 +222,17 @@ subroutine HydrologyDrainage(bounds, & g = col_pp%gridcell(c) ! In the following, we convert glc_snow_persistence_max_days to r8 to avoid overflow if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & - .or. lun_pp%itype(l) == istice_mec .or. lun_pp%itype(l) == istice) then + .or. lun_pp%itype(l) == istice_mec) then qflx_glcice_frz(c) = qflx_snwcp_ice(c) qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 end if + + if (lun_pp%itype(l) == istice) then + qflx_glcice_frz(c) = qflx_snwcp_ice(c) + qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + end if + end do ! Determine wetland and land ice hydrology (must be placed here diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index 9ed41f2afa7..c062f1643fd 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1643,7 +1643,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & ! as computed in HydrologyDrainageMod.F90. l = col_pp%landunit(c) - if ( (lun_pp%itype(l)==istice) .or. (lun_pp%itype(l)==istice_mec) ) then + if ( lun_pp%itype(l)==istice_mec) then if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater ! melting corresponds to a negative ice flux qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime @@ -1655,6 +1655,16 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & endif ! liquid water is present endif ! istice_mec + ! for diagnostic QICE SMB output only - + ! these are to calculate SMB even without MECs + if ( lun_pp%itype(l)==istice) then + if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater + ! melting corresponds to a negative ice flux + qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime + qflx_glcice(c) = qflx_glcice(c) - h2osoi_liq(c,j)/dtime + endif ! liquid water is present + endif ! istice_mec + end do ! end of column-loop enddo ! end of level-loop From 8a6317e0e69fdadffbb041b173992f8dee261b84 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 3 Oct 2024 21:54:06 -0500 Subject: [PATCH 185/529] Add moab_dev test suite Add e3sm_moab_dev test suite which runs an ERS test for cases that have at least one data model as well as a fully coupled case. --- cime_config/tests.py | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/cime_config/tests.py b/cime_config/tests.py index eeca5343ba1..5d607763b16 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -751,6 +751,19 @@ ) }, + "e3sm_moab_dev" : { + "time" : "01:00:00", + "tests" : ( + "ERS_Vmoab_Ld3.ne4pg2_oQU480.WCYCL1850NS", + "ERS_Vmoab_Ld3.ne4pg2_oQU480.F1850", + "ERS_Vmoab_Ld3.ne4pg2_ne4pg2.I1850CNPRDCTCBCTOP", + "ERS_Vmoab_Ld3.T62_oQU240wLI.GMPAS-IAF", + "ERS_Vmoab_Ld3.T62_oQU120.CMPASO-NYF", + "ERS_Vmoab_Ld3.r05_r05.RMOSGPCC", + ) + }, + + "e3sm_gpuacc" : { "tests" : ( From c95c1e306cf8b504d526afc6f000160b48c6ff75 Mon Sep 17 00:00:00 2001 From: Chloe Date: Fri, 4 Oct 2024 08:02:57 -0700 Subject: [PATCH 186/529] modified conditional for outputting diagnostic QICE fields --- .../src/biogeophys/HydrologyDrainageMod.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index 05b5f09622e..ca5143567fe 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -222,15 +222,16 @@ subroutine HydrologyDrainage(bounds, & g = col_pp%gridcell(c) ! In the following, we convert glc_snow_persistence_max_days to r8 to avoid overflow if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & - .or. lun_pp%itype(l) == istice_mec) then - qflx_glcice_frz(c) = qflx_snwcp_ice(c) - qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) - if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 - end if - - if (lun_pp%itype(l) == istice) then - qflx_glcice_frz(c) = qflx_snwcp_ice(c) - qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + .or. lun_pp%itype(l) == istice_mec .or. lun_pp%itype(l) == istice) then + + if (lun_pp%itype(l) == istice) then + qflx_glcice_frz(c) = qflx_snwcp_ice(c) + qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + else + qflx_glcice_frz(c) = qflx_snwcp_ice(c) + qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 + end if ! lun_pp%itype(l) == istice end if end do From 1ee9b462c232e860edf5ea8fe134724a951c82ad Mon Sep 17 00:00:00 2001 From: Chloe Date: Fri, 4 Oct 2024 09:07:08 -0700 Subject: [PATCH 187/529] mods to QICE conditions to get b4b --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index ca5143567fe..3e5c8d0221c 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -224,13 +224,14 @@ subroutine HydrologyDrainage(bounds, & if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & .or. lun_pp%itype(l) == istice_mec .or. lun_pp%itype(l) == istice) then - if (lun_pp%itype(l) == istice) then + if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & + .or. lun_pp%itype(l) == istice_mec) then qflx_glcice_frz(c) = qflx_snwcp_ice(c) qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) - else + if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 + else qflx_glcice_frz(c) = qflx_snwcp_ice(c) qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) - if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 end if ! lun_pp%itype(l) == istice end if From d8a9c4fc09d3f190c1c3c3ad11326affe51a7b4a Mon Sep 17 00:00:00 2001 From: Chloe Date: Fri, 4 Oct 2024 10:51:49 -0700 Subject: [PATCH 188/529] QICE calc mods --- components/elm/src/biogeophys/BalanceCheckMod.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/components/elm/src/biogeophys/BalanceCheckMod.F90 b/components/elm/src/biogeophys/BalanceCheckMod.F90 index 7737f2adbe3..23d6acbfc02 100755 --- a/components/elm/src/biogeophys/BalanceCheckMod.F90 +++ b/components/elm/src/biogeophys/BalanceCheckMod.F90 @@ -503,7 +503,11 @@ subroutine ColWaterBalanceCheck( bounds, num_do_smb_c, filter_do_smb_c, & if (glc_dyn_runoff_routing(g)) then ! Need to add qflx_glcice_frz to snow_sinks for the same reason as it is ! added to errh2o above - see the comment above for details. - snow_sinks(c) = snow_sinks(c) + qflx_glcice_frz(c) + if (lun_pp%itype(l) == istice) then + snow_sinks(c) = snow_sinks(c) + else + snow_sinks(c) = snow_sinks(c) + qflx_glcice_frz(c) + end if end if errh2osno(c) = (h2osno(c) - h2osno_old(c)) - (snow_sources(c) - snow_sinks(c)) * dtime From 0a4d14754de4ef5a5702c89dd802c3860404a5ea Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 4 Oct 2024 18:11:46 +0000 Subject: [PATCH 189/529] update ekat (which has updated kokkos) --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index 237edd071c6..ea985c76836 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit 237edd071c6c6e7f92edaa598582ce961c6b69ef +Subproject commit ea985c76836d2ef9d433756654f821a64a7d57bf From 49bd4313135f2262e49698e3673f2a198506f1d4 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 4 Oct 2024 18:12:07 +0000 Subject: [PATCH 190/529] update aurora modules --- cime_config/machines/config_machines.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 981a1b3161b..c5894916e8f 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3793,15 +3793,15 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors /soft/modulefiles /soft/restricted/CNDA/updates/modulefiles - spack-pe-gcc/0.6.1-23.275.2 cmake - python/3.10.10 + spack-pe-gcc/0.7.0-24.086.0 cmake + python/3.10.11 - oneapi/eng-compiler/2024.04.15.002 + oneapi/eng-compiler/2024.07.30.002 mpich/icc-all-pmix-gpu/20240717 - cray-pals/1.3.3 - libfabric/1.15.2.0 + cray-pals/1.4.0 + libfabric/1.20.1 $CIME_OUTPUT_ROOT/$CASE/run From 5ce020b12b3545f31866b38b96bee5db7f45b39e Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Fri, 4 Oct 2024 14:24:00 -0500 Subject: [PATCH 191/529] restart case ERS_Vmoab_Ld3.T62_oQU120.CMPASO-NYF fix for this restart case, prep_ocn_mrg_moab is called after prep_ocn_accum_avg_moab (for restart only) --- driver-moab/main/prep_ocn_mod.F90 | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index b13cce62f95..d3e97c74b56 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -1043,6 +1043,7 @@ subroutine prep_ocn_accum_avg_moab() use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh ! Local Variables integer :: ent_type, ierr + integer noflds, lsize ! used for restart case only? character(CXX) :: tagname character(*), parameter :: subname = '(prep_ocn_accum_avg_moab)' #ifdef MOABDEBUG @@ -1056,7 +1057,18 @@ subroutine prep_ocn_accum_avg_moab() x2oacc_om = 1./x2oacc_om_cnt * x2oacc_om end if + if (.not. allocated(x2o_om)) then + ! we could come here in the restart case; not sure why only for + ! the case ERS_Vmoab_T62_oQU120.CMPASO-NYF + lsize = size(x2oacc_om, 1) + noflds = size(x2oacc_om, 2) + allocate (x2o_om(lsize, noflds)) + arrSize_x2o_om = noflds * lsize + + endif + ! ***NOTE***THE FOLLOWING ACTUALLY MODIFIES x2o_om + x2o_om = x2oacc_om !call mct_avect_copy(x2oacc_ox(eoi), x2o_ox) ! modify the tags @@ -1339,9 +1351,11 @@ subroutine prep_ocn_mrg_moab(infodata, xao_ox) !nwflds = mct_aVect_nRattr(w2x_o) nxflds = mct_aVect_nRattr(xao_o) - !ngflds = mct_aVect_nRattr(g2x_o) - allocate(x2o_om (lsize, noflds)) - arrSize_x2o_om = lsize * noflds ! this willbe used to set/get x2o_om tags + if (.not. allocated(x2o_om)) then + !ngflds = mct_aVect_nRattr(g2x_o) + allocate(x2o_om (lsize, noflds)) + arrSize_x2o_om = lsize * noflds ! this willbe used to set/get x2o_om tags + endif allocate(a2x_om (lsize, naflds)) allocate(i2x_om (lsize, niflds)) allocate(r2x_om (lsize, nrflds)) From 9e3f2a85767029480d487b0dd2f029ec316920be Mon Sep 17 00:00:00 2001 From: Chloe Date: Fri, 4 Oct 2024 13:17:06 -0700 Subject: [PATCH 192/529] mods to QICE scheme, if not GLC/MEC output diagnostic QICE fields that do not change h2o mass balance --- .../elm/src/biogeophys/BalanceCheckMod.F90 | 8 +-- .../src/biogeophys/HydrologyDrainageMod.F90 | 25 +++++---- .../elm/src/biogeophys/SoilTemperatureMod.F90 | 6 ++- .../elm/src/data_types/ColumnDataType.F90 | 52 ++++++++++++++----- 4 files changed, 56 insertions(+), 35 deletions(-) diff --git a/components/elm/src/biogeophys/BalanceCheckMod.F90 b/components/elm/src/biogeophys/BalanceCheckMod.F90 index 23d6acbfc02..48144b045e9 100755 --- a/components/elm/src/biogeophys/BalanceCheckMod.F90 +++ b/components/elm/src/biogeophys/BalanceCheckMod.F90 @@ -167,7 +167,7 @@ subroutine ColWaterBalanceCheck( bounds, num_do_smb_c, filter_do_smb_c, & use elm_varcon , only : spval use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_perv, icol_road_imperv - use landunit_varcon , only : istice_mec, istdlak, istsoil,istcrop,istwet + use landunit_varcon , only : istice_mec, istice, istdlak, istsoil,istcrop,istwet use elm_varctl , only : create_glacier_mec_landunit use elm_initializeMod , only : surfalb_vars use CanopyStateType , only : canopystate_type @@ -503,11 +503,7 @@ subroutine ColWaterBalanceCheck( bounds, num_do_smb_c, filter_do_smb_c, & if (glc_dyn_runoff_routing(g)) then ! Need to add qflx_glcice_frz to snow_sinks for the same reason as it is ! added to errh2o above - see the comment above for details. - if (lun_pp%itype(l) == istice) then - snow_sinks(c) = snow_sinks(c) - else - snow_sinks(c) = snow_sinks(c) + qflx_glcice_frz(c) - end if + snow_sinks(c) = snow_sinks(c) + qflx_glcice_frz(c) end if errh2osno(c) = (h2osno(c) - h2osno_old(c)) - (snow_sources(c) - snow_sinks(c)) * dtime diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index 3e5c8d0221c..35e7643b848 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -120,8 +120,9 @@ subroutine HydrologyDrainage(bounds, & qflx_runoff_r => col_wf%qflx_runoff_r , & ! Output: [real(r8) (:) ] Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) qflx_snwcp_ice => col_wf%qflx_snwcp_ice , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+]` qflx_glcice => col_wf%qflx_glcice , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O /s) - qflx_glcice_frz => col_wf%qflx_glcice_frz & ! Output: [real(r8) (:) ] ice growth (positive definite) (mm H2O/s) - ) + qflx_glcice_frz => col_wf%qflx_glcice_frz , & ! Output: [real(r8) (:) ] ice growth (positive definite) (mm H2O/s) + qflx_glcice_diag => col_wf%qflx_glcice_diag , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) - diagnostic, no MECs or GLC + qflx_glcice_frz_diag => col_wf%qflx_glcice_frz_diag & ! Output: [real(r8) (:) ] ice growth (positive definite) (mm H2O/s)) - diagnostic, no MECs or GLC ! Determine time step and step size @@ -222,19 +223,17 @@ subroutine HydrologyDrainage(bounds, & g = col_pp%gridcell(c) ! In the following, we convert glc_snow_persistence_max_days to r8 to avoid overflow if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & - .or. lun_pp%itype(l) == istice_mec .or. lun_pp%itype(l) == istice) then - - if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & - .or. lun_pp%itype(l) == istice_mec) then - qflx_glcice_frz(c) = qflx_snwcp_ice(c) - qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) - if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 - else - qflx_glcice_frz(c) = qflx_snwcp_ice(c) - qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) - end if ! lun_pp%itype(l) == istice + .or. lun_pp%itype(l) == istice_mec ) then + qflx_glcice_frz(c) = qflx_snwcp_ice(c) + qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 end if + if (lun_pp%itype(l)==istice) then + qflx_glcice_frz_diags(c) = qflx_snwcp_ice(c) + qflx_glcice_diags(c) = qflx_glcice_diags(c) + qflx_glcice_frz_diags(c) + endif + end do ! Determine wetland and land ice hydrology (must be placed here diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index c062f1643fd..c97e68f85ef 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1369,6 +1369,8 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & qflx_snofrz_col => col_wf%qflx_snofrz , & ! Output: [real(r8) (:) ] column-integrated snow freezing rate (positive definite) [kg m-2 s-1] qflx_glcice => col_wf%qflx_glcice , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) [+ = ice grows] qflx_glcice_melt => col_wf%qflx_glcice_melt , & ! Output: [real(r8) (:) ] ice melt (positive definite) (mm H2O/s) + qflx_glcice_diag => col_wf%qflx_glcice_diag , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) [+ = ice grows] + qflx_glcice_melt_diag => col_wf%qflx_glcice_melt_diag , & ! Output: [real(r8) (:) ] ice melt (positive definite) (mm H2O/s) qflx_snomelt => col_wf%qflx_snomelt , & ! Output: [real(r8) (:) ] snow melt (mm H2O /s) eflx_snomelt => col_ef%eflx_snomelt , & ! Output: [real(r8) (:) ] snow melt heat flux (W/m**2) @@ -1660,8 +1662,8 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & if ( lun_pp%itype(l)==istice) then if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater ! melting corresponds to a negative ice flux - qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime - qflx_glcice(c) = qflx_glcice(c) - h2osoi_liq(c,j)/dtime + qflx_glcice_melt_diags(c) = qflx_glcice_melt_diags(c) + h2osoi_liq(c,j)/dtime + qflx_glcice_diags(c) = qflx_glcice_daigs(c) - h2osoi_liq(c,j)/dtime endif ! liquid water is present endif ! istice_mec diff --git a/components/elm/src/data_types/ColumnDataType.F90 b/components/elm/src/data_types/ColumnDataType.F90 index 3cec1d2d303..d74827060d7 100644 --- a/components/elm/src/data_types/ColumnDataType.F90 +++ b/components/elm/src/data_types/ColumnDataType.F90 @@ -502,6 +502,9 @@ module ColumnDataType real(r8), pointer :: qflx_glcice (:) => null() ! net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC real(r8), pointer :: qflx_glcice_frz (:) => null() ! ice growth (positive definite) (mm H2O/s) real(r8), pointer :: qflx_glcice_melt (:) => null() ! ice melt (positive definite) (mm H2O/s) + real(r8), pointer :: qflx_glcice_diag (:) => null() ! net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC + real(r8), pointer :: qflx_glcice_frz_diag (:) => null() ! ice growth (positive definite) (mm H2O/s) + real(r8), pointer :: qflx_glcice_melt_daig(:) => null() ! ice melt (positive definite) (mm H2O/s) real(r8), pointer :: qflx_drain_vr (:,:) => null() ! liquid water lost as drainage (m /time step) real(r8), pointer :: qflx_h2osfc2topsoi (:) => null() ! liquid water coming from surface standing water top soil (mm H2O/s) real(r8), pointer :: qflx_snow2topsoi (:) => null() ! liquid water coming from residual snow to topsoil (mm H2O/s) @@ -5725,6 +5728,9 @@ subroutine col_wf_init(this, begc, endc) allocate(this%qflx_glcice (begc:endc)) ; this%qflx_glcice (:) = spval allocate(this%qflx_glcice_frz (begc:endc)) ; this%qflx_glcice_frz (:) = spval allocate(this%qflx_glcice_melt (begc:endc)) ; this%qflx_glcice_melt (:) = spval + allocate(this%qflx_glcice_diag (begc:endc)) ; this%qflx_glcice_daig (:) = spval + allocate(this%qflx_glcice_frz_diag (begc:endc)) ; this%qflx_glcice_frz_diag (:) = spval + allocate(this%qflx_glcice_melt_diag (begc:endc)) ; this%qflx_glcice_melt_diag(:) = spval allocate(this%qflx_drain_vr (begc:endc,1:nlevgrnd)) ; this%qflx_drain_vr (:,:) = spval allocate(this%qflx_h2osfc2topsoi (begc:endc)) ; this%qflx_h2osfc2topsoi (:) = spval allocate(this%qflx_snow2topsoi (begc:endc)) ; this%qflx_snow2topsoi (:) = spval @@ -5842,21 +5848,39 @@ subroutine col_wf_init(this, begc, endc) call hist_addfld1d (fname='QSNOFRZ', units='kg/m2/s', & avgflag='A', long_name='column-integrated snow freezing rate', & ptr_col=this%qflx_snofrz, set_lake=spval, c2l_scale_type='urbanf', default='inactive') + + if (create_glacier_mec_landunit) then + this%qflx_glcice(begc:endc) = spval + call hist_addfld1d (fname='QICE', units='mm/s', & + avgflag='A', long_name='ice growth/melt', & + ptr_col=this%qflx_glcice, l2g_scale_type='ice') + + this%qflx_glcice_frz(begc:endc) = spval + call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & + avgflag='A', long_name='ice growth', & + ptr_col=this%qflx_glcice_frz, l2g_scale_type='ice') + + this%qflx_glcice_melt(begc:endc) = spval + call hist_addfld1d (fname='QICE_MELT', units='mm/s', & + avgflag='A', long_name='ice melt', & + ptr_col=this%qflx_glcice_melt, l2g_scale_type='ice') + else + this%qflx_glcice_diag(begc:endc) = spval + call hist_addfld1d (fname='QICE', units='mm/s', & + avgflag='A', long_name='diagnostic ice growth/melt (no active GLC/MECs)', & + ptr_col=this%qflx_glcice_diag, l2g_scale_type='ice') + + this%qflx_glcice_frz_diag(begc:endc) = spval + call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & + avgflag='A', long_name='diagnostic ice growth (no active GLC/MECs)', & + ptr_col=this%qflx_glcice_frz_diag, l2g_scale_type='ice') + + this%qflx_glcice_melt_diag(begc:endc) = spval + call hist_addfld1d (fname='QICE_MELT', units='mm/s', & + avgflag='A', long_name='diagnostic ice melt (no active GLC/MECs)', & + ptr_col=this%qflx_glcice_melt_diag, l2g_scale_type='ice') + end if - this%qflx_glcice(begc:endc) = spval - call hist_addfld1d (fname='QICE', units='mm/s', & - avgflag='A', long_name='ice growth/melt', & - ptr_col=this%qflx_glcice, l2g_scale_type='ice') - - this%qflx_glcice_frz(begc:endc) = spval - call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & - avgflag='A', long_name='ice growth', & - ptr_col=this%qflx_glcice_frz, l2g_scale_type='ice') - - this%qflx_glcice_melt(begc:endc) = spval - call hist_addfld1d (fname='QICE_MELT', units='mm/s', & - avgflag='A', long_name='ice melt', & - ptr_col=this%qflx_glcice_melt, l2g_scale_type='ice') ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at any ! given time step but only if there is at least one snow layer (for all landunits From 518ea7b43d5ba9eac67a4d51e3ef91c30ff44992 Mon Sep 17 00:00:00 2001 From: xie7 Date: Sun, 6 Oct 2024 17:25:58 -0700 Subject: [PATCH 193/529] Added a new orographic drag topo file toolkit 1. A new toolkit for generation of the topographic file for new orographic drag schemes is included in code/components/eam/tools/topo_tool/. new file: orographic_drag_toolkit/Makefile new file: orographic_drag_toolkit/README new file: orographic_drag_toolkit/Tempest-remap_generation.sh new file: orographic_drag_toolkit/cube_to_target.F90 new file: orographic_drag_toolkit/make.ncl new file: orographic_drag_toolkit/ogwd_sub.F90 new file: orographic_drag_toolkit/reconstruct.F90 new file: orographic_drag_toolkit/remap.F90 new file: orographic_drag_toolkit/run.sh new file: orographic_drag_toolkit/shr_kind_mod.F90 new file: orographic_drag_toolkit/transform.F90 [BFB] --- .../orographic_drag_toolkit/Makefile | 106 + .../topo_tool/orographic_drag_toolkit/README | 18 + .../Tempest-remap_generation.sh | 13 + .../cube_to_target.F90 | 2550 ++++++++++++++++ .../orographic_drag_toolkit/make.ncl | 21 + .../orographic_drag_toolkit/ogwd_sub.F90 | 900 ++++++ .../orographic_drag_toolkit/reconstruct.F90 | 2675 +++++++++++++++++ .../orographic_drag_toolkit/remap.F90 | 1562 ++++++++++ .../topo_tool/orographic_drag_toolkit/run.sh | 6 + .../orographic_drag_toolkit/shr_kind_mod.F90 | 20 + .../orographic_drag_toolkit/transform.F90 | 351 +++ 11 files changed, 8222 insertions(+) create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/Makefile create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/README create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/Tempest-remap_generation.sh create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/cube_to_target.F90 create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/reconstruct.F90 create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/run.sh create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/shr_kind_mod.F90 create mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/transform.F90 diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/Makefile b/components/eam/tools/topo_tool/orographic_drag_toolkit/Makefile new file mode 100755 index 00000000000..ec236185cf6 --- /dev/null +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/Makefile @@ -0,0 +1,106 @@ +EXEDIR = . +EXENAME = cube_to_target +RM = rm + +.SUFFIXES: +.SUFFIXES: .F90 .o + +FC = ifort +DEBUG = FALSE + + +# Check for the NetCDF library and include directories +ifeq ($(LIB_NETCDF),$(null)) +LIB_NETCDF := /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/intel-20.0.4/netcdf-fortran-4.4.4-rdxohvp/lib +#/global/common/software/nersc/pm-2023q1/spack-stacks-1/views/climate-utils/lib +#/public/software/mathlib/netcdf/4.3.2/intel/lib +endif + +ifeq ($(INC_NETCDF),$(null)) +INC_NETCDF := /gpfs/fs1/soft/chrysalis/spack/opt/spack/linux-centos8-x86_64/intel-20.0.4/netcdf-fortran-4.4.4-rdxohvp/include +#/global/common/software/nersc/pm-2023q1/spack-stacks-1/views/climate-utils/include +#/public/software/mathlib/netcdf/4.3.2/intel/include +endif + +# Determine platform +UNAMES := $(shell uname -s) +UNAMEM := $(findstring CRAY,$(shell uname -m)) + +#------------------------------------------------------------------------ +# LF95 +#------------------------------------------------------------------------ +# +# setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib +# +ifeq ($(FC),lf95) +# +# Tramhill +# + INC_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/include + LIB_NETCDF :=/usr/local/netcdf-4.1.3-gcc-4.4.4-13-lf9581/lib + + LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -lcurl -lhdf5 -lhdf5_hl -mcmodel=medium + FFLAGS := -c --trace --trap --wide -CcdRR8 -I$(INC_NETCDF) + ifeq ($(DEBUG),TRUE) +# FFLAGS += --chk aesu -Cpp --trace + FFLAGS += -g --chk a,e,s,u --pca + else + FFLAGS += -O + endif + +endif + + + +.F90.o: + $(FC) $(FFLAGS) $< + + +#------------------------------------------------------------------------ +# AIX +# #------------------------------------------------------------------------ +# + #ifeq ($(UNAMES),AIX) + FC = ifort #xlf90 + #FFLAGS = -c -I$(INC_NETCDF) -I/BIGDATA1/iapcas_mhzhang_xiejinbo/topo_tool/cube_to_target/functional/ -convert big_endian + + FFLAGS = -c -I$(INC_NETCDF) -convert big_endian -traceback + #FFLAGS := -c -I$(INC_NETCDF) -no-prec-div -traceback -convert big_endian -fp-model source -assume byterecl -ftz -m64 -mcmodel=large -safe-cray-ptr + LDFLAGS = -L$(LIB_NETCDF) -lnetcdff + #LDFLAGS = -L$(LIB_NETCDF) -lnetcdf -lnetcdff -m64 -static-intel + .F90.o: + $(FC) $(FFLAGS) -qsuffix=f=F90 $< +# #endif + + +.F90.o: + $(FC) $(FFLAGS) $< + + + + + + + + + + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +#OBJS := reconstruct.o remap.o cube_to_target.o shr_kind_mod.o +OBJS := reconstruct.o remap.o shr_kind_mod.o transform.o sub_xjb.o cube_to_target.o +#OBJS := reconstruct.o remap.o cube_to_target.o sub.o shr_kind_mod.o +#sub.o shr_kind_mod.o + +$(EXEDIR)/$(EXENAME): $(OBJS) + $(FC) -o $@ $(OBJS) -I$(INC_NETCDF) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod $(EXEDIR)/$(EXENAME) + +cube_to_target.o: shr_kind_mod.o remap.o reconstruct.o sub_xjb.o transform.o +remap.o: +reconstruct.o: remap.o +#reconstruct.o : shr_kind_mod.o diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/README b/components/eam/tools/topo_tool/orographic_drag_toolkit/README new file mode 100755 index 00000000000..1675a91d5e7 --- /dev/null +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/README @@ -0,0 +1,18 @@ +cube_to_target performs rigourous remapping of topo variables from cubed-sphere grid to +any target grid. In the process SGH is computed. + +Input files: + +1. USGS-topo-cube.nc (may be found here $CESMDATA/inputdata/atm/cam/hrtopo/USGS-topo-cube3000.nc) + + This is the topo data on a cubed-sphere (default is 3km cubed-sphere grid) + +2. target.nc (e.g., $CESMDATA/inputdata/atm/cam/grid-description/se/ne30np4_091226_pentagons.nc) + + This is a SCRIP/ESMF grid descriptor file for the target grid + +3. phis-smooth.nc + + (optional) The user may provide a smoothed PHIS field. The software then recomputes SGH to + account for the smoothing in the sub-grid-scale. + diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/Tempest-remap_generation.sh b/components/eam/tools/topo_tool/orographic_drag_toolkit/Tempest-remap_generation.sh new file mode 100755 index 00000000000..e9bb8470393 --- /dev/null +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/Tempest-remap_generation.sh @@ -0,0 +1,13 @@ + + +source /lcrc/soft/climate/e3sm-unified/load_latest_e3sm_unified_chrysalis.sh +tempest_root=~/.conda/envs/jinbo +# Generate the element mesh. +${tempest_root}/bin/GenerateCSMesh --alt --res 30 --file topo2/ne30.g +# Generate the target physgrid mesh. +${tempest_root}/bin/GenerateVolumetricMesh --in topo2/ne30.g --out topo2/ne30pg2.g --np 2 --uniform +# Generate a high-res target physgrid mesh for cube_to_target. +${tempest_root}/bin/GenerateVolumetricMesh --in topo2/ne30.g --out topo2/ne30pg4.g --np 4 --uniform +# Generate SCRIP files for cube_to_target. +${tempest_root}/bin/ConvertMeshToSCRIP --in topo2/ne30pg4.g --out topo2/ne30pg4_scrip.nc +${tempest_root}/bin/ConvertMeshToSCRIP --in topo2/ne30pg2.g --out topo2/ne30pg2_scrip.nc diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/cube_to_target.F90 b/components/eam/tools/topo_tool/orographic_drag_toolkit/cube_to_target.F90 new file mode 100755 index 00000000000..60ce1349593 --- /dev/null +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/cube_to_target.F90 @@ -0,0 +1,2550 @@ +! +! DATE CODED: Nov 7, 2011 to Oct 15, 2012 +! DESCRIPTION: Remap topo data from cubed-sphere grid to target grid using rigorous remapping +! (Lauritzen, Nair and Ullrich, 2010, J. Comput. Phys.) +! +! Author: Peter Hjort Lauritzen (pel@ucar.edu), AMP/CGD/NESL/NCAR +! +program convterr + use shr_kind_mod, only: r8 => shr_kind_r8 + use reconstruct + use ogwd_sub + implicit none +# include + + !************************************** + ! + ! USER SETTINGS BELOW + ! + !************************************** + ! + ! + ! if smoothed PHIS is available SGH needs to be recomputed to account for the sub-grid-scale + ! variability introduced by the smoothing + ! +logical :: lsmooth_terr = .FALSE. +!logical :: lsmooth_terr = .TRUE. + ! + ! PHIS is smoothed by other software/dynamical core + ! + logical :: lexternal_smooth_terr = .FALSE. ! lexternal_smooth_terr = .FALSE. is NOT supported currently +!logical :: lexternal_smooth_terr = .TRUE. + ! + ! set PHIS=0.0 if LANDFRAC<0.01 + ! + logical :: lzero_out_ocean_point_phis = .TRUE.!.FALSE. +!logical :: lzero_out_ocean_point_phis = .FALSE. + ! + ! For internal smoothing (experimental at this point) + ! =================================================== + ! + ! if smoothing is internal (lexternal_smooth_terr=.FALSE.) choose coarsening factor + ! + ! recommendation: 2*(target resolution)/(0.03 degree) + ! + ! factor must be an even integer + ! + integer, parameter :: factor = 60 !coarse grid = 2.25 degrees + integer, parameter :: norder = 2 + integer, parameter :: nmono = 0 + integer, parameter :: npd = 1 + ! + !********************************************************************** + ! + ! END OF USER SETTINS BELOW + ! (do not edit beyond this point unless you know what you are doing!) + ! + !********************************************************************** + ! + integer :: im, jm, ncoarse + integer :: ncube !dimension of cubed-sphere grid + + real(r8), allocatable, dimension(:) :: landm_coslat, landfrac, terr, sgh30 + real(r8), allocatable, dimension(:) :: terr_coarse !for internal smoothing + + integer :: alloc_error,dealloc_error + integer :: i,j,n,k,index + integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile + integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file + integer :: srcid,dstid, jm_dbg ! for netCDF weight file + integer, dimension(2) :: src_grid_dims ! for netCDF weight file + + integer :: dimid + + logical :: ldbg + real(r8), allocatable, dimension(:) :: lon , lat + real(r8), allocatable, dimension(:) :: lon_landm , lat_landm + real(r8), allocatable, dimension(:) :: area + integer :: im_landm, jm_landm + integer :: lonid, latid, phisid + ! + ! constants + ! + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: pih = 0.50*pi + REAL (r8), PARAMETER :: deg2rad = pi/180.0 + + real(r8) :: wt,dlat + integer :: ipanel,icube,jcube + real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube + real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube + integer, allocatable, dimension(:,:) :: idx,idy,idp + integer :: npatch, isub,jsub, itmp, iplm1,jmin,jmax + real(r8) :: sum,dx,scale,dmax,arad,jof,term,s1,c1,clon,iof,dy,s2,c2,dist + ! + ! for linear interpolation + ! + real(r8) :: lambda,theta,wx,wy,offset + integer :: ilon,ilat,ip1,jp1 + ! + ! variable for regridding + ! + integer :: src_grid_dim ! for netCDF weight file + integer :: n_a,n_b,n_s,n_aid,n_bid,n_sid + integer :: count + real(r8), allocatable, dimension(:) :: landfrac_target, terr_target, sgh30_target, sgh_target + real(r8), allocatable, dimension(:) :: oc_target + real(r8), allocatable, dimension(:,:) :: oa_target,ol_target + real(r8) :: terr_if + real(r8), allocatable, dimension(:) :: lat_terr,lon_terr + integer :: nvar_dirOA,nvar_dirOL + integer,allocatable,dimension(:) :: indexb !max indice dimension + real(r8),allocatable,dimension(:,:,:) :: terrout + real(r8),allocatable,dimension(:,:) :: dxy + + real(r8), allocatable, dimension(:) :: landm_coslat_target, area_target + ! + ! this is only used if target grid is a lat-lon grid + ! + integer , parameter :: im_target = 360 , jm_target = 180 + ! + ! this is only used if target grid is not a lat-lon grid + ! + real(r8), allocatable, dimension(:) :: lon_target, lat_target + ! + ! new + ! + integer :: ntarget, ntarget_id, ncorner, ncorner_id, nrank, nrank_id + integer :: ntarget_smooth + real(r8), allocatable, dimension(:,:):: target_corner_lon, target_corner_lat + real(r8), allocatable, dimension(:) :: target_center_lon, target_center_lat, target_area +real(r8), allocatable, dimension(:,:):: target_corner_lon_deg,target_corner_lat_deg + integer :: ii,ip,jx,jy,jp + real(r8), dimension(:), allocatable :: xcell, ycell, xgno, ygno + real(r8), dimension(:), allocatable :: gauss_weights,abscissae + integer, parameter :: ngauss = 3 + integer :: jmax_segments,jall + real(r8) :: tmp + + real(r8), allocatable, dimension(:,:) :: weights_all + integer , allocatable, dimension(:,:) :: weights_eul_index_all + integer , allocatable, dimension(:) :: weights_lgr_index_all + integer :: ix,iy + ! + ! volume of topography + ! + real(r8) :: vol_target, vol_target_un, area_target_total,vol_source,vol_tmp + integer :: nlon,nlon_smooth,nlat,nlat_smooth + logical :: ltarget_latlon,lpole + real(r8), allocatable, dimension(:,:) :: terr_smooth + ! + ! for internal filtering + ! + real(r8), allocatable, dimension(:,:) :: weights_all_coarse + integer , allocatable, dimension(:,:) :: weights_eul_index_all_coarse + integer , allocatable, dimension(:) :: weights_lgr_index_all_coarse + real(r8), allocatable, dimension(:) :: area_target_coarse + real(r8), allocatable, dimension(:,:) :: da_coarse,da + real(r8), allocatable, dimension(:,:) :: recons,centroids + integer :: nreconstruction + + integer :: jmax_segments_coarse,jall_coarse,ncube_coarse + real(r8) :: all_weights + character(len=512) :: target_grid_file + character(len=512) :: input_topography_file + character(len=512) :: output_topography_file + character(len=512) :: smoothed_topography_file +real(r8) :: xxt,yyt,zzt +!real(r8),allocatable,dimension(:) :: xbar,ybar,zbar +real(r8),dimension(32768) :: xhds,yhds,zhds,hds,xbar,ybar,zbar,lon_bar,lat_bar +real(r8) :: rad,xx2,yy2,zz2,ix2,iy2,ip2 +real(r8) :: lonii,latii +character*20 :: indice + ! + nvar_dirOA=2+1!4 !2+1!4!36 + nvar_dirOL=180 + ! + ! turn extra debugging on/off + ! + ldbg = .FALSE. + + nreconstruction = 1 + ! + call parse_arguments(target_grid_file , input_topography_file , & + output_topography_file, smoothed_topography_file, & + lsmooth_terr ) + ! + !********************************************************* + ! + ! read in target grid + ! + !********************************************************* + ! + status = nf_open(trim(target_grid_file), 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + + status = NF_INQ_DIMID(ncid, 'grid_size', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, ntarget) + WRITE(*,*) "dimension of target grid: ntarget=",ntarget + + status = NF_INQ_DIMID(ncid, 'grid_corners', ncorner_id) + status = NF_INQ_DIMLEN(ncid, ncorner_id, ncorner) + WRITE(*,*) "maximum number of corners: ncorner=",ncorner + + status = NF_INQ_DIMID(ncid, 'grid_rank', nrank_id);status = NF_INQ_DIMLEN(ncid, nrank_id, nrank) + WRITE(*,*) "grid rank: nrank=",nrank + IF (nrank==2) THEN + WRITE(*,*) "target grid is a lat-lon grid" + ltarget_latlon = .TRUE. + status = NF_INQ_DIMID(ncid, 'nlon', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon) + status = NF_INQ_DIMID(ncid, 'nlat', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat) + status = NF_INQ_DIMID(ncid, 'lpole', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, lpole) + WRITE(*,*) "nlon=",nlon,"nlat=",nlat + IF (lpole) THEN + WRITE(*,*) "center of most Northern grid cell is lat=90; similarly for South pole" + ELSE + WRITE(*,*) "center of most Northern grid cell is NOT lat=90; similarly for South pole" + END IF + ELSE IF (nrank==1) THEN + ltarget_latlon = .FALSE. + ELSE + WRITE(*,*) "nrank out of range",nrank + STOP + ENDIF + + allocate ( target_corner_lon(ncorner,ntarget),stat=alloc_error) + allocate ( target_corner_lat(ncorner,ntarget),stat=alloc_error) + allocate ( target_corner_lon_deg(ncorner,ntarget),stat=alloc_error) + allocate ( target_corner_lat_deg(ncorner,ntarget),stat=alloc_error) + status = NF_INQ_VARID(ncid, 'grid_corner_lon', lonid) + status = NF_GET_VAR_DOUBLE(ncid, lonid,target_corner_lon) + ! + target_corner_lon_deg=target_corner_lon + ! + IF (maxval(target_corner_lon)>10.0) target_corner_lon = deg2rad*target_corner_lon + + status = NF_INQ_VARID(ncid, 'grid_corner_lat', latid) + status = NF_GET_VAR_DOUBLE(ncid, latid,target_corner_lat) + ! + target_corner_lat_deg=target_corner_lat + ! + IF (maxval(target_corner_lat)>10.0) target_corner_lat = deg2rad*target_corner_lat + ! + ! for writing remapped data on file at the end of the program + ! + allocate ( target_center_lon(ntarget),stat=alloc_error) + allocate ( target_center_lat(ntarget),stat=alloc_error) + allocate ( target_area (ntarget),stat=alloc_error)!dbg + + status = NF_INQ_VARID(ncid, 'grid_center_lon', lonid) + status = NF_GET_VAR_DOUBLE(ncid, lonid,target_center_lon) + + status = NF_INQ_VARID(ncid, 'grid_center_lat', latid) + status = NF_GET_VAR_DOUBLE(ncid, latid,target_center_lat) + + status = NF_INQ_VARID(ncid, 'grid_area', latid) + status = NF_GET_VAR_DOUBLE(ncid, latid,target_area) + + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + !**************************************************** + ! + ! get dimension of cubed-sphere grid + ! + !**************************************************** + ! + WRITE(*,*) "get dimension of cubed-sphere data from file" + !status = nf_open('USGS-topo-cube3000.nc', 0, ncid) + status = nf_open(trim(input_topography_file), 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + status = NF_INQ_DIMID(ncid, 'grid_size', dimid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimid, n) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + ncube = INT(SQRT(DBLE(n/6))) + WRITE(*,*) "cubed-sphere dimension: ncube = ",ncube + WRITE(*,*) "average grid-spacing at the Equator (degrees):" ,90.0/ncube + + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + !**************************************************** + ! + ! compute weights for remapping + ! + !**************************************************** + ! + jall = ncube*ncube*12*10 !anticipated number of weights (cab be tweaked) + jmax_segments = 100000 !can be tweaked + + allocate (weights_all(jall,nreconstruction),stat=alloc_error ) + allocate (weights_eul_index_all(jall,3),stat=alloc_error ) + allocate (weights_lgr_index_all(jall),stat=alloc_error ) + CALL overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& + jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) + ! + !**************************************************** + ! + ! read cubed-sphere 3km data + ! + !**************************************************** + ! + WRITE(*,*) "read cubed-sphere 3km data from file" + status = nf_open('USGS-topo-cube3000.nc', 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + + status = NF_INQ_DIMID(ncid, 'grid_size', dimid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_INQ_DIMLEN(ncid, dimid, n) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + ncube = INT(SQRT(DBLE(n/6))) + WRITE(*,*) "cubed-sphere dimension, ncube: ",ncube + + allocate ( landm_coslat(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) + ! + ! read LANDFRAC + ! + allocate ( landfrac(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'LANDFRAC', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,landfrac) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of landfrac",MINVAL(landfrac),MAXVAL(landfrac) + ! + ! read terr + ! + allocate ( terr(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'terr', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,terr) + + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of terr",MINVAL(terr),MAXVAL(terr) + allocate ( lat_terr(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for lat_terr' + stop + end if + status = NF_INQ_VARID(ncid, 'lat', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + status = NF_GET_VAR_DOUBLE(ncid, landid,lat_terr) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of lat",MINVAL(lat_terr),MAXVAL(lat_terr) + + allocate ( lon_terr(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for lon_terr' + stop + end if + status = NF_INQ_VARID(ncid, 'lon', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,lon_terr) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of lon",MINVAL(lon_terr),MAXVAL(lon_terr) + ! + ! + ! + allocate ( sgh30(n),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + + status = NF_INQ_VARID(ncid, 'SGH30', landid) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + + status = NF_GET_VAR_DOUBLE(ncid, landid,sgh30) + IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) + WRITE(*,*) "min/max of sgh30",MINVAL(sgh30),MAXVAL(sgh30) + + print *,"close file" + status = nf_close (ncid) + if (status .ne. NF_NOERR) call handle_err(status) + + WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' + ! + !********************************************************* + ! + ! do actual remapping + ! + !********************************************************* + ! + allocate (terr_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for terr_target' + stop + end if + allocate (landfrac_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac_target' + stop + end if + allocate (landm_coslat_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac_target' + stop + end if + allocate (sgh30_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for sgh30_target' + stop + end if + allocate (area_target(ntarget),stat=alloc_error ) + terr_target = 0.0 + landfrac_target = 0.0 + sgh30_target = 0.0 + landm_coslat_target = 0.0 + area_target = 0.0 + + tmp = 0.0 + do count=1,jall + i = weights_lgr_index_all(count) + wt = weights_all(count,1) + area_target (i) = area_target(i) + wt + end do + + + do count=1,jall + i = weights_lgr_index_all(count) + + ix = weights_eul_index_all(count,1) + iy = weights_eul_index_all(count,2) + ip = weights_eul_index_all(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix + + wt = weights_all(count,1) + terr_target (i) = terr_target (i) + wt*terr (ii)/area_target(i) + landfrac_target (i) = landfrac_target (i) + wt*landfrac (ii)/area_target(i) + landm_coslat_target(i) = landm_coslat_target(i) + wt*landm_coslat(ii)/area_target(i) + sgh30_target (i) = sgh30_target (i) + wt*sgh30 (ii)/area_target(i) + tmp = tmp+wt*terr(ii) + end do + ! + write(*,*) "tmp", tmp + WRITE(*,*) "max difference between target grid area and remapping software area",& + MAXVAL(target_area-area_target) + + do count=1,ntarget + if (terr_target(count)>8848.0) then + ! + ! max height is higher than Mount Everest + ! + write(*,*) "FATAL error: max height is higher than Mount Everest!" + write(*,*) "terr_target",count,terr_target(count) + write(*,*) "(lon,lat) locations of vertices of cell with excessive max height::" + do i=1,ncorner + write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) + end do + STOP + else if (terr_target(count)<-423.0) then + ! + ! min height is lower than Dead Sea + ! + write(*,*) "FATAL error: min height is lower than Dead Sea!" + write(*,*) "terr_target",count,terr_target(count) + write(*,*) "(lon,lat) locations of vertices of cell with excessive min height::" + do i=1,ncorner + write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) + end do + STOP + else + + end if + end do + WRITE(*,*) "Elevation data passed min/max consistency check!" + WRITE(*,*) + + WRITE(*,*) "min/max of unsmoothed terr_target : ",MINVAL(terr_target ),MAXVAL(terr_target ) + WRITE(*,*) "min/max of landfrac_target : ",MINVAL(landfrac_target),MAXVAL(landfrac_target) + WRITE(*,*) "min/max of landm_coslat_target : ",& + MINVAL(landm_coslat_target),MAXVAL(landm_coslat_target) + WRITE(*,*) "min/max of var30_target : ",MINVAL(sgh30_target ),MAXVAL(sgh30_target ) + ! + ! compute mean height (globally) of topography about sea-level for target grid unfiltered elevation + ! + vol_target_un = 0.0 + area_target_total = 0.0 + DO i=1,ntarget + area_target_total = area_target_total+area_target(i) + vol_target_un = vol_target_un+terr_target(i)*area_target(i) + END DO + WRITE(*,*) "mean height (globally) of topography about sea-level for target grid unfiltered elevation",& + vol_target_un/area_target_total + + ! + ! diagnostics + ! + vol_source = 0.0 + allocate ( dA(ncube,ncube),stat=alloc_error ) + CALL EquiangularAllAreas(ncube, dA) + DO jp=1,6 + DO jy=1,ncube + DO jx=1,ncube + ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx + vol_source = vol_source+terr(ii)*dA(jx,jy) + END DO + END DO + END DO + WRITE(*,*) "volume of input cubed-sphere terrain :",vol_source + WRITE(*,*) "average elevation of input cubed-sphere terrain:",vol_source/(4.0*pi) + + DEALLOCATE(dA) + ! + ! + ! + allocate (sgh_target(ntarget),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for sgh_target' + stop + end if + ! + ! compute variance with respect to cubed-sphere data + ! + WRITE(*,*) "compute variance with respect to 3km cubed-sphere data: SGH" + + IF (lsmooth_terr) THEN + WRITE(*,*) "smoothing PHIS" + IF (lexternal_smooth_terr) THEN + WRITE(*,*) "using externally generated smoothed topography" + + status = nf_open(trim(smoothed_topography_file), 0, ncid) + IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + status = nf_close(ncid) + !status = nf_open('phis-smooth.nc', 0, ncid) + !IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) + ! + IF (.NOT.ltarget_latlon) THEN + ! + !********************************************************* + ! + ! read in smoothed topography + ! + !********************************************************* + ! + status = NF_INQ_DIMID (ncid, 'ncol', ntarget_id ) + status = NF_INQ_DIMLEN(ncid, ntarget_id , ntarget_smooth) + IF (ntarget.NE.ntarget_smooth) THEN + WRITE(*,*) "mismatch in smoothed data-set and target grid specification" + WRITE(*,*) ntarget, ntarget_smooth + STOP + END IF + status = NF_INQ_VARID(ncid, 'PHIS', phisid) + ! + ! overwrite terr_target with smoothed version + ! + status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_target) + terr_target = terr_target/9.80616 + ELSE + ! + ! read in smoothed lat-lon topography + ! + status = NF_INQ_DIMID(ncid, 'lon', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon_smooth) + status = NF_INQ_DIMID(ncid, 'lat', ntarget_id) + status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat_smooth) + IF (nlon.NE.nlon_smooth.OR.nlat.NE.nlat_smooth) THEN + WRITE(*,*) "smoothed topography dimensions do not match target grid dimensions" + WRITE(*,*) "target grid : nlon ,nlat =",nlon,nlat + WRITE(*,*) "smoothed topo: nlon_smooth,nlat_smooth =",nlon_smooth,nlat_smooth + STOP + END IF + ALLOCATE(terr_smooth(nlon_smooth,nlat_smooth),stat=alloc_error) + status = NF_INQ_VARID(ncid, 'PHIS', phisid) + status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_smooth) + ! + ! overwrite terr_target with smoothed version + ! + ii=1 + DO j=1,nlat + DO i=1,nlon + terr_target(ii) = terr_smooth(i,j)/9.80616 + ii=ii+1 + END DO + END DO + DEALLOCATE(terr_smooth) + END IF + ELSE + WRITE(*,*) "unstested software - uncomment this line of you know what you are doing!" + STOP + ! + !***************************************************** + ! + ! smoothing topography internally + ! + !***************************************************** + ! + WRITE(*,*) "internally smoothing orography" + ! CALL smooth(terr_target,ntarget,target_corner_lon,target_corner_lat) + ! + ! smooth topography internally + ! + ncoarse = n/(factor*factor) + ! + ! + ! + ncube_coarse = ncube/factor + WRITE(*,*) "resolution of coarse grid", 90.0/ncube_coarse + allocate ( terr_coarse(ncoarse),stat=alloc_error ) + if( alloc_error /= 0 ) then + print*,'Program could not allocate space for landfrac' + stop + end if + WRITE(*,*) "coarsening" + allocate ( dA_coarse(ncube_coarse,ncube_coarse),stat=alloc_error ) + CALL coarsen(terr,terr_coarse,factor,n,dA_coarse) + ! + ! + ! + vol_tmp = 0.0 + DO jp=1,6 + DO jy=1,ncube_coarse + DO jx=1,ncube_coarse + ii = (jp-1)*ncube_coarse*ncube_coarse+(jy-1)*ncube_coarse+jx + vol_tmp = vol_tmp+terr_coarse(ii)*dA_coarse(jx,jy) + END DO + END DO + END DO + WRITE(*,*) "volume of coarsened cubed-sphere terrain :",vol_source + WRITE(*,*) "difference between coarsened cubed-sphere data and input cubed-sphere data",& + vol_tmp-vol_source + + + + WRITE(*,*) "done coarsening" + + nreconstruction = 1 + IF (norder>1) THEN + IF (norder == 2) THEN + nreconstruction = 3 + ELSEIF (norder == 3) THEN + nreconstruction = 6 + END IF + ALLOCATE(recons (nreconstruction, ncoarse), STAT=status) + ALLOCATE(centroids(nreconstruction, ncoarse), STAT=status) + CALL get_reconstruction(terr_coarse,norder, nmono, recons, npd,da_coarse,& + ncube_coarse+1,nreconstruction,centroids) + SELECT CASE (nmono) + CASE (0) + WRITE(*,*) "coarse grid reconstructions are not filtered with shape-preesrving filter" + CASE (1) + WRITE(*,*) "coarse grid reconstructions are filtered with shape-preserving filter" + CASE DEFAULT + WRITE(*,*) "nmono out of range: ",nmono + STOP + END SELECT + SELECT CASE (0) + CASE (0) + WRITE(*,*) "coarse grid reconstructions are not filtered with positive definite filter" + CASE (1) + WRITE(*,*) "coarse grid reconstructions filtered with positive definite filter" + CASE DEFAULT + WRITE(*,*) "npd out of range: ",npd + STOP + END SELECT + END IF + + jall_coarse = (ncube*ncube*12) !anticipated number of weights + jmax_segments_coarse = jmax_segments!/factor ! + WRITE(*,*) "anticipated",jall_coarse + allocate (weights_all_coarse(jall_coarse,nreconstruction),stat=alloc_error ) + allocate (weights_eul_index_all_coarse(jall_coarse,3),stat=alloc_error ) + allocate (weights_lgr_index_all_coarse(jall_coarse),stat=alloc_error ) + ! + ! + ! + CALL overlap_weights(weights_lgr_index_all_coarse,weights_eul_index_all_coarse,weights_all_coarse,& + jall_coarse,ncube_coarse,ngauss,ntarget,ncorner,jmax_segments_coarse,target_corner_lon,& + target_corner_lat,nreconstruction) + + WRITE(*,*) "MIN/MAX of area-weight [0:1]: ",& + MINVAL(weights_all_coarse(:,1)),MAXVAL(weights_all_coarse(:,1)) + ! + ! compute new weights + ! + + ! + ! do mapping + ! + terr_target = 0.0 + tmp = 0.0 + allocate ( area_target_coarse(ntarget),stat=alloc_error) + all_weights = 0.0 + area_target_coarse = 0.0 + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + wt = weights_all_coarse(count,1) + area_target_coarse (i) = area_target_coarse(i) + wt + all_weights = all_weights+wt + end do + WRITE(*,*) "sum of all weights (coarse to target) minus area of sphere : ",all_weights-4.0*pi + WRITE(*,*) "MIN/MAX of area_target_coarse [0:1]:",& + MINVAL(area_target_coarse),MAXVAL(area_target_coarse) + IF (norder==1) THEN + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + + ix = weights_eul_index_all_coarse(count,1) + iy = weights_eul_index_all_coarse(count,2) + ip = weights_eul_index_all_coarse(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix + + wt = weights_all_coarse(count,1) + + terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) + tmp = tmp+wt*terr_coarse(ii) + end do + ELSE IF (norder==2) THEN + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + IF (i>jall_coarse.OR.i<1) THEN + WRITE(*,*) i,jall_coarse + STOP + END IF + ix = weights_eul_index_all_coarse(count,1) + iy = weights_eul_index_all_coarse(count,2) + ip = weights_eul_index_all_coarse(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix + + terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& + ! + ! all constant terms + ! + terr_coarse(ii) & + - recons(1,ii)*centroids(1,ii) & + - recons(2,ii)*centroids(2,ii) & + ! + ! + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& + ! + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& + ! + ! + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& + )+& + ! + ! linear terms + ! + weights_all_coarse(count,2)*(& + + recons(1,ii)& + + ! - recons(3,ii)*2.0*centroids(1,ii)& + ! - recons(5,ii)* centroids(2,ii)& + )+& + ! + weights_all_coarse(count,3)*(& + recons(2,ii)& + ! + ! - recons(4,ii)*2.0*centroids(2,ii)& + ! - recons(5,ii)* centroids(1,ii)& + )& + ! + ! quadratic terms + ! + ! weights_all_coarse(count,4)*recons(3,ii)+& + ! weights_all_coarse(count,5)*recons(4,ii)+& + ! weights_all_coarse(count,6)*recons(5,ii) + )/area_target_coarse(i) + end do + DEALLOCATE(centroids) + DEALLOCATE(recons) + DEALLOCATE(weights_all_coarse) + + ELSE IF (norder==3) THEN + ! recons(4,:) = 0.0 + ! recons(5,:) = 0.0 + do count=1,jall_coarse + i = weights_lgr_index_all_coarse(count) + IF (i>jall_coarse.OR.i<1) THEN + WRITE(*,*) i,jall_coarse + STOP + END IF + ix = weights_eul_index_all_coarse(count,1) + iy = weights_eul_index_all_coarse(count,2) + ip = weights_eul_index_all_coarse(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix + + ! terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) + + ! WRITE(*,*) count,area_target_coarse(i) + ! terr_target(i) = terr_target(i) + area_target_coarse(i) + ! + terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& + + + ! centroids(5,ii))/area_target_coarse(i)) + ! centroids(1,ii)/area_target_coarse(i)) + ! /area_target_coarse(i)) + + + + + ! + ! all constant terms + ! + terr_coarse(ii) & + - recons(1,ii)*centroids(1,ii) & + - recons(2,ii)*centroids(2,ii) & + ! + + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& + + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& + ! + + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& + )+& + ! + ! linear terms + ! + weights_all_coarse(count,2)*(& + + recons(1,ii)& + + - recons(3,ii)*2.0*centroids(1,ii)& + - recons(5,ii)* centroids(2,ii)& + )+& + ! + weights_all_coarse(count,3)*(& + recons(2,ii)& + ! + - recons(4,ii)*2.0*centroids(2,ii)& + - recons(5,ii)* centroids(1,ii)& + )+& + ! + ! quadratic terms + ! + weights_all_coarse(count,4)*recons(3,ii)+& + weights_all_coarse(count,5)*recons(4,ii)+& + weights_all_coarse(count,6)*recons(5,ii))/area_target_coarse(i) + end do + DEALLOCATE(centroids) + DEALLOCATE(recons) + DEALLOCATE(weights_all_coarse) + END IF + DEALLOCATE(area_target_coarse) + WRITE(*,*) "done smoothing" + END IF + ! + ! compute mean height (globally) of topography about sea-level for target grid filtered elevation + ! + vol_target = 0.0 + DO i=1,ntarget + vol_target = vol_target+terr_target(i)*area_target(i) + ! if (ABS(area_target(i)-area_target_coarse(i))>0.000001) THEN + ! WRITE(*,*) "xxx",area_target(i),area_target_coarse(i),area_target(i)-area_target_coarse(i) + ! STOP + ! END IF + END DO + WRITE(*,*) "mean height (globally) of topography about sea-level for target grid filtered elevation",& + vol_target/area_target_total + WRITE(*,*) "percentage change in mean height between filtered and unfiltered elevations",& + 100.0*(vol_target-vol_target_un)/vol_target_un + WRITE(*,*) "percentage change in mean height between input cubed-sphere and unfiltered elevations",& + 100.0*(vol_source-vol_target_un)/vol_source + + END IF + ! + ! Done internal smoothing + ! + WRITE(*,*) "min/max of terr_target : ",MINVAL(terr_target),MAXVAL(terr_target) + + if (lzero_out_ocean_point_phis) then + WRITE(*,*) "if ocean mask PHIS=0.0" + end if + + + sgh_target=0.0 + do count=1,jall + i = weights_lgr_index_all(count)!! + ! + ix = weights_eul_index_all(count,1) + iy = weights_eul_index_all(count,2) + ip = weights_eul_index_all(count,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + + wt = weights_all(count,1) + + if (lzero_out_ocean_point_phis.AND.landfrac_target(i).lt.0.01_r8) then + terr_target(i) = 0.0_r8 !5*terr_target(i) + end if + sgh_target(i) = sgh_target(i)+wt*((terr_target(i)-terr(ii))**2)/area_target(i) + end do + + + + + ! + ! zero out small values + ! + DO i=1,ntarget + IF (landfrac_target(i)<.001_r8) landfrac_target(i) = 0.0 + IF (sgh_target(i)<0.5) sgh_target(i) = 0.0 + IF (sgh30_target(i)<0.5) sgh30_target(i) = 0.0 + END DO + sgh_target = SQRT(sgh_target) + sgh30_target = SQRT(sgh30_target) + +!for centroid of mass +!wt is useful proxy for dA +print*,"cal oa" +allocate(oa_target(ntarget,nvar_dirOA),stat=alloc_error) +call OAdir(terr,ntarget,ncube,n,nvar_dirOA,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,target_center_lon,target_center_lat,lon_terr,lat_terr,area_target,oa_target)!OAx,OAy) +!call OAorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,lon_terr,lat_terr,area_target,oa_target) +!par +!OC + print*,"cal oc" + allocate(oc_target(ntarget),stat=alloc_error) + oc_target=0.0_r8 + call OC(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,area_target,sgh_target,terr_target,oc_target) + +!OL + print*,"cal ol" + allocate(ol_target(ntarget,nvar_dirOL),stat=alloc_error) + ol_target=0.0_r8 + !call OLorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,lon_terr,lat_terr,area_target,sgh_target,target_center_lat,target_center_lon,target_corner_lat_deg,target_corner_lon_deg,ol_target) + allocate(indexb(ntarget),stat=alloc_error) + indexb=0.0_r8 + do count=1,jall + i = weights_lgr_index_all(count) + indexb(i)=indexb(i)+1 + enddo + allocate(terrout(4,ntarget,maxval(indexb)),stat=alloc_error) + allocate(dxy(ntarget,nvar_dirOL),stat=alloc_error) + call OLdir(terr,ntarget,ncube,n,jall,nlon,nlat,maxval(indexb),nvar_dirOL,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,target_center_lon,target_center_lat,target_corner_lon_deg,target_corner_lat_deg,lon_terr,lat_terr,sgh_target,area_target,ol_target,terrout,dxy) +!par + + WRITE(*,*) "min/max of sgh_target : ",MINVAL(sgh_target),MAXVAL(sgh_target) + WRITE(*,*) "min/max of sgh30_target : ",MINVAL(sgh30_target),MAXVAL(sgh30_target) + + DEALLOCATE(terr,weights_all,weights_eul_index_all,landfrac,landm_coslat) + + + + IF (ltarget_latlon) THEN +!#if 0 +! CALL wrtncdf_rll(nlon,nlat,lpole,ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& +! landm_coslat_target,target_center_lon,target_center_lat,.true.) +!#endif +print*,"output rll" + CALL wrtncdf_rll(nlon,nlat,nvar_dirOA,nvar_dirOL,maxval(indexb),lpole,ntarget,terr_target,landfrac_target,sgh_target,sgh30_target, oc_target,oa_target,ol_target,terrout,dxy,& + landm_coslat_target,target_center_lon,target_center_lat,.false.,output_topography_file) + + ELSE +!#if 0 +! CALL wrtncdf_unstructured(ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& +! landm_coslat_target,target_center_lon,target_center_lat) +!#endif + print*,"output unstructure" + CALL wrtncdf_unstructured(nvar_dirOA,nvar_dirOL,maxval(indexb),ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,oc_target,oa_target,ol_target,terrout,dxy,landm_coslat_target,target_center_lon,target_center_lat,output_topography_file) + END IF + + DEALLOCATE(terr_target,landfrac_target,sgh30_target,sgh_target,landm_coslat_target) +DEALLOCATE(oc_target) + +end program convterr + +! +! +! +!#if 0 +!subroutine wrtncdf_unstructured(n,terr,landfrac,sgh,sgh30,landm_coslat,lon,lat) +!#endif +subroutine wrtncdf_unstructured(nvar_dirOA,nvar_dirOL,indexb,n,terr,landfrac,sgh,sgh30,oc_in,oa_in,ol_in,terrout,dxy_in,landm_coslat,lon,lat,output) + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +# include + + ! + ! Dummy arguments + ! + integer, intent(in) :: n + real(r8),dimension(n) , intent(in) :: terr, landfrac,sgh,sgh30,lon, lat, landm_coslat + ! + ! Local variables + ! + character (len=512) :: fout ! NetCDF output file + + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: terrid,nid + integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid + integer :: status ! return value for error control of netcdf routin + integer :: i,j + integer, dimension(2) :: nc_lat_vid,nc_lon_vid + character (len=8) :: datestring + integer :: nc_gridcorn_id, lat_vid, lon_vid + + real(r8), parameter :: fillvalue = 1.d36 + integer, intent(in) :: nvar_dirOA,nvar_dirOL,indexb + character(len=512) :: output + integer :: ocid,varid,var2id,indexbid,terroutid(4) + integer :: oaid,olid,dxyid + integer :: oa1id,oa2id,oa3id,oa4id + integer :: ol1id,ol2id,ol3id,ol4id + integer, dimension(2) :: ocdim + integer, dimension(3) :: oadim,oldim,terroutdim + real(r8),dimension(n) , intent(in) :: oc_in + real(r8),dimension(n,nvar_dirOA) , intent(in) :: oa_in + real(r8),dimension(n,nvar_dirOL) , intent(in) :: ol_in + real(r8),dimension(4,n,indexb),intent(in) :: terrout + real(r8),dimension(n,nvar_dirOL),intent(in) :: dxy_in + character*20,dimension(4) :: terroutchar + real(r8),dimension(n) :: oc + real(r8),dimension(n,nvar_dirOA) :: oa + real(r8),dimension(n,nvar_dirOL) :: ol + real(r8),dimension(n,nvar_dirOL) :: dxy + character*20 :: numb + write(numb,"(i0.1)") nvar_dirOL + print*,"dir number", nvar_dirOL + !fout='final-'//adjustl(trim(numb))//'.nc' + fout=output + oc=oc_in + oa=oa_in + ol=ol_in + dxy=dxy_in + ! + ! Create NetCDF file for output + ! + print *,"Create NetCDF file for output" + status = nf_create (fout, NF_64BIT_OFFSET , foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create dimensions for output + ! + status = nf_def_dim (foutid, 'ncol', n, nid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'nvar_dirOA', nvar_dirOA, varid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'nvar_dirOL', nvar_dirOL, var2id) + if (status .ne. NF_NOERR) call handle_err(status) + !status = nf_def_dim (foutid, 'indexb',23, indexbid) + status = nf_def_dim (foutid, 'indexb', indexb, indexbid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create variable for output + ! + print *,"Create variable for output" + status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 1, nid, terrid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 1, nid, landfracid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'SGH', NF_DOUBLE, 1, nid, sghid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 1, nid, sgh30id) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 1, nid, landm_coslatid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, nid, latvid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, nid, lonvid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_var (foutid,'OC', NF_DOUBLE, 1, nid, ocid) + oadim(1)=nid + oadim(2)=varid + status = nf_def_var (foutid,'OA', NF_DOUBLE, 2, oadim, oaid) + oldim(1)=nid + oldim(2)=var2id + status = nf_def_var (foutid,'OL', NF_DOUBLE, 2, oldim, olid) +!#if 0 +! terroutdim(1)=nid +! terroutdim(2)=indexbid +! !name +! terroutchar(1)="terr" +! terroutchar(2)="terrx" +! terroutchar(3)="terry" +! terroutchar(4)="wt" +! do i=1,4 +! status = nf_def_var (foutid, terroutchar(i), NF_DOUBLE, 2, & +! terroutdim, terroutid(i)) +! enddo +! !dxy +! status = nf_def_var (foutid,'dxy', NF_DOUBLE, 2, oldim, dxyid) +!#endif + ! + ! Create attributes for output variables + ! + status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') + status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') + status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) + ! status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from USGS 30-sec data') + + status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & + 'standard deviation of 3km cubed-sphere elevation and target grid elevation') + status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') + ! status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & + 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') + status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') + ! status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') + status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') + ! status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') + + + status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,NF_GLOBAL,'source', 50, 'USGS 30-sec dataset binned to ncube3000 (cube-sphere) grid') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') + if (status .ne. NF_NOERR) call handle_err(status) + call DATE_AND_TIME(DATE=datestring) + status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,oaid,'note', 40, '(2)+1 in nvar_dirOA to avoid bug in io') +!#if 0 +! do i=1,4 +! status = nf_put_att_double (foutid, terroutid(i),& +! 'missing_value', nf_double, 1,fillvalue) +! status = nf_put_att_double (foutid, terroutid(i),& +! '_FillValue' , nf_double, 1,fillvalue) +! enddo +!#endif + ! + ! End define mode for output file + ! + status = nf_enddef (foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Write variable for output + ! + print*,"writing oc data",MINVAL(oc),MAXVAL(oc) + status = nf_put_var_double (foutid, ocid, oc) + if (status .ne. NF_NOERR) call handle_err(status) + !oa,ol + print*,"writing oa data",MINVAL(oa),MAXVAL(oa) + status = nf_put_var_double (foutid, oaid, oa) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"writing ol data",MINVAL(ol),MAXVAL(ol) + status = nf_put_var_double (foutid, olid, ol) + if (status .ne. NF_NOERR) call handle_err(status) +!#if 0 +! do i=1,4 +! status = nf_put_att_double (foutid, terroutid(i),& +! 'missing_value', nf_double, 1,fillvalue) +! status = nf_put_att_double (foutid, terroutid(i),& +! '_FillValue' , nf_double, 1,fillvalue) +! print*,"writing"//terroutchar(i)//" data",& +! MINVAL(terrout(i,:,:)),MAXVAL(terrout(i,:,:)) +! status = nf_put_var_double (foutid, terroutid(i), terrout(i,:,:)) +! if (status .ne. NF_NOERR) call handle_err(status) +! enddo +!#endif +!#if 0 +! print*,"writing dxy data",MINVAL(dxy),MAXVAL(dxy) +! status = nf_put_var_double (foutid, dxyid, dxy) +! if (status .ne. NF_NOERR) call handle_err(status) +!#endif + print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) + status = nf_put_var_double (foutid, terrid, terr*9.80616) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing terrain data" + + print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) + status = nf_put_var_double (foutid, landfracid, landfrac) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing landfrac data" + + print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) + status = nf_put_var_double (foutid, sghid, sgh) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh data" + + print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) + status = nf_put_var_double (foutid, sgh30id, sgh30) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + + print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) + status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + ! + print*,"writing lat data" + status = nf_put_var_double (foutid, latvid, lat) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lat data" + + print*,"writing lon data" + status = nf_put_var_double (foutid, lonvid, lon) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lon data" + ! + ! Close output file + ! + print *,"close file" + status = nf_close (foutid) + if (status .ne. NF_NOERR) call handle_err(status) +end subroutine wrtncdf_unstructured +! +!************************************************************** +! +! if target grid is lat-lon output structured +! +!************************************************************** +! + +!#if 0 +!subroutine wrtncdf_rll(nlon,nlat,lpole,n,terr_in,landfrac_in,sgh_in,sgh30_in,landm_coslat_in,lon,lat,lprepare_fv_smoothing_routine) +!#endif +subroutine wrtncdf_rll(nlon,nlat,nvar_dirOA,nvar_dirOL,indexb,lpole,n,terr_in,landfrac_in,sgh_in,sgh30_in,oc_in,oa_in,ol_in,terrout,dxy_in,landm_coslat_in,lon,lat,lprepare_fv_smoothing_routine,output) + + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + +# include + + ! + ! Dummy arguments + ! + integer, intent(in) :: n,nlon,nlat,nvar_dirOA,nvar_dirOL,indexb + ! + ! lprepare_fv_smoothing_routine is to make a NetCDF file that can be used with the CAM-FV smoothing software + ! + logical , intent(in) :: lpole,lprepare_fv_smoothing_routine + real(r8),dimension(n) , intent(in) :: terr_in, landfrac_in,sgh_in,sgh30_in,lon, lat, landm_coslat_in + real(r8),dimension(n) , intent(in) :: oc_in + real(r8),dimension(n,nvar_dirOA) , intent(in) :: oa_in + real(r8),dimension(n,nvar_dirOL) , intent(in) :: ol_in + real(r8),dimension(4,n,indexb),intent(in) :: terrout + real(r8),dimension(n,nvar_dirOL),intent(in) :: dxy_in + character*20,dimension(4) :: terroutchar + character(len=512),intent(in) :: output + ! + ! Local variables + ! + character (len=512):: fout ! NetCDF output file + integer :: foutid ! Output file id + integer :: lonid, lonvid + integer :: latid, latvid + integer :: terrid,nid + integer :: ocid,varid,var2id,indexbid,terroutid(4) + integer :: oaid,olid,dxyid + integer :: oa1id,oa2id,oa3id,oa4id + integer :: ol1id,ol2id,ol3id,ol4id + integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid + integer :: status ! return value for error control of netcdf routin + integer :: i,j + integer, dimension(2) :: nc_lat_vid,nc_lon_vid + character (len=8) :: datestring + integer :: nc_gridcorn_id, lat_vid, lon_vid + real(r8), parameter :: fillvalue = 1.d36 + real(r8) :: ave + + real(r8),dimension(nlon) :: lonar ! longitude array + real(r8),dimension(nlat) :: latar ! latitude array + + integer, dimension(2) :: htopodim,landfdim,sghdim,sgh30dim,landmcoslatdim +integer, dimension(2) :: ocdim +integer, dimension(3) :: oadim,oldim,terroutdim + real(r8),dimension(n) :: terr, landfrac,sgh,sgh30,landm_coslat + real(r8),dimension(n) :: oc + real(r8),dimension(n,nvar_dirOA) :: oa + real(r8),dimension(n,nvar_dirOL) :: ol + real(r8),dimension(n,nvar_dirOL) :: dxy + character*20 :: numb +!print*,"nlon nlat n",nlon, nlat, n + IF (nlon*nlat.NE.n) THEN + WRITE(*,*) "inconsistent input for wrtncdf_rll" + STOP + END IF + ! + ! we assume that the unstructured layout of the lat-lon grid is ordered in latitude rows, that is, + ! unstructured index n is given by + ! + ! n = (j-1)*nlon+i + ! + ! where j is latitude index and i longitude index + ! + do i = 1,nlon + lonar(i)= lon(i) + enddo + do j = 1,nlat + latar(j)= lat((j-1)*nlon+1) + enddo + + terr = terr_in + sgh=sgh_in + sgh30 =sgh30_in + landfrac = landfrac_in + landm_coslat = landm_coslat_in + oc=oc_in + oa=oa_in + ol=ol_in + dxy=dxy_in + + if (lpole) then + write(*,*) "average pole control volume" + ! + ! North pole - terr + ! + ave = 0.0 + do i=1,nlon + ave = ave + terr_in(i) + end do + terr(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + terr_in(i) + end do + terr(n-(nlon+1):n) = ave/DBLE(nlon) + !oc + ! North pole - terr + ave = 0.0 + do i=1,nlon + ave = ave + oc_in(i) + end do + oc(1:nlon) = ave/DBLE(nlon) + ! South pole + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + oc_in(i) + end do + oc(n-(nlon+1):n) = ave/DBLE(nlon) + !oa + ! North pole - terr +do j =1,nvar_dirOA + ave = 0.0 + do i=1,nlon + ave = ave + oa_in(i,j) + end do + oa(1:nlon,j) = ave/DBLE(nlon) + ! South pole + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + oa_in(i,j) + end do + oa(n-(nlon+1):n,j) = ave/DBLE(nlon) +enddo + !ol +!#if 0 +! North pole - terr +do j =1,nvar_dirOL + ave = 0.0 + do i=1,nlon + ave = ave + ol_in(i,j) + end do + ol(1:nlon,j) = ave/DBLE(nlon) + ! South pole + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + ol_in(j,i) + end do + ol(n-(nlon+1):n,j) = ave/DBLE(nlon) +enddo +!#endif + + ! + ! North pole - sgh + ! + ave = 0.0 + do i=1,nlon + ave = ave + sgh_in(i) + end do + sgh(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + sgh_in(i) + end do + sgh(n-(nlon+1):n) = ave/DBLE(nlon) + + ! + ! North pole - sgh30 + ! + ave = 0.0 + do i=1,nlon + ave = ave + sgh30_in(i) + end do + sgh30(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + sgh30_in(i) + end do + sgh30(n-(nlon+1):n) = ave/DBLE(nlon) + + ! + ! North pole - landfrac + ! + ave = 0.0 + do i=1,nlon + ave = ave + landfrac_in(i) + end do + landfrac(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + landfrac_in(i) + end do + landfrac(n-(nlon+1):n) = ave/DBLE(nlon) + + ! + ! North pole - landm_coslat + ! + ave = 0.0 + do i=1,nlon + ave = ave + landm_coslat_in(i) + end do + landm_coslat(1:nlon) = ave/DBLE(nlon) + ! + ! South pole + ! + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + landm_coslat_in(i) + end do + landm_coslat(n-(nlon+1):n) = ave/DBLE(nlon) + +!dxy + do j=1,4 + ave = 0.0 + do i=n-(nlon+1),n + ave = ave + dxy(j,i) + end do + dxy(j,n-(nlon+1):n) = ave/DBLE(nlon) + enddo +!dxy + end if + ! + write(numb,"(i0.1)") nvar_dirOL + print*,"dir number", nvar_dirOL + + + !fout='final-'//adjustl(trim(numb))//'.nc' + fout=output + ! + ! Create NetCDF file for output + ! + print *,"Create NetCDF file for output" + status = nf_create (fout, NF_64BIT_OFFSET , foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create dimensions for output + ! + print *,"Create dimensions for output" + status = nf_def_dim (foutid, 'lon', nlon, lonid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'lat', nlat, latid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'nvar_dirOA', nvar_dirOA, varid) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'nvar_dirOL', nvar_dirOL, var2id) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_def_dim (foutid, 'indexb', indexb, indexbid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Create variable for output + ! + print *,"Create variable for output" + ocdim(1)=lonid + ocdim(2)=latid + status = nf_def_var (foutid,'OC', NF_DOUBLE, 2, ocdim, ocid) + oadim(1)=lonid + oadim(2)=latid + oadim(3)=varid + status = nf_def_var (foutid,'OA', NF_DOUBLE, 3, oadim, oaid) + oldim(1)=lonid + oldim(2)=latid + oldim(3)=var2id + status = nf_def_var (foutid,'OL', NF_DOUBLE, 3, oldim, olid) + terroutdim(1)=lonid + terroutdim(2)=latid + terroutdim(3)=indexbid + !name + terroutchar(1)="terr" + terroutchar(2)="terrx" + terroutchar(3)="terry" + terroutchar(4)="wt" +!#if 0 + do i=1,4 + status = nf_def_var (foutid, terroutchar(i), NF_DOUBLE, 3, & + terroutdim, terroutid(i)) + enddo +!#endif + !dxy + status = nf_def_var (foutid,'dxy', NF_DOUBLE, 3, oldim, dxyid) +!#endif + +!#if 0 +! status = nf_def_var (foutid,'OL1', NF_DOUBLE, 2, ocdim, ol1id) +! status = nf_def_var (foutid,'OL2', NF_DOUBLE, 2, ocdim, ol2id) +! status = nf_def_var (foutid,'OL3', NF_DOUBLE, 2, ocdim, ol3id) +! status = nf_def_var (foutid,'OL4', NF_DOUBLE, 2, ocdim, ol4id) +! status = nf_def_var (foutid,'OA1', NF_DOUBLE, 2, ocdim, oa1id) +! status = nf_def_var (foutid,'OA2', NF_DOUBLE, 2, ocdim, oa2id) +! status = nf_def_var (foutid,'OA3', NF_DOUBLE, 2, ocdim, oa3id) +! status = nf_def_var (foutid,'OA4', NF_DOUBLE, 2, ocdim, oa4id) +!#endif + + htopodim(1)=lonid + htopodim(2)=latid + + if (lprepare_fv_smoothing_routine) then + status = nf_def_var (foutid,'htopo', NF_DOUBLE, 2, htopodim, terrid) + else + status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 2, htopodim, terrid) + end if + if (status .ne. NF_NOERR) call handle_err(status) + + landfdim(1)=lonid + landfdim(2)=latid + + if (lprepare_fv_smoothing_routine) then + status = nf_def_var (foutid,'ftopo', NF_DOUBLE, 2, landfdim, landfracid) + else + status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 2, landfdim, landfracid) + end if + + if (status .ne. NF_NOERR) call handle_err(status) + + sghdim(1)=lonid + sghdim(2)=latid + + status = nf_def_var (foutid,'SGH', NF_DOUBLE, 2, sghdim, sghid) + if (status .ne. NF_NOERR) call handle_err(status) + + sgh30dim(1)=lonid + sgh30dim(2)=latid + + status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 2, sgh30dim, sgh30id) + if (status .ne. NF_NOERR) call handle_err(status) + + landmcoslatdim(1)=lonid + landmcoslatdim(2)=latid + + status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, landmcoslatdim, landm_coslatid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) + if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) + if (status .ne. NF_NOERR) call handle_err(status) + + ! + ! Create attributes for output variables + ! + status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') + status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') + status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from ncube3000 data') + status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) + + + status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & + 'standard deviation of 3km cubed-sphere elevation and target grid elevation') + status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') + status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & + 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') + status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') + status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') + status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') + + status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) + status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) + status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') + status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') + + + status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') + if (status .ne. NF_NOERR) call handle_err(status) + ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') + ! if (status .ne. NF_NOERR) call handle_err(status) + + status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') + if (status .ne. NF_NOERR) call handle_err(status) + call DATE_AND_TIME(DATE=datestring) + status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) + if (status .ne. NF_NOERR) call handle_err(status) + status = nf_put_att_text (foutid,oaid,'note', 40, '(2)+1 in nvar_dirOA to avoid bug in io') + do i=1,4 + status = nf_put_att_double (foutid, terroutid(i),& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, terroutid(i),& + '_FillValue' , nf_double, 1,fillvalue) + enddo + + status = nf_put_att_double (foutid, oa1id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, oa1id,& + '_FillValue' , nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, oa2id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, oa2id,& + '_FillValue' , nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, oa3id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, oa3id,& + '_FillValue' , nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, oa4id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, oa4id,& + '_FillValue' , nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol1id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol1id,& + '_FillValue' , nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol2id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol2id,& + '_FillValue' , nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol3id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol3id,& + '_FillValue' , nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol4id,& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, ol4id,& + '_FillValue' , nf_double, 1,fillvalue) + ! + ! End define mode for output file + ! + status = nf_enddef (foutid) + if (status .ne. NF_NOERR) call handle_err(status) + ! + ! Write variable for output +print*,"writing oc data",MINVAL(oc),MAXVAL(oc) +status = nf_put_var_double (foutid, ocid, oc) +if (status .ne. NF_NOERR) call handle_err(status) +!oa,ol +print*,"writing oa data",MINVAL(oa),MAXVAL(oa) +status = nf_put_var_double (foutid, oaid, oa) +if (status .ne. NF_NOERR) call handle_err(status) +print*,"writing ol data",MINVAL(ol),MAXVAL(ol) +status = nf_put_var_double (foutid, olid, ol) + +!============ +#if 0 +print*,"writing oa1 data",MINVAL(oa),MAXVAL(oa) +status = nf_put_var_double (foutid, oa1id, oa(:,1)) +if (status .ne. NF_NOERR) call handle_err(status) +print*,"writing ol1 data",MINVAL(ol),MAXVAL(ol) +status = nf_put_var_double (foutid, ol1id, ol(:,1)) +print*,"writing oa2 data",MINVAL(oa),MAXVAL(oa) +status = nf_put_var_double (foutid, oa2id, oa(:,2)) +if (status .ne. NF_NOERR) call handle_err(status) +print*,"writing ol2 data",MINVAL(ol),MAXVAL(ol) +status = nf_put_var_double (foutid, ol2id, ol(:,2)) +print*,"writing oa3 data",MINVAL(oa),MAXVAL(oa) +status = nf_put_var_double (foutid, oa3id, oa(:,3)) +if (status .ne. NF_NOERR) call handle_err(status) +print*,"writing ol3 data",MINVAL(ol),MAXVAL(ol) +status = nf_put_var_double (foutid, ol3id, ol(:,3)) +print*,"writing oa4 data",MINVAL(oa),MAXVAL(oa) +status = nf_put_var_double (foutid, oa4id, oa(:,4)) +if (status .ne. NF_NOERR) call handle_err(status) +print*,"writing ol4 data",MINVAL(ol),MAXVAL(ol) +status = nf_put_var_double (foutid, ol4id, ol(:,4)) +#endif +!=========== + + +if (status .ne. NF_NOERR) call handle_err(status) +!#if 0 + do i=1,4 + status = nf_put_att_double (foutid, terroutid(i),& + 'missing_value', nf_double, 1,fillvalue) + status = nf_put_att_double (foutid, terroutid(i),& + '_FillValue' , nf_double, 1,fillvalue) + print*,"writing"//terroutchar(i)//" data",& + MINVAL(terrout(i,:,:)),MAXVAL(terrout(i,:,:)) + status = nf_put_var_double (foutid, terroutid(i), terrout(i,:,:)) + if (status .ne. NF_NOERR) call handle_err(status) + enddo +!#endif + +!#if 0 + print*,"writing dxy data",MINVAL(dxy),MAXVAL(dxy) + status = nf_put_var_double (foutid, dxyid, dxy) + if (status .ne. NF_NOERR) call handle_err(status) +!#endif + ! + print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) + if (lprepare_fv_smoothing_routine) then + status = nf_put_var_double (foutid, terrid, terr) + else + status = nf_put_var_double (foutid, terrid, terr*9.80616) + end if + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing terrain data" + + print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) + status = nf_put_var_double (foutid, landfracid, landfrac) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing landfrac data" + + print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) + status = nf_put_var_double (foutid, sghid, sgh) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh data" + + print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) + status = nf_put_var_double (foutid, sgh30id, sgh30) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + + print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) + status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing sgh30 data" + ! + print*,"writing lat data" + status = nf_put_var_double (foutid, latvid, latar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lat data" + + print*,"writing lon data" + status = nf_put_var_double (foutid, lonvid, lonar) + if (status .ne. NF_NOERR) call handle_err(status) + print*,"done writing lon data" + ! + ! Close output file + ! + print *,"close file" + status = nf_close (foutid) + if (status .ne. NF_NOERR) call handle_err(status) +end subroutine wrtncdf_rll +!************************************************************************ +!!handle_err +!************************************************************************ +! +!!ROUTINE: handle_err +!!DESCRIPTION: error handler +!-------------------------------------------------------------------------- + +subroutine handle_err(status) + + implicit none + +# include + + integer status + + if (status .ne. nf_noerr) then + print *, nf_strerror(status) + stop 'Stopped' + endif + +end subroutine handle_err + + +SUBROUTINE coarsen(f,fcoarse,nf,n,dA_coarse) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + REAL (R8), DIMENSION(n) , INTENT(IN) :: f + REAL (R8), DIMENSION(n/nf), INTENT(OUT) :: fcoarse + INTEGER, INTENT(in) :: n,nf + REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf),INTENT(OUT) :: dA_coarse + !must be an even number + ! + ! local workspace + ! + ! ncube = INT(SQRT(DBLE(n/6))) + + REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6))),INT(SQRT(DBLE(n/6)))):: dA + REAL (R8) :: sum, sum_area,tmp + INTEGER :: jx,jy,jp,ii,ii_coarse,coarse_ncube,ncube + INTEGER :: jx_coarse,jy_coarse,jx_s,jy_s + + + ! REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf) :: dAtmp + + ncube = INT(SQRT(DBLE(n/6))) + coarse_ncube = ncube/nf + + IF (ABS(DBLE(ncube)/DBLE(nf)-coarse_ncube)>0.000001) THEN + WRITE(*,*) "ncube/nf must be an integer" + WRITE(*,*) "ncube and nf: ",ncube,nf + STOP + END IF + + da_coarse = 0.0 + + WRITE(*,*) "compute all areas" + CALL EquiangularAllAreas(ncube, dA) + ! CALL EquiangularAllAreas(coarse_ncube, dAtmp)!dbg + tmp = 0.0 + DO jp=1,6 + DO jy_coarse=1,coarse_ncube + DO jx_coarse=1,coarse_ncube + ! + ! inner loop + ! + sum = 0.0 + sum_area = 0.0 + DO jy_s=1,nf + jy = (jy_coarse-1)*nf+jy_s + DO jx_s=1,nf + jx = (jx_coarse-1)*nf+jx_s + ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx + sum = sum +f(ii)*dA(jx,jy) + sum_area = sum_area+dA(jx,jy) + ! WRITE(*,*) "jx,jy",jx,jy + END DO + END DO + tmp = tmp+sum_area + da_coarse(jx_coarse,jy_coarse) = sum_area + ! WRITE(*,*) "jx_coarse,jy_coarse",jx_coarse,jy_coarse,& + ! da_coarse(jx_coarse,jy_coarse)-datmp(jx_coarse,jy_coarse) + ii_coarse = (jp-1)*coarse_ncube*coarse_ncube+(jy_coarse-1)*coarse_ncube+jx_coarse + fcoarse(ii_coarse) = sum/sum_area + END DO + END DO + END DO + WRITE(*,*) "coarsened surface area",tmp-4.0*3.141592654 +END SUBROUTINE COARSEN + +SUBROUTINE overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& + jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) + use shr_kind_mod, only: r8 => shr_kind_r8 + use remap + IMPLICIT NONE + + + INTEGER, INTENT(INOUT) :: jall !anticipated number of weights + INTEGER, INTENT(IN) :: ncube, ngauss, ntarget, jmax_segments, ncorner, nreconstruction + + INTEGER, DIMENSION(jall,3), INTENT(OUT) :: weights_eul_index_all + REAL(R8), DIMENSION(jall,nreconstruction) , INTENT(OUT) :: weights_all + INTEGER, DIMENSION(jall) , INTENT(OUT) :: weights_lgr_index_all + + REAL(R8), DIMENSION(ncorner,ntarget), INTENT(IN) :: target_corner_lon, target_corner_lat + + INTEGER, DIMENSION(ncorner+1) :: ipanel_array, ipanel_tmp + REAL(R8), DIMENSION(ncorner) :: lat, lon + REAL(R8), DIMENSION(0:ncube+2):: xgno, ygno + REAL(R8), DIMENSION(0:ncorner+1) :: xcell, ycell + + REAL(R8), DIMENSION(ngauss) :: gauss_weights, abscissae + + REAL(R8) :: da, tmp, alpha, beta + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: pih = 0.50*pi + INTEGER :: i, j,ncorner_this_cell,k,ip,ipanel,ii,jx,jy,jcollect + integer :: alloc_error + + REAL (r8), PARAMETER :: rad2deg = 180.0/pi + + real(r8), allocatable, dimension(:,:) :: weights + integer , allocatable, dimension(:,:) :: weights_eul_index + + + LOGICAL:: ldbg = .FAlSE. + + INTEGER :: jall_anticipated + + jall_anticipated = jall + + ipanel_array = -99 + ! + da = pih/DBLE(ncube) + xgno(0) = -bignum + DO i=1,ncube+1 + xgno(i) = TAN(-piq+(i-1)*da) + END DO + xgno(ncube+2) = bignum + ygno = xgno + + CALL glwp(ngauss,gauss_weights,abscissae) + + + allocate (weights(jmax_segments,nreconstruction),stat=alloc_error ) + allocate (weights_eul_index(jmax_segments,2),stat=alloc_error ) + + tmp = 0.0 + jall = 1 + DO i=1,ntarget + WRITE(*,*) "cell",i," ",100.0*DBLE(i)/DBLE(ntarget),"% done" + ! + !--------------------------------------------------- + ! + ! determine how many vertices the cell has + ! + !--------------------------------------------------- + ! + CALL remove_duplicates_latlon(ncorner,target_corner_lon(:,i),target_corner_lat(:,i),& + ncorner_this_cell,lon,lat,1.0E-10,ldbg) + + IF (ldbg) THEN + WRITE(*,*) "number of vertices ",ncorner_this_cell + WRITE(*,*) "vertices locations lon,",lon(1:ncorner_this_cell)*rad2deg + WRITE(*,*) "vertices locations lat,",lat(1:ncorner_this_cell)*rad2deg + DO j=1,ncorner_this_cell + WRITE(*,*) lon(j)*rad2deg, lat(j)*rad2deg + END DO + WRITE(*,*) " " + END IF + ! + !--------------------------------------------------- + ! + ! determine how many and which panels the cell spans + ! + !--------------------------------------------------- + ! + DO j=1,ncorner_this_cell + CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ipanel_tmp(j), .TRUE.) + IF (ldbg) WRITE(*,*) "ipanel for corner ",j," is ",ipanel_tmp(j) + END DO + ipanel_tmp(ncorner_this_cell+1) = ipanel_tmp(1) + ! make sure to include possible overlap areas not on the face the vertices are located + IF (MINVAL(lat(1:ncorner_this_cell))<-pi/6.0) THEN + ! include South-pole panel in search + ipanel_tmp(ncorner_this_cell+1) = 5 + IF (ldbg) WRITE(*,*) "add panel 5 to search" + END IF + IF (MAXVAL(lat(1:ncorner_this_cell))>pi/6.0) THEN + ! include North-pole panel in search + ipanel_tmp(ncorner_this_cell+1) = 6 + IF (ldbg) WRITE(*,*) "add panel 6 to search" + END IF + ! + ! remove duplicates in ipanel_tmp + ! + CALL remove_duplicates_integer(ncorner_this_cell+1,ipanel_tmp(1:ncorner_this_cell+1),& + k,ipanel_array(1:ncorner_this_cell+1)) + ! + !--------------------------------------------------- + ! + ! loop over panels with possible overlap areas + ! + !--------------------------------------------------- + ! + DO ip = 1,k + ipanel = ipanel_array(ip) + DO j=1,ncorner_this_cell + ii = ipanel + CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ii,.FALSE.) + IF (j==1) THEN + jx = CEILING((alpha + piq) / da) + jy = CEILING((beta + piq) / da) + END IF + xcell(ncorner_this_cell+1-j) = TAN(alpha) + ycell(ncorner_this_cell+1-j) = TAN(beta) + END DO + xcell(0) = xcell(ncorner_this_cell) + ycell(0) = ycell(ncorner_this_cell) + xcell(ncorner_this_cell+1) = xcell(1) + ycell(ncorner_this_cell+1) = ycell(1) + + jx = MAX(MIN(jx,ncube+1),0) + jy = MAX(MIN(jy,ncube+1),0) + + CALL compute_weights_cell(xcell(0:ncorner_this_cell+1),ycell(0:ncorner_this_cell+1),& + jx,jy,nreconstruction,xgno,ygno,& + 1, ncube+1, 1,ncube+1, tmp,& + ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& + ncube,0,ncorner_this_cell,ldbg) + + weights_all(jall:jall+jcollect-1,1:nreconstruction) = weights(1:jcollect,1:nreconstruction) + + weights_eul_index_all(jall:jall+jcollect-1,1:2) = weights_eul_index(1:jcollect,:) + weights_eul_index_all(jall:jall+jcollect-1, 3) = ipanel + weights_lgr_index_all(jall:jall+jcollect-1 ) = i + + jall = jall+jcollect + IF (jall>jall_anticipated) THEN + WRITE(*,*) "more weights than anticipated" + WRITE(*,*) "increase jall" + STOP + END IF + IF (ldbg) WRITE(*,*) "jcollect",jcollect + END DO + END DO + jall = jall-1 + WRITE(*,*) "sum of all weights divided by surface area of sphere =",tmp/(4.0*pi) + WRITE(*,*) "actual number of weights",jall + WRITE(*,*) "anticipated number of weights",jall_anticipated + IF (jall>jall_anticipated) THEN + WRITE(*,*) "anticipated number of weights < actual number of weights" + WRITE(*,*) "increase jall!" + STOP + END IF + WRITE(*,*) MINVAL(weights_all(1:jall,1)),MAXVAL(weights_all(1:jall,1)) + IF (ABS(tmp/(4.0*pi))-1.0>0.001) THEN + WRITE(*,*) "sum of all weights does not match the surface area of the sphere" + WRITE(*,*) "sum of all weights is : ",tmp + WRITE(*,*) "surface area of sphere: ",4.0*pi + STOP + END IF +END SUBROUTINE overlap_weights + + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereABPFromRLL +! +! Description: +! Determine the (alpha,beta,panel) coordinate of a point on the sphere from +! a given regular lat lon coordinate. +! +! Parameters: +! lon - Coordinate longitude +! lat - Coordinate latitude +! alpha (OUT) - Alpha coordinate +! beta (OUT) - Beta coordinate +! ipanel (OUT) - Face panel +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel, ldetermine_panel) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (R8), INTENT(IN) :: lon, lat + REAL (R8), INTENT(OUT) :: alpha, beta + INTEGER :: ipanel + LOGICAL, INTENT(IN) :: ldetermine_panel + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: rotate_cube = 0.0 + + ! Local variables + REAL (R8) :: xx, yy, zz, pm + REAL (R8) :: sx, sy, sz + INTEGER :: ix, iy, iz + + ! Translate to (x,y,z) space + xx = COS(lon-rotate_cube) * COS(lat) + yy = SIN(lon-rotate_cube) * COS(lat) + zz = SIN(lat) + + pm = MAX(ABS(xx), ABS(yy), ABS(zz)) + + ! Check maximality of the x coordinate + IF (pm == ABS(xx)) THEN + IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF + ELSE + ix = 0 + ENDIF + + ! Check maximality of the y coordinate + IF (pm == ABS(yy)) THEN + IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF + ELSE + iy = 0 + ENDIF + + ! Check maximality of the z coordinate + IF (pm == ABS(zz)) THEN + IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF + ELSE + iz = 0 + ENDIF + + ! Panel assignments + IF (ldetermine_panel) THEN + IF (iz == 1) THEN + ipanel = 6; sx = yy; sy = -xx; sz = zz + + ELSEIF (iz == -1) THEN + ipanel = 5; sx = yy; sy = xx; sz = -zz + + ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN + ipanel = 1; sx = yy; sy = zz; sz = xx + + ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN + ipanel = 3; sx = -yy; sy = zz; sz = -xx + + ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN + ipanel = 2; sx = -xx; sy = zz; sz = yy + + ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN + ipanel = 4; sx = xx; sy = zz; sz = -yy + + ELSE + WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' + WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' + WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' + STOP + ENDIF + ELSE + IF (ipanel == 6) THEN + sx = yy; sy = -xx; sz = zz + ELSEIF (ipanel == 5) THEN + sx = yy; sy = xx; sz = -zz + ELSEIF (ipanel == 1) THEN + sx = yy; sy = zz; sz = xx + ELSEIF (ipanel == 3) THEN + sx = -yy; sy = zz; sz = -xx + ELSEIF (ipanel == 2) THEN + sx = -xx; sy = zz; sz = yy + ELSEIF (ipanel == 4) THEN + sx = xx; sy = zz; sz = -yy + ELSE + WRITE(*,*) "ipanel out of range",ipanel + STOP + END IF + END IF + + ! Use panel information to calculate (alpha, beta) coords + alpha = ATAN(sx / sz) + beta = ATAN(sy / sz) + +END SUBROUTINE CubedSphereABPFromRLL + +!------------------------------------------------------------------------------ +! SUBROUTINE EquiangularAllAreas +! +! Description: +! Compute the area of all cubed sphere grid cells, storing the results in +! a two dimensional array. +! +! Parameters: +! icube - Resolution of the cubed sphere +! dA (OUT) - Output array containing the area of all cubed sphere grid cells +!------------------------------------------------------------------------------ +SUBROUTINE EquiangularAllAreas(icube, dA) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + INTEGER, INTENT(IN) :: icube + REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA + + ! Local variables + INTEGER :: k, k1, k2 + REAL (r8) :: a1, a2, a3, a4 + REAL (r8), DIMENSION(icube+1,icube+1) :: ang + REAL (r8), DIMENSION(icube+1) :: gp + + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + + !#ifdef DBG + REAL (r8) :: dbg1 !DBG + !#endif + + ! Recall that we are using equi-angular spherical gridding + ! Compute the angle between equiangular cubed sphere projection grid lines. + DO k = 1, icube+1 + gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) + ENDDO + + DO k2=1,icube+1 + DO k1=1,icube+1 + ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) + ENDDO + ENDDO + + DO k2=1,icube + DO k1=1,icube + a1 = ang(k1 , k2 ) + a2 = pi - ang(k1+1, k2 ) + a3 = pi - ang(k1 , k2+1) + a4 = ang(k1+1, k2+1) + ! area = r*r*(-2*pi+sum(interior angles)) + DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 + ENDDO + ENDDO + + !#ifdef DBG + ! Only for debugging - test consistency + dbg1 = 0.0 !DBG + DO k2=1,icube + DO k1=1,icube + dbg1 = dbg1 + DA(k1,k2) !DBG + ENDDO + ENDDO + write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG + !#endif +END SUBROUTINE EquiangularAllAreas + + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereRLLFromABP +! +! Description: +! Determine the lat lon coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! lon (OUT) - Calculated longitude +! lat (OUT) - Calculated latitude +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: lon, lat + ! Local variables + REAL (r8) :: xx, yy, zz, rotate_cube + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + rotate_cube = 0.0 + ! Convert to cartesian coordinates + CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + ! Convert back to lat lon + lat = ASIN(zz) + if (xx==0.0.and.yy==0.0) THEN + lon = 0.0 + else + lon = ATAN2(yy, xx) +rotate_cube + IF (lon<0.0) lon=lon+2.0*pi + IF (lon>2.0*pi) lon=lon-2.0*pi + end if +END SUBROUTINE CubedSphereRLLFromABP + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereXYZFromABP +! +! Description: +! Determine the Cartesian coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! xx (OUT) - Calculated x coordinate +! yy (OUT) - Calculated y coordinate +! zz (OUT) - Calculated z coordinate +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: xx, yy, zz + ! Local variables + REAL (r8) :: a1, b1, pm + REAL (r8) :: sx, sy, sz + + ! Convert to Cartesian coordinates + a1 = TAN(alpha) + b1 = TAN(beta) + + sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) + sx = sz * a1 + sy = sz * b1 + ! Panel assignments + IF (ipanel == 6) THEN + yy = sx; xx = -sy; zz = sz + ELSEIF (ipanel == 5) THEN + yy = sx; xx = sy; zz = -sz + ELSEIF (ipanel == 1) THEN + yy = sx; zz = sy; xx = sz + ELSEIF (ipanel == 3) THEN + yy = -sx; zz = sy; xx = -sz + ELSEIF (ipanel == 2) THEN + xx = -sx; zz = sy; yy = sz + ELSEIF (ipanel == 4) THEN + xx = sx; zz = sy; yy = -sz + ELSE + WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' + WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' + STOP + ENDIF +END SUBROUTINE CubedSphereXYZFromABP + + +SUBROUTINE remove_duplicates_integer(n_in,f_in,n_out,f_out) + use shr_kind_mod, only: r8 => shr_kind_r8 + integer, intent(in) :: n_in + integer,dimension(n_in), intent(in) :: f_in + integer, intent(out) :: n_out + integer,dimension(n_in), intent(out) :: f_out + ! + ! local work space + ! + integer :: k,i,j + ! + ! remove duplicates in ipanel_tmp + ! + k = 1 + f_out(1) = f_in(1) + outer: do i=2,n_in + do j=1,k + ! if (f_out(j) == f_in(i)) then + if (ABS(f_out(j)-f_in(i))<1.0E-10) then + ! Found a match so start looking again + cycle outer + end if + end do + ! No match found so add it to the output + k = k + 1 + f_out(k) = f_in(i) + end do outer + n_out = k +END SUBROUTINE remove_duplicates_integer + +SUBROUTINE remove_duplicates_latlon(n_in,lon_in,lat_in,n_out,lon_out,lat_out,tiny,ldbg) + use shr_kind_mod, only: r8 => shr_kind_r8 + integer, intent(in) :: n_in + real(r8),dimension(n_in), intent(inout) :: lon_in,lat_in + real, intent(in) :: tiny + integer, intent(out) :: n_out + real(r8),dimension(n_in), intent(out) :: lon_out,lat_out + logical :: ldbg + ! + ! local work space + ! + integer :: k,i,j + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: pih = 0.50*pi + ! + ! for pole points: make sure the longitudes are identical so that algorithm below works properly + ! + do i=2,n_in + if (abs(lat_in(i)-pih) ' + print *, ' ' + print *, 'REQUIRED ARGUMENTS: ' + print *, ' --target-grid Target grid descriptor in SCRIP format ' + print *, ' --input-topography Input USGS topography on cube sphere ' + print *, ' --output-topography Output topography on target grid ' + print *, ' ' + print *, 'OPTIONAL ARGUMENTS: ' + print *, ' --smoothed-topography Input smoothed topography (for surface ' + print *, ' roughness calculation). If present, ' + print *, ' output will contain estimate of subgrid' + print *, ' surface roughness (SGH). Note that the ' + print *, ' variance in elevation from the 30s to ' + print *, ' 3km grid (SGH30) is also downscaled, ' + print *, ' but does not depend on the smoothing. ' + print *, ' ' + print *, 'DESCRIPTION: ' + print *, 'This code performs rigorous remapping of topography variables on a cubed- ' + print *, 'sphere grid to any target grid. The code is documented in: ' + print *, ' ' + print *, ' Lauritzen, Nair and Ullrich, 2010, J. Comput. Phys. ' + print *, ' ' + print *, 'AUTHOR: ' + print *, ' Peter Hjort Lauritzen (pel@ucar.edu), AMP/CGD/NESL/NCAR ' + print *, ' ' +end subroutine usage diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl b/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl new file mode 100755 index 00000000000..d79fc234beb --- /dev/null +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl @@ -0,0 +1,21 @@ +load "/lcrc/group/e3sm/ac.xie7/Analysis/NCLep/self.ncl" +begin +vars=(/"PHIS","SGH","SGH30","LANDFRAC","LANDM_COSLAT"/) +;; +fil1="final-180-ne30pg2-mod-v3.nc" +;fil2="USGS-gtopo30_ne30np4pg2_16xdel2.c20200108.nc" +;fil3="final-180-ne30pg2.nc" +fil2="USGS-gtopo30_ne30np4pg2_x6t-SGH.c20210614.nc" +fil3="final-180-ne30pg2-v3.nc" +system("rm -r "+fil1) +system("cp -r "+fil3+" "+fil1) +;; +ff1=addfile(fil1,"w") +ff2=addfile(fil2,"r") +;; +do i=0,4 +ff1->$vars(i)$=ff2->$vars(i)$ +end do + + +end diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 b/components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 new file mode 100755 index 00000000000..0ffb3c0bfec --- /dev/null +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 @@ -0,0 +1,900 @@ +Module ogwd_sub +use shr_kind_mod, only: r8 => shr_kind_r8 +!use transform + +contains +!#if 0 +subroutine OAdir(terr,ntarget,ncube,n,nvar_dir,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,lon_cen,lat_cen,lon_terr,lat_terr,area_target,oa_target) +!use shr_kind_mod, only: r8 => shr_kind_r8 +IMPLICIT NONE +integer ,intent(in) :: ncube,ntarget,n,nvar_dir,jall,weights_lgr_index_all(jall) +integer ,intent(in) :: weights_eul_index_all1(jall),& + weights_eul_index_all2(jall),& + weights_eul_index_all3(jall) +real(r8),intent(in) :: weights_all(jall,1),landfrac_target(ntarget) +real(r8),intent(in) :: terr(n) +!real(r8),intent(in) :: lon_cen(ntarget),& +real(r8),intent(inout) :: lon_cen(ntarget),& + lat_cen(ntarget),& + area_target(ntarget) +real(r8),intent(in) :: lon_terr(n),lat_terr(n) +real(r8),intent(out) :: oa_target(ntarget,nvar_dir) +!local +integer :: count,i,ix,iy,ip,ii,ip2,ip3 +real(r8) :: xxterr,yyterr,zzterr,ix2,iy2,xx3,yy3,zz3,ix3,iy3 +real(r8) :: wt,xhds(ntarget),yhds(ntarget),zhds(ntarget),hds(ntarget),OAx_var(ntarget),OAy_var(ntarget),OAz_var(ntarget),OA_var(ntarget) +real(r8) :: xbar(ntarget),ybar(ntarget),zbar(ntarget),lon_bar(ntarget),lat_bar(ntarget) +real(r8) :: rad,theta1 +real(r8) :: OAlon(ntarget),OAlat(ntarget),OArad(ntarget),OAx1,OAy1,OAz1 + +real(r8) :: terr_anom(n),terr_avg(ntarget),weights_ano(jall),area_target_ano(ntarget) + +xhds=0.0_r8 +yhds=0.0_r8 +zhds=0.0_r8 +hds=0.0_r8 + +xbar=0.0_r8 +ybar=0.0_r8 +zbar=0.0_r8 +lon_bar=0.0_r8 +lat_bar=0.0_r8 +OA_var=0.0_r8 +OAx_var=0.0_r8 +OAy_var=0.0_r8 +OAz_var=0.0_r8 + + +!#if 0 +terr_anom=0.0_r8 +terr_avg=0.0_r8 +do count=1,jall + i = weights_lgr_index_all(count) + ix = weights_eul_index_all1(count)!,1) + iy = weights_eul_index_all2(count)!,2) + ip = weights_eul_index_all3(count) + ! convert to 1D indexing of cubed-sphere + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + wt = weights_all(count,1) + ! + terr_avg(i)=terr_avg(i)+(wt/area_target(i))*terr(ii) + !terr(ii)*wt!(wt/area_target(i))*terr(ii) +enddo + +do count=1,jall + i = weights_lgr_index_all(count) + ix = weights_eul_index_all1(count)!,1) + iy = weights_eul_index_all2(count)!,2) + ip = weights_eul_index_all3(count) + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix + terr_anom(ii)=terr(ii)-terr_avg(i) +! +enddo +where(terr_anom.le.0) terr_anom=0.0_r8 + +do count=1,jall + i = weights_lgr_index_all(count) + ix = weights_eul_index_all1(count)!,1) + iy = weights_eul_index_all2(count)!,2) + ip = weights_eul_index_all3(count)!,3) + ! + ! convert to 1D indexing of cubed-sphere + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + wt = weights_all(count,1) + rad=4.0_r8*atan(1.0_r8)/180.0_r8 + call CubedSphereABPFromRLL(lon_terr(ii)*rad,lat_terr(ii)*rad,ix2,iy2,ip2,.true.) + call CubedSphereXYZFromABP(ix2,iy2,ip2,xxterr,yyterr,zzterr) +!#if 0 + xhds(i)=xhds(i)+xxterr*terr_anom(ii)*wt + yhds(i)=yhds(i)+yyterr*terr_anom(ii)*wt + zhds(i)=zhds(i)+zzterr*terr_anom(ii)*wt + hds(i) =hds(i)+terr_anom(ii)*wt + + !masscenter for every coarse grid + !on Cartesian coord + !looking the h as ro + xbar(i)=xhds(i)/hds(i) + ybar(i)=yhds(i)/hds(i) + zbar(i)=zhds(i)/hds(i) + + call CubedSphereABPFromRLL(lon_cen(i)*rad,lat_cen(i)*rad,& + ix3,iy3,ip3,.true.) + call CubedSphereXYZFromABP(ix3,iy3,ip3,xx3,yy3,zz3) + !under Cartesian, the variability of the scale in the wind + !direction is the sqrt(x^2+y^2+z^2), the scale of the orthogonal + !3 directions + !then it is only a matter of using the original formula + !in the single direction + OA_var(i)=OA_var(i)+wt/area_target(i)& + *((xxterr-xx3)**2+(yyterr-yy3)**2+(zzterr-zz3)**2) + OAx_var(i)=OAx_var(i)+(wt/area_target(i))*(xxterr-xx3)**2 + OAy_var(i)=OAy_var(i)+(wt/area_target(i))*(yyterr-yy3)**2 + OAz_var(i)=OAz_var(i)+(wt/area_target(i))*(zzterr-zz3)**2 + OAx1=(xx3-xbar(i))/sqrt(OAx_var(i))!OA_var(i)) + OAy1=(yy3-ybar(i))/sqrt(OAy_var(i))!OA_var(i)) + OAz1=(zz3-zbar(i))/sqrt(OAz_var(i))!OA_var(i)) + !assuming a small change in lon_cen to lon_bar + !so it does not matter whether lon_cen or lon_bar + !thus we change onto lat-lon grid vector in target gridcell +#if 0 + OArad(i)= OAx1*sin(lat_cen(i)*rad)*cos(lon_cen(i)*rad)& + +OAy1*sin(lat_cen(i)*rad)*sin(lon_cen(i)*rad)& + +OAz1*cos(lat_cen(i)*rad) + OAlat(i)= OAx1*cos(lat_cen(i)*rad)*cos(lon_cen(i)*rad)& + +OAy1*cos(lat_cen(i)*rad)*sin(lon_cen(i)*rad)& + -OAz1*sin(lat_cen(i)*rad) + OAlon(i)=-OAx1*sin(lon_cen(i)*rad)& + +OAy1*cos(lon_cen(i)*rad) +#endif + !all lat_cen must use (90-lat_cen) since we only have + !latitude rather than colatitude + !this is equivalent to using induction formula sin(90-lat)=cos(lat) + !latitude is opposite of colatitude, thus OAlat is negative + OAlat(i)=-(OAx1*sin(lat_cen(i)*rad)*cos(lon_cen(i)*rad)& + +OAy1*sin(lat_cen(i)*rad)*sin(lon_cen(i)*rad)& + -OAz1*cos(lat_cen(i)*rad)) + OAlon(i)= -OAx1*sin(lon_cen(i)*rad)& + +OAy1*cos(lon_cen(i)*rad) +#if 0 + theta1=0. + oa_target(i,1) = OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) + theta1=90. + oa_target(i,2) = OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) + theta1=45. + oa_target(i,3)= OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) + theta1=360.-45. + oa_target(i,4)= OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) +#endif +!#if 0 + !reverse in order to be + !(2,ntarget),OAx,OAy + oa_target(i,1) = OAlon(i) + oa_target(i,2) = OAlat(i) + +!#endif + !landfrac may cause coastal area par to diminish + !oa_target(i,:) = oa_target(i,:)*landfrac_target(i) +enddo + !takeout abnormal values +!#if 0 + where(abs(oa_target)<.001_r8.or.& + abs(oa_target).gt.1e+7) oa_target=0.0_r8 + !where(abs(oa_target).gt.1) oa_target=1.0_r8 + where(oa_target.ne.oa_target) oa_target=0.0_r8 + +!#endif +end subroutine OAdir +!============================================================ +subroutine OAorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,lon_terr,lat_terr,area_target,oa_target) +!use shr_kind_mod, only: r8 => shr_kind_r8 +IMPLICIT NONE +integer ,intent(in) :: ncube,ntarget,n,jall,weights_lgr_index_all(jall),weights_eul_index_all1(jall),weights_eul_index_all2(jall),weights_eul_index_all3(jall) +real(r8),intent(in) :: weights_all(jall,1),terr(n) +real(r8),intent(in) :: landfrac_target(ntarget),lon_terr(n),lat_terr(n),area_target(ntarget) +real(r8),intent(out) :: oa_target(ntarget,4) +!local +real(r8) :: xh(ntarget),yh(ntarget),height(ntarget),modexcoords(ntarget),modeycoords(ntarget),avgx(ntarget),avgy(ntarget),varx(ntarget),vary(ntarget),OAx,OAy,theta1,rad +integer(r8) :: count,i,ix,iy,ip,ii +real(r8) :: wt + + xh=0.0_r8 + yh=0.0_r8 + height=0.0_r8 + modexcoords=0.0_r8 + modeycoords=0.0_r8 + avgx=0.0_r8 + avgy=0.0_r8 + varx=0.0_r8 + vary=0.0_r8 + OAx=0.0_r8 + OAy=0.0_r8 + theta1=0.0_r8 + rad=0.0_r8 + +do count=1,jall + i = weights_lgr_index_all(count) + ix = weights_eul_index_all1(count)!,1) + iy = weights_eul_index_all2(count)!,2) + ip = weights_eul_index_all3(count)!,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + wt = weights_all(count,1) + !for OA + avgx(i)=avgx(i)+wt/area_target(i)*lon_terr(ii) + avgy(i)=avgy(i)+wt/area_target(i)*lat_terr(ii) +enddo + + +do count=1,jall + i = weights_lgr_index_all(count) + ix = weights_eul_index_all1(count)!,1) + iy = weights_eul_index_all2(count)!,2) + ip = weights_eul_index_all3(count)!,3) + ! + ! convert to 1D indexing of cubed-sphere + ! + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + wt = weights_all(count,1) + !mode for both dim + xh(i)=xh(i)+wt/area_target(i)*lon_terr(ii)*terr(ii) + yh(i)=yh(i)+wt/area_target(i)*lat_terr(ii)*terr(ii) + height(i)=height(i)+wt/area_target(i)*terr(ii) + modexcoords(i)=xh(i)/(height(i))!+1e-14) + modeycoords(i)=yh(i)/(height(i))!+1e-14) + + varx(i)=varx(i)+(wt/area_target(i))*(lon_terr(ii)-avgx(i))**2 + vary(i)=vary(i)+(wt/area_target(i))*(lat_terr(ii)-avgy(i))**2 + !OAx,OAy + OAx=landfrac_target(i)*(avgx(i)-modexcoords(i))/sqrt(varx(i)) + OAy=landfrac_target(i)*(avgy(i)-modeycoords(i))/sqrt(vary(i)) + + rad=4.0*atan(1.0)/180.0 + theta1=0. + oa_target(i,1) = OAx*cos(theta1*rad)+OAy*sin(theta1*rad) + theta1=90. + oa_target(i,2) = OAx*cos(theta1*rad)+OAy*sin(theta1*rad) + theta1=45. + oa_target(i,3)= OAx*cos(theta1*rad)+OAy*sin(theta1*rad) + theta1=360.-45. + oa_target(i,4)= OAx*cos(theta1*rad)+OAy*sin(theta1*rad) + oa_target(i,:)= oa_target(i,:)*landfrac_target(i) +enddo + !takeout abnormal values + where(abs(oa_target)<.001_r8.or.abs(oa_target).gt.1e+7) oa_target=0.0 + where(abs(oa_target).gt.1) oa_target=0.0 + where(oa_target.ne.oa_target) oa_target=0.0 +end subroutine OAorig +!#endif +!=================================== +subroutine OC(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,area_target,sgh_target,terr_target,oc_target) +!use shr_kind_mod, only: r8 => shr_kind_r8 +IMPLICIT NONE +integer ,intent(in) :: ncube,ntarget,n,jall,weights_lgr_index_all(jall),weights_eul_index_all1(jall),weights_eul_index_all2(jall),weights_eul_index_all3(jall) +real(r8),intent(in) :: weights_all(jall,1) +real(r8),intent(in) :: landfrac_target(ntarget),area_target(ntarget),sgh_target(ntarget),terr_target(ntarget),terr(n) +real(r8),intent(out) :: oc_target(ntarget) +!local +integer :: count,i,ix,iy,ip,ii +real(r8) :: wt + + oc_target=0.0_r8 + do count=1,jall + i = weights_lgr_index_all(count) + ix = weights_eul_index_all1(count)!,1) + iy = weights_eul_index_all2(count)!,2) + ip = weights_eul_index_all3(count)!,3) + ! convert to 1D indexing of cubed-sphere + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + wt = weights_all(count,1) + oc_target(i) = oc_target(i)+(wt/area_target(i))*((terr_target(i)-terr(ii))**4)/(sgh_target(i)**4) + oc_target(i) = oc_target(i) * landfrac_target(i) + enddo + + where(abs(oc_target)<.001_r8.or.abs(oc_target).gt.1e+7) oc_target=0.0_r8 + where(abs(sgh_target).eq.0.0_r8) oc_target=0.0_r8 + where(oc_target<0.0_r8) oc_target=0.0_r8 +end subroutine OC +!======================== +subroutine OLorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,lon_terr,lat_terr,area_target,sgh_target,target_center_lat,target_center_lon,target_corner_lat_deg,target_corner_lon_deg,ol_target) +!use shr_kind_mod, only: r8 => shr_kind_r8 +IMPLICIT NONE +integer,intent(in) :: ncube,ntarget,n,jall,weights_lgr_index_all(jall),weights_eul_index_all1(jall),weights_eul_index_all2(jall),weights_eul_index_all3(jall) +real(r8),intent(in) :: weights_all(jall,1) +real(r8),intent(in) :: landfrac_target(ntarget),area_target(ntarget),sgh_target(ntarget),terr(n),lon_terr(n),lat_terr(n) +real(r8),intent(in) :: target_center_lat(ntarget),target_center_lon(ntarget),target_corner_lat_deg(4,ntarget),target_corner_lon_deg(4,ntarget) +real(r8),intent(out) :: ol_target(ntarget,4) +!local +integer :: count,i,ix,iy,ip,ii +real(r8) :: wt,terr_if,Nw(4,ntarget),area_target_par(4,ntarget),j + + + ol_target=0.0_r8 + Nw=0.0_r8 + area_target_par=0.0_r8 + + do count=1,jall + i = weights_lgr_index_all(count) + ix = weights_eul_index_all1(count)!,1) + iy = weights_eul_index_all2(count)!,2) + ip = weights_eul_index_all3(count)!,3) + ! convert to 1D indexing of cubed-sphere + ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! + wt = weights_all(count,1) + !determine terr_if + terr_if=0._r8 + if (terr(ii).GT.(1116.2-0.878*sgh_target(i))) terr_if=1. + ! (1): the lower left corner + ! (2): the lower right corner + ! (3): the upper right corner + ! (4): the upper left corner + !OL1 + if (lat_terr(ii) &!(ii)& + .GT.(target_corner_lat_deg(1,i)+target_center_lat(i))/2..and. & + lat_terr(ii) &!(ii)& + .LT.(target_corner_lat_deg(4,i)+target_center_lat(i))/2.) then + Nw(1,i)=Nw(1,i)+wt*terr_if + area_target_par(1,i)=area_target_par(1,i)+wt + endif + + !OL2 + if (lon_terr(ii) &!(ii)& + .GT.(target_corner_lon_deg(1,i)+target_center_lon(i))/2..and. & + lon_terr(ii) &!(ii)& + .LT.(target_corner_lon_deg(3,i)+target_center_lon(i))/2.) then + Nw(2,i)=Nw(2,i)+wt*terr_if + area_target_par(2,i)=area_target_par(2,i)+wt + end if + + + !OL3 + if (lon_terr(ii) &!(ii)& + .LT.target_center_lon(i).and. & + lat_terr(ii) &!(ii)& + .LT.target_center_lat(i).or. & + lon_terr(ii) &!(ii)& + .GT.target_center_lon(i).and. & + lat_terr(ii) &!(ii)& + .GT.target_center_lat(i)) then + Nw(3,i)=Nw(3,i)+wt*terr_if + area_target_par(3,i)=area_target_par(3,i)+wt + end if + + + !OL4 + if (lat_terr(ii) & !(ii)& + .GT.target_center_lat(i).and. & + lon_terr(ii) & !(ii)& + .LT.target_center_lon(i).or. & + lat_terr(ii) & !(ii)& + .LT.target_center_lat(i).and. & + lon_terr(ii) & !(ii)& + .GT.target_center_lon(i)) then + Nw(4,i)=Nw(4,i)+wt*terr_if + area_target_par(4,i)=area_target_par(4,i)+wt + end if + + !Nw(4,i)=Nw(4,i)+wt*terr_if + !area_target_par(4,i)=area_target_par(4,i)+wt + + + + do j=1,4 + ol_target(i,j)=Nw(j,i)/(area_target_par(j,i)+1e-14)!Nt(i)!/2.) + enddo + ol_target(i,:)=ol_target(i,:)*landfrac_target(i) + end do + where(abs(ol_target)<.001_r8.or.abs(ol_target).gt.1e+7) ol_target=0.0_r8 +end subroutine OLorig +!#endif +!===================== +!=================================================================== +!===================== +!#if 0 +subroutine OLgrid(terr,terrx,terry,wt,b,a,n,theta_in,hc,OLout) +!use physconst, only: rh2o,zvir,pi,rearth +!use abortutils +!Xie add +IMPLICIT NONE +integer,intent(in) :: n +real(r8),intent(in) :: hc,wt(n),terr(n),a,b,theta_in!a dy,b dx +real(r8),intent(in) :: terrx(n),terry(n) +real(r8),intent(out) :: OLout +real(r8) :: theta,theta1,theta2,rad,interval +real(r8) :: terr_count(n),terr_whole_count(n),cx(n),c1,c2 +!local +integer :: i +real(r8) :: j + terr_count=0.0_r8 + terr_whole_count=0.0_r8 + c1=0.0_r8 + c2=0.0_r8 + cx=0.0_r8 + !determine an acute theta in the triangle + !or minus 180 equilvalent acute angle + !then turn into radian + rad=4.0_r8*atan(1.0_r8)/180.0_r8 + interval=0.0_r8 + + !initialize + theta1=0.0_r8 + theta2=0.0_r8 + !set inside -360~360 + !this adds robustness of the scheme to different angle + theta1=MOD(theta_in,360._r8) + !set negative axis into 0~360 + if (theta1.ge.-360._r8.and.theta1.lt.0._r8) then + theta1=theta1+360._r8 + endif + !now we have only 0~360 angle + if (theta1.ge. 0._r8.and.theta1.le. 90._r8) then + theta=theta1*rad + theta2=theta1 + else if (theta1.gt. 90._r8.and.theta1.le. 180._r8) then + theta=(180._r8-theta1)*rad + theta2=180._r8-theta1 + else if (theta1.gt. 180._r8.and.theta1.le. 270._r8) then + theta=(theta1-180._r8)*rad + theta2=theta1-180._r8 + !we only use 0~180, so this makes similar to 1st and 2nd quadrant + else if (theta1.gt. 270._r8.and.theta1.le. 360._r8) then + theta=(360._r8-theta1)*rad + theta2=360._r8-theta1 + !we only use 0~180, so this makes similar to 1st and 2nd quadrant + endif + !we use theta2 to judge instead + !theta2=theta1 + !theta1=theta2 + !we restrict the angle in the first and second quadrant + !the third and fourth for OL are similar when theta is + !transformed by minus pi(180) + !two parallel lines are included + !xsin(theta)-ycos(theta)=c1 + !xsin(theta)-ycos(theta)=c2 + !xsin(theta)-ycos(theta)=cx,min(c1,c2) 0) .AND. (j < ncube_reconstruct)) THEN + beta = gp(j) + beta_next = gp(j+1) + ELSEIF (j == -1) THEN + beta = -piq - (gp(3) + piq) + beta_next = -piq - (gp(2) + piq) + ELSEIF (j == 0) THEN + beta = -piq - (gp(2) + piq) + beta_next = -piq + ELSEIF (j == ncube_reconstruct) THEN + beta = piq + beta_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (j == ncube_reconstruct+1) THEN + beta = piq + (piq - gp(ncube_reconstruct-1)) + beta_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + + DO i = -1, ncube_reconstruct+1 + IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN + alpha = gp(i) + alpha_next = gp(i+1) + ELSEIF (i == -1) THEN + alpha = -piq - (gp(3) + piq) + alpha_next = -piq - (gp(2) + piq) + ELSEIF (i == 0) THEN + alpha = -piq - (gp(2) + piq) + alpha_next = -piq + ELSEIF (i == ncube_reconstruct) THEN + alpha = piq + alpha_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (i == ncube_reconstruct+1) THEN + alpha = piq + (piq - gp(ncube_reconstruct-1)) + alpha_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + abp_centroid(1,i,j) = & + I_10_ab(alpha_next,beta_next)-I_10_ab(alpha ,beta_next)+& + I_10_ab(alpha ,beta )-I_10_ab(alpha_next,beta ) +! - ASINH(COS(alpha_next) * TAN(beta_next)) & +! + ASINH(COS(alpha_next) * TAN(beta)) & +! + ASINH(COS(alpha) * TAN(beta_next)) & +! - ASINH(COS(alpha) * TAN(beta)) + + abp_centroid(2,i,j) = & + I_01_ab(alpha_next,beta_next)-I_01_ab(alpha ,beta_next)+& + I_01_ab(alpha ,beta )-I_01_ab(alpha_next,beta ) +! - ASINH(TAN(alpha_next) * COS(beta_next)) & +! + ASINH(TAN(alpha_next) * COS(beta)) & +! + ASINH(TAN(alpha) * COS(beta_next)) & +! - ASINH(TAN(alpha) * COS(beta)) + + !ADD PHL START + IF (order>2) THEN + ! TAN(alpha)^2 component + abp_centroid(3,i,j) =& + I_20_ab(alpha_next,beta_next)-I_20_ab(alpha ,beta_next)+& + I_20_ab(alpha ,beta )-I_20_ab(alpha_next,beta ) + + ! TAN(beta)^2 component + abp_centroid(4,i,j) = & + I_02_ab(alpha_next,beta_next)-I_02_ab(alpha ,beta_next)+& + I_02_ab(alpha ,beta )-I_02_ab(alpha_next,beta ) + + ! TAN(alpha) TAN(beta) component + abp_centroid(5,i,j) = & + I_11_ab(alpha_next,beta_next)-I_11_ab(alpha ,beta_next)+& + I_11_ab(alpha ,beta )-I_11_ab(alpha_next,beta ) + ENDIF + !ADD PHL END + ENDDO + ENDDO + +! +! PHL outcommented below +! + ! High order calculations +! IF (order > 2) THEN +! DO k = 1, nlon +! DO i = 1, int_nx(nlat,k)-1 +! IF ((int_itype(i,k) > 4) .AND. (int_np(1,i,k) == 1)) THEN +! abp_centroid(3, int_a(i,k), int_b(i,k)) = & +! abp_centroid(3, int_a(i,k), int_b(i,k)) + int_wt_2a(i,k) +! abp_centroid(4, int_a(i,k), int_b(i,k)) = & +! abp_centroid(4, int_a(i,k), int_b(i,k)) + int_wt_2b(i,k) +! abp_centroid(5, int_a(i,k), int_b(i,k)) = & +! abp_centroid(5, int_a(i,k), int_b(i,k)) + int_wt_2c(i,k) +! ENDIF +! ENDDO +! ENDDO +! ENDIF + + ! Normalize with element areas + DO j = -1, ncube_reconstruct+1 + IF ((j > 0) .AND. (j < ncube_reconstruct)) THEN + beta = gp(j) + beta_next = gp(j+1) + ELSEIF (j == -1) THEN + beta = -piq - (gp(3) + piq) + beta_next = -piq - (gp(2) + piq) + ELSEIF (j == 0) THEN + beta = -piq - (gp(2) + piq) + beta_next = -piq + ELSEIF (j == ncube_reconstruct) THEN + beta = piq + beta_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (j == ncube_reconstruct+1) THEN + beta = piq + (piq - gp(ncube_reconstruct-1)) + beta_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + DO i = -1, ncube_reconstruct+1 + IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN + alpha = gp(i) + alpha_next = gp(i+1) + ELSEIF (i == -1) THEN + alpha = -piq - (gp(3) + piq) + alpha_next = -piq - (gp(2) + piq) + ELSEIF (i == 0) THEN + alpha = -piq - (gp(2) + piq) + alpha_next = -piq + ELSEIF (i == ncube_reconstruct) THEN + alpha = piq + alpha_next = piq + (piq - gp(ncube_reconstruct-1)) + ELSEIF (i == ncube_reconstruct+1) THEN + alpha = piq + (piq - gp(ncube_reconstruct-1)) + alpha_next = piq + (piq - gp(ncube_reconstruct-2)) + ENDIF + + IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + area = DAcube(i,j) + ELSE + area = EquiangularElementArea(alpha, alpha_next - alpha, & + beta, beta_next - beta) + ENDIF + + abp_centroid(1,i,j) = abp_centroid(1,i,j) / area + abp_centroid(2,i,j) = abp_centroid(2,i,j) / area + + IF (order > 2) THEN + IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + abp_centroid(3,i,j) = abp_centroid(3,i,j) / area + abp_centroid(4,i,j) = abp_centroid(4,i,j) / area + abp_centroid(5,i,j) = abp_centroid(5,i,j) / area + ENDIF + ENDIF + ENDDO + ENDDO + + WRITE(*,*) '...Done computing ABP element centroids' + + END SUBROUTINE ComputeABPElementCentroids + +!------------------------------------------------------------------------------ +! FUNCTION EvaluateABPReconstruction +! +! Description: +! Evaluate the sub-grid scale reconstruction at the given point. +! +! Parameters: +! fcubehalo - Array of element values +! recons - Array of reconstruction coefficients +! a - Index of element in alpha direction (1 <= a <= ncube_reconstruct-1) +! b - Index of element in beta direction (1 <= b <= ncube_reconstruct-1) +! p - Panel index of element +! alpha - Alpha coordinate of evaluation point +! beta - Beta coordinate of evaluation point +! order - Order of the reconstruction +! value (OUT) - Result of function evaluation at given point +!------------------------------------------------------------------------------ + SUBROUTINE EvaluateABPReconstruction( & + fcubehalo, recons, a, b, p, alpha, beta, order, value) + IMPLICIT NONE + + ! Dummy variables + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(IN) :: recons + INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p + REAL (KIND=dbl_kind), INTENT(IN) :: alpha, beta + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), INTENT(OUT) :: value + + ! Evaluate constant order terms + value = fcubehalo(a,b,p) + + ! Evaluate linear order terms + IF (order > 1) THEN + value = value + recons(1,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) + value = value + recons(2,a,b,p) * (TAN(beta) - abp_centroid(2,a,b)) + ENDIF + + ! Evaluate second order terms + IF (order > 2) THEN + value = value + recons(3,a,b,p) * & + (abp_centroid(1,a,b)**2 - abp_centroid(3,a,b)) + value = value + recons(4,a,b,p) * & + (abp_centroid(2,a,b)**2 - abp_centroid(4,a,b)) + value = value + recons(5,a,b,p) * & + (abp_centroid(1,a,b) * abp_centroid(2,a,b) - & + abp_centroid(5,a,b)) + + value = value + recons(3,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b))**2 + value = value + recons(4,a,b,p) * (TAN(beta) - abp_centroid(2,a,b))**2 + value = value + recons(5,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) & + * (TAN(beta) - abp_centroid(2,a,b)) + ENDIF + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ABPHaloMinMax +! +! Description: +! Calculate the minimum and maximum values of the cell-averaged function +! around the given element. +! +! Parameters: +! fcubehalo - Cell-averages for the cubed sphere +! a - Local element alpha index +! b - Local element beta index +! p - Local element panel index +! min_val (OUT) - Minimum value in the halo +! max_val (OUT) - Maximum value in the halo +! nomiddle - whether to not include the middle cell (index a,b) in the search. +! +! NOTE: Since this routine is not vectorized, it will likely be called MANY times. +! To speed things up, make sure to pass the first argument as the ENTIRE original +! array, not as a subset of it, since repeatedly cutting up that array and creating +! an array temporary (on some compilers) is VERY slow. +! ex: +! CALL APBHaloMinMax(zarg, a, ...) !YES +! CALL ABPHaloMinMax(zarg(-1:ncube_reconstruct+1,-1:ncube_reconstruct+1,:)) !NO -- slow +!------------------------------------------------------------------------------ + SUBROUTINE ABPHaloMinMax(fcubehalo, a, b, p, min_val, max_val, nomiddle) + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p + REAL (KIND=dbl_kind), INTENT(OUT) :: min_val, max_val + LOGICAL, INTENT(IN) :: nomiddle + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, il, jl, inew, jnew + REAL (KIND=dbl_kind) :: value + + min_val = fcubehalo(a,b,p) + max_val = fcubehalo(a,b,p) + value = fcubehalo(a,b,p) + + DO il = a-1,a+1 + DO jl = b-1,b+1 + + i = il + j = jl + + inew = i + jnew = j + + IF (nomiddle .AND. i==a .AND. j==b) CYCLE + + !Interior + IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + value = fcubehalo(i,j,p) + + ELSE + + + !The next 4.0 regions are cases in which a,b themselves lie in the panel's halo, and the cell's "halo" (in this usage the 8.0 cells surrounding it) might wrap around into another part of the halo. This happens for (a,b) = {(1,:0),(ncube_reconstruct-1,:0),(1,ncube_reconstruct:),(ncube_reconstruct-1,ncube_reconstruct:)} and for the transposes thereof ({(:0,1), etc.}). In these cases (i,j) could lie in the "Corners" where nothing should lie. We correct this by moving i,j to its appropriate position on the "facing" halo, and then the remainder of the routine then moves it onto the correct face. + +101 FORMAT("ERROR cannot find (i,j) = (", I4, ", ", I4, ") for (a,b,p) = ", I4, ",", I4, ",", I4, ")") +102 FORMAT("i,j,p = ", 3I4, " moved to " 2I4, " (CASE ", I1, ")") + !NOTE: we need the general case to be able to properly handle (0,0), (ncube_reconstruct,0), etc. Note that we don't need to bother with (0,0), etc. when a, b lie in the interior, since both sides of the (0,0) cell are already accounted for by this routine. + !LOWER LEFT + IF (i < 1 .AND. j < 1) THEN + IF (a < 1) THEN !(a,b) centered on left halo, cross to lower halo + inew = 1-j + jnew = i + ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to left halo + jnew = 1-i + inew = j + END IF +! WRITE(*,102) i, j, p, inew, jnew, 1 + !LOWER RIGHT + ELSE IF (i > ncube_reconstruct-1 .AND. j < 1) THEN + IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to lower halo + inew = ncube_reconstruct-1+j + jnew = ncube_reconstruct-i + ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to right halo + jnew = 1+(i-ncube_reconstruct) + inew = ncube_reconstruct-j + END IF +! WRITE(*,102) i, j, p, inew, jnew, 2 + !UPPER LEFT + ELSE IF (i < 1 .AND. j > ncube_reconstruct-1) THEN + IF (a < 1) THEN! (a,b) centered on left halo, cross to upper halo + inew = 1-(j-ncube_reconstruct) + jnew = ncube_reconstruct-i + ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to left halo + inew = ncube_reconstruct-j + jnew = ncube_reconstruct-1-i + END IF +! WRITE(*,102) i, j, p, inew, jnew, 3 + !UPPER RIGHT + ELSE IF (i > ncube_reconstruct-1 .AND. j > ncube_reconstruct-1) THEN + IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to upper halo + inew = ncube_reconstruct-1-(ncube_reconstruct-j) + jnew = i + ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to right halo + inew = j + jnew = ncube_reconstruct-1-(ncube_reconstruct-i) + END IF +! WRITE(*,102) i, j, p, inew, jnew, 4 + END IF + + i = inew + j = jnew + + + !Lower halo ("halo" meaning the panel's halo, not the nine-cell halo + IF ((i < 1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,4) + ELSEIF (p == 2) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,1) + ELSEIF (p == 3) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,2) + ELSEIF (p == 4) THEN + value = fcubehalo(ncube_reconstruct-1+i,j,3) + ELSEIF (p == 5) THEN + value = fcubehalo(j,1-i,4) + ELSEIF (p == 6) THEN + value = fcubehalo(ncube_reconstruct-j,ncube_reconstruct-1+i,4) + ENDIF + + !Upper halo + ELSEIF ((i > ncube_reconstruct-1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,2) + ELSEIF (p == 2) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,3) + ELSEIF (p == 3) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,4) + ELSEIF (p == 4) THEN + value = fcubehalo(i-ncube_reconstruct+1,j,1) + ELSEIF (p == 5) THEN + value = fcubehalo(ncube_reconstruct-j,i-ncube_reconstruct+1,2) + ELSEIF (p == 6) THEN + value = fcubehalo(j,2*ncube_reconstruct-i-1,2) + ENDIF + + !Left halo + ELSEIF ((j < 1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(i,ncube_reconstruct-1+j,5) + ELSEIF (p == 2) THEN + value = fcubehalo(ncube_reconstruct-1+j,ncube_reconstruct-i,5) + ELSEIF (p == 3) THEN + value = fcubehalo(ncube_reconstruct-i,1-j,5) + ELSEIF (p == 4) THEN + value = fcubehalo(1-j,i,5) + ELSEIF (p == 5) THEN + value = fcubehalo(ncube_reconstruct-i,1-j,3) + ELSEIF (p == 6) THEN + value = fcubehalo(i,ncube_reconstruct-1+j,1) + ENDIF + + !Right halo + ELSEIF ((j > ncube_reconstruct-1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN + IF (p == 1) THEN + value = fcubehalo(i,j-ncube_reconstruct+1,6) + ELSEIF (p == 2) THEN + value = fcubehalo(2*ncube_reconstruct-j-1,i,6) + ELSEIF (p == 3) THEN + value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,6) + ELSEIF (p == 4) THEN + value = fcubehalo(j-ncube_reconstruct+1,ncube_reconstruct-i,6) + ELSEIF (p == 5) THEN + value = fcubehalo(i,j-ncube_reconstruct+1,1) + ELSEIF (p == 6) THEN + value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,3) + ENDIF + + ENDIF + + END IF + min_val = MIN(min_val, value) + max_val = MAX(max_val, value) + ENDDO + ENDDO + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE MonotonizeABPGradient +! +! Description: +! Apply a monotonic filter to the calculated ABP gradient. +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! selective - whether to apply a simple form of selective limiting, + !which assumes that if a point is larger/smaller than ALL of its + !surrounding points, that the extremum is physical, and that + !filtering should not be applied to it. +! +! Remarks: +! This monotonizing scheme is based on the monotone scheme for unstructured +! grids of Barth and Jespersen (1989). +!------------------------------------------------------------------------------ + SUBROUTINE MonotonizeABPGradient(fcubehalo, order, recons, selective) + +! USE selective_limiting + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + LOGICAL, INTENT(IN) :: selective + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n, skip + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi + REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & + gamma + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + +! +! xxxxx +! +! IF (selective) THEN +! CALL smoothness2D(fcubehalo, gamma, 2) +! WRITE(*,*) 'gamma range: max ', MAXVAL(gamma), " min ", MINVAL(gamma) +! DO i=1,ncube_reconstruct-1 +! WRITE(*,*) gamma(i, i, 3) +! ENDDO +! skip = 0 +! END IF + + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + + + IF (selective) THEN + + CALL ABPHaloMinMax(gamma, i, j, k, gamma_min, gamma_max, .FALSE.) + + IF (gamma_max/(gamma_min + tiny) < lammax) THEN + skip = skip + 1 + CYCLE + END IF + + END IF + + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) + + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), local_min, local_max, min_phi) + ENDDO + ENDDO + + ! For the third order method, the minima and maxima may occur along + ! the line segments given by du/dx = 0 and du/dy = 0. Also check + ! for the presence of a maxima / minima of the quadratic within + ! the domain. + IF (order == 3) THEN + disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) + + ! Check if the quadratic is minimized within the element + IF (ABS(disc) > tiny) THEN + mx = - recons(5,i,j,k) * recons(2,i,j,k) & + + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) + my = - recons(5,i,j,k) * recons(1,i,j,k) & + + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) + + mx = mx / disc + abp_centroid(1,i,j) + my = my / disc + abp_centroid(2,i,j) + + IF ((mx - TAN(gp(i)) > -tiny) .AND. & + (mx - TAN(gp(i+1)) < tiny) .AND. & + (my - TAN(gp(j)) > -tiny) .AND. & + (my - TAN(gp(j+1)) < tiny) & + ) THEN + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDIF + ENDIF + + ! Check all potential minimizer points along element boundaries + IF (ABS(recons(5,i,j,k)) > tiny) THEN + + ! Left/right edge, intercept with du/dx = 0 + DO m = i, i+1 + my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / recons(5,i,j,k) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + + ! Top/bottom edge, intercept with du/dy = 0 + DO n = j, j+1 + mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Top/bottom edge, intercept with du/dx = 0 + IF (ABS(recons(3,i,j,k)) > tiny) THEN + DO n = j, j+1 + mx = - recons(1,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Left/right edge, intercept with du/dy = 0 + IF (ABS(recons(4,i,j,k)) > tiny) THEN + DO m = i, i+1 + my = - recons(2,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + ENDIF + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + ! Apply monotone limiter to all reconstruction coefficients + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + IF (order > 2) THEN + recons(3,i,j,k) = min_phi * recons(3,i,j,k) + recons(4,i,j,k) = min_phi * recons(4,i,j,k) + recons(5,i,j,k) = min_phi * recons(5,i,j,k) + ENDIF + ENDDO + ENDDO + ENDDO + + IF (selective) WRITE(*,*) 'skipped ', skip, ' points out of ', 6*(ncube_reconstruct-1)**2 + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE PosDefABPGradient +! +! Description: +! Scale the reconstructions so they are positive definite +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! +! Remarks: +! This monotonizing scheme is based on the monotone scheme for unstructured +! grids of Barth and Jespersen (1989), but simpler. This simply finds the +! minimum and then scales the reconstruction so that it is 0. +!------------------------------------------------------------------------------ + SUBROUTINE PosDefABPGradient(fcubehalo, order, recons) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi + REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & + gamma + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + + !If the average value in the cell is 0.0, then we should skip + !all of the scaling and just set the reconstruction to 0.0 +! IF (ABS(fcubehalo(i,j,k)) < tiny) THEN +! recons(:,i,j,k) = 0.0 +! CYCLE +! END IF + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) + + + !This allowance for miniscule negative values appearing around the cell being + !filtered/limited. Before this, negative values would be caught in adjust_limiter + !and would stop the model. Doing this only causes minor negative values; no blowing + !up is observed. The rationale is the same as for the monotone filter, which does + !allow miniscule negative values due to roundoff error --- of the order E-10 --- + !in flux-form methods (and E-17 in the s-L method, indicating that roundoff error + !is more severe in the flux-form method, as we expect since we are often subtracting + !2.0 values which are very close together. + local_min = MIN(0.0,local_min) + local_max = bignum !prevents scaling upward; for positive + !definite limiting we don't care about the upper bound + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), local_min, local_max, min_phi) + ENDDO + ENDDO + + ! For the third order method, the minima and maxima may occur along + ! the line segments given by du/dx = 0 and du/dy = 0. Also check + ! for the presence of a maxima / minima of the quadratic within + ! the domain. + IF (order == 3) THEN + disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) + + ! Check if the quadratic is minimized within the element + IF (ABS(disc) > tiny) THEN + mx = - recons(5,i,j,k) * recons(2,i,j,k) & + + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) + my = - recons(5,i,j,k) * recons(1,i,j,k) & + + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) + + mx = mx / disc + abp_centroid(1,i,j) + my = my / disc + abp_centroid(2,i,j) + + IF ((mx - TAN(gp(i)) > -tiny) .AND. & + (mx - TAN(gp(i+1)) < tiny) .AND. & + (my - TAN(gp(j)) > -tiny) .AND. & + (my - TAN(gp(j+1)) < tiny) & + ) THEN + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDIF + ENDIF + + ! Check all potential minimizer points along element boundaries + IF (ABS(recons(5,i,j,k)) > tiny) THEN + + ! Left/right edge, intercept with du/dx = 0 + DO m = i, i+1 + my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / recons(5,i,j,k) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + + ! Top/bottom edge, intercept with du/dy = 0 + DO n = j, j+1 + mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Top/bottom edge, intercept with du/dx = 0 + IF (ABS(recons(3,i,j,k)) > tiny) THEN + DO n = j, j+1 + mx = - recons(1,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Left/right edge, intercept with du/dy = 0 + IF (ABS(recons(4,i,j,k)) > tiny) THEN + DO m = i, i+1 + my = - recons(2,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), & + local_min, local_max, min_phi) + ENDDO + ENDIF + ENDIF + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + ! Apply monotone limiter to all reconstruction coefficients + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + IF (order > 2) THEN + recons(3,i,j,k) = min_phi * recons(3,i,j,k) + recons(4,i,j,k) = min_phi * recons(4,i,j,k) + recons(5,i,j,k) = min_phi * recons(5,i,j,k) + ENDIF + + ENDDO + ENDDO + ENDDO + + + END SUBROUTINE PosDefABPGradient + +!------------------------------------------------------------------------------ +! SUBROUTINE MonotonizeABPGradient_New +! +! Description: +! Apply a monotonic filter to the calculated ABP gradient. +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! +! Remarks: +! This monotonizing scheme is similar to the one in MonotonizeABPGradient, +! except the second order derivatives are limited after the first order +! derivatives. +!------------------------------------------------------------------------------ + SUBROUTINE MonotonizeABPGradient_New(fcubehalo, order, recons) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, linval + REAL (KIND=dbl_kind) :: disc, mx, my + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max, .FALSE.) + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point, only taking into + ! account the linear component of the reconstruction. + value = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + CALL AdjustLimiter( & + value, fcubehalo(i,j,k), local_min, local_max, min_phi) + ENDDO + ENDDO + + ! Apply monotone limiter to all reconstruction coefficients + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + ! For the third order method, the minima and maxima may occur along + ! the line segments given by du/dx = 0 and du/dy = 0. Also check + ! for the presence of a maxima / minima of the quadratic within + ! the domain. + IF (order == 3) THEN + ! Reset the limiter + min_phi = one + + ! Calculate discriminant, which we use to determine the absolute + ! minima/maxima of the paraboloid + disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) + + ! Check if the quadratic is minimized within the element + IF (ABS(disc) > tiny) THEN + mx = - recons(5,i,j,k) * recons(2,i,j,k) & + + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) + my = - recons(5,i,j,k) * recons(1,i,j,k) & + + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) + + mx = mx / disc + abp_centroid(1,i,j) + my = my / disc + abp_centroid(2,i,j) + + IF ((mx - TAN(gp(i)) > -tiny) .AND. & + (mx - TAN(gp(i+1)) < tiny) .AND. & + (my - TAN(gp(j)) > -tiny) .AND. & + (my - TAN(gp(j+1)) < tiny) & + ) THEN + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDIF + ENDIF + + ! Check all potential minimizer points along element boundaries + IF (ABS(recons(5,i,j,k)) > tiny) THEN + + ! Left/right edge, intercept with du/dx = 0 + DO m = i, i+1 + my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / recons(5,i,j,k) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + + ! Top/bottom edge, intercept with du/dy = 0 + DO n = j, j+1 + mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Top/bottom edge, intercept with du/dx = 0 + IF (ABS(recons(3,i,j,k)) > tiny) THEN + DO n = j, j+1 + mx = - recons(1,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(n)) - abp_centroid(2,i,j)) + + mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) + + IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDIF + + ! Left/right edge, intercept with du/dy = 0 + IF (ABS(recons(4,i,j,k)) > tiny) THEN + DO m = i, i+1 + my = - recons(2,i,j,k) - recons(5,i,j,k) * & + (TAN(gp(m)) - abp_centroid(1,i,j)) + + my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) + + IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN + CYCLE + ENDIF + + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), ATAN(my), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDIF + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), & + order, value) + + linval = & + fcubehalo(i,j,k) & + + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & + + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) + + IF (linval < local_min) THEN + linval = local_min + ENDIF + IF (linval > local_max) THEN + linval = local_max + ENDIF + + CALL AdjustLimiter( & + value, linval, local_min, local_max, min_phi) + ENDDO + ENDDO + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + WRITE (*,*) '2: ', min_phi + + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + recons(3,i,j,k) = min_phi * recons(3,i,j,k) + recons(4,i,j,k) = min_phi * recons(4,i,j,k) + recons(5,i,j,k) = min_phi * recons(5,i,j,k) + ENDIF + ENDDO + ENDDO + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_NEL +! +! Description: +! Construct a non-equidistant linear reconstruction of the gradient +! within each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_NEL(fcubehalo, recons, order) + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: alpha1, alpha2, beta1, beta2 + REAL (KIND=dbl_kind) :: dx_left, dx_right, top_value, bot_value + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) + dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) + + recons(1,i,j,p) = & + (+ fcubehalo(i-1,j,p) * dx_right**2 & + - fcubehalo(i+1,j,p) * dx_left**2 & + - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(2,i,j,p) = & + (+ fcubehalo(i,j-1,p) * dx_right**2 & + - fcubehalo(i,j+1,p) * dx_left**2 & + - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + IF (order > 2) THEN + dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) + dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) + + recons(3,i,j,p) = & + (+ fcubehalo(i-1,j,p) * dx_right & + - fcubehalo(i+1,j,p) * dx_left & + - fcubehalo(i,j,p) * (dx_right - dx_left)) / & + (dx_right * dx_left * (dx_left - dx_right)) + + dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(4,i,j,p) = & + (+ fcubehalo(i,j-1,p) * dx_right & + - fcubehalo(i,j+1,p) * dx_left & + - fcubehalo(i,j,p) * (dx_right - dx_left)) / & + (dx_right * dx_left * (dx_left - dx_right)) + ENDIF + ENDDO + ENDDO + + IF (order > 2) THEN + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + dx_left = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) + dx_right = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) + + top_value = & + (+ fcubehalo(i-1,j+1,p) * dx_right**2 & + - fcubehalo(i+1,j+1,p) * dx_left**2 & + - fcubehalo(i,j+1,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + dx_left = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) + dx_right = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) + + bot_value = & + (+ fcubehalo(i-1,j-1,p) * dx_right**2 & + - fcubehalo(i+1,j-1,p) * dx_left**2 & + - fcubehalo(i,j-1,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(5,i,j,p) = & + (+ bot_value * dx_right**2 & + - top_value * dx_left**2 & + - recons(1,i,j,p) * (dx_right**2 - dx_left**2)) / & + (dx_right * dx_left * (dx_right - dx_left)) + + ENDDO + ENDDO + ENDIF + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_NEP +! +! Description: +! Construct a non-equidistant parabolic reconstruction of the gradient +! within each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_NEP(fcubehalo, recons, order) + + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: x1, x2, x4, x5, y1, y2, y3, y4, y5 + + REAL (KIND=dbl_kind), DIMENSION(5) :: t, pa, denom + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + ! X-direction reconstruction + x1 = abp_centroid(1,i-2,j) - abp_centroid(1,i,j) + x2 = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) + x4 = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) + x5 = abp_centroid(1,i+2,j) - abp_centroid(1,i,j) + + !IF (i == 1) THEN + ! x1 = piq + !ELSEIF (i == ncube_reconstruct-1) THEN + ! x5 = -piq + !ENDIF + + y1 = fcubehalo(i-2,j,p) + y2 = fcubehalo(i-1,j,p) + y3 = fcubehalo(i,j,p) + y4 = fcubehalo(i+1,j,p) + y5 = fcubehalo(i+2,j,p) + + denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 + denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 + denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 + denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 + + t(1) = x5 * x4 * x2 + t(2) = x5 * x4 * x1 + t(4) = x5 * x2 * x1 + t(5) = x4 * x2 * x1 + t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) + + pa(1) = x2 * x4 + x2 * x5 + x4 * x5 + pa(2) = x1 * x4 + x1 * x5 + x4 * x5 + pa(4) = x1 * x2 + x1 * x5 + x2 * x5 + pa(5) = x1 * x2 + x1 * x4 + x2 * x4 + pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) + + recons(1,i,j,p) = & + + y1 * t(1) / denom(1) & + + y2 * t(2) / denom(2) & + - y3 * t(3) & + + y4 * t(4) / denom(4) & + + y5 * t(5) / denom(5) + + IF (order > 2) THEN + recons(3,i,j,p) = & + - y1 * pa(1) / denom(1) & + - y2 * pa(2) / denom(2) & + + y3 * pa(3) & + - y4 * pa(4) / denom(4) & + - y5 * pa(5) / denom(5) + ENDIF + + ! Y-direction reconstruction + x1 = abp_centroid(2,i,j-2) - abp_centroid(2,i,j) + x2 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + x4 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + x5 = abp_centroid(2,i,j+2) - abp_centroid(2,i,j) + + !IF (j == 1) THEN + ! x1 = piq + !ELSEIF (j == ncube_reconstruct-1) THEN + ! x5 = -piq + !ENDIF + + y1 = fcubehalo(i,j-2,p) + y2 = fcubehalo(i,j-1,p) + y3 = fcubehalo(i,j,p) + y4 = fcubehalo(i,j+1,p) + y5 = fcubehalo(i,j+2,p) + + denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 + denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 + denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 + denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 + + t(1) = x5 * x4 * x2 + t(2) = x5 * x4 * x1 + t(4) = x5 * x2 * x1 + t(5) = x4 * x2 * x1 + t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) + + pa(1) = x2 * x4 + x2 * x5 + x4 * x5 + pa(2) = x1 * x4 + x1 * x5 + x4 * x5 + pa(4) = x1 * x2 + x1 * x5 + x2 * x5 + pa(5) = x1 * x2 + x1 * x4 + x2 * x4 + pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) + + recons(2,i,j,p) = & + + y1 * t(1) / denom(1) & + + y2 * t(2) / denom(2) & + - y3 * t(3) & + + y4 * t(4) / denom(4) & + + y5 * t(5) / denom(5) + + IF (order > 2) THEN + recons(4,i,j,p) = & + - y1 * pa(1) / denom(1) & + - y2 * pa(2) / denom(2) & + + y3 * pa(3) & + - y4 * pa(4) / denom(4) & + - y5 * pa(5) / denom(5) + recons(5,i,j,p) = 0.0 + ENDIF + + ENDDO + ENDDO + IF (order > 2) THEN + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + x1 = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) + x2 = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) + + y2 = (+ fcubehalo(i-1,j+1,p) * x2**2 & + - fcubehalo(i+1,j+1,p) * x1**2 & + - fcubehalo(i,j+1,p) * (x2**2 - x1**2)) / & + (x2 * x1 * (x2 - x1)) + + x1 = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) + x2 = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) + + y1 = (+ fcubehalo(i-1,j-1,p) * x2**2 & + - fcubehalo(i+1,j-1,p) * x1**2 & + - fcubehalo(i,j-1,p) * (x2**2 - x1**2)) / & + (x2 * x1 * (x2 - x1)) + + x1 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) + x2 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) + + recons(5,i,j,p) = & + (+ y1 * x2**2 & + - y2 * x1**2 & + - recons(1,i,j,p) * (x2**2 - x1**2)) / & + (x2 * x1 * (x2 - x1)) + + ENDDO + ENDDO + ENDIF + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_PLM +! +! Description: +! Construct a piecewise linear reconstruction of the gradient within +! each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_PLM(fcubehalo, recons, order) + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: width + + ! ABP width between elements + width = pih / DBLE(ncube_reconstruct-1) + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + ! df/dx + recons(1,i,j,p) = (fcubehalo(i+1,j,p) - fcubehalo(i-1,j,p)) / & + (2.0 * width) + + ! df/dy + recons(2,i,j,p) = (fcubehalo(i,j+1,p) - fcubehalo(i,j-1,p)) / & + (2.0 * width) + + ! Stretching + recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) + recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) + + ! Third order scheme + IF (order > 2) THEN + ! d^2f/dx^2 + recons(3,i,j,p) = & + (fcubehalo(i+1,j,p) - 2.0 * fcubehalo(i,j,p) & + + fcubehalo(i-1,j,p)) / (width * width) + + ! d^2f/dy^2 + recons(4,i,j,p) = & + (fcubehalo(i,j+1,p) - 2.0 * fcubehalo(i,j,p) & + + fcubehalo(i,j-1,p)) / (width * width) + + ! d^2f/dxdy + recons(5,i,j,p) = & + (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & + - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & + ) / (4.0 * width * width) + + ! Stretching + recons(3,i,j,p) = & + (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & + + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 + + recons(4,i,j,p) = & + (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & + + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 + + recons(5,i,j,p) = recons(5,i,j,p) / & + ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) + + ! Scaling + recons(3,i,j,p) = 0.5 * recons(3,i,j,p) + recons(4,i,j,p) = 0.5 * recons(4,i,j,p) + + ENDIF + ENDDO + ENDDO + ENDDO + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient_PPM +! +! Description: +! Construct a piecewise parabolic reconstruction of the gradient within +! each element on an ABP grid. +! +! Parameters: +! fcubehalo - Scalar field on the ABP grid to use in reconstruction +! recons (OUT) - Array of reconstructed coefficients for total elements +! order - Order of the scheme (2 or 3) +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient_PPM(fcubehalo, recons, order) + + +! USE CubedSphereTrans +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind) :: width + + ! ABP width between elements + width = pih / DBLE(ncube_reconstruct-1) + + DO p = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + ! df/dalfa + recons(1,i,j,p) = & + (+ fcubehalo(i+2,j,p) - 8.0 * fcubehalo(i+1,j,p) & + + 8.0 * fcubehalo(i-1,j,p) - fcubehalo(i-2,j,p)) / & + (- 12.0 * width) + + ! df/dbeta + recons(2,i,j,p) = & + (+ fcubehalo(i,j+2,p) - 8.0 * fcubehalo(i,j+1,p) & + + 8.0 * fcubehalo(i,j-1,p) - fcubehalo(i,j-2,p)) / & + (- 12.0 * width) + + ! Stretching + recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) + recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) + + ! Third order scheme + IF (order > 2) THEN + ! d^2f/dx^2 + recons(3,i,j,p) = (- fcubehalo(i+2,j,p) & + + 16_dbl_kind * fcubehalo(i+1,j,p) & + - 30_dbl_kind * fcubehalo(i,j,p) & + + 16_dbl_kind * fcubehalo(i-1,j,p) & + - fcubehalo(i-2,j,p) & + ) / (12_dbl_kind * width**2) + + ! d^2f/dy^2 + recons(4,i,j,p) = (- fcubehalo(i,j+2,p) & + + 16_dbl_kind * fcubehalo(i,j+1,p) & + - 30_dbl_kind * fcubehalo(i,j,p) & + + 16_dbl_kind * fcubehalo(i,j-1,p) & + - fcubehalo(i,j-2,p) & + ) / (12_dbl_kind * width**2) + + ! d^2f/dxdy + recons(5,i,j,p) = & + (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & + - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & + ) / (4.0 * width * width) + + ! Stretching + recons(3,i,j,p) = & + (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & + + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 + + recons(4,i,j,p) = & + (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & + + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 + + recons(5,i,j,p) = recons(5,i,j,p) / & + ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) + + ! Scaling + recons(3,i,j,p) = 0.5 * recons(3,i,j,p) + recons(4,i,j,p) = 0.5 * recons(4,i,j,p) + ENDIF + ENDDO + ENDDO + ENDDO + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE ReconstructABPGradient +! +! Description: +! Compute the reconstructed gradient in gnomonic coordinates for each +! ABP element. +! +! Parameters: +! fcube - Scalar field on the cubed sphere to use in reconstruction +! halomethod - Method for computing halo elements +! (0) Piecewise constant +! (1) Piecewise linear +! (3) Piecewise cubic +! recons_method - Method for computing the sub-grid scale gradient +! (0) Non-equidistant linear reconstruction +! (1) Non-equidistant parabolic reconstruction +! (2) Piecewise linear reconstruction with stretching +! (3) Piecewise parabolic reconstruction with stretching +! order - Order of the method being applied +! kmono - Apply monotone limiting (1) or not (0) +! recons (INOUT) - Array of reconstructed coefficients +!------------------------------------------------------------------------------ + SUBROUTINE ReconstructABPGradient( & + fcube, halomethod, recons_method, order, kmono, recons, kpd, kscheme) + +! USE InterpolateCSLL_Utils + + IMPLICIT NONE + + REAL (KIND=dbl_kind), & + DIMENSION(1:ncube_reconstruct-1, 1:ncube_reconstruct-1, 6), INTENT(IN) :: fcube + + INTEGER (KIND=int_kind), INTENT(IN) :: halomethod, recons_method + INTEGER (KIND=int_kind), INTENT(IN) :: order, kmono, kpd, kscheme + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, p + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: fcubehalo + + ! Report status + WRITE (*,*) '...Performing sub-grid scale reconstruction on ABP grid' + + ! Compute element haloes + WRITE(*,*) "fill cubed-sphere halo for reconstruction" + DO p = 1, 6 + IF (halomethod == 0) THEN + CALL CubedSphereFillHalo(fcube, fcubehalo, p, ncube_reconstruct, 2) + + ELSEIF (halomethod == 1) THEN + CALL CubedSphereFillHalo_Linear(fcube, fcubehalo, p, ncube_reconstruct) + + ELSEIF (halomethod == 3) THEN + !halomethod is always 3 in the standard CSLAM setup + CALL CubedSphereFillHalo_Cubic(fcube, fcubehalo, p, ncube_reconstruct) + ELSE + WRITE (*,*) 'Fatal Error: In ReconstructABPGradient' + WRITE (*,*) 'Invalid halo method: ', halomethod + WRITE (*,*) 'Halo method must be 0, 1 or 3.' + STOP + ENDIF + ENDDO + + ! Nonequidistant linear reconstruction + IF (recons_method == 1) THEN + CALL ReconstructABPGradient_NEL(fcubehalo, recons, order) + + ! Nonequidistant parabolic reconstruction (JCP paper) + ELSEIF (recons_method == 2) THEN + WRITE(*,*) "Nonequidistant parabolic reconstruction" + CALL ReconstructABPGradient_NEP(fcubehalo, recons, order) + + ! Piecewise linear reconstruction with rotation + ELSEIF (recons_method == 3) THEN + CALL ReconstructABPGradient_PLM(fcubehalo, recons, order) + + ! Piecewise parabolic reconstruction with rotation + ELSEIF (recons_method == 4) THEN + CALL ReconstructABPGradient_PPM(fcubehalo, recons, order) + + ELSE + WRITE(*,*) 'Fatal Error: In ReconstructABPGradient' + WRITE(*,*) 'Specified recons_method out of range. Given: ', recons_method + WRITE(*,*) 'Valid values: 1, 2, 3, 4' + STOP + ENDIF + + ! Apply monotone filtering + SELECT CASE (kmono) + CASE (0) !Do nothing + WRITE(*,*) "no filter applied to the reconstruction" + CASE (1) + + !Simplest filter: just scales the recon so it's extreme value + !is no bigger than the original values of this point and its neighbors + CALL MonotonizeABPGradient(fcubehalo, order, recons, .FALSE.) + + CASE (2) + + !Applies a more sophisticated Van Leer limiter (or, to be consistent, a filter) + CALL VanLeerLimit(fcubehalo, order, recons) + + CASE (3) + + !Applies a selective filter + CALL MonotonizeABPGradient(fcubehalo, order, recons, .TRUE.) + + CASE (4) + + !A filter that filters the linear part first + CALL MonotonizeABPGradient_New(fcubehalo, order, recons) + + CASE DEFAULT + WRITE(*,*) "Limiter kmono = ", kmono, " does not exist." + STOP 1201 + + END SELECT + + !Apply positive-definite filtering, if desired. This should + !ONLY be applied to the S-L method, since the flux-form + !method needs something different done. (In particular, using + !positive-definite reconstructions does not ensure that a flux- + !form scheme is positive definite, since we could get negatives + !when subtracting the resulting fluxes.) + !HOWEVER...we will allow this to be enabled, for testing purposes + IF ( (kpd > 0 .AND. kscheme == 2) .OR. (kpd == 2 .AND. kscheme == 4) ) THEN + WRITE(*,*) "applying positive deifnite constraint" + CALL PosDefABPGradient(fcubehalo, order, recons) + END IF + + + END SUBROUTINE + + + +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ +! SUBROUTINE AdjustLimiter +! +! Description: +! Adjust the slope limiter based on new point values. +! +! Parameters: +! value - Point value +! element_value - Value at the center of the element +! local_max - Local maximum value of the function (from neighbours) +! local_min - Local minimum value of the function (to neighbours) +! min_phi (INOUT) - Slope limiter +!------------------------------------------------------------------------------ + SUBROUTINE AdjustLimiter(value, element_value, local_min, local_max, min_phi) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), INTENT(IN) :: value, element_value + REAL (KIND=dbl_kind), INTENT(IN) :: local_min, local_max + REAL (KIND=dbl_kind), INTENT(INOUT) :: min_phi + + ! Local variables + REAL (KIND=dbl_kind) :: phi = 0.0 + + IF ((local_min > element_value ) .OR. (local_max < element_value )) THEN + WRITE (*,*) 'Fatal Error: In AdjustLimiter' + WRITE (*,*) 'Local min: ', local_min, ' max: ', local_max + WRITE (*,*) 'Elemn: ', element_value + STOP + ENDIF + + ! Check against the minimum bound on the reconstruction + IF (value - element_value > tiny * value) THEN + phi = (local_max - element_value) / & + (value - element_value) + + min_phi = MIN(min_phi, phi) + + ! Check against the maximum bound on the reconstruction + ELSEIF (value - element_value < -tiny * value) THEN + phi = (local_min - element_value) / & + (value - element_value) + + min_phi = MIN(min_phi, phi) + + ENDIF + + IF (min_phi < 0.0) THEN + WRITE (*,*) 'Fatal Error: In AdjustLimiter' + WRITE (*,*) 'Min_Phi: ', min_phi + WRITE (*,*) 'Phi: ', phi + WRITE (*,*) 'Value: ', value + WRITE (*,*) 'Elemn: ', element_value + WRITE (*,*) 'Val-E: ', value - element_value + STOP + ENDIF + + END SUBROUTINE + +!------------------------------------------------------------------------------ +! SUBROUTINE VanLeerLimit +! +! Description: +! Apply a 2D Van Leer-type limiter to a reconstruction. This acts ONLY +! on the linear part of the reconstruction , if any. If passed a PCoM +! reconstruction, this just returns without altering the recon. +! +! Parameters: +! fcubehalo - Scalar field on the cubed sphere to use in reconstruction +! order - Order of the reconstruction +! recons (INOUT) - Array of reconstructed coefficients +! +! Remarks: +! The Van Leer Limiter described here is given on pages 328--329 +! of Dukowicz and Baumgardner (2000). There are no guarantees +! on what it will do to PPM. +!------------------------------------------------------------------------------ + SUBROUTINE VanLeerLimit(fcubehalo, order, recons) + + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & + INTENT(IN) :: fcubehalo + + INTEGER (KIND=int_kind), INTENT(IN) :: order + + REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons + + ! Local variables + INTEGER (KIND=int_kind) :: i, j, k, m, n + + REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, & + recon_min, recon_max + + ! The first-order piecewise constant scheme is monotone by construction + IF (order == 1) THEN + RETURN + ENDIF + + ! Apply monotone limiting + DO k = 1, 6 + DO j = 1, ncube_reconstruct-1 + DO i = 1, ncube_reconstruct-1 + CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) + + ! Initialize the limiter + min_phi = one + + ! For the second-order calculation, the minima and maxima will occur + ! at the corner points of the element. For the Van Leer limiter, we + !wish to find BOTH of the reconstruction extrema. + recon_min = bignum + recon_max = -bignum + + DO m = i, i+1 + DO n = j, j+1 + + ! Evaluate the function at each corner point + CALL EvaluateABPReconstruction( & + fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) + recon_min = MIN(recon_min, value) + recon_max = MAX(recon_max, value) + + ENDDO + ENDDO + + !This is equation 27 in Dukowicz and Baumgardner 2000 + min_phi = MIN(one, MAX(0.0, (local_min - fcubehalo(i,j,k))/(recon_min - fcubehalo(i,j,k))), & + MAX(0.0, (local_max - fcubehalo(i,j,k))/(recon_max - fcubehalo(i,j,k))) ) + + IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN + WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' + WRITE (*,*) 'Slope limiter out of range: ', min_phi + STOP + ENDIF + + ! Apply monotone limiter to all reconstruction coefficients + recons(1,i,j,k) = min_phi * recons(1,i,j,k) + recons(2,i,j,k) = min_phi * recons(2,i,j,k) + + END DO + END DO + END DO + + + + + END SUBROUTINE VanLeerLimit + + !------------------------------------------------------------------------------ + ! SUBROUTINE EquiangularElementArea + ! + ! Description: + ! Compute the area of a single equiangular cubed sphere grid cell. + ! + ! Parameters: + ! alpha - Alpha coordinate of lower-left corner of grid cell + ! da - Delta alpha + ! beta - Beta coordinate of lower-left corner of grid cell + ! db - Delta beta + !------------------------------------------------------------------------------ + REAL(KIND=dbl_kind) FUNCTION EquiangularElementArea(alpha, da, beta, db) + + IMPLICIT NONE + +! REAL (kind=dbl_kind) :: EquiangularElementArea + REAL (kind=dbl_kind) :: alpha, da, beta, db + REAL (kind=dbl_kind) :: a1, a2, a3, a4 + + ! Calculate interior grid angles + a1 = EquiangularGridAngle(alpha , beta ) + a2 = pi - EquiangularGridAngle(alpha+da, beta ) + a3 = pi - EquiangularGridAngle(alpha , beta+db) + a4 = EquiangularGridAngle(alpha+da, beta+db) + + ! Area = r*r*(-2*pi+sum(interior angles)) + EquiangularElementArea = -pi2 + a1 + a2 + a3 + a4 + + END FUNCTION EquiangularElementArea + + !------------------------------------------------------------------------------ + ! FUNCTION EquiangularGridAngle + ! + ! Description: + ! Compute the angle between equiangular cubed sphere projection grid lines. + ! + ! Parameters: + ! alpha - Alpha coordinate of evaluation point + ! beta - Beta coordinate of evaluation point + !------------------------------------------------------------------------------ + REAL(KIND=dbl_kind) FUNCTION EquiangularGridAngle(alpha, beta) + IMPLICIT NONE + REAL (kind=dbl_kind) :: alpha, beta + EquiangularGridAngle = ACOS(-SIN(alpha) * SIN(beta)) + END FUNCTION EquiangularGridAngle + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereFillHalo +! +! Description: +! Recompute the cubed sphere data storage array, with the addition of a +! halo region around the specified panel. +! +! Parameters: +! parg - Current panel values +! zarg (OUT) - Calculated panel values with halo/ghost region +! np - Panel number +! ncube - Dimension of the cubed sphere (# of grid lines) +! nhalo - Number of halo/ghost elements around each panel +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereFillHalo(parg, zarg, np, ncube, nhalo) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & + INTENT(OUT) :: zarg + + INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube,nhalo + + ! Local variables + INTEGER (KIND=int_kind) :: jh,jhy + + !zarg = 0.0 !DBG + zarg(1:ncube-1,1:ncube-1,np) = parg(1:ncube-1,1:ncube-1,np) + + zarg(1-nhalo:0,1-nhalo:0,np) = 0.0 + zarg(1-nhalo:0,ncube:ncube+nhalo-1,np) = 0.0 + zarg(ncube:ncube+nhalo-1,1-nhalo:0,np) = 0.0 + zarg(ncube:ncube+nhalo-1,ncube:ncube+nhalo-1,np) = 0.0 + + ! Equatorial panels + IF (np==1) THEN + DO jh=1,nhalo + zarg(ncube+jh-1,1:ncube-1 ,1) = parg(jh ,1:ncube-1 ,2) !exchange right + zarg(1-jh ,1:ncube-1 ,1) = parg(ncube-jh ,1:ncube-1 ,4) !exchange left + zarg(1:ncube-1 ,1-jh ,1) = parg(1:ncube-1 ,ncube-jh ,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,1) = parg(1:ncube-1 ,jh ,6) !exchange over + ENDDO + + ELSE IF (np==2) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,2) = parg(ncube-jh,1:ncube-1 ,1) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,2) = parg(jh ,1:ncube-1 ,3) !exchange right + zarg(1:ncube-1 ,1-jh ,2) = parg(ncube-jh,ncube-1:1:-1,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,2) = parg(ncube-jh,1:ncube-1 ,6) !exchange over + ENDDO + + ELSE IF (np==3) THEN + DO jh=1,nhalo + zarg(ncube+jh-1,1:ncube-1 ,3) = parg(jh ,1:ncube-1,4) !exchange right + zarg(1-jh ,1:ncube-1 ,3) = parg(ncube-jh ,1:ncube-1,2) !exchange left + zarg(1:ncube-1 ,1-jh ,3) = parg(ncube-1:1:-1,jh ,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,3) = parg(ncube-1:1:-1,ncube-jh ,6) !exchange over + ENDDO + + ELSE IF (np==4) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,4) = parg(ncube-jh,1:ncube-1 ,3) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,4) = parg(jh ,1:ncube-1 ,1) !exchange right + zarg(1:ncube-1 ,1-jh ,4) = parg(jh ,1:ncube-1 ,5) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,4) = parg(jh ,ncube-1:1:-1,6) !exchange over + ENDDO + + ! Bottom panel + ELSE IF (np==5) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,5) = parg(1:ncube-1 ,jh ,4) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,5) = parg(ncube-1:1:-1,jh ,2) !exchange right + zarg(1:ncube-1 ,1-jh ,5) = parg(ncube-1:1:-1,jh ,3) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,5) = parg(1:ncube-1 ,jh ,1) !exchange over + ENDDO + + ! Top panel + ELSE IF (np==6) THEN + DO jh=1,nhalo + zarg(1-jh ,1:ncube-1 ,6) = parg(ncube-1:1:-1,ncube-jh,4) !exchange left + zarg(ncube+jh-1,1:ncube-1 ,6) = parg(1:ncube-1 ,ncube-jh,2) !exchange right + zarg(1:ncube-1 ,1-jh ,6) = parg(1:ncube-1 ,ncube-jh,1) !exchange below + zarg(1:ncube-1 ,ncube+jh-1,6) = parg(ncube-1:1:-1,ncube-jh,3) !exchange over + ENDDO + + ELSE + WRITE (*,*) 'Fatal error: In CubedSphereFillHalo' + WRITE (*,*) 'Invalid panel id ', np + STOP + ENDIF + + END SUBROUTINE CubedSphereFillHalo + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereFillHalo_Linear +! +! Description: +! Recompute the cubed sphere data storage array, with the addition of a +! 2-element halo region around the specified panel. Use linear order +! interpolation to translate between panels. +! +! Parameters: +! parg - Current panel values +! zarg (OUT) - Calculated panel values with halo/ghost region +! np - Panel number +! ncube - Dimension of the cubed sphere (# of grid lines) +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereFillHalo_Linear(parg, zarg, np, ncube) + +! USE CubedSphereTrans ! Cubed sphere transforms + + IMPLICIT NONE + + INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 + + REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & + INTENT(OUT) :: zarg + + INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube + + ! Local variables + INTEGER (KIND=int_kind) :: ii, iref, jj, ipanel, imin, imax + REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta + + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg + + ! Use 0.0 order interpolation to begin + CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) + + zarg(:,:,np) = yarg(:,:,np) + + ! Calculate the overlapping alpha coordinates + width = pih / DBLE(ncube-1) + + DO jj = 1, nhalo + DO ii = 0, ncube + prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq + beta = - width * (DBLE(jj-1) + 0.5) - piq + + CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & + newalpha(ii,jj), newbeta) + ENDDO + ENDDO + + ! Now apply linear interpolation to obtain edge components + DO jj = 1, nhalo + ! Reset the reference index + iref = 2 + + ! Interpolation can be applied to more elements after first band + IF (jj == 1) THEN + imin = 1 + imax = ncube-1 + ELSE + imin = 0 + imax = ncube + ENDIF + + ! Apply linear interpolation + DO ii = imin, imax + DO WHILE ((iref .NE. ncube-1) .AND. & + (newalpha(ii,jj) > prealpha(iref,jj))) + iref = iref + 1 + ENDDO + + IF ((newalpha(ii,jj) > prealpha(iref-1,jj)) .AND. & + (newalpha(ii,jj) .LE. prealpha(iref ,jj))) & + THEN + a = (newalpha(ii,jj) - prealpha(iref-1,jj)) / & + (prealpha(iref,jj) - prealpha(iref-1,jj)) + + IF ((a < 0.0) .OR. (a > one)) THEN + WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' + WRITE (*,*) 'a out of bounds' + STOP + ENDIF + + ! Bottom edge of panel + zarg(ii, 1-jj, np) = & + (one - a) * yarg(iref-1, 1-jj, np) + & + a * yarg(iref, 1-jj, np) + + ! Left edge of panel + zarg(1-jj, ii, np) = & + (one - a) * yarg(1-jj, iref-1, np) + & + a * yarg(1-jj, iref, np) + + ! Top edge of panel + zarg(ii, ncube+jj-1, np) = & + (one - a) * yarg(iref-1, ncube+jj-1, np) + & + a * yarg(iref, ncube+jj-1, np) + + ! Right edge of panel + zarg(ncube+jj-1, ii, np) = & + (one - a) * yarg(ncube+jj-1, iref-1, np) + & + a * yarg(ncube+jj-1, iref, np) + + ELSE + WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' + WRITE (*,*) 'ii: ', ii, ' jj: ', jj + WRITE (*,*) 'newalpha: ', newalpha(ii,jj) + WRITE (*,*) 'prealpha: ', prealpha(iref-1,jj), '-', prealpha(iref,jj) + STOP + ENDIF + ENDDO + ENDDO + + ! Fill in corner bits + zarg(0, 0, np) = & + 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & + zarg(-1,0,np) + zarg(0,-1,np)) + zarg(0, ncube, np) = & + 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & + zarg(-1,ncube,np) + zarg(1,ncube,np)) + zarg(ncube, 0, np) = & + 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & + zarg(ncube,-1,np) + zarg(ncube,1,np)) + zarg(ncube, ncube, np) = & + 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & + zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) + + END SUBROUTINE CubedSphereFillHalo_Linear + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereFillHalo_Cubic +! +! Description: +! Recompute the cubed sphere data storage array, with the addition of a +! 2-element halo region around the specified panel. Use higher order +! interpolation to translate between panels. +! +! Parameters: +! parg - Current panel values +! zarg (OUT) - Calculated panel values with halo/ghost region +! np - Panel number +! ncube - Dimension of the cubed sphere (# of grid lines) +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereFillHalo_Cubic(parg, zarg, np, ncube) + +! USE CubedSphereTrans ! Cubed sphere transforms +! USE MathUtils ! Has function for 1D cubic interpolation + + IMPLICIT NONE + + INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 + + REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & + INTENT(OUT) :: zarg + + INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube + + ! Local variables + INTEGER (KIND=int_kind) :: ii, iref, ibaseref, jj, ipanel, imin, imax + REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta + + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha + REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha + REAL (KIND=dbl_kind), DIMENSION(1:4) :: C, D, X + + REAL (KIND=dbl_kind), & + DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg + + ! Use 0.0 order interpolation to begin + CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) + + zarg(:,:,np) = yarg(:,:,np) + + ! Calculate the overlapping alpha coordinates + width = pih / DBLE(ncube-1) + + DO jj = 1, nhalo + DO ii = 0, ncube + ! + ! alpha,beta for the cell center (extending the panel) + ! + prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq + beta = - width * (DBLE(jj-1) + 0.5) - piq + + CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & + newalpha(ii,jj), newbeta) + ENDDO + ENDDO + + ! Now apply cubic interpolation to obtain edge components + DO jj = 1, nhalo + ! Reset the reference index, which gives the element in newalpha that + ! is closest to ii, looking towards larger values of alpha. + iref = 2 + + ! Interpolation can be applied to more elements after first band +! IF (jj == 1) THEN +! imin = 1 +! imax = ncube-1 +! ELSE + imin = 0 + imax = ncube +! ENDIF + + ! Apply cubic interpolation + DO ii = imin, imax + DO WHILE ((iref .NE. ncube-1) .AND. & + (newalpha(ii,jj) > prealpha(iref,jj))) + iref = iref + 1 + ENDDO + + ! Smallest index for cubic interpolation - apply special consideration + IF (iref == 2) THEN + ibaseref = iref-1 + + ! Largest index for cubic interpolation - apply special consideration + ELSEIF (iref == ncube-1) THEN + ibaseref = iref-3 + + ! Normal range + ELSE + ibaseref = iref-2 + ENDIF + + ! Bottom edge of panel + zarg(ii, 1-jj, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(ibaseref:ibaseref+3, 1-jj, np)) + + ! Left edge of panel + zarg(1-jj, ii, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(1-jj, ibaseref:ibaseref+3, np)) + + ! Top edge of panel + zarg(ii, ncube+jj-1, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(ibaseref:ibaseref+3, ncube+jj-1, np)) + + ! Right edge of panel + zarg(ncube+jj-1, ii, np) = & + CUBIC_EQUISPACE_INTERP( & + width, newalpha(ii,jj) - prealpha(ibaseref,jj), & + yarg(ncube+jj-1, ibaseref:ibaseref+3, np)) + + ENDDO + ENDDO + + ! Fill in corner bits + zarg(0, 0, np) = & + 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & + zarg(-1,0,np) + zarg(0,-1,np)) + zarg(0, ncube, np) = & + 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & + zarg(-1,ncube,np) + zarg(1,ncube,np)) + zarg(ncube, 0, np) = & + 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & + zarg(ncube,-1,np) + zarg(ncube,1,np)) + zarg(ncube, ncube, np) = & + 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & + zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) + + END SUBROUTINE CubedSphereFillHalo_Cubic + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereABPFromABP +! +! Description: +! Determine the (alpha,beta,idest) coordinate of a source point on +! panel isource. +! +! Parameters: +! alpha_in - Alpha coordinate in +! beta_in - Beta coordinate in +! isource - Source panel +! idest - Destination panel +! alpha_out (OUT) - Alpha coordinate out +! beta_out (OUT) - Beta coordiante out +!------------------------------------------------------------------------------ + SUBROUTINE CubedSphereABPFromABP(alpha_in, beta_in, isource, idest, & + alpha_out, beta_out) + + IMPLICIT NONE + + REAL (KIND=dbl_kind), INTENT(IN) :: alpha_in, beta_in + INTEGER (KIND=int_kind), INTENT(IN) :: isource, idest + REAL (KIND=dbl_kind), INTENT(OUT) :: alpha_out, beta_out + + ! Local variables + REAL (KIND=dbl_kind) :: a1, b1 + REAL (KIND=dbl_kind) :: xx, yy, zz + REAL (KIND=dbl_kind) :: sx, sy, sz + + ! Convert to relative Cartesian coordinates + a1 = TAN(alpha_in) + b1 = TAN(beta_in) + + sz = (one + a1 * a1 + b1 * b1)**(-0.5) + sx = sz * a1 + sy = sz * b1 + + ! Convert to full Cartesian coordinates + IF (isource == 6) THEN + yy = sx; xx = -sy; zz = sz + + ELSEIF (isource == 5) THEN + yy = sx; xx = sy; zz = -sz + + ELSEIF (isource == 1) THEN + yy = sx; zz = sy; xx = sz + + ELSEIF (isource == 3) THEN + yy = -sx; zz = sy; xx = -sz + + ELSEIF (isource == 2) THEN + xx = -sx; zz = sy; yy = sz + + ELSEIF (isource == 4) THEN + xx = sx; zz = sy; yy = -sz + + ELSE + WRITE(*,*) 'Fatal Error: Source panel invalid in CubedSphereABPFromABP' + WRITE(*,*) 'panel = ', isource + STOP + ENDIF + + ! Convert to relative Cartesian coordinates on destination panel + IF (idest == 6) THEN + sx = yy; sy = -xx; sz = zz + + ELSEIF (idest == 5) THEN + sx = yy; sy = xx; sz = -zz + + ELSEIF (idest == 1) THEN + sx = yy; sy = zz; sz = xx + + ELSEIF (idest == 3) THEN + sx = -yy; sy = zz; sz = -xx + + ELSEIF (idest == 2) THEN + sx = -xx; sy = zz; sz = yy + + ELSEIF (idest == 4) THEN + sx = xx; sy = zz; sz = -yy + + ELSE + WRITE(*,*) 'Fatal Error: Dest panel invalid in CubedSphereABPFromABP' + WRITE(*,*) 'panel = ', idest + STOP + ENDIF + IF (sz < 0) THEN + WRITE(*,*) 'Fatal Error: In CubedSphereABPFromABP' + WRITE(*,*) 'Invalid relative Z coordinate' + STOP + ENDIF + + ! Use panel information to calculate (alpha, beta) coords + alpha_out = ATAN(sx / sz) + beta_out = ATAN(sy / sz) + + END SUBROUTINE + + +!------------------------------------------------------------------------------ +! FUNCTION CUBIC_EQUISPACE_INTERP +! +! Description: +! Apply cubic interpolation on the specified array of values, where all +! points are equally spaced. +! +! Parameters: +! dx - Spacing of points +! x - X coordinate where interpolation is to be applied +! y - Array of 4 values = f(x + k * dx) where k = 0,1,2,3 +!------------------------------------------------------------------------------ + FUNCTION CUBIC_EQUISPACE_INTERP(dx, x, y) + + IMPLICIT NONE + + REAL (KIND=dbl_kind) :: CUBIC_EQUISPACE_INTERP + REAL (KIND=dbl_kind) :: dx, x + REAL (KIND=dbl_kind), DIMENSION(1:4) :: y + + CUBIC_EQUISPACE_INTERP = & + (-y(1) / (6.0 * dx**3)) * (x - dx) * (x - 2.0 * dx) * (x - 3.0 * dx) + & + ( y(2) / (2.0 * dx**3)) * (x) * (x - 2.0 * dx) * (x - 3.0 * dx) + & + (-y(3) / (2.0 * dx**3)) * (x) * (x - dx) * (x - 3.0 * dx) + & + ( y(4) / (6.0 * dx**3)) * (x) * (x - dx) * (x - 2.0 * dx) + + END FUNCTION CUBIC_EQUISPACE_INTERP + +! FUNCTION I_10_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind) :: I_10_AB +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! I_10_ab = -ASINH(COS(alpha) * TAN(beta)) +! END FUNCTION I_10_AB +!! +! +! REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! I_01_ab = -ASINH(COS(beta) * TAN(alpha)) +! END FUNCTION I_01_AB +! +! REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! +! I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) +! END FUNCTION I_20_AB +! +! REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! +! I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) +! END FUNCTION I_02_AB +! +! REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) +! IMPLICIT NONE +! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta +! +! I_11_ab = -SQRT(1.0+TAN(alpha)**2+TAN(beta)**2) +! END FUNCTION I_11_AB +! + + +END MODULE reconstruct + diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 b/components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 new file mode 100755 index 00000000000..ed87b29c5a6 --- /dev/null +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 @@ -0,0 +1,1562 @@ +MODULE remap + INTEGER, PARAMETER :: & + int_kind = KIND(1), & + real_kind = SELECTED_REAL_KIND(p=14,r=100),& + dbl_kind = selected_real_kind(13) + + INTEGER :: nc,nhe + +! LOGICAL, PARAMETER:: ldbgr_r = .FALSE. + LOGICAL :: ldbgr + LOGICAL :: ldbg_global + + REAL(kind=real_kind), PARAMETER :: & + one = 1.0 ,& + aa = 1.0 ,& + tiny= 1.0E-9 ,& + bignum = 1.0E20 + REAL (KIND=dbl_kind), parameter :: fuzzy_width = 10.0*tiny !CAM-SE add + + contains + + + subroutine compute_weights_cell(xcell_in,ycell_in,jx,jy,nreconstruction,xgno,ygno,& + jx_min, jx_max, jy_min, jy_max,tmp,& + ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& + nc_in,nhe_in,nvertex,ldbg) + + implicit none + integer (kind=int_kind) , intent(in):: nreconstruction, jx,jy,ngauss,jmax_segments + real (kind=real_kind) , dimension(0:nvertex+1) :: xcell_in,ycell_in +! real (kind=real_kind) , dimension(0:5), intent(in):: xcell_in,ycell_in + integer (kind=int_kind), intent(in) :: nc_in,nhe_in,nvertex + logical, intent(in) :: ldbg + ! + ! ipanel is just for debugging + ! + integer (kind=int_kind), intent(in) :: jx_min, jy_min, jx_max, jy_max + real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: xgno + real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: ygno + ! + ! for Gaussian quadrature + ! + real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae + ! + ! boundaries of domain + ! + real (kind=real_kind):: tmp + ! + ! Number of Eulerian sub-cell integrals for the cell in question + ! + integer (kind=int_kind), intent(out) :: jcollect + ! + ! local workspace + ! + ! + ! max number of line segments is: + ! + ! (number of longitudes)*(max average number of crossings per line segment = 3)*ncube*2 + ! + real (kind=real_kind) , & + dimension(jmax_segments,nreconstruction), intent(out) :: weights + integer (kind=int_kind), & + dimension(jmax_segments,2), intent(out) :: weights_eul_index + + real (kind=real_kind), dimension(0:3) :: x,y + integer (kind=int_kind),dimension(0:5) :: jx_eul, jy_eul + integer (kind=int_kind) :: jsegment,i + ! + ! variables for registering crossings with Eulerian latitudes and longitudes + ! + integer (kind=int_kind) :: jcross_lat, iter + ! + ! max. crossings per side is 2*nhe + ! + real (kind=real_kind), & + dimension(jmax_segments,2) :: r_cross_lat + integer (kind=int_kind), & + dimension(jmax_segments,2) :: cross_lat_eul_index + real (kind=real_kind) , dimension(1:nvertex) :: xcell,ycell + + real (kind=real_kind) :: eps + + ldbg_global = ldbg + ldbgr = ldbg + + nc = nc_in + nhe = nhe_in + + xcell = xcell_in(1:nvertex) + ycell = ycell_in(1:nvertex) + + + ! + ! this is to avoid ill-conditioning problems + ! + eps = 1.0E-9 + + jsegment = 0 + weights = 0.0D0 + jcross_lat = 0 + ! + !********************** + ! + ! Integrate cell sides + ! + !********************** + + + IF (jx<-nhe.OR.jx>nc+1+nhe.OR.jy<-nhe.OR.jy>nc+1+nhe) THEN + WRITE(*,*) "jx,jy,-nhe,nc+1+nhe",jx,jy,-nhe,nc+1+nhe + STOP + END IF + + + call side_integral(xcell,ycell,nvertex,jsegment,jmax_segments,& + weights,weights_eul_index,nreconstruction,jx,jy,xgno,ygno,jx_min, jx_max, jy_min, jy_max,& + ngauss,gauss_weights,abscissae,& + jcross_lat,r_cross_lat,cross_lat_eul_index) + + ! + !********************** + ! + ! Do inner integrals + ! + !********************** + ! + call compute_inner_line_integrals_lat_nonconvex(r_cross_lat,cross_lat_eul_index,& + jcross_lat,jsegment,jmax_segments,xgno,jx_min, jx_max, jy_min, jy_max,& + weights,weights_eul_index,& + nreconstruction,ngauss,gauss_weights,abscissae) + ! + ! collect line-segment that reside in the same Eulerian cell + ! + if (jsegment>0) then + call collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) + ! + ! DBG + ! + tmp=0.0 + do i=1,jcollect + tmp=tmp+weights(i,1) + enddo + + IF (abs(tmp)>0.01) THEN + WRITE(*,*) "sum of weights too large",tmp + !stop + END IF + IF (tmp<-1.0E-9) THEN + WRITE(*,*) "sum of weights is negative - negative area?",tmp,jx,jy + ! ldbgr=.TRUE. + !stop + !!turn this off for phys grid as that of E3SM + END IF + else + jcollect = 0 + end if + end subroutine compute_weights_cell + + + ! + !**************************************************************************** + ! + ! organize data and store it + ! + !**************************************************************************** + ! + subroutine collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) + implicit none + integer (kind=int_kind) , intent(in) :: nreconstruction + real (kind=real_kind) , dimension(jmax_segments,nreconstruction), intent(inout) :: weights + integer (kind=int_kind), dimension(jmax_segments,2 ), intent(inout) :: weights_eul_index + integer (kind=int_kind), INTENT(OUT ) :: jcollect + integer (kind=int_kind), INTENT(IN ) :: jsegment,jmax_segments + ! + ! local workspace + ! + integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k,h + logical :: ltmp + + real (kind=real_kind) , dimension(jmax_segments,nreconstruction) :: weights_out + integer (kind=int_kind), dimension(jmax_segments,2 ) :: weights_eul_index_out + + weights_out = 0.0D0 + weights_eul_index_out = -100 + + imin = MINVAL(weights_eul_index(1:jsegment,1)) + imax = MAXVAL(weights_eul_index(1:jsegment,1)) + jmin = MINVAL(weights_eul_index(1:jsegment,2)) + jmax = MAXVAL(weights_eul_index(1:jsegment,2)) + + ltmp = .FALSE. + + jcollect = 1 + + do j=jmin,jmax + do i=imin,imax + do k=1,jsegment + if (weights_eul_index(k,1)==i.AND.weights_eul_index(k,2)==j) then + weights_out(jcollect,1:nreconstruction) = & + weights_out(jcollect,1:nreconstruction) + weights(k,1:nreconstruction) + ltmp = .TRUE. + h = k + endif + enddo + if (ltmp) then + weights_eul_index_out(jcollect,:) = weights_eul_index(h,:) + jcollect = jcollect+1 + endif + ltmp = .FALSE. + enddo + enddo + jcollect = jcollect-1 + weights = weights_out + weights_eul_index = weights_eul_index_out + end subroutine collect + ! + !***************************************************************************************** + ! + ! + ! + !***************************************************************************************** + ! + subroutine compute_inner_line_integrals_lat(r_cross_lat,cross_lat_eul_index,& + jcross_lat,jsegment,jmax_segments,xgno,jx_min,jx_max,jy_min, jy_max,weights,weights_eul_index,& + nreconstruction,ngauss,gauss_weights,abscissae)!phl add jx_min etc. + implicit none + ! + ! for Gaussian quadrature + ! + real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae + ! + ! variables for registering crossings with Eulerian latitudes and longitudes + ! + integer (kind=int_kind), intent(in):: jcross_lat, jmax_segments,nreconstruction,ngauss + integer (kind=int_kind), intent(inout):: jsegment + ! + ! max. crossings per side is 2*nhe + ! + real (kind=real_kind), & + dimension(jmax_segments,2), intent(in):: r_cross_lat + integer (kind=int_kind), & + dimension(jmax_segments,2), intent(in):: cross_lat_eul_index + integer (kind=int_kind), intent(in) ::jx_min, jx_max, jy_min, jy_max + real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: xgno + real (kind=real_kind) , & + dimension(jmax_segments,nreconstruction), intent(inout) :: weights + integer (kind=int_kind), & + dimension(jmax_segments,2), intent(inout) :: weights_eul_index + real (kind=real_kind) , dimension(nreconstruction) :: weights_tmp + + integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k, isgn, h, eul_jx, eul_jy + integer (kind=int_kind) :: idx_start_y,idx_end_y + logical :: ltmp,lcontinue + real (kind=real_kind), dimension(2) :: rstart,rend,rend_tmp + real (kind=real_kind), dimension(2) :: xseg, yseg +5 FORMAT(10e14.6) + + + if (jcross_lat>0) then + do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) + ! + ! find "first" crossing with Eulerian cell i + ! + do k=1,jcross_lat + if (cross_lat_eul_index(k,2)==i) exit + enddo + do j=k+1,jcross_lat + ! + ! find "second" crossing with Eulerian cell i + ! + if (cross_lat_eul_index(j,2)==i) then + if (r_cross_lat(k,1)0) then + do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) + ! WRITE(*,*) "looking at latitude ",i !xxxx + count = 1 + ! + ! find all crossings with Eulerian latitude i + ! + do k=1,jcross_lat + if (cross_lat_eul_index(k,2)==i) then + ! WRITE(*,*) "other crossings with latitude",i ," is ",k!xxxx + r_cross_lat_seg (count,:) = r_cross_lat (k,:) + cross_lat_eul_index_seg(count,:) = cross_lat_eul_index(k,:) + + IF (ldbg_global) then + WRITE(*,*) r_cross_lat_seg(count,1),r_cross_lat_seg(count,2) + WRITE(*,*) " " + END IF + count = count+1 + end if + enddo + count = count-1 + IF (ABS((count/2)-DBLE(count)/2.0)1000) THEN + WRITE(*,*) "search not converging",iter + STOP + END IF + lsame_cell_x = (x(2).GE.xgno(jx_eul).AND.x(2).LE.xgno(jx_eul+1)) + lsame_cell_y = (y(2).GE.ygno(jy_eul).AND.y(2).LE.ygno(jy_eul+1)) +! IF (ldbgr) WRITE(*,*) "lsame_cell_x,lsame_cell_y=",lsame_cell_x,lsame_cell_y + IF (lsame_cell_x.AND.lsame_cell_y) THEN + ! + !**************************** + ! + ! same cell integral + ! + !**************************** + ! +! IF (ldbgr) WRITE(*,*) "same cell integral",jx_eul,jy_eul + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = x(2); yseg(2) = y(2) + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + lcontinue = .FALSE. + ! + ! prepare for next side if (x(2),y(2)) is on a grid line + ! + IF (x(2).EQ.xgno(jx_eul+1).AND.x(3)>xgno(jx_eul+1)) THEN + ! + ! cross longitude jx_eul+1 + ! +! IF (ldbgr) WRITE(*,*) "cross longitude",jx_eul+1 + jx_eul=jx_eul+1 + ELSE IF (x(2).EQ.xgno(jx_eul ).AND.x(3)ygno(jy_eul+1)) THEN + ! + ! register crossing with latitude: line-segments point Northward + ! + jcross_lat = jcross_lat + 1 + jy_eul = jy_eul + 1 +! IF (ldbgr) WRITE(*,*) "cross latitude",jy_eul + cross_lat_eul_index(jcross_lat,1) = jx_eul + cross_lat_eul_index(jcross_lat,2) = jy_eul + r_cross_lat(jcross_lat,1) = x(2) + r_cross_lat(jcross_lat,2) = y(2) + ELSE IF (y(2).EQ.ygno(jy_eul ).AND.y(3)y(1) else "0" + ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" + ! + !******************************************************************************* + ! + ! there is at least one crossing with latitudes but no crossing with longitudes + ! + !******************************************************************************* + ! + yeul = ygno(jy_eul+ysgn1) + IF (x(1).EQ.x(2)) THEN + ! + ! line segment is parallel to longitude (infinite slope) + ! +! IF (ldbgr) WRITE(*,*) "line segment parallel to longitude" + xcross = x(1) + ELSE + slope = (y(2)-y(1))/(x(2)-x(1)) + xcross = x_cross_eul_lat(x(1),y(1),yeul,slope) + ! + ! constrain crossing to be "physically" possible + ! + xcross = MIN(MAX(xcross,xgno(jx_eul)),xgno(jx_eul+1)) + + +! IF (ldbgr) WRITE(*,*) "cross latitude" + ! + ! debugging + ! + IF (xcross.GT.xgno(jx_eul+1).OR.xcross.LT.xgno(jx_eul)) THEN + WRITE(*,*) "xcross is out of range",jx,jy + WRITE(*,*) "xcross-xgno(jx_eul+1), xcross-xgno(jx_eul))",& + xcross-xgno(jx_eul+1), xcross-ygno(jx_eul) + STOP + END IF + END IF + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 + ! + ! register crossing with latitude + ! + jcross_lat = jcross_lat+1 + cross_lat_eul_index(jcross_lat,1) = jx_eul + if (ysgn2>0) then + cross_lat_eul_index(jcross_lat,2) = jy_eul + else + cross_lat_eul_index(jcross_lat,2) = jy_eul+1 + end if + r_cross_lat(jcross_lat,1) = xcross + r_cross_lat(jcross_lat,2) = yeul + ELSE IF (lsame_cell_y) THEN +! IF (ldbgr) WRITE(*,*) "same cell y" + ! + !******************************************************************************* + ! + ! there is at least one crossing with longitudes but no crossing with latitudes + ! + !******************************************************************************* + ! + xsgn1 = (1+INT(SIGN(1.0D0,x(2)-x(1))))/2 !"1" if x(2)>x(1) else "0" + xsgn2 = INT(SIGN(1.0D0,x(2)-x(1))) !"1" if x(2)>x(1) else "-1" + xeul = xgno(jx_eul+xsgn1) +! IF (ldbgr) WRITE(*,*) " crossing longitude",jx_eul+xsgn1 + IF (ABS(x(2)-x(1))x(1) else "0" + xsgn2 = (INT(SIGN(1.0D0,x(2)-x(1)))) !"1" if x(2)>x(1) else "0" + xeul = xgno(jx_eul+xsgn1) + ysgn1 = (1+INT(SIGN(1.0D0,y(2)-y(1))))/2 !"1" if y(2)>y(1) else "0" + ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" + yeul = ygno(jy_eul+ysgn1) + + slope = (y(2)-y(1))/(x(2)-x(1)) + IF (ABS(x(2)-x(1))0.AND.xcross.LE.xeul).OR.(xsgn2<0.AND.xcross.GE.xeul)) THEN + ! + ! cross latitude + ! +! IF (ldbgr) WRITE(*,*) "crossing latitude",jy_eul+ysgn1 + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 + ! + ! register crossing with latitude + ! + jcross_lat = jcross_lat+1 + cross_lat_eul_index(jcross_lat,1) = jx_eul + if (ysgn2>0) then + cross_lat_eul_index(jcross_lat,2) = jy_eul + else + cross_lat_eul_index(jcross_lat,2) = jy_eul+1 + end if + r_cross_lat(jcross_lat,1) = xcross + r_cross_lat(jcross_lat,2) = yeul + ELSE + ! + ! cross longitude + ! +! IF (ldbgr) WRITE(*,*) "crossing longitude",jx_eul+xsgn1 + xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xeul; yseg(2) = ycross + jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; + ! + ! prepare for next iteration + ! + x(0) = x(1); y(0) = y(1); x(1) = xeul; y(1) = ycross; jx_eul = jx_eul+xsgn2 + END IF + + END IF + END IF + ! + ! register line-segment (don't register line-segment if outside of panel) + ! + if (jx_eul_tmp>=jx_min.AND.jy_eul_tmp>=jy_min.AND.& + jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1) then + ! jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1.AND.side_count<3) then + jsegment=jsegment+1 + weights_eul_index(jsegment,1) = jx_eul_tmp + weights_eul_index(jsegment,2) = jy_eul_tmp + call get_weights_gauss(weights(jsegment,1:nreconstruction),& + xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) + +! if (ldbg_global) then +! OPEN(unit=40, file='side_integral.dat',status='old',access='append') +! WRITE(40,*) xseg(1),yseg(1) +! WRITE(40,*) xseg(2),yseg(2) +! WRITE(40,*) " " +! CLOSE(40) +! end if + + + jdbg=jdbg+1 + + if (xseg(1).EQ.xseg(2))then + slope = bignum + else if (abs(yseg(1) -yseg(2))0) THEN + compute_slope = (y(2)-y(1))/(x(2)-x(1)) + else + compute_slope = bignum + end if + end function compute_slope + + real (kind=real_kind) function y_cross_eul_lon(x,y,xeul,slope) + implicit none + real (kind=real_kind), intent(in) :: x,y + real (kind=real_kind) , intent(in) :: xeul,slope + ! line: y=a*x+b + real (kind=real_kind) :: a,b + b = y-slope*x + y_cross_eul_lon = slope*xeul+b + end function y_cross_eul_lon + + real (kind=real_kind) function x_cross_eul_lat(x,y,yeul,slope) + implicit none + real (kind=real_kind), intent(in) :: x,y + real (kind=real_kind) , intent(in) :: yeul,slope + + if (fuzzy(ABS(slope),fuzzy_width)>0) THEN + x_cross_eul_lat = x+(yeul-y)/slope + ELSE + ! WRITE(*,*) "WARNING: slope is epsilon - ABORT" + x_cross_eul_lat = bignum + END IF + end function x_cross_eul_lat + + subroutine get_weights_exact(weights,xseg,yseg,nreconstruction) +! use cslam_analytic_mod, only: I_00, I_10, I_01, I_20, I_02, I_11 + implicit none + integer (kind=int_kind), intent(in) :: nreconstruction + real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights + real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg + ! + ! compute weights + ! + real (kind=real_kind) :: tmp,slope,b,integral,dx2,xc + integer (kind=int_kind) :: i +! weights(:) = -half*(xseg(1)*yseg(2)-xseg(2)*yseg(1)) !dummy for testing + + weights(1) = ((I_00(xseg(2),yseg(2))-I_00(xseg(1),yseg(1)))) + if (ABS(weights(1))>1.0) THEN + WRITE(*,*) "1 exact weights(jsegment)",weights(1),xseg,yseg + stop + end if + if (nreconstruction>1) then + weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) + weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) + endif + if (nreconstruction>3) then + weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) + weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) + weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) + endif + + end subroutine get_weights_exact + + + + subroutine get_weights_gauss(weights,xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) + implicit none + integer (kind=int_kind), intent(in) :: nreconstruction,ngauss + real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights + real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg + real (kind=real_kind) :: slope + ! + ! compute weights + ! + ! + ! for Gaussian quadrature + ! + real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae + + ! if line-segment parallel to x or y use exact formulaes else use qudrature + ! + real (kind=real_kind) :: tmp,b,integral,dx2,xc,x,y + integer (kind=int_kind) :: i + + + + +! if (fuzzy(abs(xseg(1) -xseg(2)),fuzzy_width)==0)then + if (xseg(1).EQ.xseg(2))then + weights = 0.0D0 + else if (abs(yseg(1) -yseg(2))1) then + weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) + weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) + endif + if (nreconstruction>3) then + weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) + weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) + weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) + endif + else + + + slope = (yseg(2)-yseg(1))/(xseg(2)-xseg(1)) + b = yseg(1)-slope*xseg(1) + dx2 = 0.5D0*(xseg(2)-xseg(1)) + if (ldbgr) WRITE(*,*) "dx2 and slope in gauss weight",dx2,slope + xc = 0.5D0*(xseg(1)+xseg(2)) + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_00(x,y) + enddo + weights(1) = integral*dx2 + if (nreconstruction>1) then + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_10(x,y) + enddo + weights(2) = integral*dx2 + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_01(x,y) + enddo + weights(3) = integral*dx2 + endif + if (nreconstruction>3) then + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_20(x,y) + enddo + weights(4) = integral*dx2 + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_02(x,y) + enddo + weights(5) = integral*dx2 + integral = 0.0D0 + do i=1,ngauss + x = xc+abscissae(i)*dx2 + y = slope*x+b + integral = integral+gauss_weights(i)*F_11(x,y) + enddo + weights(6) = integral*dx2 + endif + end if + end subroutine get_weights_gauss + + real (kind=real_kind) function F_00(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_00 =y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) + end function F_00 + + real (kind=real_kind) function F_10(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_10 =x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) + end function F_10 + + real (kind=real_kind) function F_01(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_01 =-1.0D0/(SQRT(1.0D0+x*x+y*y)) + end function F_01 + + real (kind=real_kind) function F_20(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_20 =x*x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) + end function F_20 + + real (kind=real_kind) function F_02(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,alpha, tmp + + x = x_in + y = y_in + + alpha = ATAN(x) + tmp=y*COS(alpha) + F_02 =-y/SQRT(1.0D0+x*x+y*y)+log(tmp+sqrt(tmp*tmp+1)) + + ! + ! cos(alpha) = 1/sqrt(1+x*x) + ! + end function F_02 + + real (kind=real_kind) function F_11(x_in,y_in) + implicit none + real (kind=real_kind), intent(in) :: x_in,y_in + real (kind=real_kind) :: x,y,tmp + + x = x_in + y = y_in + + F_11 =-x/(SQRT(1.0D0+x*x+y*y)) + end function F_11 + + subroutine which_eul_cell(x,j_eul,gno) + implicit none + integer (kind=int_kind) , intent(inout) :: j_eul + real (kind=real_kind), dimension(3) , intent(in) :: x + real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl +! real (kind=real_kind), intent(in) :: eps + + real (kind=real_kind) :: d1,d2,d3,d1p1 + logical :: lcontinue + integer :: iter + + + ! + ! this is not needed in transport code search + ! +! IF (x(1)gno(nc+2+nhe)) j_eul=nc+1+nhe +! RETURN + +! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added + + lcontinue = .TRUE. + iter = 0 + IF (ldbgr) WRITE(*,*) "from which_eul_cell",x(1),x(2),x(3) + DO WHILE (lcontinue) + iter = iter+1 + IF (x(1).GE.gno(j_eul).AND.x(1).LT.gno(j_eul+1)) THEN + lcontinue = .FALSE. + ! + ! special case when x(1) is on top of grid line + ! + IF (x(1).EQ.gno(j_eul)) THEN +! IF (ABS(x(1)-gno(j_eul))1000.OR.j_eul<-nhe.OR.j_eul>nc+2+nhe) THEN + WRITE(*,*) "search in which_eul_cell not converging!", iter,j_eul + WRITE(*,*) "input", x + WRITE(*,*) "gno", gno(nc),gno(nc+1),gno(nc+2),gno(nc+3) + STOP + END IF + END DO + END subroutine which_eul_cell + + + subroutine truncate_vertex(x,j_eul,gno) + implicit none + integer (kind=int_kind) , intent(inout) :: j_eul + real (kind=real_kind) , intent(inout) :: x + real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl +! real (kind=real_kind), intent(in) :: eps + + logical :: lcontinue + integer :: iter + real (kind=real_kind) :: xsgn,dist,dist_new,tmp + + ! + ! this is not needed in transport code search + ! +! IF (xgno(nc+2+nhe)) j_eul=nc+1+nhe +! +! RETURN + + + lcontinue = .TRUE. + iter = 0 + dist = bignum +! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added + xsgn = INT(SIGN(1.0_dbl_kind,x-gno(j_eul))) + DO WHILE (lcontinue) + iter = iter+1 + tmp = x-gno(j_eul) + dist_new = ABS(tmp) + IF (dist_new>dist) THEN + lcontinue = .FALSE. +! ELSE IF (ABS(tmp)<1.0E-11) THEN + ELSE IF (ABS(tmp)<1.0E-9) THEN +! ELSE IF (ABS(tmp)<1.0E-4) THEN + x = gno(j_eul) + lcontinue = .FALSE. + ELSE + j_eul = j_eul+xsgn + dist = dist_new + END IF + IF (iter>10000) THEN + WRITE(*,*) "truncate vertex not converging" + STOP + END IF + END DO + END subroutine truncate_vertex + + + + +!******************************************************************************** +! +! Gauss-Legendre quadrature +! +! Tabulated values +! +!******************************************************************************** +subroutine gauss_points(n,weights,points) + implicit none + real (kind=real_kind), dimension(n), intent(out) :: weights, points + integer (kind=int_kind) , intent(in ) :: n + + select case (n) +! CASE(1) +! abscissae(1) = 0.0D0 +! weights(1) = 2.0D0 + case(2) + points(1) = -sqrt(1.0D0/3.0D0) + points(2) = sqrt(1.0D0/3.0D0) + weights(1) = 1.0D0 + weights(2) = 1.0D0 + case(3) + points(1) = -0.774596669241483377035853079956D0 + points(2) = 0.0D0 + points(3) = 0.774596669241483377035853079956D0 + weights(1) = 0.555555555555555555555555555556D0 + weights(2) = 0.888888888888888888888888888889D0 + weights(3) = 0.555555555555555555555555555556D0 + case(4) + points(1) = -0.861136311594052575223946488893D0 + points(2) = -0.339981043584856264802665659103D0 + points(3) = 0.339981043584856264802665659103D0 + points(4) = 0.861136311594052575223946488893D0 + weights(1) = 0.347854845137453857373063949222D0 + weights(2) = 0.652145154862546142626936050778D0 + weights(3) = 0.652145154862546142626936050778D0 + weights(4) = 0.347854845137453857373063949222D0 + case(5) + points(1) = -(1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) + points(2) = -(1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) + points(3) = 0.0D0 + points(4) = (1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) + points(5) = (1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) + weights(1) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 + weights(2) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 + weights(3) = 128.0D0/225.0D0 + weights(4) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 + weights(5) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 + case default + write(*,*) 'n out of range in glwp of module gll. n=',n + write(*,*) '0 0.0D0) THEN + signum = 1.0D0 + ELSEIF (x < 0.0D0) THEN + signum = -1.0D0 + ELSE + signum = 0.0D0 + ENDIF + end function + +!------------------------------------------------------------------------------ +! FUNCTION SIGNUM_FUZZY +! +! Description: +! Gives the sign of the given real number, returning zero if x is within +! a small amount from zero. +!------------------------------------------------------------------------------ + function signum_fuzzy(x) + implicit none + + real (kind=real_kind) :: signum_fuzzy + real (kind=real_kind) :: x + + IF (x > fuzzy_width) THEN + signum_fuzzy = 1.0D0 + ELSEIF (x < fuzzy_width) THEN + signum_fuzzy = -1.0D0 + ELSE + signum_fuzzy = 0.0D0 + ENDIF + end function + + function fuzzy(x,epsilon) + implicit none + + integer (kind=int_kind) :: fuzzy + real (kind=real_kind), intent(in) :: epsilon + real (kind=real_kind) :: x + + IF (ABS(x)epsilon) THEN + fuzzy = 1 + ELSE !IF (x < fuzzy_width) THEN + fuzzy = -1 + ENDIF + end function + +! +! see, e.g., http://local.wasp.uwa.edu.au/~pbourke/geometry/lineline2d/ +! +subroutine check_lines_cross(x1,x2,x3,x4,y1,y2,y3,y4,lcross) + implicit none + real (kind=real_kind), INTENT(IN) :: x1,x2,x3,x4,y1,y2,y3,y4 + LOGICAL, INTENT(OUT) :: lcross + ! + ! local workspace + ! + real (kind=real_kind) :: cp,tx,ty + + cp = (y4-y3)*(x2-x1)-(x4-x3)*(y2-y1) + IF (ABS(cp)-tiny.AND.tx<1.0D0+tiny.AND.& + ty>-tiny.AND.ty<1.0D0+tiny) THEN + lcross = .TRUE. + ELSE + lcross = .FALSE. +! WRITE(*,*) "not parallel but not crossing,",tx,ty + ENDIF + ENDIF +end subroutine check_lines_cross + + + REAL (KIND=dbl_kind) FUNCTION I_00(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y + + x = x_in/aa + y = y_in/aa +! x = x_in +! y = y_in + I_00 = ATAN(x*y/SQRT(one+x*x+y*y)) + END FUNCTION I_00 + + REAL (KIND=dbl_kind) FUNCTION I_10(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y,tmp + + x = x_in/aa + y = y_in/aa + tmp = ATAN(x) + I_10 = -ASINH(y*COS(tmp)) + ! + ! = -arcsinh(y/sqrt(1+x^2)) + ! + END FUNCTION I_10 + + REAL (KIND=dbl_kind) FUNCTION I_10_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + I_10_ab = -ASINH(COS(alpha) * TAN(beta)) + END FUNCTION I_10_AB + + REAL (KIND=dbl_kind) FUNCTION I_01(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y!,beta + + x = x_in/aa + y = y_in/aa +! beta = ATAN(y) +! I_01 = -ASINH(x*COS(beta)) + I_01 = -ASINH(x/SQRT(1+y*y)) + END FUNCTION I_01 + + REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + I_01_ab = -ASINH(COS(beta) * TAN(alpha)) + END FUNCTION I_01_AB + + REAL (KIND=dbl_kind) FUNCTION I_20(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta + + x = x_in/aa + y = y_in/aa +! alpha = aa*ATAN(x) +! beta = aa*ATAN(y) + + tmp = one+y*y + +! I_20 = y*ASINH(COS(beta)*x)+ACOS(SIN(alpha)*SIN(beta)) + I_20 = y*ASINH(x/SQRT(tmp))+ACOS(x*y/(SQRT((one+x*x)*tmp))) + END FUNCTION I_20 + + REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + + I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) + END FUNCTION I_20_AB + + REAL (KIND=dbl_kind) FUNCTION I_02(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta + + x = x_in/aa + y = y_in/aa +! alpha = aa*ATAN(x) +! beta = aa*ATAN(y) + + tmp=one+x*x + + I_02 = x*ASINH(y/SQRT(tmp))+ACOS(x*y/SQRT(tmp*(1+y*y))) + END FUNCTION I_02 + + REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + + I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) + END FUNCTION I_02_AB + + + REAL (KIND=dbl_kind) FUNCTION I_11(x_in,y_in) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in + REAL (KIND=dbl_kind) :: x,y + + x = x_in/aa + y = y_in/aa + + I_11 = -SQRT(1+x*x+y*y) + END FUNCTION I_11 + + REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) + IMPLICIT NONE + REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta + + I_11_ab = -SQRT(one+TAN(alpha)**2+TAN(beta)**2) + END FUNCTION I_11_AB +!------------------------------------------------------------------------------ +! FUNCTION ASINH +! +! Description: +! Hyperbolic arcsin function +!------------------------------------------------------------------------------ + FUNCTION ASINH(x) + IMPLICIT NONE + + REAL (KIND=dbl_kind) :: ASINH + REAL (KIND=dbl_kind) :: x + + ASINH = LOG(x + SQRT(x * x + one)) + END FUNCTION + + + !******************************************************************************** + ! + ! Gauss-Legendre quadrature + ! + ! Tabulated values + ! + !******************************************************************************** + SUBROUTINE glwp(n,weights,abscissae) + IMPLICIT NONE + REAL (KIND=dbl_kind), DIMENSION(n), INTENT(OUT) :: weights, abscissae + INTEGER (KIND=int_kind) , INTENT(IN ) :: n + + SELECT CASE (n) + CASE(1) + abscissae(1) = 0.0 + weights(1) = 2.0 + CASE(2) + abscissae(1) = -SQRT(1.0/3.0) + abscissae(2) = SQRT(1.0/3.0) + weights(1) = 1.0 + weights(2) = 1.0 + CASE(3) + abscissae(1) = -0.774596669241483377035853079956_dbl_kind + abscissae(2) = 0.0 + abscissae(3) = 0.774596669241483377035853079956_dbl_kind + weights(1) = 0.555555555555555555555555555556_dbl_kind + weights(2) = 0.888888888888888888888888888889_dbl_kind + weights(3) = 0.555555555555555555555555555556_dbl_kind + CASE(4) + abscissae(1) = -0.861136311594052575223946488893_dbl_kind + abscissae(2) = -0.339981043584856264802665659103_dbl_kind + abscissae(3) = 0.339981043584856264802665659103_dbl_kind + abscissae(4) = 0.861136311594052575223946488893_dbl_kind + weights(1) = 0.347854845137453857373063949222_dbl_kind + weights(2) = 0.652145154862546142626936050778_dbl_kind + weights(3) = 0.652145154862546142626936050778_dbl_kind + weights(4) = 0.347854845137453857373063949222_dbl_kind + CASE(5) + abscissae(1) = -(1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) + abscissae(2) = -(1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) + abscissae(3) = 0.0 + abscissae(4) = (1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) + abscissae(5) = (1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) + weights(1) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + weights(2) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + weights(3) = 128.0_dbl_kind/225.0_dbl_kind + weights(4) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + weights(5) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind + CASE DEFAULT + WRITE(*,*) 'n out of range in glwp of module gll. n=',n + WRITE(*,*) '0 shr_kind_r8 +contains +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereABPFromRLL +! +! Description: +! Determine the (alpha,beta,panel) coordinate of a point on the sphere from +! a given regular lat lon coordinate. +! +! Parameters: +! lon - Coordinate longitude +! lat - Coordinate latitude +! alpha (OUT) - Alpha coordinate +! beta (OUT) - Beta coordinate +! ipanel (OUT) - Face panel +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel, ldetermine_panel) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (R8), INTENT(IN) :: lon, lat + REAL (R8), INTENT(OUT) :: alpha, beta + INTEGER :: ipanel + LOGICAL, INTENT(IN) :: ldetermine_panel + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + REAL (r8), PARAMETER :: rotate_cube = 0.0 + + ! Local variables + REAL (R8) :: xx, yy, zz, pm + REAL (R8) :: sx, sy, sz + INTEGER :: ix, iy, iz + + ! Translate to (x,y,z) space + xx = COS(lon-rotate_cube) * COS(lat) + yy = SIN(lon-rotate_cube) * COS(lat) + zz = SIN(lat) + + pm = MAX(ABS(xx), ABS(yy), ABS(zz)) + + ! Check maximality of the x coordinate + IF (pm == ABS(xx)) THEN + IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF + ELSE + ix = 0 + ENDIF + + ! Check maximality of the y coordinate + IF (pm == ABS(yy)) THEN + IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF + ELSE + iy = 0 + ENDIF + + ! Check maximality of the z coordinate + IF (pm == ABS(zz)) THEN + IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF + ELSE + iz = 0 + ENDIF + + ! Panel assignments + IF (ldetermine_panel) THEN + IF (iz == 1) THEN + ipanel = 6; sx = yy; sy = -xx; sz = zz + + ELSEIF (iz == -1) THEN + ipanel = 5; sx = yy; sy = xx; sz = -zz + + ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN + ipanel = 1; sx = yy; sy = zz; sz = xx + + ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN + ipanel = 3; sx = -yy; sy = zz; sz = -xx + + ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN + ipanel = 2; sx = -xx; sy = zz; sz = yy + + ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN + ipanel = 4; sx = xx; sy = zz; sz = -yy + + ELSE + WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' + WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' + WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' + STOP + ENDIF + ELSE + IF (ipanel == 6) THEN + sx = yy; sy = -xx; sz = zz + ELSEIF (ipanel == 5) THEN + sx = yy; sy = xx; sz = -zz + ELSEIF (ipanel == 1) THEN + sx = yy; sy = zz; sz = xx + ELSEIF (ipanel == 3) THEN + sx = -yy; sy = zz; sz = -xx + ELSEIF (ipanel == 2) THEN + sx = -xx; sy = zz; sz = yy + ELSEIF (ipanel == 4) THEN + sx = xx; sy = zz; sz = -yy + ELSE + WRITE(*,*) "ipanel out of range",ipanel + STOP + END IF + END IF + + ! Use panel information to calculate (alpha, beta) coords + alpha = ATAN(sx / sz) + beta = ATAN(sy / sz) + +END SUBROUTINE CubedSphereABPFromRLL + +!------------------------------------------------------------------------------ +! SUBROUTINE EquiangularAllAreas +! +! Description: +! Compute the area of all cubed sphere grid cells, storing the results in +! a two dimensional array. +! +! Parameters: +! icube - Resolution of the cubed sphere +! dA (OUT) - Output array containing the area of all cubed sphere grid cells +!------------------------------------------------------------------------------ +SUBROUTINE EquiangularAllAreas(icube, dA) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + INTEGER, INTENT(IN) :: icube + REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA + + ! Local variables + INTEGER :: k, k1, k2 + REAL (r8) :: a1, a2, a3, a4 + REAL (r8), DIMENSION(icube+1,icube+1) :: ang + REAL (r8), DIMENSION(icube+1) :: gp + + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + + !#ifdef DBG + REAL (r8) :: dbg1 !DBG + !#endif + + ! Recall that we are using equi-angular spherical gridding + ! Compute the angle between equiangular cubed sphere projection grid lines. + DO k = 1, icube+1 + gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) + ENDDO + + DO k2=1,icube+1 + DO k1=1,icube+1 + ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) + ENDDO + ENDDO + + DO k2=1,icube + DO k1=1,icube + a1 = ang(k1 , k2 ) + a2 = pi - ang(k1+1, k2 ) + a3 = pi - ang(k1 , k2+1) + a4 = ang(k1+1, k2+1) + ! area = r*r*(-2*pi+sum(interior angles)) + DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 + ENDDO + ENDDO + + !#ifdef DBG + ! Only for debugging - test consistency + dbg1 = 0.0 !DBG + DO k2=1,icube + DO k1=1,icube + dbg1 = dbg1 + DA(k1,k2) !DBG + ENDDO + ENDDO + write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG + !#endif +END SUBROUTINE EquiangularAllAreas + + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereRLLFromABP +! +! Description: +! Determine the lat lon coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! lon (OUT) - Calculated longitude +! lat (OUT) - Calculated latitude +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: lon, lat + ! Local variables + REAL (r8) :: xx, yy, zz, rotate_cube + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: piq = 0.25*pi + + rotate_cube = 0.0 + ! Convert to cartesian coordinates + CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + ! Convert back to lat lon + lat = ASIN(zz) + if (xx==0.0.and.yy==0.0) THEN + lon = 0.0 + else + lon = ATAN2(yy, xx) +rotate_cube + IF (lon<0.0) lon=lon+2.0*pi + IF (lon>2.0*pi) lon=lon-2.0*pi + end if +END SUBROUTINE CubedSphereRLLFromABP + +!------------------------------------------------------------------------------ +! SUBROUTINE CubedSphereXYZFromABP +! +! Description: +! Determine the Cartesian coordinate of a point on a sphere given its +! (alpha,beta,panel) coordinate. +! +! Parameters: +! alpha - Alpha coordinate +! beta - Beta coordinate +! panel - Cubed sphere panel id +! xx (OUT) - Calculated x coordinate +! yy (OUT) - Calculated y coordinate +! zz (OUT) - Calculated z coordinate +!------------------------------------------------------------------------------ +SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) + use shr_kind_mod, only: r8 => shr_kind_r8 + IMPLICIT NONE + + REAL (r8), INTENT(IN) :: alpha, beta + INTEGER , INTENT(IN) :: ipanel + REAL (r8), INTENT(OUT) :: xx, yy, zz + ! Local variables + REAL (r8) :: a1, b1, pm + REAL (r8) :: sx, sy, sz + + ! Convert to Cartesian coordinates + a1 = TAN(alpha) + b1 = TAN(beta) + + sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) + sx = sz * a1 + sy = sz * b1 + ! Panel assignments + IF (ipanel == 6) THEN + yy = sx; xx = -sy; zz = sz + ELSEIF (ipanel == 5) THEN + yy = sx; xx = sy; zz = -sz + ELSEIF (ipanel == 1) THEN + yy = sx; zz = sy; xx = sz + ELSEIF (ipanel == 3) THEN + yy = -sx; zz = sy; xx = -sz + ELSEIF (ipanel == 2) THEN + xx = -sx; zz = sy; yy = sz + ELSEIF (ipanel == 4) THEN + xx = sx; zz = sy; yy = -sz + ELSE + WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' + WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' + STOP + ENDIF +END SUBROUTINE CubedSphereXYZFromABP + + +SUBROUTINE remove_duplicates_integer(n_in,f_in,n_out,f_out) + use shr_kind_mod, only: r8 => shr_kind_r8 + integer, intent(in) :: n_in + integer,dimension(n_in), intent(in) :: f_in + integer, intent(out) :: n_out + integer,dimension(n_in), intent(out) :: f_out + ! + ! local work space + ! + integer :: k,i,j + ! + ! remove duplicates in ipanel_tmp + ! + k = 1 + f_out(1) = f_in(1) + outer: do i=2,n_in + do j=1,k + ! if (f_out(j) == f_in(i)) then + if (ABS(f_out(j)-f_in(i))<1.0E-10) then + ! Found a match so start looking again + cycle outer + end if + end do + ! No match found so add it to the output + k = k + 1 + f_out(k) = f_in(i) + end do outer + n_out = k +END SUBROUTINE remove_duplicates_integer + +SUBROUTINE remove_duplicates_latlon(n_in,lon_in,lat_in,n_out,lon_out,lat_out,tiny,ldbg) + use shr_kind_mod, only: r8 => shr_kind_r8 + integer, intent(in) :: n_in + real(r8),dimension(n_in), intent(inout) :: lon_in,lat_in + real, intent(in) :: tiny + integer, intent(out) :: n_out + real(r8),dimension(n_in), intent(out) :: lon_out,lat_out + logical :: ldbg + ! + ! local work space + ! + integer :: k,i,j + REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 + REAL (r8), PARAMETER :: pih = 0.50*pi + ! + ! for pole points: make sure the longitudes are identical so that algorithm below works properly + ! + do i=2,n_in + if (abs(lat_in(i)-pih) Date: Sun, 6 Oct 2024 17:30:30 -0700 Subject: [PATCH 194/529] Implement the new orographic drag schemes 1. The new orographic drag schemes is implemented into physics package. It includes nonlinear orographic gravity wave drag (oGWD), flow-blocking drag (FBD), small-scale GWD (sGWD), turbulent orographic form drag (TOFD). The code modifications are in physics, clubb, and control of eam (for input of the new topo file). 2. A new topo file including new topo parameters is input into the model. namelist_defaults_eam.xml is modified to add the new topo file. 3. See #PR 6665 for more info. modified: bld/namelist_files/namelist_defaults_eam.xml modified: src/control/startup_initialconds.F90 modified: src/physics/cam/clubb_intr.F90 modified: src/physics/cam/comsrf.F90 modified: src/physics/cam/gw_common.F90 modified: src/physics/cam/gw_drag.F90 modified: src/physics/cam/hb_diff.F90 modified: src/physics/cam/physics_types.F90 modified: src/physics/cam/physpkg.F90 modified: src/physics/cam/ppgrid.F90 modified: src/physics/clubb/advance_windm_edsclrm_module.F90 [Non-BFB] --- .../namelist_files/namelist_defaults_eam.xml | 2 +- .../eam/src/control/startup_initialconds.F90 | 41 + components/eam/src/physics/cam/clubb_intr.F90 | 125 +- components/eam/src/physics/cam/comsrf.F90 | 44 +- components/eam/src/physics/cam/gw_common.F90 | 1244 +++++++++++++++++ components/eam/src/physics/cam/gw_drag.F90 | 221 ++- components/eam/src/physics/cam/hb_diff.F90 | 118 ++ .../eam/src/physics/cam/physics_types.F90 | 41 +- components/eam/src/physics/cam/physpkg.F90 | 10 +- components/eam/src/physics/cam/ppgrid.F90 | 12 +- .../clubb/advance_windm_edsclrm_module.F90 | 2 +- 11 files changed, 1831 insertions(+), 29 deletions(-) diff --git a/components/eam/bld/namelist_files/namelist_defaults_eam.xml b/components/eam/bld/namelist_files/namelist_defaults_eam.xml index cfd9bf682c8..1f357767f8b 100755 --- a/components/eam/bld/namelist_files/namelist_defaults_eam.xml +++ b/components/eam/bld/namelist_files/namelist_defaults_eam.xml @@ -133,7 +133,7 @@ atm/cam/topo/USGS-gtopo30_ne16np4_16xconsistentSGH.c20160612.nc atm/cam/topo/USGS-gtopo30_ne16np4pg2_16xdel2_20200527.nc atm/cam/topo/USGS-gtopo30_ne30np4_16xdel2-PFC-consistentSGH.nc -atm/cam/topo/USGS-gtopo30_ne30np4pg2_x6t-SGH.c20210614.nc +atm/cam/topo/USGS-gtopo30_ne30np4pg2_x6t-SGH_forOroDrag.c20241001.nc atm/cam/topo/USGS-gtopo30_ne30np4pg3_16xdel2.c20200504.nc atm/cam/topo/USGS-gtopo30_ne30np4pg4_16xdel2.c20200504.nc atm/cam/topo/USGS-gtopo30_ne45np4pg2_16xdel2.c20200615.nc diff --git a/components/eam/src/control/startup_initialconds.F90 b/components/eam/src/control/startup_initialconds.F90 index fed4cece646..6b8b4062f9d 100644 --- a/components/eam/src/control/startup_initialconds.F90 +++ b/components/eam/src/control/startup_initialconds.F90 @@ -5,16 +5,28 @@ module startup_initialconds ! !----------------------------------------------------------------------- +use pio, only: file_desc_t + implicit none private save public :: initial_conds ! Read in initial conditions (dycore dependent) +!added for orographic drag +public topoGWD_file_get_id +public setup_initialGWD +public close_initial_fileGWD +type(file_desc_t), pointer :: ncid_topoGWD !======================================================================= contains !======================================================================= +function topoGWD_file_get_id() + type(file_desc_t), pointer :: topoGWD_file_get_id + topoGWD_file_get_id => ncid_topoGWD +end function topoGWD_file_get_id + subroutine initial_conds(dyn_in) ! This routine does some initializing of buffers that should move to a @@ -62,4 +74,33 @@ end subroutine initial_conds !======================================================================= +subroutine setup_initialGWD() + use filenames, only: bnd_topo + use ioFileMod, only: getfil + use cam_pio_utils, only: cam_pio_openfile + use pio, only: pio_nowrite +! +! Input arguments +! +!----------------------------------------------------------------------- + include 'netcdf.inc' +!----------------------------------------------------------------------- + character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk + allocate(ncid_topoGWD) + call getfil(bnd_topo, bnd_topo_loc) + call cam_pio_openfile(ncid_topoGWD, bnd_topo_loc, PIO_NOWRITE) +end subroutine setup_initialGWD + +subroutine close_initial_fileGWD + use pio, only: pio_closefile + call pio_closefile(ncid_topoGWD) + deallocate(ncid_topoGWD) + nullify(ncid_topoGWD) +end subroutine close_initial_fileGWD +!======================================================================= + + + + + end module startup_initialconds diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index a93331fabdd..9118c9bb39a 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -927,7 +927,18 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) call addfld ('VMAGDP', horiz_only, 'A', '-', 'ZM gustiness enhancement') call addfld ('VMAGCL', horiz_only, 'A', '-', 'CLUBB gustiness enhancement') call addfld ('TPERTBLT', horiz_only, 'A', 'K', 'perturbation temperature at PBL top') - + !================================== + !!added for TOFD output + call addfld ('DTAUX3_FD',(/'lev'/),'A','m/s2','U tendency - fd orographic drag') + call addfld ('DTAUY3_FD',(/'lev'/),'A','m/s2','V tendency - fd orographic drag') + call addfld ('DUSFC_FD',horiz_only,'A','N/m2','fd zonal oro surface stress') + call addfld ('DVSFC_FD',horiz_only,'A','N/m2','fd merio oro surface stress') + call add_default('DTAUX3_FD', 1, ' ') + call add_default('DTAUY3_FD', 1, ' ') + call add_default('DUSFC_FD', 1, ' ') + call add_default('DVSFC_FD', 1, ' ') + !!added for TOFD output + !===================================== ! Initialize statistics, below are dummy variables dum1 = 300._r8 dum2 = 1200._r8 @@ -1155,7 +1166,11 @@ subroutine clubb_tend_cam( & use model_flags, only: ipdf_call_placement use advance_clubb_core_module, only: ipdf_post_advance_fields #endif - + use gw_common, only: gwdo_gsd,grid_size,pblh_get_level_idx + use hycoef, only: etamid + use physconst, only: rh2o,pi,rearth,r_universal + !!get the znu,znw,p_top set to 0 + use phys_grid, only: get_rlat_all_p implicit none ! --------------- ! @@ -1518,7 +1533,24 @@ subroutine clubb_tend_cam( & real(r8) :: sfc_v_diff_tau(pcols) ! Response to tau perturbation, m/s real(r8), parameter :: pert_tau = 0.1_r8 ! tau perturbation, Pa - + !=========================== + !simply add par + !for z,dz,from other files + real(r8) :: ztop(pcols,pver) ! top interface height asl(m) + real(r8) :: zbot(pcols,pver) ! bottom interface height asl(m) + real(r8) :: zmid(pcols,pver) ! middle interface height asl(m) + real(r8) :: dz(pcols,pver) + real(r8) :: rlat(pcols) ! latitude in radians for columns + integer :: kpbl2d_in(pcols) + real(r8) :: ttgw(pcols,pver) ! temperature tendency + real(r8) :: utgw(pcols,pver) ! zonal wind tendency + real(r8) :: vtgw(pcols,pver) ! meridional wind tendency + real(r8) :: dtaux3_fd(pcols,pver) + real(r8) :: dtauy3_fd(pcols,pver) + real(r8) :: dusfc_fd(pcols) + real(r8) :: dvsfc_fd(pcols) + real(r8) :: dx(pcols),dy(pcols) + !============================== real(r8) :: inv_exner_clubb_surf @@ -1946,7 +1978,73 @@ subroutine clubb_tend_cam( & tautmsx, tautmsy, cam_in%landfrac ) call t_stopf('compute_tms') endif - + ztop= 0.0_r8 ! top interface height asl(m) + zbot= 0.0_r8 ! bottom interface height asl(m) + zmid= 0.0_r8 ! middle interface height asl(m) + dz= 0.0_r8 + kpbl2d_in = -1 + dtaux3_fd= 0.0_r8 + dtauy3_fd= 0.0_r8 + dusfc_fd= 0.0_r8 + dvsfc_fd= 0.0_r8 + !similar as in gw_drag + do k=1,pverp-1 + ! assign values from top + ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) + ! assign values from bottom + zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) + end do + !transform adding the pressure + !transfer from surface to sea level + do k=1,pver + do i=1,ncol + ztop(i,k)=ztop(i,k)+state%phis(i)/gravit + zbot(i,k)=zbot(i,k)+state%phis(i)/gravit + zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit + !dz is from bottom to top already for gw_drag + dz(i,k)=ztop(i,k)-zbot(i,k) + end do + end do + !get the layer index of pblh in layer + kpbl2d_in=0._r8 + do i=1,pcols + kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/gravit),pblh(i)) + end do + !rlat + call get_rlat_all_p(lchnk, ncol, rlat) + !========================================= + utgw=0._r8 + vtgw=0._r8 + ttgw=0._r8 + dusfc_fd=0._r8 + dvsfc_fd=0._r8 + ! + call grid_size(state,dx,dy) + call gwdo_gsd(& + u3d=state%u(:,pver:1:-1),v3d=state%v(:,pver:1:-1),& + t3d=state%t(:,pver:1:-1),qv3d=state%q(:,pver:1:-1,1),& + p3d=state%pmid(:,pver:1:-1),p3di=state%pint(:,pver+1:1:-1),& + pi3d=state%exner(:,pver:1:-1),z=zbot,& + rublten=utgw(:,pver:1:-1),rvblten=vtgw(:,pver:1:-1),& + rthblten=ttgw(:,pver:1:-1),& + dtaux3d_fd=dtaux3_fd(:,pver:1:-1),dtauy3d_fd=dtauy3_fd(:,pver:1:-1),& + dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& + xland=cam_in%landfrac,br=state%ribulk,& + var2d=sgh30(:ncol),& + znu=etamid(pver:1:-1),dz=dz,pblh=pblh,& + cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,& + dx=dx,dy=dy,& + kpbl2d=kpbl2d_in,itimestep=hdtime,gwd_opt=0,& + ids=1,ide=pcols,jds=0,jde=0,kds=1,kde=pver, & + ims=1,ime=pcols,jms=0,jme=0,kms=1,kme=pver, & + its=1,ite=pcols,jts=0,jte=0,kts=1,kte=pver,& + gwd_ls=0,gwd_bl=0,gwd_ss=0,gwd_fd=1) + !! + call outfld ('DTAUX3_FD', dtaux3_fd, pcols, lchnk) + call outfld ('DTAUY3_FD', dtauy3_fd, pcols, lchnk) + call outfld ('DUSFC_FD', dusfc_fd, pcols, lchnk) + call outfld ('DVSFC_FD', dvsfc_fd, pcols, lchnk) + !! if (micro_do_icesupersat) then call physics_ptend_init(ptend_loc,state%psetcols, 'clubb_ice3', ls=.true., lu=.true., lv=.true., lq=lq) endif @@ -2067,7 +2165,12 @@ subroutine clubb_tend_cam( & dum_core_rknd = real((ksrftms(i)*state1%v(i,pver)), kind = core_rknd) vpwp_sfc = vpwp_sfc-(dum_core_rknd/rho_ds_zm(1)) endif - + !----------------------------------------------------! + !Apply TOFD + !----------------------------------------------------! + !tendency is flipped already + um_forcing(2:pverp)=dtaux3_fd(i,pver:1:-1) + vm_forcing(2:pverp)=dtauy3_fd(i,pver:1:-1) ! Need to flip arrays around for CLUBB core do k=1,pverp um_in(k) = real(um(i,pverp-k+1), kind = core_rknd) @@ -3112,6 +3215,7 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) use ppgrid, only: pver, pcols use constituents, only: cnst_get_ind use camsrfexch, only: cam_in_t + use hb_diff, only: pblintd_ri implicit none @@ -3143,6 +3247,7 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) real(r8) :: kinheat ! kinematic surface heat flux real(r8) :: kinwat ! kinematic surface vapor flux real(r8) :: kbfs ! kinematic surface buoyancy flux + real(r8) :: kbfs_pcol(pcols) integer :: ixq,ixcldliq !PMA fix for thv real(r8) :: rrho ! Inverse air density @@ -3180,7 +3285,15 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) call calc_obklen( th(i), thv(i), cam_in%cflx(i,1), cam_in%shf(i), rrho, ustar(i), & kinheat, kinwat, kbfs, obklen(i) ) enddo - + !!===== add calculation of ribulk here===== + kbfs_pcol=0.0_r8 + do i=1,ncol + call calc_obklen( th(i), thv(i), cam_in%cflx(i,1), cam_in%shf(i), rrho, ustar(i), & + kinheat, kinwat, kbfs, obklen(i) ) + kbfs_pcol(i)=kbfs + enddo + call pblintd_ri(ncol, thv, state%zm, state%u, state%v, & + ustar, obklen, kbfs_pcol, state%ribulk) return #endif diff --git a/components/eam/src/physics/cam/comsrf.F90 b/components/eam/src/physics/cam/comsrf.F90 index 856cc9d23a6..c916ef661e2 100644 --- a/components/eam/src/physics/cam/comsrf.F90 +++ b/components/eam/src/physics/cam/comsrf.F90 @@ -17,7 +17,7 @@ module comsrf ! USES: ! use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 - use ppgrid, only: pcols, begchunk, endchunk + use ppgrid, only: pcols, begchunk, endchunk,nvar_dirOA,nvar_dirOL,indexb use infnan, only: nan, assignment(=) use cam_abortutils, only: endrun @@ -31,6 +31,8 @@ module comsrf ! ! PUBLIC MEMBER FUNCTIONS: ! public initialize_comsrf ! Set the surface temperature and sea-ice fraction + !!added for separate input of ogwd parareters in gw_drag + public initialize_comsrf2 ! ! Public data ! @@ -53,13 +55,17 @@ module comsrf real(r8), allocatable:: prcsnw(:,:) ! cam tot snow precip real(r8), allocatable:: trefmxav(:,:) ! diagnostic: tref max over the day real(r8), allocatable:: trefmnav(:,:) ! diagnostic: tref min over the day - + ! + public var,var30,oc,ol,oadir + real(r8), allocatable:: var(:,:) ! sgh + real(r8), allocatable:: var30(:,:) ! sgh30 + real(r8), allocatable:: oc(:,:) ! Convexity + real(r8), allocatable:: oadir(:,:,:) ! Asymmetry + real(r8), allocatable:: ol(:,:,:) ! Effective length + ! ! Private module data -!=============================================================================== CONTAINS -!=============================================================================== - !====================================================================== ! PUBLIC ROUTINES: Following routines are publically accessable !====================================================================== @@ -134,4 +140,32 @@ subroutine initialize_comsrf end if end subroutine initialize_comsrf + subroutine initialize_comsrf2 + use cam_control_mod, only: ideal_phys, adiabatic +!----------------------------------------------------------------------- +! +! Purpose: +! Initialize surface data +! +! Method: +! +! Author: Mariana Vertenstein +! +!----------------------------------------------------------------------- + integer k,c ! level, constituent indices + + if(.not. (adiabatic .or. ideal_phys)) then + allocate (var(pcols,begchunk:endchunk)) + allocate (var30(pcols,begchunk:endchunk)) + allocate (oc(pcols,begchunk:endchunk)) + allocate (oadir(pcols,nvar_dirOA,begchunk:endchunk)) + allocate (ol(pcols,nvar_dirOL,begchunk:endchunk)) + var(:,:)=nan + var30(:,:)=nan + oc (:,:) = nan + oadir (:,:,:) = nan + ol (:,:,:) = nan + end if + end subroutine initialize_comsrf2 + end module comsrf diff --git a/components/eam/src/physics/cam/gw_common.F90 b/components/eam/src/physics/cam/gw_common.F90 index 86881900e59..989852b00e4 100644 --- a/components/eam/src/physics/cam/gw_common.F90 +++ b/components/eam/src/physics/cam/gw_common.F90 @@ -5,6 +5,8 @@ module gw_common ! parameterizations. ! use gw_utils, only: r8 +use ppgrid, only: nvar_dirOA,nvar_dirOL!pcols,pver,pverp, +use cam_logfile, only: iulog implicit none private @@ -26,6 +28,7 @@ module gw_common public :: kwv public :: gravit public :: rair +public :: gwdo_gsd,pblh_get_level_idx,grid_size ! This flag preserves answers for vanilla CAM by making a few changes (e.g. ! order of operations) when only orographic waves are on. @@ -741,5 +744,1246 @@ subroutine gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, & end if end subroutine gw_drag_prof +!========================================================================== +function pblh_get_level_idx(height_array ,pblheight) +implicit none +real(8),intent(in),dimension(30) :: height_array +real(8),intent(in) :: pblheight +integer :: pblh_get_level_idx + +!local +integer :: i +logical :: found + +pblh_get_level_idx = -1 +found=.False. + +do i = 1, pver + if((pblheight >= height_array(i+1).and.pblheight 300._r8) then + kpbl2 = k + IF (k == kpbl(i)) then + hpbl2 = hpbl(i)+10._r8 + ELSE + hpbl2 = za(i,k)+10._r8 + ENDIF + exit + ENDIF + enddo + + if(xland1(i).gt.0._r8 .and. 2._r8*var(i).le.hpbl(i))then + if(br1(i).gt.0._r8 .and. thvx(i,kpbl2)-thvx(i,kts) > 0._r8)then + cleff = sqrt(dxy(i)**2_r8 + dxyp(i)**2_r8) + cleff = (2.0_r8/sncleff) * max(dxmax_ss,cleff) + coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) + xlinv(i) = coefm(i) / cleff + govrth(i)=g/(0.5_r8*(thvx(i,kpbl2)+thvx(i,kts))) + XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) +! + if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then + tauwavex0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2_r8*ro(i,kvar)*u1(i,kvar) + tauwavex0=tauwavex0*ss_taper ! "Scale-awareness" + else + tauwavex0=0._r8 + endif +! + if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then + tauwavey0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2._r8*ro(i,kvar)*v1(i,kvar) + tauwavey0=tauwavey0*ss_taper ! "Scale-awareness" + else + tauwavey0=0._r8 + endif +! + + do k=kts,kpbl(i) !MIN(kpbl2+1,kte-1) + utendwave(i,k)=-1._r8*tauwavex0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + vtendwave(i,k)=-1._r8*tauwavey0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + enddo + endif + endif + enddo ! end i loop + + do k = kts,kte + do i = its,ite + dudt(i,k) = dudt(i,k) + utendwave(i,k) + dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) + dtaux2d_ss(i,k) = utendwave(i,k) + dtauy2d_ss(i,k) = vtendwave(i,k) + dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) + dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) + enddo + enddo + +ENDIF ! end if gsd_gwd_ss == 1 +!================================================================ +!add Beljaars et al. (2004, QJRMS, equ. 16) form drag: +!================================================================ +IF ( (gsd_gwd_fd .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN + + utendform=0._r8 + vtendform=0._r8 + zq=0._r8 + + IF ( (gsd_gwd_ss .NE. 1).and.(ss_taper.GT.1.E-02) ) THEN + ! Defining layer height. This is already done above is small-scale GWD is used + do k = kts,kte + do i = its,ite + zq(i,k+1) = dz2(i,k)+zq(i,k) + enddo + enddo + + do k = kts,kte + do i = its,ite + za(i,k) = 0.5_r8*(zq(i,k)+zq(i,k+1)) + enddo + enddo + ENDIF + + DO i=its,ite + IF (xland1(i) .gt. 0..and.2._r8*var(i).gt.0) then + a1=0.00026615161_r8*var(i)**2_r8 + a2=a1*0.005363_r8 + DO k=kts,kte + wsp=SQRT(u1(i,k)**2_r8 + v1(i,k)**2_r8) + ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + utendform(i,k)=-0.0759_r8*wsp*u1(i,k)* & + EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper + vtendform(i,k)=-0.0759_r8*wsp*v1(i,k)* & + EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper + ! + ENDDO + ENDIF + ENDDO + ! + do k = kts,kte + do i = its,ite + dudt(i,k) = dudt(i,k) + utendform(i,k) + dvdt(i,k) = dvdt(i,k) + vtendform(i,k) + !limit drag tendency + !some tendency is likely to even overturn the wind, + !making wind reverse in 1 timestep and reverse again in next, + !this limitation may help to make model stable, + !and no more wind reversal due to drag, + !which is suppose to decelerate, not accelerate + utendform(i,k) = sign(min(abs(utendform(i,k)),abs(u1(i,k))/kdt),utendform(i,k)) + vtendform(i,k) = sign(min(abs(vtendform(i,k)),abs(v1(i,k))/kdt),vtendform(i,k)) + dtaux2d_fd(i,k) = utendform(i,k) + dtauy2d_fd(i,k) = vtendform(i,k) + dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) + dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) + enddo + enddo + ENDIF ! end if gsd_gwd_fd == 1 +!======================================================= +! More for the large-scale gwd component +!======================================================= +IF ( (gsd_gwd_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN +! +! now compute vertical structure of the stress. +! + do k = kts,kpblmax + do i = its,ite + if (k .le. kbl(i)) taup(i,k) = taub(i) + enddo + enddo +! +!determination of the interface height +do i=its,ite +iint=.false. + do k=kpblmin,kte-1 + if (k.gt.kbl(i).and.usqj(1,k)-usqj(1,k-1).lt.0.and.(.not.iint)) then + iint=.true. + zl_hint(i)=zl(i,k+1) + endif + enddo +enddo + do k = kpblmin, kte-1 ! vertical level k loop! + kp1 = k + 1 + do i = its,ite +! +! unstablelayer if ri < ric +! unstable layer if upper air vel comp along surf vel <=0 (crit lay) +! at (u-c)=0. crit layer exists and bit vector should be set (.le.) +! + if (k .ge. kbl(i)) then + !we modify the criteria for unstable layer + !that the lv is critical under 0.25 + !while we keep wave breaking ric for + !other larger lv + icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric_rig)& + .or. (velco(i,k) .le. 0.0_r8) + brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared + brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency + endif + enddo +! + do i = its,ite + if (k .ge. kbl(i) .and. (.not. ldrag(i))) then + if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0_r8 ) then + temv = 1.0_r8 / velco(i,k) + tem1 = coefm(i)/(dxy(i)/ncleff)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5_r8 + hd = sqrt(taup(i,k) / tem1) + fro = brvf(i) * hd * temv + + ! + ! rim is the minimum-richardson number by shutts (1985) + ! + tem2 = sqrt(usqj(i,k)) + tem = 1._r8 + tem2 * fro + rim = usqj(i,k) * (1._r8-fro) / (tem * tem) + + ! + ! check stability to employ the 'saturation hypothesis' + ! of lindzen (1981) except at tropospheric downstream regions + ! + if (rim .le. ric) then ! saturation hypothesis! + if ((oa1(i) .le. 0._r8).or.(kp1 .ge. kpblmin )) then + temc = 2.0_r8 + 1.0_r8 / tem2 + hd = velco(i,k) * (2.0_r8*sqrt(temc)-temc) / brvf(i) + taup(i,kp1) = tem1 * hd * hd + ! + ! taup is restricted to monotoncally decrease + ! to avoid unexpected high taup with taup cal + taup(i,kp1)=min(tem1*hd*hd,taup(i,k)) + !add vertical decrease at low level below hint (Kim and Doyle 2005) + !where Ri first decreases + if (k.gt.klowtop(i).and.zl(i,k).le.zl_hint(i)) then + l1=(9.81_r8*bnv2(i,kp1)/velco(i,kp1)**2)!-(shr2_xjb(i,kp1)/velco(i,kp1)) + l2=(9.81_r8*bnv2(i,k)/velco(i,k)**2)!-(shr2_xjb(i,k)/velco(i,k)) + taup(i,kp1)=min(taup(i,k),taup(i,k)*(l1/l2),tem1*hd*hd) + endif + endif + else ! no wavebreaking! + taup(i,kp1) = taup(i,k) + endif + endif + endif + enddo + enddo +! + + + if(lcap.lt.kte) then + do klcap = lcapp1,kte + + do i = its,ite + taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) + enddo + enddo + endif + +ENDIF !END LARGE-SCALE TAU CALCULATION +!=============================================================== +!COMPUTE BLOCKING COMPONENT +!=============================================================== +IF ( (gsd_gwd_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN + + do i = its,ite + if(.not.ldrag(i)) then +! +!------- determine the height of flow-blocking layer +! + kblk = 0 + pe = 0.0_r8 + + do k = kte, kpblmin, -1 + if(kblk.eq.0 .and. k.le.komax(i)) then + !flow block appears within the reference level + !compare potential energy and kinetic energy + !divided by g*ro is to turn del(pa) into height + pe = pe + bnv2(i,k)*(zl(i,komax(i))-zl(i,k))*del(i,k)/g/ro(i,k) + ke = 0.5_r8*((rcs*u1(i,k))**2._r8+(rcs*v1(i,k))**2._r8) +! +!---------- apply flow-blocking drag when pe >= ke +! + if(pe.ge.ke) then + kblk = k + kblk = min(kblk,kbl(i)) + zblk = zl(i,kblk)-zl(i,kts) + endif + endif + enddo + if(kblk.ne.0) then +! +!--------- compute flow-blocking stress +! + + !dxmax_ls is different than the usual one + !because the taper is very different + !dxy is a length scale mostly in the direction of the flow to the ridge + !so it is good and not needed for an uneven grid area + !ref Lott and Miller (1997) original scheme + cd = max(2.0_r8-1.0_r8/od(i),0.0_r8) + ! + !tuning of the drag magnitude + ! + cd=ncd*cd + ! + taufb(i,kts) = 0.5_r8 * roll(i) * coefm(i) / max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) & + * olp(i) * zblk * ulow(i)**2 + !changed grid box area into dy*dy + tautem = taufb(i,kts)/float(kblk-kts) + do k = kts+1, kblk + taufb(i,k) = taufb(i,k-1) - tautem + enddo + + ! + !----------sum orographic GW stress and flow-blocking stress + ! + !taup(i,:) = taup(i,:) + taufb(i,:) ! Keep taup and taufb separate for now + endif + endif + enddo + +ENDIF ! end blocking drag +!=========================================================== +IF ( (gsd_gwd_ls .EQ. 1 .OR. gsd_gwd_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN + +! +! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy +! + do k = kts,kte + do i = its,ite + taud_ls(i,k) = 1._r8 * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) + taud_bl(i,k) = 1._r8 * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) + enddo + enddo +! +! limit de-acceleration (momentum deposition ) at top to 1/2 value +! the idea is some stuff must go out the 'top' +! + + do klcap = lcap,kte + do i = its,ite + taud_ls(i,klcap) = taud_ls(i,klcap) * factop + taud_bl(i,klcap) = taud_bl(i,klcap) * factop + enddo + enddo + +! +! if the gravity wave drag would force a critical line +! in the lower ksmm1 layers during the next deltim timestep, +! then only apply drag until that critical line is reached. +! + do k = kts,kpblmax-1 + do i = its,ite + if (k .le. kbl(i)) then + if((taud_ls(i,k)+taud_bl(i,k)).ne.0._r8) & + dtfac(i) = min(dtfac(i),abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo + enddo +! + + do k = kts,kte + do i = its,ite + taud_ls(i,k) = taud_ls(i,k) * dtfac(i) * ls_taper + !apply limiter for ogwd + !1.dudt < |c-u|/dt, so u-c cannot change sign(u^n+1 = u^n + du/dt * dt) + !2.dudt shr_kind_r8 - use ppgrid, only: pcols, pver + use ppgrid, only: pcols,pver,pverp,nvar_dirOA,nvar_dirOL,indexb,begchunk,endchunk + use hycoef, only: hyai, hybi, hyam, hybm, etamid !get the znu,znw,p_top set to 0 use constituents, only: pcnst use physics_types, only: physics_state, physics_ptend, physics_ptend_init use spmd_utils, only: masterproc @@ -33,7 +34,8 @@ module gw_drag use cam_abortutils, only: endrun use ref_pres, only: do_molec_diff, ntop_molec, nbot_molec - use physconst, only: cpair + use physconst, only: cpair,rh2o,zvir,pi,rearth,r_universal + !zvir is the ep1 in wrf,rearth is the radius of earth(m),r_universal is the gas constant ! These are the actual switches for different gravity wave sources. use phys_control, only: use_gw_oro, use_gw_front, use_gw_convect, use_gw_energy_fix @@ -117,7 +119,8 @@ module gw_drag ! namelist logical :: history_amwg ! output the variables used by the AMWG diag package - + integer :: pblh_idx = 0 + ! !========================================================================== contains !========================================================================== @@ -214,7 +217,13 @@ subroutine gw_init() use gw_oro, only: gw_oro_init use gw_front, only: gw_front_init use gw_convect, only: gw_convect_init - + !! + use comsrf, only:var,var30,oc,oadir,ol,initialize_comsrf2 + use pio, only:file_desc_t + use startup_initialconds,only:topoGWD_file_get_id,setup_initialGWD,close_initial_fileGWD + use ncdio_atm, only:infld + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id,cam_grid_get_dim_names + !! !---------------------------Local storage------------------------------- integer :: l, k @@ -287,7 +296,38 @@ subroutine gw_init() character(len=128) :: errstring !----------------------------------------------------------------------- - + !added for input of ogwd parameters + type(file_desc_t), pointer :: ncid_topoGWD + logical :: found=.false. + character(len=8) :: dim1name, dim2name + character*11 :: subname='gw_init' ! subroutine name + integer :: grid_id + pblh_idx = pbuf_get_index('pblh') + ! + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + !! + call initialize_comsrf2() + call setup_initialGWD() + ncid_topoGWD=>topoGWD_file_get_id() + call infld('SGH' ,ncid_topoGWD,dim1name,dim2name, 1,pcols,begchunk,& + endchunk, var, found, gridname='physgrid') + call infld('SGH30',ncid_topoGWD,dim1name,dim2name, 1,pcols,begchunk,& + endchunk, var30, found, gridname='physgrid') + call infld('OC', ncid_topoGWD,dim1name,dim2name, 1,pcols,begchunk, & + endchunk, oc, found, gridname='physgrid') + !keep the same interval of OA,OL + call infld('OA', ncid_topoGWD,dim1name,'nvar_dirOA',dim2name,1,pcols,1,nvar_dirOA,begchunk, & + endchunk, oadir(:,:,:), found, gridname='physgrid') + call infld('OL', ncid_topoGWD,dim1name,'nvar_dirOL',dim2name,1,pcols,1,nvar_dirOL,begchunk, & + endchunk, ol, found, gridname='physgrid') + if(.not. found) call endrun('ERROR: GWD topo file readerr') + ! + call close_initial_fileGWD() + ! ! Set model flags. do_spectral_waves = (pgwv > 0 .and. (use_gw_front .or. use_gw_convect)) orographic_only = (use_gw_oro .and. .not. do_spectral_waves) @@ -383,6 +423,32 @@ subroutine gw_init() 'Zonal gravity wave surface stress') call addfld ('TAUGWY',horiz_only, 'A','N/m2', & 'Meridional gravity wave surface stress') + !added for orographic drag + call addfld ('DTAUX3_LS',(/'lev'/),'A','m/s2','U tendency - ls orographic drag') + call addfld ('DTAUY3_LS',(/'lev'/),'A','m/s2','V tendency - ls orographic drag') + call addfld ('DTAUX3_BL',(/'lev'/),'A','m/s2','U tendency - bl orographic drag') + call addfld ('DTAUY3_BL',(/'lev'/),'A','m/s2','V tendency - bl orographic drag') + call addfld ('DTAUX3_SS',(/'lev'/),'A','m/s2','U tendency - ss orographic drag') + call addfld ('DTAUY3_SS',(/'lev'/),'A','m/s2','V tendency - ss orographic drag') + call addfld ('DUSFC_LS',horiz_only,'A', 'N/m2', 'ls zonal oro surface stress') + call addfld ('DVSFC_LS',horiz_only,'A', 'N/m2', 'ls merio oro surface stress') + call addfld ('DUSFC_BL',horiz_only,'A', 'N/m2', 'bl zonal oro surface stress') + call addfld ('DVSFC_BL',horiz_only,'A', 'N/m2', 'bl merio oro surface stress') + call addfld ('DUSFC_SS',horiz_only,'A', 'N/m2', 'ss zonal oro surface stress') + call addfld ('DVSFC_SS',horiz_only,'A', 'N/m2', 'ss merio oro surface stress') + call add_default('DTAUX3_LS ', 1,' ') + call add_default('DTAUY3_LS ', 1,' ') + call add_default('DTAUX3_BL ', 1,' ') + call add_default('DTAUY3_BL ', 1,' ') + call add_default('DTAUX3_SS ', 1,' ') + call add_default('DTAUY3_SS ', 1,' ') + call add_default ('DUSFC_LS ', 1,' ') + call add_default ('DVSFC_LS ', 1,' ') + call add_default ('DUSFC_BL ', 1,' ') + call add_default ('DVSFC_BL ', 1,' ') + call add_default ('DUSFC_SS ', 1,' ') + call add_default ('DVSFC_SS ', 1,' ') + !added for orographic drag output if (history_amwg) then call add_default('TAUGWX ', 1, ' ') @@ -589,6 +655,9 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) use gw_front, only: gw_cm_src use gw_convect, only: gw_beres_src use dycore, only: dycore_is + use phys_grid, only: get_rlat_all_p + use gw_common, only: gwdo_gsd,pblh_get_level_idx,grid_size + use physconst, only: gravit,rair !------------------------------Arguments-------------------------------- type(physics_state), intent(in) :: state ! physics state structure ! Standard deviation of orography. @@ -598,6 +667,43 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) ! Parameterization net tendencies. type(physics_ptend), intent(out):: ptend type(cam_in_t), intent(in) :: cam_in + !input par + integer :: kpbl2d_in(pcols) + !simply add par + !for z,dz,from other files + real(r8) :: ztop(pcols,pver) ! top interface height asl (m) + real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) + real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) + real(r8) :: dz(pcols,pver) ! model layer height + + !bulk richardson number from hb_diff + !bulk at the surface + !real(r8),parameter :: rino(pcols,nver) + real(r8) :: rlat(pcols) + !locally added gw and bl drag + real(r8) :: dtaux3_ls(pcols,pver) + real(r8) :: dtauy3_ls(pcols,pver) + real(r8) :: dtaux3_bl(pcols,pver) + real(r8) :: dtauy3_bl(pcols,pver) + ! + real(r8) :: dtaux3_ss(pcols,pver) + real(r8) :: dtauy3_ss(pcols,pver) + ! + real(r8) :: dusfc_ls(pcols) + real(r8) :: dvsfc_ls(pcols) + real(r8) :: dusfc_bl(pcols) + real(r8) :: dvsfc_bl(pcols) + ! + real(r8) :: dusfc_ss(pcols) + real(r8) :: dvsfc_ss(pcols) + real(r8) :: g + + real(r8) :: dtaux3_fd(pcols,pver) + real(r8) :: dtauy3_fd(pcols,pver) + real(r8) :: dusfc_fd(pcols) + real(r8) :: dvsfc_fd(pcols) + real(r8), pointer :: pblh(:) + real(r8) :: dx(pcols),dy(pcols) !---------------------------Local storage------------------------------- @@ -894,10 +1000,102 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) effgw_oro, c, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, taucd, egwdffi, gwut(:,:,0:0), dttdf, dttke) - ! Add the orographic tendencies to the spectrum tendencies - ! Compute the temperature tendency from energy conservation - ! (includes spectrum). + + !--------------------------------------------------------------------- + ! Replaced the basic units with cam's states + !--------------------------------------------------------------------- + !this is for z,dz,dx,dy + !add surface height (surface geopotential/gravity) to convert CAM + !heights based on geopotential above surface into height above sea + !level + !taken from %%module cospsimulator_intr + !CAM is top to surface, which may be opposite in WRF + !fv is same dlat,dlon, so we do it directly + !%%needs to decide which to reverse!!!!!!! + !ztop and zbot are already reversed, start from bottom to top + !dz needs no reverse also + !zmid is different calculation process, + !so it needs reverse if to use + ztop(1:ncol,1:pver)=0._r8 + zbot(1:ncol,1:pver)=0._r8 + zmid(1:ncol,1:pver)=0._r8 + ! + do k=1,pverp-1 + ! assign values from top + ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) + ! assign values from bottom + zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) + end do + !get g + g=gravit + !transform adding the pressure + !transfer from surface to sea level + do k=1,pver + do i=1,ncol + ztop(i,k)=ztop(i,k)+state%phis(i)/g + zbot(i,k)=zbot(i,k)+state%phis(i)/g + zmid(i,k)=state%zm(i,k)+state%phis(i)/g + !dz is from bottom to top already for gw_drag + dz(i,k)=ztop(i,k)-zbot(i,k) + end do + end do + !reverse to keep good format in scheme + ztop=ztop(:,pver:1:-1) + zbot=zbot(:,pver:1:-1) + !get the layer index of pblh in layer + call pbuf_get_field(pbuf, pblh_idx, pblh) + ! + kpbl2d_in=0_r8 + do i=1,pcols + kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/g),pblh(i)) + end do + call get_rlat_all_p(lchnk, ncol, rlat) + !Initialize + utgw=0._r8 + vtgw=0._r8 + ttgw=0._r8 + call grid_size(state,dx,dy) + call gwdo_gsd(& + u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& + qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& + pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& + rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& + dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& + dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& + dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& + dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& + dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& + dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& + xland=cam_in%landfrac,br=state%ribulk(:ncol),& + var2d=state%var(:ncol),& + oc12d=state%oc(:ncol),& + oa2d=state%oadir(:ncol,:),& + ol2d=state%ol(:ncol,:),& + znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& + cp=cpair,g=g,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& + dt=dt,dx=dx,dy=dy,& + kpbl2d=kpbl2d_in,itimestep=dt,gwd_opt=0,& + ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & + ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & + its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & + gwd_ls=1,gwd_bl=1,gwd_ss=1,gwd_fd=0 ) + ! + call outfld ('DTAUX3_LS', dtaux3_ls, pcols, lchnk) + call outfld ('DTAUY3_LS', dtauy3_ls, pcols, lchnk) + call outfld ('DTAUX3_BL', dtaux3_bl, pcols, lchnk) + call outfld ('DTAUY3_BL', dtauy3_bl, pcols, lchnk) + call outfld ('DTAUX3_SS', dtaux3_ss, pcols, lchnk) + call outfld ('DTAUY3_SS', dtauy3_ss, pcols, lchnk) + call outfld ('DUSFC_LS', dusfc_ls, pcols, lchnk) + call outfld ('DVSFC_LS', dvsfc_ls, pcols, lchnk) + call outfld ('DUSFC_BL', dusfc_bl, pcols, lchnk) + call outfld ('DVSFC_BL', dvsfc_bl, pcols, lchnk) + call outfld ('DUSFC_SS', dusfc_ss, pcols, lchnk) + call outfld ('DVSFC_SS', dvsfc_ss, pcols, lchnk) + ! Add the orographic tendencies to the spectrum tendencies + ! Compute the temperature tendency from energy conservation + ! (includes spectrum). if(.not. use_gw_energy_fix) then !original do k = 1, pver @@ -947,8 +1145,11 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) call outfld('UTGWORO', utgw, ncol, lchnk) call outfld('VTGWORO', vtgw, ncol, lchnk) call outfld('TTGWORO', ttgw, ncol, lchnk) - tau0x = tau(:,0,pver) * xv * effgw_oro - tau0y = tau(:,0,pver) * yv * effgw_oro + !set the GWORO as combination of 3 + tau0x=dusfc_ls+dusfc_bl+dusfc_ss + tau0y=dvsfc_ls+dvsfc_bl+dvsfc_ss + !tau0x = tau(:,0,pver) * xv * effgw_oro + !tau0y = tau(:,0,pver) * yv * effgw_oro call outfld('TAUGWX', tau0x, ncol, lchnk) call outfld('TAUGWY', tau0y, ncol, lchnk) call outfld('SGH ', sgh,pcols, lchnk) diff --git a/components/eam/src/physics/cam/hb_diff.F90 b/components/eam/src/physics/cam/hb_diff.F90 index fdebeb1ee93..88f0cd8032a 100644 --- a/components/eam/src/physics/cam/hb_diff.F90 +++ b/components/eam/src/physics/cam/hb_diff.F90 @@ -36,6 +36,8 @@ module hb_diff public init_hb_diff public compute_hb_diff public pblintd + !added for separation calculation of monin-obklen length + public pblintd_ri ! ! PBL limits ! @@ -764,5 +766,121 @@ subroutine austausch_pbl(lchnk ,ncol , & end do return end subroutine austausch_pbl + !=============================================================================== + subroutine pblintd_ri(ncol , & + thv ,z ,u ,v , & + ustar ,obklen ,kbfs ,rino_bulk) + !! + use pbl_utils, only: virtem, calc_ustar, calc_obklen + !! + integer, intent(in) :: ncol ! number of atmospheric columns + + real(r8), intent(in) :: thv(pcols,pver) ! virtual temperature + real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] + real(r8), intent(in) :: u(pcols,pver) ! windspeed x-direction [m/s] + real(r8), intent(in) :: v(pcols,pver) ! windspeed y-direction [m/s] + real(r8), intent(in) :: ustar(pcols) ! surface friction velocity [m/s] + real(r8), intent(in) :: obklen(pcols) ! Obukhov length + real(r8), intent(in) :: kbfs(pcols) ! sfc kinematic buoyancy flux [m^2/s^3] + !! + ! Output arguments + ! + real(r8) :: wstar(pcols) ! convective sclae velocity [m/s] + real(r8) :: pblh(pcols) ! boundary-layer height [m] + real(r8) :: bge(pcols) ! buoyancy gradient enhancment + real(r8), intent(out) :: rino_bulk(pcols) ! bulk Richardson no. surface level + !! + !---------------------------Local parameters---------------------------- + ! + real(r8), parameter :: tiny = 1.e-36_r8 ! lower bound for wind magnitude + real(r8), parameter :: fac = 100._r8 ! ustar parameter in height diagnosis + ! + !---------------------------Local workspace----------------------------- + ! + integer :: i ! longitude index + integer :: k ! level index + real(r8) :: phiminv(pcols) ! inverse phi function for momentum + real(r8) :: phihinv(pcols) ! inverse phi function for heat + real(r8) :: rino(pcols,pver) ! bulk Richardson no. from level to ref lev + real(r8) :: tlv(pcols) ! ref. level pot tmp + tmp excess + real(r8) :: vvk ! velocity magnitude squared + + logical :: unstbl(pcols) ! pts w/unstbl pbl (positive virtual ht flx) + logical :: check(pcols) ! True=>chk if Richardson no.>critcal + !! + do i=1,ncol + check(i) = .true. + rino(i,pver) = 0.0_r8 + rino_bulk(i) = 0.0_r8 + pblh(i) = z(i,pver) + end do + ! + ! + ! PBL height calculation: Scan upward until the Richardson number between + ! the first level and the current level exceeds the "critical" value. + ! + do k=pver-1,pver-npbl+1,-1 + do i=1,ncol + if (check(i)) then + vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 + vvk = max(vvk,tiny) + rino(i,k) = g*(thv(i,k) - thv(i,pver))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + if (rino(i,k) >= ricr) then + pblh(i) = z(i,k+1) + (ricr - rino(i,k+1))/(rino(i,k) - rino(i,k+1)) * & + (z(i,k) - z(i,k+1)) + check(i) = .false. + end if + end if + end do + end do + ! + ! Estimate an effective surface temperature to account for surface fluctuations + ! + do i=1,ncol + if (check(i)) pblh(i) = z(i,pverp-npbl) + unstbl(i) = (kbfs(i) > 0._r8) + check(i) = (kbfs(i) > 0._r8) + if (check(i)) then + phiminv(i) = (1._r8 - binm*pblh(i)/obklen(i))**onet + rino(i,pver) = 0.0_r8 + tlv(i) = thv(i,pver) + kbfs(i)*fak/( ustar(i)*phiminv(i) ) + end if + end do + ! + ! Improve pblh estimate for unstable conditions using the convective temperature excess: + ! + do i = 1,ncol + bge(i) = 1.e-8_r8 + end do + do k=pver-1,pver-npbl+1,-1 + do i=1,ncol + if (check(i)) then + vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 + vvk = max(vvk,tiny) + rino(i,k) = g*(thv(i,k) - tlv(i))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + if (rino(i,k) >= ricr) then + pblh(i) = z(i,k+1) + (ricr - rino(i,k+1))/(rino(i,k) - rino(i,k+1))* & + (z(i,k) - z(i,k+1)) + bge(i) = 2._r8*g/(thv(i,k)+thv(i,k+1))*(thv(i,k)-thv(i,k+1))/(z(i,k)-z(i,k+1))*pblh(i) + if (bge(i).lt.0._r8) then + bge(i) = 1.e-8_r8 + endif + check(i) = .false. + end if + end if + end do + end do + ! + !calculate bulk richardson number in the surface layer + ! + do i=1,ncol + vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 + vvk = max(vvk,tiny) + rino_bulk(i)=g*(thv(i,k) - tlv(i))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + enddo + ! + return + end subroutine pblintd_ri + !=============================================================================== end module hb_diff diff --git a/components/eam/src/physics/cam/physics_types.F90 b/components/eam/src/physics/cam/physics_types.F90 index 2b7d78c1461..652d43644d6 100644 --- a/components/eam/src/physics/cam/physics_types.F90 +++ b/components/eam/src/physics/cam/physics_types.F90 @@ -6,7 +6,7 @@ module physics_types use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, psubcols + use ppgrid, only: pcols, pver, psubcols,nvar_dirOA,nvar_dirOL use constituents, only: pcnst, qmin, cnst_name, icldliq, icldice use geopotential, only: geopotential_t use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv @@ -137,7 +137,20 @@ module physics_types cid ! unique column id integer :: ulatcnt, &! number of unique lats in chunk uloncnt ! number of unique lons in chunk - + real(r8), dimension(:),allocatable :: & + var !standard deviation of high-res grid height + real(r8), dimension(:),allocatable :: & + var30 !standard deviation of high-res grid height below 3km + real(r8), dimension(:),allocatable :: & + oc !convexity of high-res grid height + real(r8), dimension(:,:),allocatable :: & + oadir !orographic asymmetry in a coarse grid + real(r8), dimension(:,:),allocatable :: & + ol !orographic length in a coarse grid + real(r8), dimension(:),allocatable :: & + pblh !get plantet boundary layer height + real(r8), dimension(:),allocatable :: & + ribulk end type physics_state !------------------------------------------------------------------------------- @@ -1830,7 +1843,29 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%cid(psetcols), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%cid') - + allocate(state%var(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%var') + allocate(state%var30(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%var30') + allocate(state%oc(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%oc') + allocate(state%oadir(psetcols,nvar_dirOA), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%oadir') + allocate(state%ol(psetcols,nvar_dirOL), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ol') + allocate(state%pblh(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pblh') + allocate(state%ribulk(psetcols), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ribulk') + !! + state%var(:)=0.0_r8!inf + state%var30(:)=0.0_r8!inf + state%oc(:)=inf + state%oadir(:,:)=inf + state%ol(:,:)=inf + state%pblh(:)=inf + state%ribulk(:)=0.0_r8!inf + !! state%lat(:) = inf state%lon(:) = inf state%ulat(:) = inf diff --git a/components/eam/src/physics/cam/physpkg.F90 b/components/eam/src/physics/cam/physpkg.F90 index 5ece6725279..72703371f3d 100644 --- a/components/eam/src/physics/cam/physpkg.F90 +++ b/components/eam/src/physics/cam/physpkg.F90 @@ -1321,7 +1321,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & use cam_diagnostics,only: diag_deallocate, diag_surf - use comsrf, only: trefmxav, trefmnav, sgh, sgh30, fsds + use comsrf, only: trefmxav, trefmnav, sgh, sgh30, fsds, var, var30,oc,oadir,ol use physconst, only: stebol, latvap #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf2 @@ -1432,7 +1432,13 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & call t_startf('diag_surf') call diag_surf(cam_in(c), cam_out(c), phys_state(c)%ps,trefmxav(1,c), trefmnav(1,c)) call t_stopf('diag_surf') - + ! for tranport of ogwd related parameters + phys_state(c)%var(:)=var(:,c) + phys_state(c)%var30(:)=var30(:,c) + phys_state(c)%oc(:)=oc(:,c) + phys_state(c)%oadir(:,:)=oadir(:,:,c) + phys_state(c)%ol(:,:)=ol(:,:,c) + ! call tphysac(ztodt, cam_in(c), & sgh(1,c), sgh30(1,c), cam_out(c), & phys_state(c), phys_tend(c), phys_buffer_chunk, phys_diag(c), & diff --git a/components/eam/src/physics/cam/ppgrid.F90 b/components/eam/src/physics/cam/ppgrid.F90 index 88c5740a350..8a1779ca3b4 100644 --- a/components/eam/src/physics/cam/ppgrid.F90 +++ b/components/eam/src/physics/cam/ppgrid.F90 @@ -21,7 +21,9 @@ module ppgrid public psubcols public pver public pverp - + public nvar_dirOA + public nvar_dirOL + public indexb ! Grid point resolution parameters @@ -31,6 +33,10 @@ module ppgrid integer psubcols ! number of sub-columns (max) integer pver ! number of vertical levels integer pverp ! pver + 1 + !added for ogwd + integer nvar_dirOA + integer nvar_dirOL + integer indexb #ifdef PPCOLS parameter (pcols = PCOLS) @@ -38,6 +44,10 @@ module ppgrid parameter (psubcols = PSUBCOLS) parameter (pver = PLEV) parameter (pverp = pver + 1 ) + !added for ogwd + parameter (nvar_dirOA =2+1 )!avoid bug when nvar_dirOA is 2 + parameter (nvar_dirOL =180)!set for 360 degrees wind direction + parameter (indexb = 3232)!set for 3km-inputs ! ! start, end indices for chunks owned by a given MPI task ! (set in phys_grid_init). diff --git a/components/eam/src/physics/clubb/advance_windm_edsclrm_module.F90 b/components/eam/src/physics/clubb/advance_windm_edsclrm_module.F90 index 72d2e4d214b..d4f3dc9c8d0 100644 --- a/components/eam/src/physics/clubb/advance_windm_edsclrm_module.F90 +++ b/components/eam/src/physics/clubb/advance_windm_edsclrm_module.F90 @@ -1572,7 +1572,7 @@ subroutine compute_uv_tndcy( solve_type, fcor, perp_wind_m, perp_wind_g, xm_forc else ! implemented in a host model. - xm_tndcy = 0.0_core_rknd + xm_tndcy(1:gr%nz) = xm_forcing(1:gr%nz) endif From c0874b57abe1979fa25f510e9e9908b56d29f525 Mon Sep 17 00:00:00 2001 From: Chloe Date: Mon, 7 Oct 2024 13:48:09 -0700 Subject: [PATCH 195/529] generated new diagnostic QICE fields for non MEC/GLC sims --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 5 +++-- components/elm/src/biogeophys/SoilTemperatureMod.F90 | 4 ++-- components/elm/src/data_types/ColumnDataType.F90 | 4 ++-- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index 35e7643b848..753448aae35 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -123,6 +123,7 @@ subroutine HydrologyDrainage(bounds, & qflx_glcice_frz => col_wf%qflx_glcice_frz , & ! Output: [real(r8) (:) ] ice growth (positive definite) (mm H2O/s) qflx_glcice_diag => col_wf%qflx_glcice_diag , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) - diagnostic, no MECs or GLC qflx_glcice_frz_diag => col_wf%qflx_glcice_frz_diag & ! Output: [real(r8) (:) ] ice growth (positive definite) (mm H2O/s)) - diagnostic, no MECs or GLC + ) ! Determine time step and step size @@ -230,8 +231,8 @@ subroutine HydrologyDrainage(bounds, & end if if (lun_pp%itype(l)==istice) then - qflx_glcice_frz_diags(c) = qflx_snwcp_ice(c) - qflx_glcice_diags(c) = qflx_glcice_diags(c) + qflx_glcice_frz_diags(c) + qflx_glcice_frz_diag(c) = qflx_snwcp_ice(c) + qflx_glcice_diag(c) = qflx_glcice_diag(c) + qflx_glcice_frz_diag(c) endif end do diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index c97e68f85ef..7610265cbb8 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1662,8 +1662,8 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & if ( lun_pp%itype(l)==istice) then if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater ! melting corresponds to a negative ice flux - qflx_glcice_melt_diags(c) = qflx_glcice_melt_diags(c) + h2osoi_liq(c,j)/dtime - qflx_glcice_diags(c) = qflx_glcice_daigs(c) - h2osoi_liq(c,j)/dtime + qflx_glcice_melt_diag(c) = qflx_glcice_melt_diag(c) + h2osoi_liq(c,j)/dtime + qflx_glcice_diag(c) = qflx_glcice_diag(c) - h2osoi_liq(c,j)/dtime endif ! liquid water is present endif ! istice_mec diff --git a/components/elm/src/data_types/ColumnDataType.F90 b/components/elm/src/data_types/ColumnDataType.F90 index d74827060d7..fd1a17d74d6 100644 --- a/components/elm/src/data_types/ColumnDataType.F90 +++ b/components/elm/src/data_types/ColumnDataType.F90 @@ -504,7 +504,7 @@ module ColumnDataType real(r8), pointer :: qflx_glcice_melt (:) => null() ! ice melt (positive definite) (mm H2O/s) real(r8), pointer :: qflx_glcice_diag (:) => null() ! net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC real(r8), pointer :: qflx_glcice_frz_diag (:) => null() ! ice growth (positive definite) (mm H2O/s) - real(r8), pointer :: qflx_glcice_melt_daig(:) => null() ! ice melt (positive definite) (mm H2O/s) + real(r8), pointer :: qflx_glcice_melt_diag(:) => null() ! ice melt (positive definite) (mm H2O/s) real(r8), pointer :: qflx_drain_vr (:,:) => null() ! liquid water lost as drainage (m /time step) real(r8), pointer :: qflx_h2osfc2topsoi (:) => null() ! liquid water coming from surface standing water top soil (mm H2O/s) real(r8), pointer :: qflx_snow2topsoi (:) => null() ! liquid water coming from residual snow to topsoil (mm H2O/s) @@ -5728,7 +5728,7 @@ subroutine col_wf_init(this, begc, endc) allocate(this%qflx_glcice (begc:endc)) ; this%qflx_glcice (:) = spval allocate(this%qflx_glcice_frz (begc:endc)) ; this%qflx_glcice_frz (:) = spval allocate(this%qflx_glcice_melt (begc:endc)) ; this%qflx_glcice_melt (:) = spval - allocate(this%qflx_glcice_diag (begc:endc)) ; this%qflx_glcice_daig (:) = spval + allocate(this%qflx_glcice_diag (begc:endc)) ; this%qflx_glcice_diag (:) = spval allocate(this%qflx_glcice_frz_diag (begc:endc)) ; this%qflx_glcice_frz_diag (:) = spval allocate(this%qflx_glcice_melt_diag (begc:endc)) ; this%qflx_glcice_melt_diag(:) = spval allocate(this%qflx_drain_vr (begc:endc,1:nlevgrnd)) ; this%qflx_drain_vr (:,:) = spval From e2f149db2d28f3695e2589abadeba4236c6d9af7 Mon Sep 17 00:00:00 2001 From: Chloe Date: Mon, 7 Oct 2024 18:00:53 -0700 Subject: [PATCH 196/529] debugging QICE --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 3 +++ components/elm/src/biogeophys/SoilTemperatureMod.F90 | 4 ++++ components/elm/src/main/elm_driver.F90 | 3 +++ 3 files changed, 10 insertions(+) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index 753448aae35..eafd47da99d 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -217,6 +217,7 @@ subroutine HydrologyDrainage(bounds, & do c = bounds%begc,bounds%endc qflx_glcice_frz(c) = 0._r8 + qflx_glcice_frz_diag(c) = 0._r8 end do do fc = 1,num_do_smb_c c = filter_do_smb_c(fc) @@ -233,6 +234,8 @@ subroutine HydrologyDrainage(bounds, & if (lun_pp%itype(l)==istice) then qflx_glcice_frz_diag(c) = qflx_snwcp_ice(c) qflx_glcice_diag(c) = qflx_glcice_diag(c) + qflx_glcice_frz_diag(c) + !write(iulog,*) 'CAW lun_pp%itype(l)==istice',lun_pp%itype(l)==istice + !write(iulog,*) 'qflx_snwcp_ice(c)',qflx_snwcp_ice(c) endif end do diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index 7610265cbb8..034e186e479 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1395,6 +1395,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & qflx_snofrz_lyr(c,-nlevsno+1:0) = 0._r8 qflx_snofrz_col(c) = 0._r8 qflx_glcice_melt(c) = 0._r8 + qflx_glcice_melt_diag(c) = 0._r8 qflx_snow_melt(c) = 0._r8 end do @@ -1664,6 +1665,9 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & ! melting corresponds to a negative ice flux qflx_glcice_melt_diag(c) = qflx_glcice_melt_diag(c) + h2osoi_liq(c,j)/dtime qflx_glcice_diag(c) = qflx_glcice_diag(c) - h2osoi_liq(c,j)/dtime + !write(iulog,*) 'CAW lun_pp%itype(l)==istice',lun_pp%itype(l)==istice + !write(iulog,*) 'CAW j',j + !write(iulog,*) 'CAW h2osoi_liq(c,j) ',h2osoi_liq(c,j) endif ! liquid water is present endif ! istice_mec diff --git a/components/elm/src/main/elm_driver.F90 b/components/elm/src/main/elm_driver.F90 index 51f08bf235c..18ecae88e37 100644 --- a/components/elm/src/main/elm_driver.F90 +++ b/components/elm/src/main/elm_driver.F90 @@ -1604,6 +1604,8 @@ subroutine elm_drv_init(bounds, & qflx_glcice => col_wf%qflx_glcice , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) [+ = ice grows] + qflx_glcice_diag => col_wf%qflx_glcice_diag , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) [+ = ice grows] + eflx_bot => col_ef%eflx_bot , & ! Output: [real(r8) (:) ] heat flux from beneath soil/ice column (W/m**2) cisun_z => photosyns_vars%cisun_z_patch , & ! Output: [real(r8) (:) ] intracellular sunlit leaf CO2 (Pa) @@ -1637,6 +1639,7 @@ subroutine elm_drv_init(bounds, & ! Initialize qflx_glcice everywhere, to zero. qflx_glcice(c) = 0._r8 + qflx_glcice_diag(c) = 0._r8 end do From a4376cce41a3f19a0a60b974bc2df6e43b1e287f Mon Sep 17 00:00:00 2001 From: Chloe Date: Tue, 8 Oct 2024 09:31:37 -0700 Subject: [PATCH 197/529] removed debugging write statements --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 2 -- components/elm/src/biogeophys/SoilTemperatureMod.F90 | 3 --- 2 files changed, 5 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index eafd47da99d..ea31ca6fd30 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -234,8 +234,6 @@ subroutine HydrologyDrainage(bounds, & if (lun_pp%itype(l)==istice) then qflx_glcice_frz_diag(c) = qflx_snwcp_ice(c) qflx_glcice_diag(c) = qflx_glcice_diag(c) + qflx_glcice_frz_diag(c) - !write(iulog,*) 'CAW lun_pp%itype(l)==istice',lun_pp%itype(l)==istice - !write(iulog,*) 'qflx_snwcp_ice(c)',qflx_snwcp_ice(c) endif end do diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index 034e186e479..927c0aac305 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1665,9 +1665,6 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & ! melting corresponds to a negative ice flux qflx_glcice_melt_diag(c) = qflx_glcice_melt_diag(c) + h2osoi_liq(c,j)/dtime qflx_glcice_diag(c) = qflx_glcice_diag(c) - h2osoi_liq(c,j)/dtime - !write(iulog,*) 'CAW lun_pp%itype(l)==istice',lun_pp%itype(l)==istice - !write(iulog,*) 'CAW j',j - !write(iulog,*) 'CAW h2osoi_liq(c,j) ',h2osoi_liq(c,j) endif ! liquid water is present endif ! istice_mec From bcf8e7d0757e42ad9dfa165153b0a36605ee41a0 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 8 Oct 2024 18:26:49 -0500 Subject: [PATCH 198/529] get ice domain for data from SDICE structure --- components/data_comps/dice/src/ice_comp_mct.F90 | 17 ++--------------- 1 file changed, 2 insertions(+), 15 deletions(-) diff --git a/components/data_comps/dice/src/ice_comp_mct.F90 b/components/data_comps/dice/src/ice_comp_mct.F90 index f8c48c89240..3cd5557f1f2 100644 --- a/components/data_comps/dice/src/ice_comp_mct.F90 +++ b/components/data_comps/dice/src/ice_comp_mct.F90 @@ -79,16 +79,6 @@ subroutine ice_init_mct( EClock, cdata, x2i, i2x, NLFilename ) logical :: scmMode = .false. ! single column mode real(R8) :: scmLat = shr_const_SPVAL ! single column lat real(R8) :: scmLon = shr_const_SPVAL ! single column lon -#ifdef HAVE_MOAB - character(CL) :: filePath ! generic file path - character(CL) :: fileName ! generic file name - character(CS) :: timeName ! domain file: time variable name - character(CS) :: lonName ! domain file: lon variable name - character(CS) :: latName ! domain file: lat variable name - character(CS) :: hgtName ! domain file: hgt variable name - character(CS) :: maskName ! domain file: mask variable name - character(CS) :: areaName ! domain file: area variable name -#endif character(*), parameter :: subName = "(ice_init_mct) " !------------------------------------------------------------------------------- @@ -171,12 +161,9 @@ subroutine ice_init_mct( EClock, cdata, x2i, i2x, NLFilename ) #ifdef HAVE_MOAB if (my_task == master_task) then - call shr_stream_getDomainInfo(SDICE%stream(1), filePath,fileName,timeName,lonName, & - latName,hgtName,maskName,areaName) - call shr_stream_getFile(filePath,fileName) ! send path of ice domain to MOAB coupler. - call seq_infodata_PutData( infodata, ice_domain=fileName) - write(logunit,*), ' filename: ', filename + write(logunit,*), ' file used for ice domain ', SDICE%domainFile + call seq_infodata_PutData( infodata, ice_domain=SDICE%domainFile) endif #endif !---------------------------------------------------------------------------- From 3afe043133525835bb693b4e45d49102c0597043 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 9 Oct 2024 19:20:19 +0000 Subject: [PATCH 199/529] add no-vni --- cime_config/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index c5894916e8f..376b2b8adda 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3777,7 +3777,7 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors -np {{ total_tasks }} --label -ppn {{ tasks_per_node }} - --cpu-bind $ENV{RANKS_BIND} -envall + --no-vni --cpu-bind $ENV{RANKS_BIND} -envall -d $ENV{OMP_NUM_THREADS} $ENV{GPU_TILE_COMPACT} From 900845259322ddd87fa5749403720c8b6af74551 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 10 Oct 2024 17:43:38 +0000 Subject: [PATCH 200/529] fixes after merge --- cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake | 1 + cime_config/machines/config_machines.xml | 2 -- components/eamxx/cmake/machine-files/aurora.cmake | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake index 1ee009aa515..d5a9a6494a2 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake @@ -3,6 +3,7 @@ string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_c if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 7b279ae2362..083253a62e6 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3503,7 +3503,6 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh 131072 20 - $ENV{KOKKOS_ROOT} 1 0:4,1:4,2:4,3:4:4:4,5:4,6:4,7:4 @@ -3611,7 +3610,6 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh 131072 20 - $ENV{KOKKOS_ROOT} 1 0:4,1:4,2:4,3:4:4:4,5:4,6:4,7:4 diff --git a/components/eamxx/cmake/machine-files/aurora.cmake b/components/eamxx/cmake/machine-files/aurora.cmake index a8cfb611c25..e6a32fc72c0 100644 --- a/components/eamxx/cmake/machine-files/aurora.cmake +++ b/components/eamxx/cmake/machine-files/aurora.cmake @@ -1,7 +1,6 @@ include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) common_setup() -<<<<<<< HEAD include (${EKAT_MACH_FILES_PATH}/kokkos/intel-pvc.cmake) include (${EKAT_MACH_FILES_PATH}/mpi/other.cmake) set(EKAT_MPIRUN_EXE "mpiexec" CACHE STRING "" FORCE) From 43ef3b0bcd62c6361f9f84d1c599b179fba3cd9f Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 11 Oct 2024 22:45:46 -0500 Subject: [PATCH 201/529] Rename OCN2GLC_*MAPNAME to OCN2GLC_SHELF_*FMAPNAME for new grids Four new gridspecs were introduced recently that were brought in to this branch after a rebase and were missed in the original renaming of OCN2GLC_*MAPNAME to OCN2GLC_SHELF_*FMAPNAME. This commit makes the name change for those grids as well. --- cime_config/config_grids.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index 6240d4e320b..fd9258051f7 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -5724,8 +5724,8 @@ - cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais20km_esmfaave.20240509.nc - cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais20km_esmfbilin.20240509.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais20km_esmfaave.20240509.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais20km_esmfbilin.20240509.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU240wLI-nomask_esmfaave.20240509.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU240wLI-nomask_esmfbilin.20240509.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU240wLI-nomask_esmfaave.20240509.nc @@ -5753,8 +5753,8 @@ - cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais8to30_esmfaave.20240701.nc - cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais8to30_esmfbilin.20240701.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais8to30_esmfaave.20240701.nc + cpl/gridmaps/oQU240wLI/map_oQU240wLI-nomask_to_ais8to30_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_oQU240wLI-nomask_esmfaave.20240701.nc @@ -5764,8 +5764,8 @@ - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais8to30_esmfaave.20240701.nc - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais8to30_esmfbilin.20240701.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais8to30_esmfaave.20240701.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais8to30_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais8to30km/map_ais8to30_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc @@ -5793,8 +5793,8 @@ - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais4to20_esmfaave.20240701.nc - cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais4to20_esmfbilin.20240701.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais4to20_esmfaave.20240701.nc + cpl/gridmaps/IcoswISC30E3r5/map_IcoswISC30E3r5-nomask_to_ais4to20_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfbilin.20240701.nc cpl/gridmaps/mpas.ais4to20km/map_ais4to20_to_IcoswISC30E3r5-nomask_esmfaave.20240701.nc From 9d21c15026d417867ae8e0b33af3749ddec8b3da Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Mon, 14 Oct 2024 12:10:58 -0700 Subject: [PATCH 202/529] Add _RKIND to RK4 weights --- .../mode_forward/mpas_ocn_time_integration_rk4.F | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F index eaae3771e8d..9c4cda353df 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F @@ -349,10 +349,10 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ ! The coefficients of k_j are b_j = (1/6, 1/3, 1/3, 1/6) and are ! initialized here as delta t * b_j: - rk_weights(1) = dt/6. - rk_weights(2) = dt/3. - rk_weights(3) = dt/3. - rk_weights(4) = dt/6. + rk_weights(1) = dt/6.0_RKIND + rk_weights(2) = dt/3.0_RKIND + rk_weights(3) = dt/3.0_RKIND + rk_weights(4) = dt/6.0_RKIND ! The a_j coefficients of h in the computation of k_j are typically written (0, 1/2, 1/2, 1). ! However, in the algorithm below we pre-compute the state for the tendency one iteration early. @@ -361,8 +361,8 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ ! That is why the coefficients of h are one index early in the following, i.e. ! a = (1/2, 1/2, 1) - rk_substep_weights(1) = dt/2. - rk_substep_weights(2) = dt/2. + rk_substep_weights(1) = dt/2.0_RKIND + rk_substep_weights(2) = dt/2.0_RKIND rk_substep_weights(3) = dt rk_substep_weights(4) = dt ! a_4 only used for ALE step, otherwise it is skipped. @@ -370,8 +370,8 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ ! intermediate time-steps as required by RK4 forcingTimeIncrementRK4(1) = 0.0_RKIND - forcingTimeIncrementRK4(2) = dt/2. - forcingTimeIncrementRK4(3) = dt/2. + forcingTimeIncrementRK4(2) = dt/2.0_RKIND + forcingTimeIncrementRK4(3) = dt/2.0_RKIND forcingTimeIncrementRK4(4) = dt call mpas_timer_start("RK4-main loop") From 7773fe47ea001c217728c53da3fa3b43c23b3621 Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Mon, 14 Oct 2024 12:17:49 -0700 Subject: [PATCH 203/529] Remove unneeded decimal timestep code --- .../src/framework/mpas_forcing.F | 37 +------------------ 1 file changed, 1 insertion(+), 36 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_forcing.F b/components/mpas-framework/src/framework/mpas_forcing.F index 67829b5126b..95de2ca6184 100644 --- a/components/mpas-framework/src/framework/mpas_forcing.F +++ b/components/mpas-framework/src/framework/mpas_forcing.F @@ -1255,44 +1255,9 @@ subroutine mpas_advance_forcing_clock(&!{{{ type(MPAS_TimeInterval_type) :: & timeStep ! time step interval - !! assuming it is not possible to give dts of months or years - !integer :: DD, H, M, S, S_n, S_d, foundNumAndDen, powerOfTen - - !real(kind=RKIND) :: factor - - !DD = dt / 86400_RKIND - !H = dt / 3600_RKIND - !M = dt / 60_RKIND - !S = dt - !S_n = 0 - !S_d = 0 - !if (abs(real(S) - dt) > 1.e-10) then !the time step has decimals - ! S = 0 - ! foundNumAndDen = 0 - ! powerOfTen = 1 - ! factor = 10_RKIND - ! S_n = abs(dt) * factor - ! S_d = factor - ! do while (foundNumAndDen == 0 .and. powerOfTen < 11) - ! if (abs(real(S_n)/real(S_d) - abs(dt)) < 1.e-10) then - ! foundNumAndDen = 1 - ! else - ! powerOfTen = powerOfTen + 1 - ! factor = 10_RKIND ** powerOfTen - ! S_n = abs(dt) * factor - ! S_d = factor - ! end if - ! end do - ! if (dt < 0.0_RKIND) then - ! S_n = - S_n - ! end if - !end if - ! increment clock with timestep - ! call mpas_set_timeInterval(timeStep, DD=DD, H=H, M=M, S=S, S_n=S_n, S_d=S_d) call mpas_set_timeInterval(timeStep, dt=dt) - !call mpas_log_write('jl time step $i $i $i', intArgs=(/S, S_n, S_d /)) - !call mpas_log_write('time step $i $i $i', intArgs=(/int(timeStep%ti%basetime%S), int(timeStep%ti%basetime%Sn), int(timeStep%ti%basetime%Sd) /)) + !call mpas_log_write('time step from mpas_set_timeInterval: $i $i $i', intArgs=(/int(timeStep%ti%basetime%S), int(timeStep%ti%basetime%Sn), int(timeStep%ti%basetime%Sd) /)) call mpas_advance_clock(forcingGroup % forcingClock, timeStep) end subroutine mpas_advance_forcing_clock!}}} From c62698d25f902961513638b92d3b0b2fa5482ee4 Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Mon, 14 Oct 2024 12:31:12 -0700 Subject: [PATCH 204/529] Use enum for time integrator choice --- .../src/mode_forward/mpas_ocn_forward_mode.F | 4 ++-- .../mode_forward/mpas_ocn_time_integration.F | 19 ++++++++++--------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F index 7fa5a3e7b15..b7ec0bed057 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_forward_mode.F @@ -669,7 +669,7 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{ ! if not using RK4, calculate time varying forcing terms once per ! time-step as opposed at each RK substage as implemented in RK4 - if (timeIntegratorChoice /= 4) then + if (timeIntegratorChoice /= timeIntRK4) then call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) endif @@ -841,7 +841,7 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{ endif ! read in next time level data required for time-varying forcing - if (timeIntegratorChoice /= 4) then + if (timeIntegratorChoice /= timeIntRK4) then ! if not using RK4, calculate time varying forcing terms once per ! time-step as opposed at each RK substage as implemented in RK4 call ocn_time_varying_forcing_get(domain % streamManager, domain, domain % clock) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F index 46142b6e4d7..89ab1294514 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration.F @@ -51,6 +51,16 @@ module ocn_time_integration ! Enum for selecting different time integrators integer, public :: timeIntegratorChoice + integer, public, parameter :: & + timeIntUnknown = 0, &! unknown or undefined + timeIntSplitExplicit = 1, &! split-explicit + timeIntUnsplitExplicit = 2, &! unsplit-explicit + timeIntSemiImplicit = 3, &! Semi-implicit + timeIntRK4 = 4, &! 4th-order Runge-Kutta + timeIntLTS = 5, &! local time-stepping + timeIntFBLTS = 6, &! forward-backward lts + timeIntSplitExplicitAB2 = 7 ! split-explicit AB2 baroclinic + !-------------------------------------------------------------------- ! ! Public member functions @@ -66,15 +76,6 @@ module ocn_time_integration ! !-------------------------------------------------------------------- - integer, parameter :: & - timeIntUnknown = 0, &! unknown or undefined - timeIntSplitExplicit = 1, &! split-explicit - timeIntUnsplitExplicit = 2, &! unsplit-explicit - timeIntSemiImplicit = 3, &! Semi-implicit - timeIntRK4 = 4, &! 4th-order Runge-Kutta - timeIntLTS = 5, &! local time-stepping - timeIntFBLTS = 6, &! forward-backward lts - timeIntSplitExplicitAB2 = 7 ! split-explicit AB2 baroclinic !*********************************************************************** From 056c884bbf6f8d7ffc67c30a71131fe9704de704 Mon Sep 17 00:00:00 2001 From: Chloe Date: Tue, 15 Oct 2024 10:18:58 -0700 Subject: [PATCH 205/529] move QICE_FRZ diag calc outside of do_smb loop --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index ea31ca6fd30..5512dcc8e51 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -218,6 +218,11 @@ subroutine HydrologyDrainage(bounds, & do c = bounds%begc,bounds%endc qflx_glcice_frz(c) = 0._r8 qflx_glcice_frz_diag(c) = 0._r8 + + if (lun_pp%itype(l)==istice .and. qflx_snwcp_ice(c) > 0.0_r8) then + qflx_glcice_frz_diag(c) = qflx_snwcp_ice(c) + qflx_glcice_diag(c) = qflx_glcice_diag(c) + qflx_glcice_frz_diag(c) + endif end do do fc = 1,num_do_smb_c c = filter_do_smb_c(fc) From f3e864b478fd4181e4113c57aec0f7463bffd806 Mon Sep 17 00:00:00 2001 From: Chloe Date: Tue, 15 Oct 2024 13:15:17 -0700 Subject: [PATCH 206/529] remove old QICE diag field calc from do_smb loop --- components/elm/src/biogeophys/HydrologyDrainageMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index 5512dcc8e51..8356449be1a 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -236,10 +236,10 @@ subroutine HydrologyDrainage(bounds, & if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 end if - if (lun_pp%itype(l)==istice) then - qflx_glcice_frz_diag(c) = qflx_snwcp_ice(c) - qflx_glcice_diag(c) = qflx_glcice_diag(c) + qflx_glcice_frz_diag(c) - endif + !if (lun_pp%itype(l)==istice) then + ! qflx_glcice_frz_diag(c) = qflx_snwcp_ice(c) + ! qflx_glcice_diag(c) = qflx_glcice_diag(c) + qflx_glcice_frz_diag(c) + !endif end do From 1ff064ae3b3e24f0f7a37b2d00588697a9e912a2 Mon Sep 17 00:00:00 2001 From: Hannah Date: Thu, 17 Oct 2024 10:35:11 -0600 Subject: [PATCH 207/529] updated docs from PR review --- .../add-grid-config.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index 271b1ef63fd..98756640800 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -15,17 +15,17 @@ When setting up a new grid you will need to edit some or all of these files: ## Mono-Grid vs Bi-Grid vs Tri-Grid -The mono-bi-tri grid options in E3SM can be confusing, but it's important to understand what these terms mean when adding a new grid to E3SM. At the surface these terms mean that the whole model either using a single grid for all componennt models, or a combination of 2 or 3 grids shared among the component models. Note that mono-grid and bi-grid terms often ignore that the river model needs to be on i/ts own regular lat-lon grid (for now). +The mono-bi-tri grid options in E3SM can be confusing, but it is important to understand what these terms mean when adding a new grid to E3SM. At the surface these terms mean that the whole model is either using a single grid for all componennt models, or a combination of 2 or 3 grids shared among the component models. Note that mono-grid and bi-grid terms often ignore that the river model needs to be on its own regular lat-lon grid. -Historically, climate models would use a single grid for all components (i.e. mono-grid), but this is often not the case anymore. In E3SM the ocean and sea-ice components often use targeted regional refinement with special consideration of ocean mesoscale eddies, whereas the atmosphere will generally use a globally homogenous grid. In practice, the main difference between "bi" and "tri" grids often comes down to whether the land surface model shares a grid with the atmosphere or not. The component coupler is in charge of facilitating communication between component models, primarily through fluxes, and so mapping files are needed to support a combination of different grids. E3SMv3 uses a tri-grid configuration for production simulations. +In practice, "bi" and "tri" grids are most commonly used and the main difference between them comes down to whether the land surface model shares a grid with the atmosphere or not. The component coupler is responsible for facilitating communication between component models, primarily through fluxes, and so mapping files are needed to support a combination of different grids. E3SMv3 uses a tri-grid configuration for production simulations. ## Grid Naming Conventions -The atmosphere grid name should always indicate the "ne" value and add "pg2" to indicate that the physgrid is being used. For a regionally refined mesh (RRM) the grid name should always start with `ne0` followed a descriptive string that includes the region being refined and the degree of refinement. +The atmosphere grid name should always indicate the base "ne" value and whether the physgrid is being used, usually by adding ".pg2" at the end. For a regionally refined mesh (RRM) the grid name should always start with `ne0` followed a descriptive string that includes the region being refined and the degree of refinement. -**Example**: `ne0np4_northamericax4v1` +**Example**: `ne0np4_northamerica_30x4v1.pg2` -Note that the example indicates a `4x` refinement, but does indicate the base resolution, which is useful to know. A better grid name would be `ne0np4_northamerica30x4v1`, because this tells us that the grid is consistent with `ne30` in the unrefined regions. +Note that this example differs from how the North American grid is currently named as `ne0np4_northamericax4v1.pg2`, which indicates a `4x` refinement, but does not indicate the base resolution, which is useful to know. The more informative grid name `ne0np4_northamerica_30x4v1.pg2` makes it clear that unrefined regions are consistent with `ne30pg2`. For a rectilinear lat-lon grid used by the land and/or river models the grid name should start with "r" and typically use spacing less than one degree, so they indicate the nominal grid spacing, starting with "0" and omitting the decimal. From 604b5972fd938b160bf7d45dcd445ce40d85b359 Mon Sep 17 00:00:00 2001 From: Hannah Date: Thu, 17 Oct 2024 12:11:50 -0600 Subject: [PATCH 208/529] misc fixes --- .../add-grid-config.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index 98756640800..44ca480bfe9 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -2,7 +2,7 @@ In addition to generating input data to support a new grid, several code modifications are required before E3SM can run with the grid. However, the specific changes will depend on how the grid will be used. The intendend model configuration for the new grid will change which files need to be modified. For instance, a grid intended for aquaplanet experiments does not require as many changes as a historical AMIP-style run. -The guidelines here are meant to outline various possible changes the user should consider when adding support for a new grid. This document cannot be exhaustive, and it is important that the user understands the changes they are making. It is often useful to use a pre-existing grid configuration as a template. Note that the guidelines here are only relevant for "horizontal" grids. Similar considerations are needed to support a new vertical grid. +The guidelines here are meant to outline various possible changes the user should consider when adding support for a new grid. This document cannot be exhaustive, and it is important that the user understands the changes they are making. It is often useful to use a pre-existing grid configuration as a template. Note that the guidelines here are only relevant for "horizontal" grids. Additional considerations are needed to support a new vertical grid, which is a topic not currently covered here. When setting up a new grid you will need to edit some or all of these files: @@ -47,7 +47,7 @@ Tri-grid options should indicate three different grids used for atmosphere, land ### Adding a New Grid Alias -Grid aliases are defined in specified in `cime_config/config_grids.xml` and are used to specify the grid for a case when calling `create_newcase` via the `--res` argument. Below is an example grid alias for the `ne30pg2_r05_IcoswISC30E3r5` grid used in E3SMv3 production simulations. +Grid aliases are defined in `cime_config/config_grids.xml` and are used to specify the grid for a case when calling `create_newcase` via the `--res` argument. Below is an example grid alias for the `ne30pg2_r05_IcoswISC30E3r5` grid used in E3SMv3 production simulations. ```xml @@ -77,11 +77,11 @@ Domain files are needed for each grid and are specified in the `` secti ``` -Notice where I've used ellipses `...` to omit all entires except the lines relevant to the `ne30pg2_r05_IcoswISC30E3r5` grid. Also, note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. See [Generating Domain Files](/generate_domain_files/) for information about creating domain files. +Notice the ellipses `...` are used here to omit all entries that are not relevant to the `ne30pg2_r05_IcoswISC30E3r5` grid. Also, note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. See [Generating Domain Files](/generate_domain_files/) for information about creating domain files. ### Coupler Mapping Files -The mapping files used by the component coupler to communicate fluxes between the component models must be specified in the `` section of `cime_config/config_grids.xml`. these are organized for specific pairs of grids, such that tri-grids will require multiple sections. The entries relevant for `ne30pg2_r05_IcoswISC30E3r5` are shown below. +The mapping files used by the component coupler to communicate fluxes between the component models must be specified in the `` section of `cime_config/config_grids.xml`. These are organized for specific pairs of grids, such that tri-grids will require multiple sections. The entries relevant for `ne30pg2_r05_IcoswISC30E3r5` are shown below. ```xml @@ -119,7 +119,7 @@ Note that all of these paths are relative to the input data path set as `DIN_LOC When defining a new atmosphere grid, information needs to be provided on how the grid is constructed. -To define a new atmosphere grid a line must be added to `components/eam/bld/config_files/horiz_grid.xml` that indicates the numebr of elements and physics columns. In the lines below for `ne30np4` (without the physgrid) and `ne30pg2` (with the physgrid) you can see the value of `ne` is the same (number of elements along a cube edge), but the number of physics columns is different. +To define a new atmosphere grid a line must be added to `components/eam/bld/config_files/horiz_grid.xml` that indicates the number of elements and physics columns. In the lines below for `ne30np4` (without the physgrid) and `ne30pg2` (with the physgrid) you can see the value of `ne` is the same (number of elements along a cube edge), but the number of physics columns is different. ```xml From 35b72a92a54b9a4c90a0b2b6f363048432af3b40 Mon Sep 17 00:00:00 2001 From: Hannah Date: Thu, 17 Oct 2024 12:34:08 -0600 Subject: [PATCH 209/529] update for PR review --- .../add-grid-config.md | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index 44ca480bfe9..dcbf03131cb 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -31,7 +31,7 @@ For a rectilinear lat-lon grid used by the land and/or river models the grid nam **Examples**: `r05` is 0.5 degree spacing and `r0125` is 1/8 or 0.125 degree spacing. -For a mono-grid, which can only be used for idealized simulations such as aqua planet and RCE, the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. +For a mono-grid the convention is that the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. A mono-grid is typically only used for idealized simulations such as aqua planet and RCE, but can also be used for F-compsets if the CICE sea-ice model is used in place of the MPAS sea-ice model (MPASSI). **Example**: `ne30pg2_ne30pg2` @@ -43,6 +43,19 @@ Tri-grid options should indicate three different grids used for atmosphere, land **Example**: `ne30pg2_r05_IcoswISC30E3r5` + +Note that the conventions discussed above refer to the "grid alias", but for any combination of grids the full grid definition has a long form representation that spells out the grid in more detail. + +**Example**: +``` + alias: ne4pg2_ne4pg2 + + longname: a%ne4np4.pg2_l%ne4np4.pg2_oi%ne4np4.pg2_r%r05_g%null_w%null_z%null_m%oQU240 + non-default grids are: atm:ne4np4.pg2 lnd:ne4np4.pg2 ocnice:ne4np4.pg2 rof:r05 glc:null wav:null + mask is: oQU240 +``` + + ## Grid Definition ### Adding a New Grid Alias From 1cc829f1eb9978909beb403edd33c6d1109b1eb5 Mon Sep 17 00:00:00 2001 From: Hannah Date: Thu, 17 Oct 2024 12:38:36 -0600 Subject: [PATCH 210/529] linter fixes --- .../add-grid-config.md | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index dcbf03131cb..7d61c153ed5 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -31,7 +31,7 @@ For a rectilinear lat-lon grid used by the land and/or river models the grid nam **Examples**: `r05` is 0.5 degree spacing and `r0125` is 1/8 or 0.125 degree spacing. -For a mono-grid the convention is that the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. A mono-grid is typically only used for idealized simulations such as aqua planet and RCE, but can also be used for F-compsets if the CICE sea-ice model is used in place of the MPAS sea-ice model (MPASSI). +For a mono-grid the convention is that the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. A mono-grid is typically only used for idealized simulations such as aqua planet and RCE, but can also be used for F-compsets if the CICE sea-ice model is used in place of the MPAS sea-ice model (MPASSI). **Example**: `ne30pg2_ne30pg2` @@ -43,11 +43,11 @@ Tri-grid options should indicate three different grids used for atmosphere, land **Example**: `ne30pg2_r05_IcoswISC30E3r5` - Note that the conventions discussed above refer to the "grid alias", but for any combination of grids the full grid definition has a long form representation that spells out the grid in more detail. **Example**: -``` + +```shell alias: ne4pg2_ne4pg2 longname: a%ne4np4.pg2_l%ne4np4.pg2_oi%ne4np4.pg2_r%r05_g%null_w%null_z%null_m%oQU240 @@ -55,7 +55,6 @@ Note that the conventions discussed above refer to the "grid alias", but for any mask is: oQU240 ``` - ## Grid Definition ### Adding a New Grid Alias From 1b569131f7f487bf49f84fb3517b93b4624aa744 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 18 Oct 2024 13:51:29 -0500 Subject: [PATCH 211/529] v3.NARRM PE-layouts on Chrysalis - Tiny: 10 nodes, ~1 sypd - XSmall: 20 nodes, ~2 sypd --- cime_config/allactive/config_pesall.xml | 34 +++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index 3392ad71ca1..b5b802bc136 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -2164,6 +2164,40 @@ + + + + allactive+chrysalis: v3.NARRM tri-grid on 10 nodes ~1 sypd + + 576 + 576 + 576 + 576 + 576 + 64 + + + 576 + + + + allactive+chrysalis: v3.NARRM tri-grid on 20 nodes ~2 sypd + + 1152 + 1152 + 768 + 768 + 384 + 128 + + + 1152 + 384 + 384 + + + + From da0ce9d0e23d513877167afd8646bda0268ad797 Mon Sep 17 00:00:00 2001 From: Chloe Date: Sat, 19 Oct 2024 10:44:53 -0700 Subject: [PATCH 212/529] seg fault bug fix when snow mass is very low --- components/elm/src/biogeophys/SnowHydrologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/elm/src/biogeophys/SnowHydrologyMod.F90 b/components/elm/src/biogeophys/SnowHydrologyMod.F90 index f9270289d05..49503da8ad8 100644 --- a/components/elm/src/biogeophys/SnowHydrologyMod.F90 +++ b/components/elm/src/biogeophys/SnowHydrologyMod.F90 @@ -670,7 +670,7 @@ subroutine SnowCompaction(bounds, num_snowc, filter_snowc, & if (bi > dm) ddz1 = ddz1*exp(-46.0e-3_r8*(bi-dm)) else ddz1_fresh = (-grav * (burden(c) + wx/2._r8)) / & - (0.007_r8 * bi**(4.75_r8 + td/40._r8)) + (0.007_r8 * min(max(bi,dm),denice)**(4.75_r8 + min(td,0._r8)/40._r8)) snw_ssa = 3.e6_r8 / (denice * snw_rds(c,j)) if (snw_ssa < 50._r8) then ddz1_fresh = ddz1_fresh * exp(-46.e-2_r8 * (50._r8 - snw_ssa)) From 9ec257c5c55e330970602df65a579e5c5b76b99c Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Mon, 21 Oct 2024 22:09:00 -0500 Subject: [PATCH 213/529] v3.NARRM PE-layouts on Chrysalis - Small: 30 nodes, ~3 sypd - SMedium: 40 nodes, ~4 sypd - Medium: 50 nodes, ~5 sypd --- cime_config/allactive/config_pesall.xml | 47 +++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index b5b802bc136..c21b2d0932e 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -2196,6 +2196,53 @@ 384 + + allactive+chrysalis: v3.NARRM tri-grid on 30 nodes ~3 sypd + + 1792 + 1792 + 1280 + 1280 + 512 + 128 + + + 1792 + 512 + 512 + + + + allactive+chrysalis: v3.NARRM tri-grid on 40 nodes ~4 sypd + + 2368 + 2368 + 1408 + 1408 + 960 + 192 + + + 2368 + 1408 + + + + allactive+chrysalis: v3.NARRM tri-grid on 50 nodes ~5 sypd + + 3008 + 3008 + 1856 + 1856 + 1152 + 192 + + + 3008 + 1152 + 1152 + + From 066ba19a51b288e8a64b370b29395ac52aaa8fc5 Mon Sep 17 00:00:00 2001 From: xie7 Date: Tue, 22 Oct 2024 00:04:25 -0700 Subject: [PATCH 214/529] Add namelist control 1. The new orographic drag schemes are added with namelist variables to turn on/off the schemes in E3SM. 2. The correspondent model files are modified in the namelist defaults. 3. Some bugs are modified. See #PR 6667 for more info. modified: components/eam/bld/build-namelist modified: components/eam/bld/namelist_files/namelist_defaults_eam.xml modified: components/eam/bld/namelist_files/namelist_definition.xml modified: components/eam/src/physics/cam/clubb_intr.F90 modified: components/eam/src/physics/cam/comsrf.F90 modified: components/eam/src/physics/cam/gw_common.F90 modified: components/eam/src/physics/cam/gw_drag.F90 modified: components/eam/src/physics/cam/hb_diff.F90 modified: components/eam/src/physics/cam/phys_control.F90 modified: components/eam/src/physics/cam/physpkg.F90 modified: components/eam/src/physics/cam/ppgrid.F90 [Non-BFB] --- components/eam/bld/build-namelist | 11 + .../namelist_files/namelist_defaults_eam.xml | 8 +- .../namelist_files/namelist_definition.xml | 42 +++ components/eam/src/physics/cam/clubb_intr.F90 | 170 ++++++----- components/eam/src/physics/cam/comsrf.F90 | 2 +- components/eam/src/physics/cam/gw_common.F90 | 272 +++++++++++++----- components/eam/src/physics/cam/gw_drag.F90 | 235 ++++++--------- components/eam/src/physics/cam/hb_diff.F90 | 23 +- .../eam/src/physics/cam/phys_control.F90 | 23 +- components/eam/src/physics/cam/physpkg.F90 | 4 +- components/eam/src/physics/cam/ppgrid.F90 | 3 - 11 files changed, 478 insertions(+), 315 deletions(-) diff --git a/components/eam/bld/build-namelist b/components/eam/bld/build-namelist index 8dc532b6a3d..45179324f77 100755 --- a/components/eam/bld/build-namelist +++ b/components/eam/bld/build-namelist @@ -4089,13 +4089,24 @@ if ($waccm_phys or $cfg->get('nlev') >= 60) { add_default($nl, 'use_gw_oro' , 'val'=>'.true.'); add_default($nl, 'use_gw_front' , 'val'=>'.true.'); add_default($nl, 'use_gw_convect', 'val'=>'.true.'); + add_default($nl, 'use_od_ls', 'val'=>'.false.'); + add_default($nl, 'use_od_bl', 'val'=>'.false.'); + add_default($nl, 'use_od_ss', 'val'=>'.false.'); + add_default($nl, 'use_od_fd', 'val'=>'.false.'); } else { add_default($nl, 'use_gw_oro' , 'val'=>'.true.'); add_default($nl, 'use_gw_front' , 'val'=>'.false.'); add_default($nl, 'use_gw_convect', 'val'=>'.false.'); + add_default($nl, 'use_od_ls', 'val'=>'.false.'); + add_default($nl, 'use_od_bl', 'val'=>'.false.'); + add_default($nl, 'use_od_ss', 'val'=>'.false.'); + add_default($nl, 'use_od_fd', 'val'=>'.false.'); } add_default($nl, 'pgwv', 'val'=>'32'); add_default($nl, 'gw_dc','val'=>'2.5D0'); +add_default($nl, 'ncleff_ls', 'val'=>'3.D0'); +add_default($nl, 'ncd_bl', 'val'=>'3.D0'); +add_default($nl, 'sncleff_ss','val'=>'1.D0'); if ($nl->get_value('use_gw_oro') =~ /$TRUE/io) { add_default($nl, 'effgw_oro'); diff --git a/components/eam/bld/namelist_files/namelist_defaults_eam.xml b/components/eam/bld/namelist_files/namelist_defaults_eam.xml index 1f357767f8b..4ad34edf4ea 100755 --- a/components/eam/bld/namelist_files/namelist_defaults_eam.xml +++ b/components/eam/bld/namelist_files/namelist_defaults_eam.xml @@ -126,9 +126,8 @@ atm/cam/topo/USGS-gtopo30_64x128_c050520.nc - -atm/cam/topo/USGS-gtopo30_ne4np4_16x.c20160612.nc -atm/cam/topo/USGS-gtopo30_ne4np4pg2_16x_converted.c20200527.nc +atm/cam/topo/USGS-gtopo30_ne4np4_16x_forOroDrag.c20241019.nc +atm/cam/topo/USGS-gtopo30_ne4np4pg2_16x_converted_forOroDrag.c20241019.nc atm/cam/topo/USGS-gtopo30_ne11np4_16xconsistentSGH.c20160612.nc atm/cam/topo/USGS-gtopo30_ne16np4_16xconsistentSGH.c20160612.nc atm/cam/topo/USGS-gtopo30_ne16np4pg2_16xdel2_20200527.nc @@ -1884,6 +1883,9 @@ with se_tstep, dt_remap_factor, dt_tracer_factor set to -1 1.0 0.375 .true. + 3 + 3 + 1 2.5D0 268.15D0 13.8D0 diff --git a/components/eam/bld/namelist_files/namelist_definition.xml b/components/eam/bld/namelist_files/namelist_definition.xml index 8228c7d8d2e..b3dc78cb9ed 100644 --- a/components/eam/bld/namelist_files/namelist_definition.xml +++ b/components/eam/bld/namelist_files/namelist_definition.xml @@ -1078,6 +1078,48 @@ Whether or not to enable GWD brute-force energy fix. Default: set by build-namelist. + +Whether or not to enable nonlinear orographic gravity wave drag (oGWD). +Default: set by build-namelist. + + + +Whether or not to enable flow-blocking drag (FBD). +Default: set by build-namelist. + + + +Whether or not to enable small-scale orographic GWD drag (sGWD). +Default: set by build-namelist. + + + +Whether or not to enable turbulent orographic form drag (TOFD). +Default: set by build-namelist. + + + +Tuning parameter of orographic GWD (oGWD). See use_od_ls. +Default: set by build-namelist. + + + +Tuning parameter of flow-blocking drag (FBD). See use_od_bl. +Default: set by build-namelist. + + + +Tuning parameter of small-scale GWD (sGWD). See use_od_ss. +Default: set by build-namelist. + + Gravity wave spectrum dimension (wave numbers are from -pgwv to pgwv). diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index 9118c9bb39a..306ee7ca732 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -20,7 +20,7 @@ module clubb_intr use shr_kind_mod, only: r8=>shr_kind_r8 use shr_log_mod , only: errMsg => shr_log_errMsg use ppgrid, only: pver, pverp - use phys_control, only: phys_getopts + use phys_control, only: phys_getopts,use_od_ss,use_od_fd,ncleff_ls,ncd_bl,sncleff_ss use physconst, only: rair, cpair, gravit, latvap, latice, zvir, rh2o, karman, & tms_orocnst, tms_z0fac, pi use cam_logfile, only: iulog @@ -927,7 +927,6 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) call addfld ('VMAGDP', horiz_only, 'A', '-', 'ZM gustiness enhancement') call addfld ('VMAGCL', horiz_only, 'A', '-', 'CLUBB gustiness enhancement') call addfld ('TPERTBLT', horiz_only, 'A', 'K', 'perturbation temperature at PBL top') - !================================== !!added for TOFD output call addfld ('DTAUX3_FD',(/'lev'/),'A','m/s2','U tendency - fd orographic drag') call addfld ('DTAUY3_FD',(/'lev'/),'A','m/s2','V tendency - fd orographic drag') @@ -937,8 +936,6 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) call add_default('DTAUY3_FD', 1, ' ') call add_default('DUSFC_FD', 1, ' ') call add_default('DVSFC_FD', 1, ' ') - !!added for TOFD output - !===================================== ! Initialize statistics, below are dummy variables dum1 = 300._r8 dum2 = 1200._r8 @@ -1166,11 +1163,10 @@ subroutine clubb_tend_cam( & use model_flags, only: ipdf_call_placement use advance_clubb_core_module, only: ipdf_post_advance_fields #endif - use gw_common, only: gwdo_gsd,grid_size,pblh_get_level_idx + use gw_common, only: grid_size,gw_oro_interface use hycoef, only: etamid use physconst, only: rh2o,pi,rearth,r_universal !!get the znu,znw,p_top set to 0 - use phys_grid, only: get_rlat_all_p implicit none ! --------------- ! @@ -1533,25 +1529,30 @@ subroutine clubb_tend_cam( & real(r8) :: sfc_v_diff_tau(pcols) ! Response to tau perturbation, m/s real(r8), parameter :: pert_tau = 0.1_r8 ! tau perturbation, Pa - !=========================== - !simply add par - !for z,dz,from other files - real(r8) :: ztop(pcols,pver) ! top interface height asl(m) - real(r8) :: zbot(pcols,pver) ! bottom interface height asl(m) - real(r8) :: zmid(pcols,pver) ! middle interface height asl(m) - real(r8) :: dz(pcols,pver) - real(r8) :: rlat(pcols) ! latitude in radians for columns - integer :: kpbl2d_in(pcols) - real(r8) :: ttgw(pcols,pver) ! temperature tendency - real(r8) :: utgw(pcols,pver) ! zonal wind tendency - real(r8) :: vtgw(pcols,pver) ! meridional wind tendency + !add par for tofd real(r8) :: dtaux3_fd(pcols,pver) real(r8) :: dtauy3_fd(pcols,pver) real(r8) :: dusfc_fd(pcols) real(r8) :: dvsfc_fd(pcols) - real(r8) :: dx(pcols),dy(pcols) - !============================== - + logical :: gwd_ls,gwd_bl,gwd_ss,gwd_fd + real(r8) :: dummy_nm(pcols,pver) + real(r8) :: dummy_utgw(pcols,pver) + real(r8) :: dummy_vtgw(pcols,pver) + real(r8) :: dummy_ttgw(pcols,pver) + ! + real(r8) :: dummx_ls(pcols,pver) + real(r8) :: dummx_bl(pcols,pver) + real(r8) :: dummx_ss(pcols,pver) + real(r8) :: dummy_ls(pcols,pver) + real(r8) :: dummy_bl(pcols,pver) + real(r8) :: dummy_ss(pcols,pver) + real(r8) :: dummx3_ls(pcols,pver) + real(r8) :: dummx3_bl(pcols,pver) + real(r8) :: dummx3_ss(pcols,pver) + real(r8) :: dummy3_ls(pcols,pver) + real(r8) :: dummy3_bl(pcols,pver) + real(r8) :: dummy3_ss(pcols,pver) + ! real(r8) :: inv_exner_clubb_surf @@ -1978,73 +1979,36 @@ subroutine clubb_tend_cam( & tautmsx, tautmsy, cam_in%landfrac ) call t_stopf('compute_tms') endif - ztop= 0.0_r8 ! top interface height asl(m) - zbot= 0.0_r8 ! bottom interface height asl(m) - zmid= 0.0_r8 ! middle interface height asl(m) - dz= 0.0_r8 - kpbl2d_in = -1 - dtaux3_fd= 0.0_r8 - dtauy3_fd= 0.0_r8 - dusfc_fd= 0.0_r8 - dvsfc_fd= 0.0_r8 - !similar as in gw_drag - do k=1,pverp-1 - ! assign values from top - ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) - ! assign values from bottom - zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) - end do - !transform adding the pressure - !transfer from surface to sea level - do k=1,pver - do i=1,ncol - ztop(i,k)=ztop(i,k)+state%phis(i)/gravit - zbot(i,k)=zbot(i,k)+state%phis(i)/gravit - zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit - !dz is from bottom to top already for gw_drag - dz(i,k)=ztop(i,k)-zbot(i,k) - end do - end do - !get the layer index of pblh in layer - kpbl2d_in=0._r8 - do i=1,pcols - kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/gravit),pblh(i)) - end do - !rlat - call get_rlat_all_p(lchnk, ncol, rlat) - !========================================= - utgw=0._r8 - vtgw=0._r8 - ttgw=0._r8 - dusfc_fd=0._r8 - dvsfc_fd=0._r8 ! - call grid_size(state,dx,dy) - call gwdo_gsd(& - u3d=state%u(:,pver:1:-1),v3d=state%v(:,pver:1:-1),& - t3d=state%t(:,pver:1:-1),qv3d=state%q(:,pver:1:-1,1),& - p3d=state%pmid(:,pver:1:-1),p3di=state%pint(:,pver+1:1:-1),& - pi3d=state%exner(:,pver:1:-1),z=zbot,& - rublten=utgw(:,pver:1:-1),rvblten=vtgw(:,pver:1:-1),& - rthblten=ttgw(:,pver:1:-1),& - dtaux3d_fd=dtaux3_fd(:,pver:1:-1),dtauy3d_fd=dtauy3_fd(:,pver:1:-1),& - dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& - xland=cam_in%landfrac,br=state%ribulk,& - var2d=sgh30(:ncol),& - znu=etamid(pver:1:-1),dz=dz,pblh=pblh,& - cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,& - dx=dx,dy=dy,& - kpbl2d=kpbl2d_in,itimestep=hdtime,gwd_opt=0,& - ids=1,ide=pcols,jds=0,jde=0,kds=1,kde=pver, & - ims=1,ime=pcols,jms=0,jme=0,kms=1,kme=pver, & - its=1,ite=pcols,jts=0,jte=0,kts=1,kte=pver,& - gwd_ls=0,gwd_bl=0,gwd_ss=0,gwd_fd=1) - !! - call outfld ('DTAUX3_FD', dtaux3_fd, pcols, lchnk) + if (use_od_fd) then + gwd_ls=.false. + gwd_bl=.false. + gwd_ss=.false. + gwd_fd=use_od_fd + dummy_nm=0.0_r8 + dummy_utgw=0.0_r8 + dummy_vtgw=0.0_r8 + dummy_ttgw=0.0_r8 + !sgh30 as the input for TOFD instead of sgh + call gw_oro_interface(state,cam_in,sgh30,pbuf,hdtime,dummy_nm,& + gwd_ls,gwd_bl,gwd_ss,gwd_fd,& + ncleff_ls,ncd_bl,sncleff_ss,& + dummy_utgw,dummy_vtgw,dummy_ttgw,& + dtaux3_ls=dummx3_ls,dtauy3_ls=dummy3_ls,& + dtaux3_bl=dummx3_bl,dtauy3_bl=dummy3_bl,& + dtaux3_ss=dummx3_ss,dtauy3_ss=dummy3_ss,& + dtaux3_fd=dtaux3_fd,dtauy3_fd=dtauy3_fd,& + dusfc_ls=dummx_ls,dvsfc_ls=dummy_ls,& + dusfc_bl=dummx_bl,dvsfc_bl=dummy_bl,& + dusfc_ss=dummx_ss,dvsfc_ss=dummy_ss,& + dusfc_fd=dusfc_fd,dvsfc_fd=dvsfc_fd) + ! + call outfld ('DTAUX3_FD', dtaux3_fd, pcols, lchnk) call outfld ('DTAUY3_FD', dtauy3_fd, pcols, lchnk) call outfld ('DUSFC_FD', dusfc_fd, pcols, lchnk) call outfld ('DVSFC_FD', dvsfc_fd, pcols, lchnk) - !! + endif + ! if (micro_do_icesupersat) then call physics_ptend_init(ptend_loc,state%psetcols, 'clubb_ice3', ls=.true., lu=.true., lv=.true., lq=lq) endif @@ -2169,8 +2133,10 @@ subroutine clubb_tend_cam( & !Apply TOFD !----------------------------------------------------! !tendency is flipped already + if (use_od_fd) then um_forcing(2:pverp)=dtaux3_fd(i,pver:1:-1) vm_forcing(2:pverp)=dtauy3_fd(i,pver:1:-1) + endif ! Need to flip arrays around for CLUBB core do k=1,pverp um_in(k) = real(um(i,pverp-k+1), kind = core_rknd) @@ -3211,11 +3177,12 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) !------------------------------------------------------------------------------- use physics_types, only: physics_state - use physconst, only: zvir + use physconst, only: zvir,gravit use ppgrid, only: pver, pcols use constituents, only: cnst_get_ind use camsrfexch, only: cam_in_t - use hb_diff, only: pblintd_ri + use hb_diff, only: pblintd_ri + implicit none @@ -3240,10 +3207,13 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) ! --------------- ! integer :: i ! indicees + integer :: k integer :: ncol ! # of atmospheric columns real(r8) :: th(pcols) ! surface potential temperature real(r8) :: thv(pcols) ! surface virtual potential temperature + real(r8) :: th_lv(pcols,pver) ! level potential temperature + real(r8) :: thv_lv(pcols,pver) ! level virtual potential temperature real(r8) :: kinheat ! kinematic surface heat flux real(r8) :: kinwat ! kinematic surface vapor flux real(r8) :: kbfs ! kinematic surface buoyancy flux @@ -3278,22 +3248,44 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) thv(i) = th(i)*(1._r8+zvir*state%q(i,pver,ixq)) ! diagnose virtual potential temperature end if enddo - + ! do i = 1, ncol call calc_ustar( state%t(i,pver), state%pmid(i,pver), cam_in%wsx(i), cam_in%wsy(i), & rrho, ustar(i) ) call calc_obklen( th(i), thv(i), cam_in%cflx(i,1), cam_in%shf(i), rrho, ustar(i), & kinheat, kinwat, kbfs, obklen(i) ) enddo - !!===== add calculation of ribulk here===== + ! + if (use_od_ss) then + !add calculation of bulk richardson number here + ! + !compute the whole level th and thv for diagnose of bulk richardson number + thv_lv=0.0_r8 + th_lv=0.0_r8 + ! + do i=1,ncol + do k=1,pver + th_lv(i,k) = state%t(i,k)*state%exner(i,k) + if (use_sgv) then + thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq) & + - state%q(i,k,ixcldliq)) !PMA corrects thv formula + else + thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq)) + end if + enddo + enddo + ! kbfs_pcol=0.0_r8 do i=1,ncol call calc_obklen( th(i), thv(i), cam_in%cflx(i,1), cam_in%shf(i), rrho, ustar(i), & kinheat, kinwat, kbfs, obklen(i) ) kbfs_pcol(i)=kbfs enddo - call pblintd_ri(ncol, thv, state%zm, state%u, state%v, & + ! + call pblintd_ri(ncol, gravit, thv_lv, state%zm, state%u, state%v, & ustar, obklen, kbfs_pcol, state%ribulk) + endif + ! return #endif diff --git a/components/eam/src/physics/cam/comsrf.F90 b/components/eam/src/physics/cam/comsrf.F90 index c916ef661e2..9d38e117d8d 100644 --- a/components/eam/src/physics/cam/comsrf.F90 +++ b/components/eam/src/physics/cam/comsrf.F90 @@ -17,7 +17,7 @@ module comsrf ! USES: ! use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 - use ppgrid, only: pcols, begchunk, endchunk,nvar_dirOA,nvar_dirOL,indexb + use ppgrid, only: pcols, begchunk, endchunk,nvar_dirOA,nvar_dirOL use infnan, only: nan, assignment(=) use cam_abortutils, only: endrun diff --git a/components/eam/src/physics/cam/gw_common.F90 b/components/eam/src/physics/cam/gw_common.F90 index 989852b00e4..36a1691f757 100644 --- a/components/eam/src/physics/cam/gw_common.F90 +++ b/components/eam/src/physics/cam/gw_common.F90 @@ -17,6 +17,7 @@ module gw_common public :: gw_prof public :: momentum_energy_conservation public :: gw_drag_prof +public :: gw_oro_interface public :: pver, pgwv public :: dc @@ -745,9 +746,163 @@ subroutine gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, & end subroutine gw_drag_prof !========================================================================== -function pblh_get_level_idx(height_array ,pblheight) +subroutine gw_oro_interface(state, cam_in, sgh, pbuf, dtime, nm,& + gwd_ls, gwd_bl, gwd_ss, gwd_fd,& + ncleff_ls,ncd_bl, sncleff_ss,& + utgw, vtgw, ttgw,& + dtaux3_ls,dtauy3_ls,dtaux3_bl,dtauy3_bl,& + dtaux3_ss,dtauy3_ss,dtaux3_fd,dtauy3_fd,& + dusfc_ls, dvsfc_ls ,dusfc_bl, dvsfc_bl,& + dusfc_ss, dvsfc_ss ,dusfc_fd, dvsfc_fd) + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index + use camsrfexch, only: cam_in_t + use ppgrid, only: pcols,pver,pverp + use physconst, only: gravit,rair,cpair,rh2o,zvir,pi + use hycoef, only: etamid + ! + type(physics_state), intent(in) :: state ! physics state structure ! Standard deviation of orography. + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(in) :: sgh(pcols) + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + real(r8), intent(in) :: dtime + real(r8), intent(in) :: nm(state%ncol,pver) ! midpoint Brunt-Vaisalla frequency + ! + logical , intent(in) :: gwd_ls + logical , intent(in) :: gwd_bl + logical , intent(in) :: gwd_ss + logical , intent(in) :: gwd_fd + !tunable parameter from namelist + real(r8), intent(in) :: ncleff_ls + real(r8), intent(in) :: ncd_bl + real(r8), intent(in) :: sncleff_ss + ! + real(r8), intent(out), optional :: utgw(state%ncol,pver) + real(r8), intent(out), optional :: vtgw(state%ncol,pver) + real(r8), intent(out), optional :: ttgw(state%ncol,pver) + ! + real(r8), intent(out), optional :: dtaux3_ls(pcols,pver) + real(r8), intent(out), optional :: dtauy3_ls(pcols,pver) + real(r8), intent(out), optional :: dtaux3_bl(pcols,pver) + real(r8), intent(out), optional :: dtauy3_bl(pcols,pver) + real(r8), intent(out), optional :: dtaux3_ss(pcols,pver) + real(r8), intent(out), optional :: dtauy3_ss(pcols,pver) + real(r8), intent(out), optional :: dtaux3_fd(pcols,pver) + real(r8), intent(out), optional :: dtauy3_fd(pcols,pver) + real(r8), intent(out), optional :: dusfc_ls(pcols) + real(r8), intent(out), optional :: dvsfc_ls(pcols) + real(r8), intent(out), optional :: dusfc_bl(pcols) + real(r8), intent(out), optional :: dvsfc_bl(pcols) + real(r8), intent(out), optional :: dusfc_ss(pcols) + real(r8), intent(out), optional :: dvsfc_ss(pcols) + real(r8), intent(out), optional :: dusfc_fd(pcols) + real(r8), intent(out), optional :: dvsfc_fd(pcols) + ! + real(r8) :: ztop(pcols,pver) ! top interface height asl (m) + real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) + real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) + real(r8) :: dz(pcols,pver) ! model layer height + ! + !real(r8) :: g + !pblh input + integer :: pblh_idx = 0 + integer :: kpbl2d_in(pcols) + real(r8), pointer :: pblh(:) + real(r8) :: dx(pcols),dy(pcols) + !needed index + integer :: ncol + integer :: i + integer :: k + !local transfer variables + real(r8) :: dtaux3_ls_local(pcols,pver) + real(r8) :: dtauy3_ls_local(pcols,pver) + real(r8) :: dtaux3_bl_local(pcols,pver) + real(r8) :: dtauy3_bl_local(pcols,pver) + real(r8) :: dtaux3_ss_local(pcols,pver) + real(r8) :: dtauy3_ss_local(pcols,pver) + real(r8) :: dtaux3_fd_local(pcols,pver) + real(r8) :: dtauy3_fd_local(pcols,pver) + real(r8) :: dusfc_ls_local(pcols) + real(r8) :: dvsfc_ls_local(pcols) + real(r8) :: dusfc_bl_local(pcols) + real(r8) :: dvsfc_bl_local(pcols) + real(r8) :: dusfc_ss_local(pcols) + real(r8) :: dvsfc_ss_local(pcols) + real(r8) :: dusfc_fd_local(pcols) + real(r8) :: dvsfc_fd_local(pcols) + + ! + ncol=state%ncol + !convert heights above surface to heights above sea level + !obtain z,dz,dx,dy + !ztop and zbot are already reversed, start from bottom to top + kpbl2d_in=0_r8 + ! + ztop(1:ncol,1:pver)=0._r8 + zbot(1:ncol,1:pver)=0._r8 + zmid(1:ncol,1:pver)=0._r8 + ! + do k=1,pverp-1 + ! assign values for level top/bottom + ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) + zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) + end do + !transform adding the pressure + !transfer from surface to sea level + do k=1,pver + do i=1,ncol + ztop(i,k)=ztop(i,k)+state%phis(i)/gravit + zbot(i,k)=zbot(i,k)+state%phis(i)/gravit + zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit + !dz is from bottom to top already for gw_drag + dz(i,k)=ztop(i,k)-zbot(i,k) + end do + end do + !reverse to keep good format in scheme + ztop=ztop(:,pver:1:-1) + zbot=zbot(:,pver:1:-1) + !get the layer index of pblh in layer for input in drag scheme + pblh_idx = pbuf_get_index('pblh') + call pbuf_get_field(pbuf, pblh_idx, pblh) + do i=1,pcols + kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/gravit),pblh(i)) + end do + ! + !get grid size for dx,dy + call grid_size(state,dx,dy) + !interface for orographic drag + !if (gwd_fd.eq.0) then + call gwdo_gsd(& + u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& + qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& + pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& + ncleff_ls=ncleff_ls,ncd_bl=ncd_bl,sncleff_ss=sncleff_ss,& + rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& + dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& + dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& + dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& + dtaux3d_fd=dtaux3_fd(:ncol,pver:1:-1),dtauy3d_fd=dtauy3_fd(:ncol,pver:1:-1),& + dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& + dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& + dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& + dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& + xland=cam_in%landfrac,br=state%ribulk(:ncol),& + var2d=sgh(:ncol),oc12d=state%oc(:ncol),& + oa2d=state%oadir(:ncol,:),ol2d=state%ol(:ncol,:),& + znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& + cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& + dt=dtime,dx=dx,dy=dy,& + kpbl2d=kpbl2d_in,itimestep=dtime,gwd_opt=0,& + ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & + ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & + its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & + gwd_ls=gwd_ls,gwd_bl=gwd_bl,gwd_ss=gwd_ss,gwd_fd=gwd_fd ) + ! +end subroutine gw_oro_interface +!========================================================================== +function pblh_get_level_idx(height_array,pblheight) implicit none -real(8),intent(in),dimension(30) :: height_array +real(8),intent(in),dimension(pver) :: height_array real(8),intent(in) :: pblheight integer :: pblh_get_level_idx @@ -840,6 +995,7 @@ subroutine grid_size(state, grid_dx, grid_dy) end subroutine grid_size !========================================================================== subroutine gwdo_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & + ncleff_ls,ncd_bl,sncleff_ss, & rublten,rvblten,rthblten, & dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd, & @@ -916,10 +1072,11 @@ subroutine gwdo_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & t3d, & z, & dz + real(r8), dimension( ims:ime, kms:kme+1 ) ,& + intent(in ) :: p3di + real(r8), intent(in) :: ncleff_ls,ncd_bl,sncleff_ss real(r8), dimension( ims:ime, kms:kme ) , & - intent(in ) :: p3di - real(r8), dimension( ims:ime, kms:kme ) , & - intent(inout) :: rublten, & + optional, intent(inout) :: rublten, & rvblten, & rthblten real(r8), dimension( ims:ime, kms:kme ), optional , & @@ -967,7 +1124,7 @@ subroutine gwdo_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & real(r8), dimension( its:ite, nvar_dirOA ) :: oa4 real(r8), dimension( its:ite, nvar_dirOL ) :: ol4 integer :: i,j,k,kpblmax - integer , intent(in) :: gwd_ls,gwd_bl,gwd_ss,gwd_fd + logical, intent(in) :: gwd_ls,gwd_bl,gwd_ss,gwd_fd !! do k = kts,kte if(znu(k).gt.0.6_r8) kpblmax = k + 1 @@ -987,8 +1144,7 @@ subroutine gwdo_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & enddo ! !no need when there is no large drag -IF ( (gwd_ls .EQ. 1).and.(gwd_bl .EQ. 1)) then - +IF (gwd_ls.or.gwd_bl) then do i = its,ite oa4(i,:) = oa2d(i,:) ol4(i,:) = ol2d(i,:) @@ -996,7 +1152,8 @@ subroutine gwdo_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & ENDIF !================================================================= call gwdo2d(dudt=rublten(ims,kms),dvdt=rvblten(ims,kms) & - ,dthdt=rthblten(ims,kms) & + ,dthdt=rthblten(ims,kms) & + ,ncleff=ncleff_ls,ncd=ncd_bl,sncleff=sncleff_ss & ,dtaux2d_ls=dtaux2d_ls,dtauy2d_ls=dtauy2d_ls & ,dtaux2d_bl=dtaux2d_bl,dtauy2d_bl=dtauy2d_bl & ,dtaux2d_ss=dtaux2d_ss,dtauy2d_ss=dtauy2d_ss & @@ -1026,47 +1183,39 @@ subroutine gwdo_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte & ,gsd_gwd_ls=gwd_ls,gsd_gwd_bl=gwd_bl,gsd_gwd_ss=gwd_ss,gsd_gwd_fd=gwd_fd) !!============================================ -IF ( (gwd_ls .EQ. 1).and.(gwd_bl .EQ. 1)) then do i = its,ite dusfcg_ls(i)=dusfc_ls(i) dvsfcg_ls(i)=dvsfc_ls(i) dusfcg_bl(i)=dusfc_bl(i) dvsfcg_bl(i)=dvsfc_bl(i) + dusfcg_ss(i)=dusfc_ss(i) + dvsfcg_ss(i)=dvsfc_ss(i) + dusfcg_fd(i)=dusfc_fd(i) + dvsfcg_fd(i)=dvsfc_fd(i) enddo - !! + !! dtaux3d_ls=dtaux2d_ls dtaux3d_bl=dtaux2d_bl dtauy3d_ls=dtauy2d_ls dtauy3d_bl=dtauy2d_bl - !! - do i = its,ite - dusfcg_ss(i)=dusfc_ss(i) - dvsfcg_ss(i)=dvsfc_ss(i) - end do - !! dtaux3d_ss=dtaux2d_ss - dtauy3d_ss=dtauy2d_ss -ENDIF -IF (gwd_fd .EQ. 1) then - - do i = its,ite - dusfcg_fd(i)=dusfc_fd(i) - dvsfcg_fd(i)=dvsfc_fd(i) - enddo dtaux3d_fd=dtaux2d_fd + dtauy3d_ss=dtauy2d_ss dtauy3d_fd=dtauy2d_fd -ENDIF end subroutine gwdo_gsd ! !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- - subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & - dtaux2d_bl,dtauy2d_bl,dtaux2d_ss,dtauy2d_ss, & - dtaux2d_fd,dtauy2d_fd,u1,v1,t1,q1, & + subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & + dtaux2d_ls,dtauy2d_ls, & + dtaux2d_bl,dtauy2d_bl, & + dtaux2d_ss,dtauy2d_ss, & + dtaux2d_fd,dtauy2d_fd, & + u1,v1,t1,q1, & del, & prsi,prsl,prslk,zl,rcl, & - xland1,br1,hpbl,bnv_in,dz2, & + xland1,br1,hpbl,bnv_in,dz2, & kpblmax,dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd,var,oc1,oa4,ol4,& g,cp,rd,rv,fv,pi,dxmeter,dymeter,deltim,kpbl,kdt,lat, & @@ -1081,11 +1230,11 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & ! form drag (Beljaars et al.,2004). ! ! Activation of each component is done by specifying the integer-parameters -! (defined below) to 0: inactive or 1: active -! gsd_gwd_ls = 0 or 1: large-scale -! gsd_gwd_bl = 0 or 1: blocking drag -! gsd_gwd_ss = 0 or 1: small-scale gravity wave drag -! gsd_gwd_fd = 0 or 1: topographic form drag +! (defined below) to .true. (active) or .false. (inactive) +! gsd_gwd_ls : large-scale +! gsd_gwd_bl : blocking drag +! gsd_gwd_ss : small-scale gravity wave drag +! gsd_gwd_fd : topographic form drag ! ! ! References: @@ -1134,6 +1283,11 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & real(r8),intent(in) :: prsi(its:ite,kts:kte+1),del(its:ite,kts:kte) real(r8),intent(in),optional :: oa4(its:ite,nvar_dirOA) real(r8),intent(in),optional :: ol4(its:ite,nvar_dirOL) +! + !variables for open/close process + logical, intent(in) :: gsd_gwd_ls,gsd_gwd_bl,gsd_gwd_ss,gsd_gwd_fd + !tunable parameter in oro_drag_nl, ncleff_ls,ncd_bl,sncleff_ss + real(r8), intent(in) :: ncleff,ncd,sncleff ! ! added for small-scale orographic wave drag ! @@ -1233,23 +1387,11 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & real(r8) :: olp(its:ite),& od(its:ite) real(r8) :: taufb(its:ite,kts:kte+1) - !variables for open/close process - integer , intent(in) :: gsd_gwd_ls,gsd_gwd_bl,gsd_gwd_ss,gsd_gwd_fd - !tunable parameter - real(r8):: ncleff !!tunable parameter for gwd - real(r8):: ncd !!tunable parameter for fbd - real(r8):: sncleff !!tunable parameter for sgwd !readdata for low-level determination of ogwd real(r8) :: l1,l2,S!,shrrok1,shrrok0,gamma1 logical :: iint real(r8) :: zl_hint(its:ite) ! - !tunable parameter - ! - ncleff = 3._r8 - ncd = 3._r8 - sncleff = 1._r8 - ! !---- constants ! rcs = sqrt(rcl) @@ -1287,6 +1429,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & taub (i) = 0.0_r8 oa1(i) = 0.0_r8 ol(i) = 0.0_r8 + fr(i) = 0.0_r8 ulow (i) = 0.0_r8 dtfac(i) = 1.0_r8 ldrag(i) = .false. @@ -1391,7 +1534,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & enddo ! ! For ls and bl only -IF ((gsd_gwd_ls .EQ. 1).or.(gsd_gwd_bl .EQ. 1)) then +IF (gsd_gwd_ls.or.gsd_gwd_bl) then ! figure out low-level horizontal wind direction ! order into a counterclockwise index instead ! @@ -1443,9 +1586,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & !============================================ ! END INITIALIZATION; BEGIN GWD CALCULATIONS: !============================================ -IF ( ((gsd_gwd_ls .EQ. 1).or.(gsd_gwd_bl .EQ. 1)).and. & - (ls_taper .GT. 1.E-02) ) THEN !==== - +IF (gsd_gwd_ls.or.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02) ) THEN ! !--- saving richardson number in usqj for migwdi ! @@ -1553,11 +1694,11 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & ! ratio const. use simplified relationship between standard ! deviation & critical hgt ! - do i = its,ite if (.not. ldrag(i)) then - efact = (oa1(i) + 2._r8) ** (ce*fr(i)/frc) - efact = min( max(efact,efmin), efmax ) + !maintain (oa+2) greater than or equal to 0 + efact = max(oa1(i)+2._r8,0._r8) ** (ce*fr(i)/frc) + efact = min(max(efact,efmin),efmax) !!!!!!! cleff (effective grid length) is highly tunable parameter !!!!!!! the bigger (smaller) value produce weaker (stronger) wave drag cleff = sqrt(dxy(i)**2._r8 + dxyp(i)**2._r8) @@ -1568,7 +1709,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & tem = fr(i) * fr(i) * oc1(i) gfobnv = gmax * tem / ((tem + cg)*bnv(i)) !! - if ( gsd_gwd_ls .NE. 0 ) then + if (gsd_gwd_ls) then taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & * ulow(i) * gfobnv * efact else ! We've gotten what we need for the blocking scheme @@ -1581,7 +1722,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & endif enddo -ENDIF ! (gsd_gwd_ls .EQ. 1).or.(gsd_gwd_bl .EQ. 1) +ENDIF ! (gsd_gwd_ls .eq. .true.).or.(gsd_gwd_bl .eq..true.) !========================================================= ! add small-scale wavedrag for stable boundary layer !========================================================= @@ -1593,7 +1734,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & vtendwave=0._r8 zq=0._r8 ! - IF ( (gsd_gwd_ss .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN + IF (gsd_gwd_ss.and.(ss_taper.GT.1.E-02)) THEN ! ! declaring potential temperature ! @@ -1683,17 +1824,17 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & enddo enddo -ENDIF ! end if gsd_gwd_ss == 1 +ENDIF ! end if gsd_gwd_ss == .true. !================================================================ !add Beljaars et al. (2004, QJRMS, equ. 16) form drag: !================================================================ -IF ( (gsd_gwd_fd .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN +IF (gsd_gwd_fd.and.(ss_taper.GT.1.E-02) ) THEN utendform=0._r8 vtendform=0._r8 zq=0._r8 - IF ( (gsd_gwd_ss .NE. 1).and.(ss_taper.GT.1.E-02) ) THEN + IF (.not.gsd_gwd_ss.and.(ss_taper.GT.1.E-02) ) THEN ! Defining layer height. This is already done above is small-scale GWD is used do k = kts,kte do i = its,ite @@ -1742,11 +1883,11 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) enddo enddo - ENDIF ! end if gsd_gwd_fd == 1 + ENDIF ! end if gsd_gwd_fd == .true. !======================================================= ! More for the large-scale gwd component !======================================================= -IF ( (gsd_gwd_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN +IF (gsd_gwd_ls.and.(ls_taper.GT.1.E-02) ) THEN ! ! now compute vertical structure of the stress. ! @@ -1845,7 +1986,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & !=============================================================== !COMPUTE BLOCKING COMPONENT !=============================================================== -IF ( (gsd_gwd_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN +IF (gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN do i = its,ite if(.not.ldrag(i)) then @@ -1885,7 +2026,6 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & cd = max(2.0_r8-1.0_r8/od(i),0.0_r8) ! !tuning of the drag magnitude - ! cd=ncd*cd ! taufb(i,kts) = 0.5_r8 * roll(i) * coefm(i) / max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) & @@ -1906,7 +2046,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & ENDIF ! end blocking drag !=========================================================== -IF ( (gsd_gwd_ls .EQ. 1 .OR. gsd_gwd_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN +IF (gsd_gwd_ls.OR.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN ! ! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy @@ -1951,7 +2091,9 @@ subroutine gwdo2d(dudt,dvdt,dthdt,dtaux2d_ls,dtauy2d_ls, & !apply limiter for ogwd !1.dudt < |c-u|/dt, so u-c cannot change sign(u^n+1 = u^n + du/dt * dt) !2.dudt shr_kind_r8 - use ppgrid, only: pcols,pver,pverp,nvar_dirOA,nvar_dirOL,indexb,begchunk,endchunk + use ppgrid, only: pcols,pver,pverp,nvar_dirOA,nvar_dirOL,begchunk,endchunk use hycoef, only: hyai, hybi, hyam, hybm, etamid !get the znu,znw,p_top set to 0 use constituents, only: pcnst use physics_types, only: physics_state, physics_ptend, physics_ptend_init @@ -38,7 +38,7 @@ module gw_drag !zvir is the ep1 in wrf,rearth is the radius of earth(m),r_universal is the gas constant ! These are the actual switches for different gravity wave sources. - use phys_control, only: use_gw_oro, use_gw_front, use_gw_convect, use_gw_energy_fix + use phys_control, only: use_gw_oro, use_gw_front,use_gw_convect,use_gw_energy_fix,use_od_ls,use_od_bl,use_od_ss,ncleff_ls,ncd_bl,sncleff_ss ! Typical module header implicit none @@ -305,6 +305,8 @@ subroutine gw_init() pblh_idx = pbuf_get_index('pblh') ! grid_id = cam_grid_id('physgrid') + ! + if (use_od_ls.or.use_od_bl) then if (.not. cam_grid_check(grid_id)) then call endrun(trim(subname)//': Internal error, no "physgrid" grid') end if @@ -327,6 +329,7 @@ subroutine gw_init() if(.not. found) call endrun('ERROR: GWD topo file readerr') ! call close_initial_fileGWD() + endif ! ! Set model flags. do_spectral_waves = (pgwv > 0 .and. (use_gw_front .or. use_gw_convect)) @@ -402,7 +405,10 @@ subroutine gw_init() errstring) if (trim(errstring) /= "") call endrun("gw_common_init: "//errstring) - if (use_gw_oro) then + if (use_gw_oro.or.& + use_od_ls.or.& + use_od_bl.or.& + use_od_ss) then if (effgw_oro == unset_r8) then call endrun("gw_drag_init: Orographic gravity waves enabled, & @@ -650,13 +656,12 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) ! Location-dependent cpair use physconst, only: cpairv use gw_common, only: gw_prof, momentum_energy_conservation, & - gw_drag_prof + gw_drag_prof,gw_oro_interface use gw_oro, only: gw_oro_src use gw_front, only: gw_cm_src use gw_convect, only: gw_beres_src use dycore, only: dycore_is use phys_grid, only: get_rlat_all_p - use gw_common, only: gwdo_gsd,pblh_get_level_idx,grid_size use physconst, only: gravit,rair !------------------------------Arguments-------------------------------- type(physics_state), intent(in) :: state ! physics state structure @@ -667,43 +672,30 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) ! Parameterization net tendencies. type(physics_ptend), intent(out):: ptend type(cam_in_t), intent(in) :: cam_in - !input par - integer :: kpbl2d_in(pcols) - !simply add par - !for z,dz,from other files - real(r8) :: ztop(pcols,pver) ! top interface height asl (m) - real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) - real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) - real(r8) :: dz(pcols,pver) ! model layer height - - !bulk richardson number from hb_diff - !bulk at the surface - !real(r8),parameter :: rino(pcols,nver) - real(r8) :: rlat(pcols) - !locally added gw and bl drag - real(r8) :: dtaux3_ls(pcols,pver) - real(r8) :: dtauy3_ls(pcols,pver) - real(r8) :: dtaux3_bl(pcols,pver) - real(r8) :: dtauy3_bl(pcols,pver) - ! - real(r8) :: dtaux3_ss(pcols,pver) - real(r8) :: dtauy3_ss(pcols,pver) - ! - real(r8) :: dusfc_ls(pcols) - real(r8) :: dvsfc_ls(pcols) - real(r8) :: dusfc_bl(pcols) - real(r8) :: dvsfc_bl(pcols) - ! - real(r8) :: dusfc_ss(pcols) - real(r8) :: dvsfc_ss(pcols) - real(r8) :: g - - real(r8) :: dtaux3_fd(pcols,pver) - real(r8) :: dtauy3_fd(pcols,pver) - real(r8) :: dusfc_fd(pcols) - real(r8) :: dvsfc_fd(pcols) - real(r8), pointer :: pblh(:) - real(r8) :: dx(pcols),dy(pcols) + !locally added gw and bl drag + real(r8) :: dtaux3_ls(pcols,pver) + real(r8) :: dtauy3_ls(pcols,pver) + real(r8) :: dtaux3_bl(pcols,pver) + real(r8) :: dtauy3_bl(pcols,pver) + real(r8) :: dtaux3_ss(pcols,pver) + real(r8) :: dtauy3_ss(pcols,pver) + real(r8) :: dummx3_fd(pcols,pver) + real(r8) :: dummy3_fd(pcols,pver) + ! + real(r8) :: dusfc_ls(pcols) + real(r8) :: dvsfc_ls(pcols) + real(r8) :: dusfc_bl(pcols) + real(r8) :: dvsfc_bl(pcols) + real(r8) :: dusfc_ss(pcols) + real(r8) :: dvsfc_ss(pcols) + real(r8) :: dummx_fd(pcols) + real(r8) :: dummy_fd(pcols) + ! + real(r8), pointer :: pblh(:) + real(r8) :: dx(pcols),dy(pcols) + ! + logical :: gwd_ls,gwd_bl,gwd_ss,gwd_fd + ! !---------------------------Local storage------------------------------- @@ -985,7 +977,6 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) !--------------------------------------------------------------------- ! Orographic stationary gravity waves !--------------------------------------------------------------------- - ! Determine the orographic wave source call gw_oro_src(ncol, & u, v, t, sgh(:ncol), pmid, pint, dpm, zm, nm, & @@ -999,103 +990,44 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) piln, rhoi, nm, ni, ubm, ubi, xv, yv, & effgw_oro, c, kvtt, q, dse, tau, utgw, vtgw, & ttgw, qtgw, taucd, egwdffi, gwut(:,:,0:0), dttdf, dttke) + endif + ! + if (use_od_ls.or.& + use_od_bl.or.& + use_od_ss) then + !open ogwd,bl,ss, + !close fd + gwd_ls=use_od_ls + gwd_bl=use_od_bl + gwd_ss=use_od_ss + gwd_fd=.false. + ! + utgw=0.0_r8 + vtgw=0.0_r8 + ttgw=0.0_r8 + ! + call gw_oro_interface( state,cam_in,sgh,pbuf,dt,nm,& + gwd_ls,gwd_bl,gwd_ss,gwd_fd,& + ncleff_ls,ncd_bl,sncleff_ss,& + utgw,vtgw,ttgw,& + dtaux3_ls=dtaux3_ls,dtauy3_ls=dtauy3_ls,& + dtaux3_bl=dtaux3_bl,dtauy3_bl=dtauy3_bl,& + dtaux3_ss=dtaux3_ss,dtauy3_ss=dtauy3_ss,& + dtaux3_fd=dummx3_fd,dtauy3_fd=dummy3_fd,& + dusfc_ls=dusfc_ls,dvsfc_ls=dvsfc_ls,& + dusfc_bl=dusfc_bl,dvsfc_bl=dvsfc_bl,& + dusfc_ss=dusfc_ss,dvsfc_ss=dvsfc_ss,& + dusfc_fd=dummx_fd,dvsfc_fd=dummy_fd) - - - !--------------------------------------------------------------------- - ! Replaced the basic units with cam's states - !--------------------------------------------------------------------- - !this is for z,dz,dx,dy - !add surface height (surface geopotential/gravity) to convert CAM - !heights based on geopotential above surface into height above sea - !level - !taken from %%module cospsimulator_intr - !CAM is top to surface, which may be opposite in WRF - !fv is same dlat,dlon, so we do it directly - !%%needs to decide which to reverse!!!!!!! - !ztop and zbot are already reversed, start from bottom to top - !dz needs no reverse also - !zmid is different calculation process, - !so it needs reverse if to use - ztop(1:ncol,1:pver)=0._r8 - zbot(1:ncol,1:pver)=0._r8 - zmid(1:ncol,1:pver)=0._r8 - ! - do k=1,pverp-1 - ! assign values from top - ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) - ! assign values from bottom - zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) - end do - !get g - g=gravit - !transform adding the pressure - !transfer from surface to sea level - do k=1,pver - do i=1,ncol - ztop(i,k)=ztop(i,k)+state%phis(i)/g - zbot(i,k)=zbot(i,k)+state%phis(i)/g - zmid(i,k)=state%zm(i,k)+state%phis(i)/g - !dz is from bottom to top already for gw_drag - dz(i,k)=ztop(i,k)-zbot(i,k) - end do - end do - !reverse to keep good format in scheme - ztop=ztop(:,pver:1:-1) - zbot=zbot(:,pver:1:-1) - !get the layer index of pblh in layer - call pbuf_get_field(pbuf, pblh_idx, pblh) - ! - kpbl2d_in=0_r8 - do i=1,pcols - kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/g),pblh(i)) - end do - call get_rlat_all_p(lchnk, ncol, rlat) - !Initialize - utgw=0._r8 - vtgw=0._r8 - ttgw=0._r8 - call grid_size(state,dx,dy) - call gwdo_gsd(& - u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& - qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& - pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& - rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& - dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& - dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& - dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& - dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& - dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& - dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& - xland=cam_in%landfrac,br=state%ribulk(:ncol),& - var2d=state%var(:ncol),& - oc12d=state%oc(:ncol),& - oa2d=state%oadir(:ncol,:),& - ol2d=state%ol(:ncol,:),& - znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& - cp=cpair,g=g,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& - dt=dt,dx=dx,dy=dy,& - kpbl2d=kpbl2d_in,itimestep=dt,gwd_opt=0,& - ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & - ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & - its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & - gwd_ls=1,gwd_bl=1,gwd_ss=1,gwd_fd=0 ) - ! - call outfld ('DTAUX3_LS', dtaux3_ls, pcols, lchnk) - call outfld ('DTAUY3_LS', dtauy3_ls, pcols, lchnk) - call outfld ('DTAUX3_BL', dtaux3_bl, pcols, lchnk) - call outfld ('DTAUY3_BL', dtauy3_bl, pcols, lchnk) - call outfld ('DTAUX3_SS', dtaux3_ss, pcols, lchnk) - call outfld ('DTAUY3_SS', dtauy3_ss, pcols, lchnk) - call outfld ('DUSFC_LS', dusfc_ls, pcols, lchnk) - call outfld ('DVSFC_LS', dvsfc_ls, pcols, lchnk) - call outfld ('DUSFC_BL', dusfc_bl, pcols, lchnk) - call outfld ('DVSFC_BL', dvsfc_bl, pcols, lchnk) - call outfld ('DUSFC_SS', dusfc_ss, pcols, lchnk) - call outfld ('DVSFC_SS', dvsfc_ss, pcols, lchnk) + endif ! Add the orographic tendencies to the spectrum tendencies ! Compute the temperature tendency from energy conservation ! (includes spectrum). + ! both old and new gwd scheme will add the tendency to circulation + if (use_gw_oro.or. & + use_od_ls.or.& + use_od_bl.or.& + use_od_ss) then if(.not. use_gw_energy_fix) then !original do k = 1, pver @@ -1145,15 +1077,34 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) call outfld('UTGWORO', utgw, ncol, lchnk) call outfld('VTGWORO', vtgw, ncol, lchnk) call outfld('TTGWORO', ttgw, ncol, lchnk) - !set the GWORO as combination of 3 - tau0x=dusfc_ls+dusfc_bl+dusfc_ss - tau0y=dvsfc_ls+dvsfc_bl+dvsfc_ss - !tau0x = tau(:,0,pver) * xv * effgw_oro - !tau0y = tau(:,0,pver) * yv * effgw_oro + ! + if (use_gw_oro) then + !old gwd scheme + tau0x = tau(:,0,pver) * xv * effgw_oro + tau0y = tau(:,0,pver) * yv * effgw_oro call outfld('TAUGWX', tau0x, ncol, lchnk) call outfld('TAUGWY', tau0y, ncol, lchnk) + endif + ! call outfld('SGH ', sgh,pcols, lchnk) - + ! + if (use_od_ls.or.& + use_od_bl.or.& + use_od_ss) then + call outfld ('DTAUX3_LS', dtaux3_ls, pcols, lchnk) + call outfld ('DTAUY3_LS', dtauy3_ls, pcols, lchnk) + call outfld ('DTAUX3_BL', dtaux3_bl, pcols, lchnk) + call outfld ('DTAUY3_BL', dtauy3_bl, pcols, lchnk) + call outfld ('DTAUX3_SS', dtaux3_ss, pcols, lchnk) + call outfld ('DTAUY3_SS', dtauy3_ss, pcols, lchnk) + call outfld ('DUSFC_LS', dusfc_ls, pcols, lchnk) + call outfld ('DVSFC_LS', dvsfc_ls, pcols, lchnk) + call outfld ('DUSFC_BL', dusfc_bl, pcols, lchnk) + call outfld ('DVSFC_BL', dvsfc_bl, pcols, lchnk) + call outfld ('DUSFC_SS', dusfc_ss, pcols, lchnk) + call outfld ('DVSFC_SS', dvsfc_ss, pcols, lchnk) + endif + ! end if ! Convert the tendencies for the dry constituents to dry air basis. diff --git a/components/eam/src/physics/cam/hb_diff.F90 b/components/eam/src/physics/cam/hb_diff.F90 index 88f0cd8032a..7721cdef4a0 100644 --- a/components/eam/src/physics/cam/hb_diff.F90 +++ b/components/eam/src/physics/cam/hb_diff.F90 @@ -767,14 +767,14 @@ subroutine austausch_pbl(lchnk ,ncol , & return end subroutine austausch_pbl !=============================================================================== - subroutine pblintd_ri(ncol , & + subroutine pblintd_ri(ncol ,gravit , & thv ,z ,u ,v , & ustar ,obklen ,kbfs ,rino_bulk) !! use pbl_utils, only: virtem, calc_ustar, calc_obklen !! integer, intent(in) :: ncol ! number of atmospheric columns - + real(r8), intent(in) :: gravit real(r8), intent(in) :: thv(pcols,pver) ! virtual temperature real(r8), intent(in) :: z(pcols,pver) ! height above surface [m] real(r8), intent(in) :: u(pcols,pver) ! windspeed x-direction [m/s] @@ -803,16 +803,17 @@ subroutine pblintd_ri(ncol , & real(r8) :: phihinv(pcols) ! inverse phi function for heat real(r8) :: rino(pcols,pver) ! bulk Richardson no. from level to ref lev real(r8) :: tlv(pcols) ! ref. level pot tmp + tmp excess + real(r8) :: tref(pcols) ! ref. level pot tmp real(r8) :: vvk ! velocity magnitude squared - logical :: unstbl(pcols) ! pts w/unstbl pbl (positive virtual ht flx) logical :: check(pcols) ! True=>chk if Richardson no.>critcal - !! + ! do i=1,ncol check(i) = .true. rino(i,pver) = 0.0_r8 rino_bulk(i) = 0.0_r8 pblh(i) = z(i,pver) + tref(i) = thv(i,pver)!if not excess then tref is equal to lowest level thv_lv end do ! ! @@ -824,7 +825,7 @@ subroutine pblintd_ri(ncol , & if (check(i)) then vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 vvk = max(vvk,tiny) - rino(i,k) = g*(thv(i,k) - thv(i,pver))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + rino(i,k) = gravit*(thv(i,k) - thv(i,pver))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) if (rino(i,k) >= ricr) then pblh(i) = z(i,k+1) + (ricr - rino(i,k+1))/(rino(i,k) - rino(i,k+1)) * & (z(i,k) - z(i,k+1)) @@ -844,6 +845,9 @@ subroutine pblintd_ri(ncol , & phiminv(i) = (1._r8 - binm*pblh(i)/obklen(i))**onet rino(i,pver) = 0.0_r8 tlv(i) = thv(i,pver) + kbfs(i)*fak/( ustar(i)*phiminv(i) ) + ! + tref(i) = tlv(i) + ! end if end do ! @@ -857,11 +861,11 @@ subroutine pblintd_ri(ncol , & if (check(i)) then vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 vvk = max(vvk,tiny) - rino(i,k) = g*(thv(i,k) - tlv(i))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + rino(i,k) = gravit*(thv(i,k) - tlv(i))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) if (rino(i,k) >= ricr) then pblh(i) = z(i,k+1) + (ricr - rino(i,k+1))/(rino(i,k) - rino(i,k+1))* & (z(i,k) - z(i,k+1)) - bge(i) = 2._r8*g/(thv(i,k)+thv(i,k+1))*(thv(i,k)-thv(i,k+1))/(z(i,k)-z(i,k+1))*pblh(i) + bge(i) = 2._r8*gravit/(thv(i,k)+thv(i,k+1))*(thv(i,k)-thv(i,k+1))/(z(i,k)-z(i,k+1))*pblh(i) if (bge(i).lt.0._r8) then bge(i) = 1.e-8_r8 endif @@ -872,11 +876,12 @@ subroutine pblintd_ri(ncol , & end do ! !calculate bulk richardson number in the surface layer + !following Holstag and Boville (1993) equation (2.8) ! do i=1,ncol - vvk = (u(i,k) - u(i,pver))**2 + (v(i,k) - v(i,pver))**2 + fac*ustar(i)**2 + vvk = u(i,pver)**2 + v(i,pver)**2 + fac*ustar(i)**2 vvk = max(vvk,tiny) - rino_bulk(i)=g*(thv(i,k) - tlv(i))*(z(i,k)-z(i,pver))/(thv(i,pver)*vvk) + rino_bulk(i)=gravit*(thv(i,pver) - tref(i))*z(i,pver)/(thv(i,pver)*vvk) enddo ! return diff --git a/components/eam/src/physics/cam/phys_control.F90 b/components/eam/src/physics/cam/phys_control.F90 index b7c9b37fa81..400cbf31ea4 100644 --- a/components/eam/src/physics/cam/phys_control.F90 +++ b/components/eam/src/physics/cam/phys_control.F90 @@ -175,7 +175,17 @@ module phys_control !additional diagnostics switch logical, public, protected :: print_additional_diagn_phys_control = .false. - +!additional flags and tuning parameters for orographic drags, +!including orographic gravity wave drag (oGWD),flow-blocking drag (FBD), +!small-scale GWD drag (sGWD), turbulent orographic form drag (TOFD). +logical, public, protected :: use_od_ls = .false. +logical, public, protected :: use_od_bl = .false. +logical, public, protected :: use_od_ss = .false. +logical, public, protected :: use_od_fd = .false. +real(r8),public, protected :: ncleff_ls = 3._r8 !tunable parameter for oGWD +real(r8),public, protected :: ncd_bl = 3._r8 !tunable parameter for FBD +real(r8),public, protected :: sncleff_ss= 1._r8 !tunable parameter for sGWD +! ! Switches that turn on/off individual parameterizations. ! ! Comment by Hui Wan (PNNL, 2014-12): @@ -248,6 +258,8 @@ subroutine phys_ctl_readnl(nlfile) print_fixer_message, & use_hetfrz_classnuc, use_gw_oro, use_gw_front, use_gw_convect, & use_gw_energy_fix, & + use_od_ls,use_od_bl,use_od_ss,use_od_fd,& + ncleff_ls,ncd_bl,sncleff_ss,& cld_macmic_num_steps, micro_do_icesupersat, & fix_g1_err_ndrop, ssalt_tuning, resus_fix, convproc_do_aer, & convproc_do_gas, convproc_method_activate, liqcf_fix, regen_fix, demott_ice_nuc, pergro_mods, pergro_test_active, & @@ -366,7 +378,14 @@ subroutine phys_ctl_readnl(nlfile) call mpibcast(use_gw_oro, 1 , mpilog, 0, mpicom) call mpibcast(use_gw_front, 1 , mpilog, 0, mpicom) call mpibcast(use_gw_convect, 1 , mpilog, 0, mpicom) - call mpibcast(use_gw_energy_fix, 1 , mpilog, 0, mpicom) + call mpibcast(use_gw_energy_fix, 1 , mpilog, 0, mpicom) + call mpibcast(use_od_ls, 1 , mpilog, 0, mpicom) + call mpibcast(use_od_bl, 1 , mpilog, 0, mpicom) + call mpibcast(use_od_ss, 1 , mpilog, 0, mpicom) + call mpibcast(use_od_fd, 1 , mpilog, 0, mpicom) + call mpibcast(ncleff_ls, 1 , mpilog, 0, mpicom) + call mpibcast(ncd_bl, 1 , mpilog, 0, mpicom) + call mpibcast(sncleff_ss, 1 , mpilog, 0, mpicom) call mpibcast(fix_g1_err_ndrop, 1 , mpilog, 0, mpicom) call mpibcast(ssalt_tuning, 1 , mpilog, 0, mpicom) call mpibcast(resus_fix, 1 , mpilog, 0, mpicom) diff --git a/components/eam/src/physics/cam/physpkg.F90 b/components/eam/src/physics/cam/physpkg.F90 index 72703371f3d..50ce79e1540 100644 --- a/components/eam/src/physics/cam/physpkg.F90 +++ b/components/eam/src/physics/cam/physpkg.F90 @@ -1329,7 +1329,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & use time_manager, only: get_nstep, is_first_step, is_end_curr_month, & is_first_restart_step, is_last_step use check_energy, only: ieflx_gmean, check_ieflx_fix - use phys_control, only: ieflx_opt + use phys_control, only: ieflx_opt,use_od_ls,use_od_bl use co2_diagnostics,only: get_total_carbon, print_global_carbon_diags, & co2_diags_store_fields, co2_diags_read_fields use co2_cycle, only: co2_transport @@ -1433,11 +1433,13 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & call diag_surf(cam_in(c), cam_out(c), phys_state(c)%ps,trefmxav(1,c), trefmnav(1,c)) call t_stopf('diag_surf') ! for tranport of ogwd related parameters + if (use_od_ls.or.use_od_bl) then phys_state(c)%var(:)=var(:,c) phys_state(c)%var30(:)=var30(:,c) phys_state(c)%oc(:)=oc(:,c) phys_state(c)%oadir(:,:)=oadir(:,:,c) phys_state(c)%ol(:,:)=ol(:,:,c) + endif ! call tphysac(ztodt, cam_in(c), & sgh(1,c), sgh30(1,c), cam_out(c), & diff --git a/components/eam/src/physics/cam/ppgrid.F90 b/components/eam/src/physics/cam/ppgrid.F90 index 8a1779ca3b4..8ef5d205703 100644 --- a/components/eam/src/physics/cam/ppgrid.F90 +++ b/components/eam/src/physics/cam/ppgrid.F90 @@ -23,7 +23,6 @@ module ppgrid public pverp public nvar_dirOA public nvar_dirOL - public indexb ! Grid point resolution parameters @@ -36,7 +35,6 @@ module ppgrid !added for ogwd integer nvar_dirOA integer nvar_dirOL - integer indexb #ifdef PPCOLS parameter (pcols = PCOLS) @@ -47,7 +45,6 @@ module ppgrid !added for ogwd parameter (nvar_dirOA =2+1 )!avoid bug when nvar_dirOA is 2 parameter (nvar_dirOL =180)!set for 360 degrees wind direction - parameter (indexb = 3232)!set for 3km-inputs ! ! start, end indices for chunks owned by a given MPI task ! (set in phys_grid_init). From 13d2546ff5c2e2268cdf053f4f6c9d27da1f23a1 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Tue, 22 Oct 2024 20:03:32 +0000 Subject: [PATCH 215/529] update ekat with updated kokkos --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index ea985c76836..c86becf4dfa 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit ea985c76836d2ef9d433756654f821a64a7d57bf +Subproject commit c86becf4dfac6b4e3c0f2e5becd051495ccf8f26 From 340ce70f79af5ca39ca9fa276631ab8dab404aa6 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 23 Oct 2024 18:22:49 +0000 Subject: [PATCH 216/529] swithc to 12 ranks/node after merge --- cime_config/machines/config_machines.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 083253a62e6..0ff979c8f9c 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3548,9 +3548,9 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors pbspro e3sm 208 - 104 + 12 104 - 48 + 12 FALSE mpiexec From 30ddcdd1037de40b2a8f066044873b03fb32d6dd Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 23 Oct 2024 18:23:20 +0000 Subject: [PATCH 217/529] Revert "Merge Pull Request #3028 from E3SM-Project/scream/jgfouca/reduce_rrtmgp_interf_allocs" This reverts commit 9b1b4c7c5ca36923c47ca5cdb6ab6152149a88f7, reversing changes made to d9814845218b70d81d29aac152a5a7fbded48626. --- components/eam/src/physics/rrtmgp/external | 2 +- .../rrtmgp/scream_rrtmgp_interface.hpp | 178 ++++++------------ 2 files changed, 57 insertions(+), 123 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/external b/components/eam/src/physics/rrtmgp/external index e64b99cce24..8ff525eeed1 160000 --- a/components/eam/src/physics/rrtmgp/external +++ b/components/eam/src/physics/rrtmgp/external @@ -1 +1 @@ -Subproject commit e64b99cce24eb31bb6f317bddb6f0ffbdfaf8bb7 +Subproject commit 8ff525eeed1d87a2ca6f251c4d16b46222c5554d diff --git a/components/eamxx/src/physics/rrtmgp/scream_rrtmgp_interface.hpp b/components/eamxx/src/physics/rrtmgp/scream_rrtmgp_interface.hpp index a420c0c1dd4..216722b3766 100644 --- a/components/eamxx/src/physics/rrtmgp/scream_rrtmgp_interface.hpp +++ b/components/eamxx/src/physics/rrtmgp/scream_rrtmgp_interface.hpp @@ -565,44 +565,6 @@ static void rrtmgp_sw( int ngpt = k_dist.get_ngpt(); int ngas = gas_concs.get_num_gases(); - // Allocate temporaries from pool - const int size1 = nday; - const int size2 = nday*nlay; // 4 - const int size3 = nday*(nlay+1); // 5 - const int size4 = ncol*nlay; - const int size5 = nbnd*nday; //2 - const int size6 = nday*ngpt; - const int size7 = nday*(nlay+1)*nbnd; // 3 - const int size8 = ncol*nlay*(k_dist.get_ngas()+1); - - RealT* data = pool_t::template alloc_raw(size1 + size2*4 + size3*5 + size4 + size5*2 + size6 + size7*3 + size8), *dcurr = data; - - auto mu0_day = view_t (dcurr, nday); dcurr += size1; - - auto p_lay_day = view_t (dcurr, nday, nlay); dcurr += size2; - auto t_lay_day = view_t (dcurr, nday, nlay); dcurr += size2; - auto vmr_day = view_t (dcurr, nday, nlay); dcurr += size2; - auto t_lay_limited = view_t (dcurr, nday, nlay); dcurr += size2; - - auto p_lev_day = view_t (dcurr, nday, nlay+1); dcurr += size3; - auto t_lev_day = view_t (dcurr, nday, nlay+1); dcurr += size3; - auto flux_up_day = view_t (dcurr, nday, nlay+1); dcurr += size3; - auto flux_dn_day = view_t (dcurr, nday, nlay+1); dcurr += size3; - auto flux_dn_dir_day = view_t (dcurr, nday, nlay+1); dcurr += size3; - - auto vmr = view_t (dcurr, ncol, nlay); dcurr += size4; - - auto sfc_alb_dir_T = view_t (dcurr, nbnd, nday); dcurr += size5; - auto sfc_alb_dif_T = view_t (dcurr, nbnd, nday); dcurr += size5; - - auto toa_flux = view_t (dcurr, nday, ngpt); dcurr += size6; - - auto bnd_flux_up_day = view_t(dcurr, nday, nlay+1, nbnd); dcurr += size7; - auto bnd_flux_dn_day = view_t(dcurr, nday, nlay+1, nbnd); dcurr += size7; - auto bnd_flux_dn_dir_day = view_t(dcurr, nday, nlay+1, nbnd); dcurr += size7; - - auto col_gas = view_t(dcurr, ncol, nlay, k_dist.get_ngas()+1); dcurr += size8; - // Associate local pointers for fluxes auto &flux_up = fluxes.flux_up; auto &flux_dn = fluxes.flux_dn; @@ -661,15 +623,20 @@ static void rrtmgp_sw( } // Subset mu0 + auto mu0_day = view_t("mu0_day", nday); Kokkos::parallel_for(nday, KOKKOS_LAMBDA(int iday) { mu0_day(iday) = mu0(dayIndices(iday)); }); // subset state variables + auto p_lay_day = view_t("p_lay_day", nday, nlay); + auto t_lay_day = view_t("t_lay_day", nday, nlay); Kokkos::parallel_for(MDRP::template get<2>({nlay,nday}), KOKKOS_LAMBDA(int ilay, int iday) { p_lay_day(iday,ilay) = p_lay(dayIndices(iday),ilay); t_lay_day(iday,ilay) = t_lay(dayIndices(iday),ilay); }); + auto p_lev_day = view_t("p_lev_day", nday, nlay+1); + auto t_lev_day = view_t("t_lev_day", nday, nlay+1); Kokkos::parallel_for(MDRP::template get<2>({nlay+1,nday}), KOKKOS_LAMBDA(int ilev, int iday) { p_lev_day(iday,ilev) = p_lev(dayIndices(iday),ilev); t_lev_day(iday,ilev) = t_lev(dayIndices(iday),ilev); @@ -680,6 +647,8 @@ static void rrtmgp_sw( gas_concs_t gas_concs_day; gas_concs_day.init(gas_names, nday, nlay); for (int igas = 0; igas < ngas; igas++) { + auto vmr_day = view_t("vmr_day", nday, nlay); + auto vmr = view_t("vmr" , ncol, nlay); gas_concs.get_vmr(gas_names[igas], vmr); Kokkos::parallel_for(MDRP::template get<2>({nlay,nday}), KOKKOS_LAMBDA(int ilay, int iday) { vmr_day(iday,ilay) = vmr(dayIndices(iday),ilay); @@ -711,12 +680,20 @@ static void rrtmgp_sw( // RRTMGP assumes surface albedos have a screwy dimension ordering // for some strange reason, so we need to transpose these; also do // daytime subsetting in the same kernel + view_t sfc_alb_dir_T("sfc_alb_dir", nbnd, nday); + view_t sfc_alb_dif_T("sfc_alb_dif", nbnd, nday); Kokkos::parallel_for(MDRP::template get<2>({nbnd,nday}), KOKKOS_LAMBDA(int ibnd, int icol) { sfc_alb_dir_T(ibnd,icol) = sfc_alb_dir(dayIndices(icol),ibnd); sfc_alb_dif_T(ibnd,icol) = sfc_alb_dif(dayIndices(icol),ibnd); }); // Temporaries we need for daytime-only fluxes + auto flux_up_day = view_t("flux_up_day", nday, nlay+1); + auto flux_dn_day = view_t("flux_dn_day", nday, nlay+1); + auto flux_dn_dir_day = view_t("flux_dn_dir_day", nday, nlay+1); + auto bnd_flux_up_day = view_t("bnd_flux_up_day", nday, nlay+1, nbnd); + auto bnd_flux_dn_day = view_t("bnd_flux_dn_day", nday, nlay+1, nbnd); + auto bnd_flux_dn_dir_day = view_t("bnd_flux_dn_dir_day", nday, nlay+1, nbnd); fluxes_t fluxes_day; fluxes_day.flux_up = flux_up_day; fluxes_day.flux_dn = flux_dn_day; @@ -736,14 +713,18 @@ static void rrtmgp_sw( } // Limit temperatures for gas optics look-up tables + auto t_lay_limited = view_t("t_lay_limited", nday, nlay); limit_to_bounds_k(t_lay_day, k_dist_sw_k.get_temp_min(), k_dist_sw_k.get_temp_max(), t_lay_limited); // Do gas optics + view_t toa_flux("toa_flux", nday, ngpt); bool top_at_1 = false; Kokkos::parallel_reduce(1, KOKKOS_LAMBDA(int, bool& val) { val |= p_lay(0, 0) < p_lay(0, nlay-1); }, Kokkos::LOr(top_at_1)); + oview_t col_gas("col_gas", std::make_pair(0, ncol-1), std::make_pair(0, nlay-1), std::make_pair(-1, k_dist.get_ngas()-1)); + k_dist.gas_optics(nday, nlay, top_at_1, p_lay_day, p_lev_day, t_lay_limited, gas_concs_day, col_gas, optics, toa_flux); if (extra_clnsky_diag) { k_dist.gas_optics(nday, nlay, top_at_1, p_lay_day, p_lev_day, t_lay_limited, gas_concs_day, col_gas, optics_no_aerosols, toa_flux); @@ -822,8 +803,6 @@ static void rrtmgp_sw( clnsky_flux_dn_dir(icol,ilev) = flux_dn_dir_day(iday,ilev); }); } - - pool_t::dealloc(data, dcurr - data); } /* @@ -840,24 +819,6 @@ static void rrtmgp_lw( { // Problem size int nbnd = k_dist.get_nband(); - int constexpr max_gauss_pts = 4; - - const int size1 = ncol; - const int size2 = nbnd*ncol; - const int size3 = max_gauss_pts*max_gauss_pts; - const int size4 = ncol*nlay; - const int size5 = ncol*(nlay+1); - const int size6 = ncol*nlay*(k_dist.get_ngas()+1); - - RealT* data = pool_t::template alloc_raw(size1 + size2 + size3*2 + size4 + size5 + size6), *dcurr = data; - - view_t t_sfc (dcurr, ncol); dcurr += size1; - view_t emis_sfc (dcurr, nbnd,ncol); dcurr += size2; - view_t gauss_Ds (dcurr, max_gauss_pts,max_gauss_pts); dcurr += size3; - view_t gauss_wts (dcurr, max_gauss_pts,max_gauss_pts); dcurr += size3; - view_t t_lay_limited(dcurr, ncol, nlay); dcurr += size4; - view_t t_lev_limited(dcurr, ncol, nlay+1); dcurr += size5; - view_t col_gas (dcurr, std::make_pair(0, ncol-1), std::make_pair(0, nlay-1), std::make_pair(-1, k_dist.get_ngas()-1)); dcurr += size6; // Associate local pointers for fluxes auto &flux_up = fluxes.flux_up; @@ -902,6 +863,8 @@ static void rrtmgp_lw( // Boundary conditions source_func_t lw_sources; lw_sources.alloc(ncol, nlay, k_dist); + view_t t_sfc ("t_sfc" ,ncol); + view_t emis_sfc("emis_sfc",nbnd,ncol); bool top_at_1 = false; Kokkos::parallel_reduce(1, KOKKOS_LAMBDA(int, bool& val) { @@ -919,31 +882,32 @@ static void rrtmgp_lw( // Weights and angle secants for first order (k=1) Gaussian quadrature. // Values from Table 2, Clough et al, 1992, doi:10.1029/92JD01419 // after Abramowitz & Stegun 1972, page 921 - RealT gauss_Ds_host_raw[max_gauss_pts][max_gauss_pts] = { - {1.66, 1.18350343, 1.09719858, 1.06056257}, - {0., 2.81649655, 1.69338507, 1.38282560}, - {0., 0., 4.70941630, 2.40148179}, - {0., 0., 0., 7.15513024} - }; - hview_t gauss_Ds_host (&gauss_Ds_host_raw[0][0], max_gauss_pts, max_gauss_pts); - - RealT gauss_wts_host_raw[max_gauss_pts][max_gauss_pts] = { - {0.5, 0.3180413817, 0.2009319137, 0.1355069134}, - {0., 0.1819586183, 0.2292411064, 0.2034645680}, - {0., 0., 0.0698269799, 0.1298475476}, - {0., 0., 0., 0.0311809710} - }; - - hview_t gauss_wts_host(&gauss_wts_host_raw[0][0],max_gauss_pts,max_gauss_pts); - + int constexpr max_gauss_pts = 4; + hview_t gauss_Ds_host ("gauss_Ds" ,max_gauss_pts,max_gauss_pts); + gauss_Ds_host(0,0) = 1.66 ; gauss_Ds_host(1,0) = 0.; gauss_Ds_host(2,0) = 0.; gauss_Ds_host(3,0) = 0.; + gauss_Ds_host(0,1) = 1.18350343; gauss_Ds_host(1,1) = 2.81649655; gauss_Ds_host(2,1) = 0.; gauss_Ds_host(3,1) = 0.; + gauss_Ds_host(0,2) = 1.09719858; gauss_Ds_host(1,2) = 1.69338507; gauss_Ds_host(2,2) = 4.70941630; gauss_Ds_host(3,2) = 0.; + gauss_Ds_host(0,3) = 1.06056257; gauss_Ds_host(1,3) = 1.38282560; gauss_Ds_host(2,3) = 2.40148179; gauss_Ds_host(3,3) = 7.15513024; + + hview_t gauss_wts_host("gauss_wts",max_gauss_pts,max_gauss_pts); + gauss_wts_host(0,0) = 0.5 ; gauss_wts_host(1,0) = 0. ; gauss_wts_host(2,0) = 0. ; gauss_wts_host(3,0) = 0. ; + gauss_wts_host(0,1) = 0.3180413817; gauss_wts_host(1,1) = 0.1819586183; gauss_wts_host(2,1) = 0. ; gauss_wts_host(3,1) = 0. ; + gauss_wts_host(0,2) = 0.2009319137; gauss_wts_host(1,2) = 0.2292411064; gauss_wts_host(2,2) = 0.0698269799; gauss_wts_host(3,2) = 0. ; + gauss_wts_host(0,3) = 0.1355069134; gauss_wts_host(1,3) = 0.2034645680; gauss_wts_host(2,3) = 0.1298475476; gauss_wts_host(3,3) = 0.0311809710; + + view_t gauss_Ds ("gauss_Ds" ,max_gauss_pts,max_gauss_pts); + view_t gauss_wts("gauss_wts",max_gauss_pts,max_gauss_pts); Kokkos::deep_copy(gauss_Ds, gauss_Ds_host); Kokkos::deep_copy(gauss_wts, gauss_wts_host); // Limit temperatures for gas optics look-up tables + auto t_lay_limited = view_t("t_lay_limited", ncol, nlay); + auto t_lev_limited = view_t("t_lev_limited", ncol, nlay+1); limit_to_bounds_k(t_lay, k_dist_lw_k.get_temp_min(), k_dist_lw_k.get_temp_max(), t_lay_limited); limit_to_bounds_k(t_lev, k_dist_lw_k.get_temp_min(), k_dist_lw_k.get_temp_max(), t_lev_limited); // Do gas optics + oview_t col_gas("col_gas", std::make_pair(0, ncol-1), std::make_pair(0, nlay-1), std::make_pair(-1, k_dist.get_ngas()-1)); k_dist.gas_optics(ncol, nlay, top_at_1, p_lay, p_lev, t_lay_limited, t_sfc, gas_concs, col_gas, optics, lw_sources, view_t(), t_lev_limited); if (extra_clnsky_diag) { k_dist.gas_optics(ncol, nlay, top_at_1, p_lay, p_lev, t_lay_limited, t_sfc, gas_concs, col_gas, optics_no_aerosols, lw_sources, view_t(), t_lev_limited); @@ -977,22 +941,23 @@ static void rrtmgp_lw( // Compute clean-sky fluxes rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, optics_no_aerosols, top_at_1, lw_sources, emis_sfc, clnsky_fluxes); } - - pool_t::dealloc(data, dcurr - data); } /* * Return a subcolumn mask consistent with a specified overlap assumption */ -static void get_subcolumn_mask(const int ncol, const int nlay, const int ngpt, const real2dk &cldf, const int overlap_option, int1dk &seeds, int3dk& subcolumn_mask) +static int3dk get_subcolumn_mask(const int ncol, const int nlay, const int ngpt, const real2dk &cldf, const int overlap_option, int1dk &seeds) { + // Routine will return subcolumn mask with values of 0 indicating no cloud, 1 indicating cloud + int3dk subcolumn_mask = int3dk("subcolumn_mask", ncol, nlay, ngpt); + // Subcolumn generators are a means for producing a variable x(i,j,k), where // // c(i,j,k) = 1 for x(i,j,k) > 1 - cldf(i,j) // c(i,j,k) = 0 for x(i,j,k) <= 1 - cldf(i,j) // // I am going to call this "cldx" to be just slightly less ambiguous - auto cldx = pool_t::template alloc(ncol, nlay, ngpt); + auto cldx = view_t("cldx", ncol, nlay, ngpt); // Apply overlap assumption to set cldx if (overlap_option == 0) { // Dummy mask, always cloudy @@ -1052,9 +1017,6 @@ static void get_subcolumn_mask(const int ncol, const int nlay, const int ngpt, c subcolumn_mask(icol,ilay,igpt) = 0; } }); - - pool_t::dealloc(cldx); - return subcolumn_mask; } @@ -1067,7 +1029,7 @@ static void compute_cloud_area( { // Subcolumn binary cld mask; if any layers with pressure between pmin and pmax are cloudy // then 2d subcol mask is 1, otherwise it is 0 - auto subcol_mask = pool_t::template alloc(ncol, ngpt); + auto subcol_mask = view_t("subcol_mask", ncol, ngpt); Kokkos::parallel_for(MDRP::template get<3>({ngpt, nlay, ncol}), KOKKOS_LAMBDA(int igpt, int ilay, int icol) { // NOTE: using plev would need to assume level ordering (top to bottom or bottom to top), but // using play/pmid does not @@ -1084,8 +1046,6 @@ static void compute_cloud_area( cld_area(icol) += subcol_mask(icol,igpt) * ngpt_inv; } }); - - pool_t::dealloc(subcol_mask); } /* @@ -1118,7 +1078,7 @@ static void compute_aerocom_cloudtop( Kokkos::deep_copy(eff_radius_qi_at_cldtop, 0.0); // Initialize the 1D "clear fraction" as 1 (totally clear) - auto aerocom_clr = pool_t::template alloc(ncol); + auto aerocom_clr = view_t("aerocom_clr", ncol); Kokkos::deep_copy(aerocom_clr, 1.0); // Get gravity acceleration constant from constants @@ -1191,8 +1151,6 @@ static void compute_aerocom_cloudtop( // (their products) cldfrac_tot_at_cldtop(icol) = 1.0 - aerocom_clr(icol); }); - - pool_t::dealloc(aerocom_clr); } /* @@ -1295,17 +1253,14 @@ static optical_props2_t get_cloud_optics_sw( cloud_optics.set_ice_roughness(2); // Limit effective radii to be within bounds of lookup table - auto rel_limited = pool_t::template alloc(ncol, nlay); - auto rei_limited = pool_t::template alloc(ncol, nlay); + auto rel_limited = view_t("rel_limited", ncol, nlay); + auto rei_limited = view_t("rei_limited", ncol, nlay); limit_to_bounds_k(rel, cloud_optics.radliq_lwr, cloud_optics.radliq_upr, rel_limited); limit_to_bounds_k(rei, cloud_optics.radice_lwr, cloud_optics.radice_upr, rei_limited); // Calculate cloud optics cloud_optics.cloud_optics(ncol, nlay, lwp, iwp, rel_limited, rei_limited, clouds); - pool_t::dealloc(rel_limited); - pool_t::dealloc(rei_limited); - // Return optics return clouds; } @@ -1324,17 +1279,14 @@ static optical_props1_t get_cloud_optics_lw( cloud_optics.set_ice_roughness(2); // Limit effective radii to be within bounds of lookup table - auto rel_limited = pool_t::alloc(ncol, nlay); - auto rei_limited = pool_t::alloc(ncol, nlay); + auto rel_limited = view_t("rel_limited", ncol, nlay); + auto rei_limited = view_t("rei_limited", ncol, nlay); limit_to_bounds_k(rel, cloud_optics.radliq_lwr, cloud_optics.radliq_upr, rel_limited); limit_to_bounds_k(rei, cloud_optics.radice_lwr, cloud_optics.radice_upr, rei_limited); // Calculate cloud optics cloud_optics.cloud_optics(ncol, nlay, lwp, iwp, rel_limited, rei_limited, clouds); - pool_t::dealloc(rel_limited); - pool_t::dealloc(rei_limited); - // Return optics return clouds; } @@ -1346,10 +1298,6 @@ static optical_props2_t get_subsampled_clouds( optical_props2_t subsampled_optics; subsampled_optics.init(kdist.get_band_lims_wavenumber(), kdist.get_band_lims_gpoint(), "subsampled_optics"); subsampled_optics.alloc_2str(ncol, nlay); - - // Subcolumn mask with values of 0 indicating no cloud, 1 indicating cloud - auto cldmask = pool_t::alloc(ncol, nlay, ngpt); - // Check that we do not have clouds with no optical properties; this would get corrected // when we assign optical props, but we want to use a "radiative cloud fraction" // for the subcolumn sampling too because otherwise we can get vertically-contiguous cloud @@ -1357,7 +1305,7 @@ static optical_props2_t get_subsampled_clouds( // the vertical correlation of cloudy layers. I.e., cloudy layers might look maximally overlapped // even when separated by layers with no cloud properties, when in fact those layers should be // randomly overlapped. - auto cldfrac_rad = pool_t::alloc(ncol, nlay); + auto cldfrac_rad = view_t("cldfrac_rad", ncol, nlay); Kokkos::parallel_for(MDRP::template get<3>({nbnd,nlay,ncol}), KOKKOS_LAMBDA (int ibnd, int ilay, int icol) { if (cloud_optics.tau(icol,ilay,ibnd) > 0) { cldfrac_rad(icol,ilay) = cld(icol,ilay); @@ -1371,11 +1319,11 @@ static optical_props2_t get_subsampled_clouds( int overlap = 1; // Get unique seeds for each column that are reproducible across different MPI rank layouts; // use decimal part of pressure for this, consistent with the implementation in EAM - auto seeds = pool_t::alloc(ncol); + auto seeds = view_t("seeds", ncol); Kokkos::parallel_for(ncol, KOKKOS_LAMBDA(int icol) { seeds(icol) = 1e9 * (p_lay(icol,nlay-1) - int(p_lay(icol,nlay-1))); }); - get_subcolumn_mask(ncol, nlay, ngpt, cldfrac_rad, overlap, seeds, cldmask); + auto cldmask = get_subcolumn_mask(ncol, nlay, ngpt, cldfrac_rad, overlap, seeds); // Assign optical properties to subcolumns (note this implements MCICA) auto gpoint_bands = kdist.get_gpoint_bands(); Kokkos::parallel_for(MDRP::template get<3>({ngpt,nlay,ncol}), KOKKOS_LAMBDA(int igpt, int ilay, int icol) { @@ -1390,11 +1338,6 @@ static optical_props2_t get_subsampled_clouds( subsampled_optics.g (icol,ilay,igpt) = 0; } }); - - pool_t::dealloc(cldmask); - pool_t::dealloc(cldfrac_rad); - pool_t::dealloc(seeds); - return subsampled_optics; } @@ -1406,10 +1349,6 @@ static optical_props1_t get_subsampled_clouds( optical_props1_t subsampled_optics; subsampled_optics.init(kdist.get_band_lims_wavenumber(), kdist.get_band_lims_gpoint(), "subsampled_optics"); subsampled_optics.alloc_1scl(ncol, nlay); - - // Subcolumn mask with values of 0 indicating no cloud, 1 indicating cloud - auto cldmask = pool_t::alloc(ncol, nlay, ngpt); - // Check that we do not have clouds with no optical properties; this would get corrected // when we assign optical props, but we want to use a "radiative cloud fraction" // for the subcolumn sampling too because otherwise we can get vertically-contiguous cloud @@ -1417,7 +1356,7 @@ static optical_props1_t get_subsampled_clouds( // the vertical correlation of cloudy layers. I.e., cloudy layers might look maximally overlapped // even when separated by layers with no cloud properties, when in fact those layers should be // randomly overlapped. - auto cldfrac_rad = pool_t::alloc(ncol, nlay); + auto cldfrac_rad = view_t("cldfrac_rad", ncol, nlay); Kokkos::parallel_for(MDRP::template get<3>({nbnd,nlay,ncol}), KOKKOS_LAMBDA (int ibnd, int ilay, int icol) { if (cloud_optics.tau(icol,ilay,ibnd) > 0) { cldfrac_rad(icol,ilay) = cld(icol,ilay); @@ -1428,11 +1367,11 @@ static optical_props1_t get_subsampled_clouds( // Get unique seeds for each column that are reproducible across different MPI rank layouts; // use decimal part of pressure for this, consistent with the implementation in EAM; use different // seed values for longwave and shortwave - auto seeds = pool_t::alloc(ncol); + auto seeds = view_t("seeds", ncol); Kokkos::parallel_for(ncol, KOKKOS_LAMBDA(int icol) { seeds(icol) = 1e9 * (p_lay(icol,nlay-2) - int(p_lay(icol,nlay-2))); }); - get_subcolumn_mask(ncol, nlay, ngpt, cldfrac_rad, overlap, seeds, cldmask); + auto cldmask = get_subcolumn_mask(ncol, nlay, ngpt, cldfrac_rad, overlap, seeds); // Assign optical properties to subcolumns (note this implements MCICA) auto gpoint_bands = kdist.get_gpoint_bands(); Kokkos::parallel_for(MDRP::template get<3>({ngpt,nlay,ncol}), KOKKOS_LAMBDA(int igpt, int ilay, int icol) { @@ -1443,11 +1382,6 @@ static optical_props1_t get_subsampled_clouds( subsampled_optics.tau(icol,ilay,igpt) = 0; } }); - - pool_t::dealloc(cldmask); - pool_t::dealloc(cldfrac_rad); - pool_t::dealloc(seeds); - return subsampled_optics; } From 75e0fd932ed63c4e7f37e1cabfcf7d641fe70b38 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 23 Oct 2024 19:56:46 +0000 Subject: [PATCH 218/529] update kokkos --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index c86becf4dfa..17adc61faae 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit c86becf4dfac6b4e3c0f2e5becd051495ccf8f26 +Subproject commit 17adc61faae0ebb6de19fe389596e3dd3622d2d2 From 99165edeac25efd17bc85c96d4b23816812e22ad Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Wed, 23 Oct 2024 21:07:51 -0400 Subject: [PATCH 219/529] activate gh/ci on maint-3.0 --- .github/workflows/e3sm-gh-ci-cime-tests.yml | 4 +++- .github/workflows/e3sm-gh-ci-w-cime-tests.yml | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/.github/workflows/e3sm-gh-ci-cime-tests.yml b/.github/workflows/e3sm-gh-ci-cime-tests.yml index 5c6ff081f73..4aa64b457c5 100644 --- a/.github/workflows/e3sm-gh-ci-cime-tests.yml +++ b/.github/workflows/e3sm-gh-ci-cime-tests.yml @@ -2,7 +2,9 @@ name: gh on: pull_request: - branches: [ master ] + branches: + - master + - maint-3.0 paths: # first, yes to these - '.github/workflows/e3sm-gh-ci-cime-tests.yml' diff --git a/.github/workflows/e3sm-gh-ci-w-cime-tests.yml b/.github/workflows/e3sm-gh-ci-w-cime-tests.yml index f51aa88a34c..634f27ba5ac 100644 --- a/.github/workflows/e3sm-gh-ci-w-cime-tests.yml +++ b/.github/workflows/e3sm-gh-ci-w-cime-tests.yml @@ -2,7 +2,9 @@ name: gh-w on: pull_request: - branches: [ master ] + branches: + - master + - maint-3.0 paths-ignore: - 'mkdocs.yaml' - 'docs/**' From 24cf2ae762f895c0d067218d5886c539e4ba1521 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Wed, 23 Oct 2024 20:59:33 -0500 Subject: [PATCH 220/529] XMedium: 64 nodes, ~6 sypd --- cime_config/allactive/config_pesall.xml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index c21b2d0932e..4eba082b40f 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -2243,6 +2243,22 @@ 1152 + + allactive+chrysalis: v3.NARRM tri-grid on 64 nodes ~6 sypd + + 3840 + 3840 + 2304 + 2304 + 1536 + 256 + + + 3840 + 1536 + 1536 + + From 8c235f1171ab75a0a01d6ac2a8cbbd8f22470a0d Mon Sep 17 00:00:00 2001 From: Luke Van Roekel Date: Wed, 18 Sep 2024 17:08:56 -0500 Subject: [PATCH 221/529] Fixes to KPP interface --- components/mpas-ocean/src/shared/Makefile | 2 +- .../src/shared/mpas_ocn_diagnostics.F | 66 +++++-------------- .../mpas-ocean/src/shared/mpas_ocn_tendency.F | 9 +-- .../mpas-ocean/src/shared/mpas_ocn_vmix.F | 6 ++ .../src/shared/mpas_ocn_vmix_cvmix.F | 21 +++--- 5 files changed, 38 insertions(+), 66 deletions(-) diff --git a/components/mpas-ocean/src/shared/Makefile b/components/mpas-ocean/src/shared/Makefile index d378b68624b..27c3db10fee 100644 --- a/components/mpas-ocean/src/shared/Makefile +++ b/components/mpas-ocean/src/shared/Makefile @@ -157,7 +157,7 @@ mpas_ocn_tracer_short_wave_absorption_variable.o: mpas_ocn_constants.o mpas_ocn_ mpas_ocn_tracer_short_wave_absorption_jerlov.o: mpas_ocn_constants.o mpas_ocn_config.o -mpas_ocn_vmix.o: mpas_ocn_vmix_cvmix.o mpas_ocn_vmix_coefs_redi.o mpas_ocn_constants.o mpas_ocn_config.o mpas_ocn_diagnostics_variables.o mpas_ocn_vmix_gotm.o +mpas_ocn_vmix.o: mpas_ocn_vmix_cvmix.o mpas_ocn_vmix_coefs_redi.o mpas_ocn_constants.o mpas_ocn_config.o mpas_ocn_diagnostics_variables.o mpas_ocn_vmix_gotm.o mpas_ocn_diagnostics.o mpas_ocn_vmix_cvmix.o: mpas_ocn_constants.o mpas_ocn_config.o mpas_ocn_diagnostics_variables.o mpas_ocn_mesh.o mpas_ocn_stokes_drift.o diff --git a/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F b/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F index 0334667f2f1..6fa3d5d0a5b 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F @@ -64,7 +64,7 @@ module ocn_diagnostics ocn_fuperp, & ocn_filter_btr_mode_tend_vel, & ocn_reconstruct_eddy_vectors, & - ocn_compute_kpp_input_fields, & + ocn_compute_mixing_input_fields, & ocn_validate_state, & ocn_build_log_filename, & ocn_diagnostics_init @@ -3319,12 +3319,12 @@ end subroutine ocn_filter_btr_mode_tend_vel!}}} !*********************************************************************** ! -! routine ocn_compute_KPP_input_fields +! routine ocn_compute_mixing_input_fields ! !> \brief -!> Compute fields necessary to drive the CVMix KPP module -!> \author Todd Ringler -!> \date 20 August 2013 +!> Compute fields necessary to drive the CVMix KPP and gotm modules +!> \author Todd Ringler, Luke Van Roekel +!> \date 11 July 2024 !> \details !> CVMix/KPP requires the following fields as intent(in): !> surfaceBuoyancyForcing @@ -3333,7 +3333,7 @@ end subroutine ocn_filter_btr_mode_tend_vel!}}} ! !----------------------------------------------------------------------- - subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & + subroutine ocn_compute_mixing_input_fields(statePool, forcingPool, & meshPool, timeLevelIn)!{{{ !----------------------------------------------------------------- @@ -3353,7 +3353,7 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & !----------------------------------------------------------------- integer :: & - iCell, iEdge, i, k, &! loop indices for cell, edge, neighbors + iCell, iEdge, i, &! loop indices for cell, edge, neighbors kmin, &! topmost active cell index nCells, &! number of cells err, &! local error code @@ -3362,9 +3362,6 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & real (kind=RKIND) :: & fracAbsorbed, &! fraction of sfc flux absorbed fracAbsorbedRunoff, &! same for runoff - fracAbsorbedSubglacialRunoff, &! same for subglacial runoff - zTop,zBot, &! temporary variables - transmissionCoeffTop,transmissionCoeffBot, &! temporary variables sumSurfaceStressSquared ! sum of sfc stress squared ! pointers for variable/pool retrievals @@ -3385,8 +3382,7 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & evapTemperatureFlux, & icebergTemperatureFlux, & seaIceTemperatureFlux, & - surfaceStress, & - surfaceStressMagnitude + sfcStressMag real (kind=RKIND), dimension(:,:), pointer :: & layerThickness, &! layer thickness @@ -3419,7 +3415,7 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & !----------------------------------------------------------------- ! Begin code - call mpas_timer_start('KPP input fields') + call mpas_timer_start('Mixing input fields') if (present(timeLevelIn)) then timeLevel = timeLevelIn @@ -3469,18 +3465,8 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & surfaceThicknessFluxSubglacialRunoff) call mpas_pool_get_array(forcingPool, 'penetrativeTemperatureFlux', & penetrativeTemperatureFlux) - call mpas_pool_get_array(forcingPool, 'surfaceStress', & - surfaceStress) call mpas_pool_get_array(forcingPool, 'surfaceStressMagnitude', & - surfaceStressMagnitude) - call mpas_pool_get_array(forcingPool, 'rainTemperatureFlux', & - rainTemperatureFlux) - call mpas_pool_get_array(forcingPool, 'evapTemperatureFlux', & - evapTemperatureFlux) - call mpas_pool_get_array(forcingPool, 'seaIceTemperatureFlux', & - seaIceTemperatureFlux) - call mpas_pool_get_array(forcingPool, 'icebergTemperatureFlux', & - icebergTemperatureFlux) + sfcStressMag) ! allocate scratch space displaced density computation ncells = nCellsAll @@ -3594,17 +3580,8 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & activeTracersSurfaceFlux(indexTempFlux,iCell) & + penetrativeTemperatureFlux(iCell) & - penetrativeTemperatureFluxOBL(iCell) & - - fracAbsorbed* (rainTemperatureFlux(iCell) + & - evapTemperatureFlux(iCell) + & - seaIceTemperatureFlux(iCell) + & - icebergTemperatureFlux(iCell)) & - - fracAbsorbedRunoff* & - activeTracersSurfaceFluxRunoff(indexTempFlux,iCell) - if (trim(config_subglacial_runoff_mode) == 'data') then - nonLocalSurfaceTracerFlux(indexTempFlux, iCell) = nonLocalSurfaceTracerFlux(indexTempFlux, iCell) & - - fracAbsorbedSubglacialRunoff* & - activeTracersSurfaceFluxSubglacialRunoff(indexTempFlux,iCell) - end if + - fracAbsorbed*surfaceThicknessFlux(iCell) * & + activeTracers(indexTempFlux,kmin,iCell) nonLocalSurfaceTracerFlux(indexSaltFlux,iCell) = & activeTracersSurfaceFlux(indexSaltFlux,iCell) & @@ -3630,21 +3607,8 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & surfaceBuoyancyForcing(iCell) = surfaceBuoyancyForcing(iCell)* & gravity - ! compute magnitude of surface stress - sumSurfaceStressSquared = 0.0_RKIND - do i = 1, nEdgesOnCell(iCell) - iEdge = edgesOnCell(i, iCell) - sumSurfaceStressSquared = sumSurfaceStressSquared & - + edgeAreaFractionOfCell(i,iCell)* & - surfaceStress(iEdge)**2 - enddo - - ! NOTE that the factor of 2 is from averaging dot products - ! to cell centers on a C-grid - surfaceStressMagnitude(iCell) = & - sqrt(2.0_RKIND * sumSurfaceStressSquared) surfaceFrictionVelocity(iCell) = & - sqrt(surfaceStressMagnitude(iCell) / rho_sw) + sqrt(sfcStressMag(iCell) / rho_sw) enddo !$omp end do @@ -3655,11 +3619,11 @@ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, & salineContractionCoeff, & densitySurfaceDisplaced) - call mpas_timer_stop('KPP input fields') + call mpas_timer_stop('Mixing input fields') !------------------------------------------------------------------- - end subroutine ocn_compute_KPP_input_fields!}}} + end subroutine ocn_compute_mixing_input_fields!}}} !*********************************************************************** ! diff --git a/components/mpas-ocean/src/shared/mpas_ocn_tendency.F b/components/mpas-ocean/src/shared/mpas_ocn_tendency.F index 182fca7dbb9..c4f1c55eba6 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_tendency.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_tendency.F @@ -1317,12 +1317,9 @@ subroutine ocn_tend_tracer(tendPool, statePool, forcingPool, & ! ! Compute tracer tendency due to non-local flux computed in KPP ! - if (config_use_cvmix_kpp .or. config_use_gotm) then - call ocn_compute_KPP_input_fields(statePool, forcingPool,& - meshPool, timeLevel) - - if (.not. config_cvmix_kpp_nonlocal_with_implicit_mix) then + if (config_use_cvmix_kpp) then call mpas_timer_start("non-local flux from KPP") + if (.not. config_cvmix_kpp_nonlocal_with_implicit_mix) then if (computeBudgets) then !$omp parallel !$omp do schedule(runtime) private(k,n) @@ -1365,8 +1362,8 @@ subroutine ocn_tend_tracer(tendPool, statePool, forcingPool, & !$omp end do !$omp end parallel endif ! compute budgets - call mpas_timer_stop("non-local flux from KPP") end if ! not non-local with implicit mix + call mpas_timer_stop("non-local flux from KPP") end if ! KPP ! Compute tracer tendency due to production/destruction of diff --git a/components/mpas-ocean/src/shared/mpas_ocn_vmix.F b/components/mpas-ocean/src/shared/mpas_ocn_vmix.F index 68ef9d82a6b..cabdf86ba11 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_vmix.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_vmix.F @@ -27,6 +27,7 @@ module ocn_vmix use mpas_timer use ocn_mesh + use ocn_diagnostics use mpas_constants use ocn_constants use ocn_config @@ -202,6 +203,11 @@ subroutine ocn_vmix_coefs(meshPool, statePool, forcingPool, scratchPool, err, ti !$omp end parallel #endif + if(config_use_cvmix_kpp .or. config_use_gotm) then + call ocn_compute_mixing_input_fields(statePool, forcingPool,& + meshPool, timeLevel) + end if + #ifdef MPAS_OPENACC !$acc update host(vertViscTopOfEdge, vertDiffTopOfCell) #endif diff --git a/components/mpas-ocean/src/shared/mpas_ocn_vmix_cvmix.F b/components/mpas-ocean/src/shared/mpas_ocn_vmix_cvmix.F index 87fb36f2145..fce760487e3 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_vmix_cvmix.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_vmix_cvmix.F @@ -64,7 +64,7 @@ module ocn_vmix_cvmix type(cvmix_shear_params_type) :: cvmix_shear_params type(cvmix_tidal_params_type) :: cvmix_tidal_params - logical :: cvmixOn, cvmixConvectionOn, cvmixKPPOn + logical :: lnonzero_surf_nonlocal, cvmixOn, cvmixConvectionOn, cvmixKPPOn real (kind=RKIND) :: backgroundVisc, backgroundDiff integer :: cvmixBackgroundChoice ! user choice of cvmix background scheme @@ -1042,19 +1042,22 @@ subroutine ocn_vmix_cvmix_init(domain,err)!{{{ ! initialize KPP boundary layer scheme ! if (config_use_cvmix_kpp) then - if(config_cvmix_kpp_matching.eq."MatchBoth") then - call mpas_log_write( & - "Use of option MatchBoth is discouraged, use SimpleShapes instead", & - MPAS_LOG_WARN) - elseif(.not. config_cvmix_kpp_matching.eq."SimpleShapes") then + if(.not. config_cvmix_kpp_matching.eq."SimpleShapes" .and. & + .not. config_cvmix_kpp_matching.eq."MatchBoth" .and. & + .not. config_cvmix_kpp_matching.eq."ParabolicNonLocal") then call mpas_log_write( & "Unknown value for config_cvmix_kpp_matching., supported values are:" // & - " SimpleShapes or MatchBoth", & + " SimpleShapes or MatchBoth or ParabolicNonLocal", & MPAS_LOG_CRIT) err = 1 return endif + lnonzero_surf_nonlocal = .false. + if(config_cvmix_kpp_matching .eq."ParabolicNonLocal") then + lnonzero_surf_nonlocal = .true. + end if + if (trim(config_cvmix_kpp_langmuir_mixing_opt) .ne. "NONE" .and. & trim(config_cvmix_kpp_langmuir_mixing_opt) .ne. "LWF16" .and. & trim(config_cvmix_kpp_langmuir_mixing_opt) .ne. "RWHGK16") then @@ -1081,13 +1084,15 @@ subroutine ocn_vmix_cvmix_init(domain,err)!{{{ call cvmix_init_kpp ( & ri_crit = config_cvmix_kpp_criticalBulkRichardsonNumber, & interp_type = config_cvmix_kpp_interpolationOMLType, & - interp_type2 = config_cvmix_kpp_interpolationOMLType, & + interp_type2 = 'LMD94', & lEkman = config_cvmix_kpp_EkmanOBL, & lMonOb = config_cvmix_kpp_MonObOBL, & MatchTechnique = config_cvmix_kpp_matching, & surf_layer_ext = config_cvmix_kpp_surface_layer_extent, & langmuir_mixing_str = config_cvmix_kpp_langmuir_mixing_opt, & langmuir_entrainment_str = config_cvmix_kpp_langmuir_entrainment_opt, & + lnoDGat1 = .true., & + lnonzero_surf_nonlocal = lnonzero_surf_nonlocal, & lenhanced_diff = config_cvmix_kpp_use_enhanced_diff) endif From 4d243d006a900e57e1fe09f5d92d8bbba527728d Mon Sep 17 00:00:00 2001 From: Luke Van Roekel Date: Thu, 24 Oct 2024 10:35:13 -0500 Subject: [PATCH 222/529] Fixes rebase conflict --- components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F b/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F index 6fa3d5d0a5b..691bfe70b58 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_diagnostics.F @@ -3353,7 +3353,7 @@ subroutine ocn_compute_mixing_input_fields(statePool, forcingPool, & !----------------------------------------------------------------- integer :: & - iCell, iEdge, i, &! loop indices for cell, edge, neighbors + iCell, iEdge, i, k, &! loop indices for cell, edge, neighbors kmin, &! topmost active cell index nCells, &! number of cells err, &! local error code @@ -3362,6 +3362,9 @@ subroutine ocn_compute_mixing_input_fields(statePool, forcingPool, & real (kind=RKIND) :: & fracAbsorbed, &! fraction of sfc flux absorbed fracAbsorbedRunoff, &! same for runoff + fracAbsorbedSubglacialRunoff, &! same for subglacial runoff + zTop,zBot, &! temporary variables + transmissionCoeffTop,transmissionCoeffBot, &! temporary variables sumSurfaceStressSquared ! sum of sfc stress squared ! pointers for variable/pool retrievals From 8de11b56bea84ed24a89a639d50f991869151d5f Mon Sep 17 00:00:00 2001 From: Luke Van Roekel Date: Thu, 24 Oct 2024 15:23:29 -0500 Subject: [PATCH 223/529] fixes restart test failure --- components/mpas-ocean/src/Registry.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 2a21e22f40d..00d926278fb 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -2008,6 +2008,7 @@ + From e5a6ece47bfe61c67d87e201775c612da49218c6 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 25 Oct 2024 19:10:01 -0500 Subject: [PATCH 224/529] v3.NARRM PE-layouts on Anvil - Small: 64 nodes, ~1.8 sypd - SMedium: 96 nodes, ~2.5 sypd - Medium: 128 nodes, ~3.2 sypd --- cime_config/allactive/config_pesall.xml | 46 +++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index 4eba082b40f..f3c92be3c6a 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -2260,6 +2260,52 @@ + + + allactive+anvil: v3.NARRM tri-grid on 64 nodes ~1.8 sypd + + 2160 + 2160 + 2160 + 2160 + 2160 + 144 + + + 2160 + + + + allactive+anvil: v3.NARRM tri-grid on 96 nodes ~2.5 sypd + + 3240 + 3240 + 1080 + 1080 + 2160 + 216 + + + 3240 + 2160 + 2160 + + + + allactive+anvil: v3.NARRM tri-grid on 128 nodes ~3.2 sypd + + 4320 + 4320 + 4320 + 4320 + 4320 + 288 + + + 4320 + + + From daae468ccb4cc3311a65d549e2f0675bf16a24a5 Mon Sep 17 00:00:00 2001 From: xie7 Date: Tue, 29 Oct 2024 00:03:10 -0500 Subject: [PATCH 225/529] Chemistry output bug fix The output of reaction rate of r_lch4 and r_lco_h are not output due to a bug in maint-3.0, fixed it in the code. modified: components/eam/src/chemistry/mozart/rate_diags.F90 [BFB] --- components/eam/src/chemistry/mozart/rate_diags.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/components/eam/src/chemistry/mozart/rate_diags.F90 b/components/eam/src/chemistry/mozart/rate_diags.F90 index 457ede70307..4ad21392f54 100644 --- a/components/eam/src/chemistry/mozart/rate_diags.F90 +++ b/components/eam/src/chemistry/mozart/rate_diags.F90 @@ -126,7 +126,7 @@ subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk, pver, pdeldry, mbar rxt_rates(:ncol,:,rxt_tag_map(i)) = rxt_rates(:ncol,:,rxt_tag_map(i)) * m(:,:) call outfld( rate_names(i), rxt_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) - if ( .not. history_UCIgaschmbudget_2D .and. .not. history_UCIgaschmbudget_2D_levels) return + if (history_UCIgaschmbudget_2D .or. history_UCIgaschmbudget_2D_levels) then if (rate_names(i) .eq. 'r_lch4') then !kg/m2/sec @@ -166,6 +166,8 @@ subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk, pver, pdeldry, mbar endif endif + + endif enddo end subroutine rate_diags_calc From 8a6406080232a2d64d8e4c2ce4626ab2e5273992 Mon Sep 17 00:00:00 2001 From: Yunpeng Shan Date: Wed, 30 Oct 2024 16:12:29 -0500 Subject: [PATCH 226/529] Set diagnositc ice falling flux for COSP as zero to avoid ice double counting in COSP. --- components/eam/src/physics/p3/eam/micro_p3.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eam/src/physics/p3/eam/micro_p3.F90 b/components/eam/src/physics/p3/eam/micro_p3.F90 index e668cbaa494..a07e0c006b1 100644 --- a/components/eam/src/physics/p3/eam/micro_p3.F90 +++ b/components/eam/src/physics/p3/eam/micro_p3.F90 @@ -4350,7 +4350,7 @@ subroutine ice_sedimentation(kts,kte,ktop,kbot,kdir, & dt_left, prt_accum, inv_dz, inv_rho, rho, num_arrays, vs, fluxes, qnr, dt_sub) do k = k_qxbot,k_qxtop,kdir - precip_ice_flux(k+1) = precip_ice_flux(k+1) + flux_qit(k)*dt_sub ! shanyp +! precip_ice_flux(k+1) = precip_ice_flux(k+1) + flux_qit(k)*dt_sub ! shanyp sflx(k+1) = sflx(k+1) + flux_qit(k)*dt_sub enddo @@ -4363,7 +4363,7 @@ subroutine ice_sedimentation(kts,kte,ktop,kbot,kdir, & bm_incld(:) = bm(:)/cld_frac_i(:) enddo substep_sedi_i - precip_ice_flux(:)=precip_ice_flux(:)*inv_dt +! precip_ice_flux(:)=precip_ice_flux(:)*inv_dt sflx(:)=sflx(:)*inv_dt precip_ice_surf = precip_ice_surf + prt_accum*inv_rho_h2o*inv_dt From 5bec775aa33fba2ce1911a6b7358c8221fc80051 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Thu, 31 Oct 2024 01:26:31 -0500 Subject: [PATCH 227/529] Add e3sm_prod PEs for maint-3.0 on Improv --- cime_config/allactive/config_pesall.xml | 31 ++++++++++++++++++------ cime_config/machines/config_machines.xml | 2 +- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index 0d5f2456596..deedb5637de 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -1169,14 +1169,14 @@ improv: any compset on ne30np4 grid - -4 - -4 - -4 - -4 - -4 - -4 - -4 - -4 + -6 + -6 + -6 + -6 + -6 + -6 + -6 + -6 @@ -2065,6 +2065,21 @@ + + + improv+allactive: RRM-WCYCL on 6 nodes + + -6 + -6 + -6 + -6 + -6 + -6 + -6 + -6 + + + cmod016b64x1 s=2.4 diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 9142a5fb24e..0e3295d5f2c 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -2775,7 +2775,7 @@ commented out until "*** No rule to make target '.../libadios2pio-nm-lib.a'" iss /lcrc/group/e3sm/soft/improv/pnetcdf/1.12.3/gcc-12.3.0/openmpi-4.1.6/bin:/lcrc/group/e3sm/soft/improv/netcdf-fortran/4.6.1b/gcc-12.3.0/openmpi-4.1.6/bin:/lcrc/group/e3sm/soft/improv/netcdf-c/4.9.2b/gcc-12.3.0/openmpi-4.1.6/bin:/lcrc/group/e3sm/soft/improv/openmpi/4.1.6/gcc-12.3.0/bin:/lcrc/group/e3sm/soft/perl/improv/bin:$ENV{PATH} $SHELL{lp=/lcrc/group/e3sm/soft/improv/netlib-lapack/3.12.0/gcc-12.3.0:/lcrc/group/e3sm/soft/improv/pnetcdf/1.12.3/gcc-12.3.0/openmpi-4.1.6/lib:/lcrc/group/e3sm/soft/improv/netcdf-fortran/4.6.1b/gcc-12.3.0/openmpi-4.1.6/lib:/lcrc/group/e3sm/soft/improv/netcdf-c/4.9.2b/gcc-12.3.0/openmpi-4.1.6/lib:/opt/pbs/lib:/lcrc/group/e3sm/soft/improv/openmpi/4.1.6/gcc-12.3.0/lib; if [ -z "$LD_LIBRARY_PATH" ]; then echo $lp; else echo "$lp:$LD_LIBRARY_PATH"; fi} $SHELL{if [ -z "$MOAB_ROOT" ]; then echo /lcrc/soft/climate/moab/improv/gnu; else echo "$MOAB_ROOT"; fi} - ^lockedfile + ^lockedfile,individual 128M From d0c3e770aebcb66541603ad3dee87c661f485667 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Thu, 31 Oct 2024 14:40:25 -0500 Subject: [PATCH 228/529] Fix segfault in hydro init due to using cellMask before accessing it --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 06fb2239107..bf9616b4339 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -205,6 +205,8 @@ subroutine li_SGH_init(domain, err) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) call mpas_pool_get_array(hydroPool, 'hydropotential', hydropotential) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) waterPressure = max(0.0_RKIND, waterPressure) where (li_mask_is_grounded_ice(cellMask)) @@ -212,10 +214,6 @@ subroutine li_SGH_init(domain, err) end where ! set pressure and hydropotential correctly on ice-free land and in ocean - call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) - call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - ! - where ((.not. (li_mask_is_grounded_ice(cellMask))) .and. (bedTopography > config_sea_level)) waterPressure = 0.0_RKIND hydropotential = rho_water * gravity * bedTopography From f196ad0788142010daac29868daa5ae42469a772 Mon Sep 17 00:00:00 2001 From: Abhishek Bagusetty Date: Thu, 31 Oct 2024 21:13:07 +0000 Subject: [PATCH 229/529] [HOMME] removed an old kokkos cmd line flag: kokkos-num-devices --- .../homme/src/share/cxx/ExecSpaceDefs.cpp | 45 +------------------ 1 file changed, 1 insertion(+), 44 deletions(-) diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.cpp b/components/homme/src/share/cxx/ExecSpaceDefs.cpp index 0b7a3ab34f8..38db9f033d8 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.cpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.cpp @@ -14,7 +14,7 @@ #include "utilities/MathUtils.hpp" #ifdef KOKKOS_ENABLE_CUDA -# include +#include #endif #ifdef KOKKOS_ENABLE_HIP @@ -34,49 +34,6 @@ namespace Homme { void initialize_kokkos () { // This is in fact const char*, but Kokkos::initialize requires char*. std::vector args; - - // This is the only way to get the round-robin rank assignment Kokkos - // provides, as that algorithm is hardcoded in Kokkos::initialize(int& narg, - // char* arg[]). Once the behavior is exposed in the InitArguments version of - // initialize, we can remove this string code. - // If for some reason we're running on a GPU platform, have Cuda enabled, - // but are using a different execution space, this initialization is still - // OK. The rank gets a GPU assigned and simply will ignore it. -#ifdef KOKKOS_ENABLE_CUDA - int nd; - const auto ret = cudaGetDeviceCount(&nd); - if (ret != cudaSuccess) { - // It isn't a big deal if we can't get the device count. - nd = 1; - } -#elif defined(KOKKOS_ENABLE_HIP) - int nd; - const auto ret = hipGetDeviceCount(&nd); - if (ret != hipSuccess) { - // It isn't a big deal if we can't get the device count. - nd = 1; - } -#elif defined(KOKKOS_ENABLE_SYCL) - -//https://developer.codeplay.com/products/computecpp/ce/2.11.0/guides/sycl-for-cuda-developers/migrating-from-cuda-to-sycl - -//to make it build - int nd = 1; - -#endif - - -#ifdef HOMMEXX_ENABLE_GPU - std::stringstream ss; - ss << "--kokkos-num-devices=" << nd; - const auto key = ss.str(); - std::vector str(key.size()+1); - std::copy(key.begin(), key.end(), str.begin()); - str.back() = 0; - args.push_back(const_cast(str.data())); -#endif - - const char* silence = "--kokkos-disable-warnings"; args.push_back(const_cast(silence)); From 43ba2f54de3db045601d0e093bcda49d757d1ac9 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 31 Oct 2024 23:02:40 -0500 Subject: [PATCH 230/529] Modify pe layouts for anvil Modify pe layouts for v3 prod cases for anvil --- .../testmods_dirs/config_pes_tests.xml | 45 ++++++++++++++----- 1 file changed, 33 insertions(+), 12 deletions(-) diff --git a/cime_config/testmods_dirs/config_pes_tests.xml b/cime_config/testmods_dirs/config_pes_tests.xml index 1ac88ac5fe6..b35d281a3eb 100644 --- a/cime_config/testmods_dirs/config_pes_tests.xml +++ b/cime_config/testmods_dirs/config_pes_tests.xml @@ -161,31 +161,41 @@ - tests+anvil: --compset WCYCL* --res ne30pg2_IcoswISC30E3r5 on 16 nodes pure-MPI + tests+anvil: --compset WCYCL* --res ne30pg2_IcoswISC30E3r5 on 25 nodes pure-MPI - 396 - 396 - 396 - 396 - 180 - 396 + 675 + 324 + 324 + 360 + 216 + 684 - 396 + 0 + 360 + 360 + 0 + 684 + 0 tests+anvil: --compset BGC* --res ne30pg2_r05_IcoswISC30E3r5 on 30 nodes pure-MPI 675 - 684 - 684 - 684 - 396 + 324 + 324 + 360 + 216 684 + 0 + 360 + 360 + 0 684 + 0 @@ -203,6 +213,17 @@ -6 + + "tests+anvil, F compset, 6 nodes" + + -16 + -16 + -16 + -16 + -16 + -16 + + From 0a1fa176d9f220733990b6add688c5ca7282a37d Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Sat, 2 Nov 2024 12:22:33 -0500 Subject: [PATCH 231/529] Update anvil pelayout for v3 RRM Update anvil pe layout for v3 northamericax4v1pg2_WC14to60E2r3 WCYCL --- cime_config/testmods_dirs/config_pes_tests.xml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/cime_config/testmods_dirs/config_pes_tests.xml b/cime_config/testmods_dirs/config_pes_tests.xml index b35d281a3eb..eafc8e2a1fe 100644 --- a/cime_config/testmods_dirs/config_pes_tests.xml +++ b/cime_config/testmods_dirs/config_pes_tests.xml @@ -262,17 +262,17 @@ - tests+anvil: --compset WCYCL1850 --res northamericax4v1pg2_WC14to60E2r3 on 64 nodes pure-MPI, 2.133 sypd + tests+anvil: --compset WCYCL1850 --res northamericax4v1pg2_WC14to60E2r3 on 69 nodes pure-MPI, 2.046 sypd - 1800 - 1800 - 1800 - 1800 + 1980 + 1980 + 1980 + 1944 504 - 1800 + 1980 - 1800 + 1980 From 0738be8799bad20be045df2c6532976589a0b473 Mon Sep 17 00:00:00 2001 From: xie7 Date: Mon, 4 Nov 2024 15:38:49 -0600 Subject: [PATCH 232/529] Modified the code and added orodrag development suite. 1. The code is modified for better format according to comments. 2. A new development suite for the new orographic drag schemes is added to the code. modified: ../../../../../cime_config/tests.py new file: ../../../cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam modified: clubb_intr.F90 modified: comsrf.F90 modified: gw_common.F90 modified: gw_drag.F90 modified: physpkg.F90 modified: ../../../tools/topo_tool/orographic_drag_toolkit/make.ncl [BFB] --- cime_config/tests.py | 15 +- .../testmods_dirs/eam/orodrag/user_nl_eam | 6 + components/eam/src/physics/cam/clubb_intr.F90 | 37 +- components/eam/src/physics/cam/comsrf.F90 | 18 +- components/eam/src/physics/cam/gw_common.F90 | 2338 +++++++++-------- components/eam/src/physics/cam/gw_drag.F90 | 57 +- components/eam/src/physics/cam/physpkg.F90 | 14 +- .../orographic_drag_toolkit/make.ncl | 19 +- 8 files changed, 1313 insertions(+), 1191 deletions(-) create mode 100644 components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam diff --git a/cime_config/tests.py b/cime_config/tests.py index 1cbf28b8397..e2ab71f0c53 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -176,7 +176,7 @@ ) }, - "e3sm_p3_developer" : { + "e3sm_p3_developer" : { "tests" : ( "ERP.ne4pg2_oQU480.F2010.eam-p3", "REP_Ln5.ne4pg2_oQU480.F2010.eam-p3", @@ -188,6 +188,19 @@ "ERS.ne4pg2_oQU480.F2010.eam-p3" ) }, + + "e3sm_orodrag_developer" : { + "tests" : ( + "ERP.ne4pg2_oQU480.F2010.eam-orodrag", + "REP_Ln5.ne4pg2_oQU480.F2010.eam-orodrag", + "PET.ne4pg2_oQU480.F2010.eam-orodrag", + "PEM_Ln18.ne4pg2_oQU480.F2010.eam-orodrag", + "SMS_Ln5.ne30pg2_EC30to60E2r2.F2010.eam-orodrag", + "SMS_D_Ln5.ne4pg2_oQU480.F2010.eam-orodrag", + "SMS_Ln5.ne4pg2_oQU480.F2010.eam-orodrag", + "ERS.ne4pg2_oQU480.F2010.eam-orodrag" + ) + }, "e3sm_atm_integration" : { "inherit" : ("eam_preqx", "eam_theta"), diff --git a/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam new file mode 100644 index 00000000000..e14e93f8374 --- /dev/null +++ b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam @@ -0,0 +1,6 @@ +use_gw_oro=.false. +use_od_ls=.true. +use_od_bl=.true. +use_od_ss=.true. +use_od_fd=.true. + diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index 306ee7ca732..c9c3bcdfa2c 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -631,7 +631,8 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) use constituents, only: cnst_get_ind use phys_control, only: phys_getopts - use parameters_tunable, only: params_list + use parameters_tunable, only: params_list + use cam_abortutils, only: endrun #endif @@ -927,6 +928,8 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) call addfld ('VMAGDP', horiz_only, 'A', '-', 'ZM gustiness enhancement') call addfld ('VMAGCL', horiz_only, 'A', '-', 'CLUBB gustiness enhancement') call addfld ('TPERTBLT', horiz_only, 'A', 'K', 'perturbation temperature at PBL top') + ! + if (use_od_fd) then !!added for TOFD output call addfld ('DTAUX3_FD',(/'lev'/),'A','m/s2','U tendency - fd orographic drag') call addfld ('DTAUY3_FD',(/'lev'/),'A','m/s2','V tendency - fd orographic drag') @@ -936,6 +939,16 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) call add_default('DTAUY3_FD', 1, ' ') call add_default('DUSFC_FD', 1, ' ') call add_default('DVSFC_FD', 1, ' ') + if (masterproc) then + write(iulog,*)'Using turbulent orographic form drag scheme (TOFD)' + end if + ! + if (use_od_fd.and.do_tms) then + call endrun("clubb_intr: Both TMS and TOFD are turned on, please turn one off& + &by setting use_od_fd or do_tms as .false.") + end if + ! + end if ! Initialize statistics, below are dummy variables dum1 = 300._r8 dum2 = 1200._r8 @@ -1166,7 +1179,6 @@ subroutine clubb_tend_cam( & use gw_common, only: grid_size,gw_oro_interface use hycoef, only: etamid use physconst, only: rh2o,pi,rearth,r_universal - !!get the znu,znw,p_top set to 0 implicit none ! --------------- ! @@ -3217,7 +3229,7 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) real(r8) :: kinheat ! kinematic surface heat flux real(r8) :: kinwat ! kinematic surface vapor flux real(r8) :: kbfs ! kinematic surface buoyancy flux - real(r8) :: kbfs_pcol(pcols) + real(r8) :: kbfs_pcol(pcols) ! kinematic surface buoyancy flux stored for all pcols integer :: ixq,ixcldliq !PMA fix for thv real(r8) :: rrho ! Inverse air density @@ -3248,44 +3260,49 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) thv(i) = th(i)*(1._r8+zvir*state%q(i,pver,ixq)) ! diagnose virtual potential temperature end if enddo - ! + do i = 1, ncol call calc_ustar( state%t(i,pver), state%pmid(i,pver), cam_in%wsx(i), cam_in%wsy(i), & rrho, ustar(i) ) call calc_obklen( th(i), thv(i), cam_in%cflx(i,1), cam_in%shf(i), rrho, ustar(i), & kinheat, kinwat, kbfs, obklen(i) ) enddo - ! + if (use_od_ss) then !add calculation of bulk richardson number here ! !compute the whole level th and thv for diagnose of bulk richardson number thv_lv=0.0_r8 th_lv=0.0_r8 - ! + + !use the same virtual potential temperature formula as above (thv) except for all vertical levels + !used for bulk richardson number below in pblintd_ri do i=1,ncol do k=1,pver th_lv(i,k) = state%t(i,k)*state%exner(i,k) if (use_sgv) then thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq) & - - state%q(i,k,ixcldliq)) !PMA corrects thv formula + - state%q(i,k,ixcldliq)) else thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq)) end if enddo enddo - ! + + !recalculate the kbfs stored in kbfs_pcol for bulk richardson number in pblintd_ri kbfs_pcol=0.0_r8 do i=1,ncol + call calc_ustar( state%t(i,pver), state%pmid(i,pver), cam_in%wsx(i), cam_in%wsy(i), rrho, ustar(i) ) call calc_obklen( th(i), thv(i), cam_in%cflx(i,1), cam_in%shf(i), rrho, ustar(i), & kinheat, kinwat, kbfs, obklen(i) ) kbfs_pcol(i)=kbfs enddo - ! + + !calculate the bulk richardson number call pblintd_ri(ncol, gravit, thv_lv, state%zm, state%u, state%v, & ustar, obklen, kbfs_pcol, state%ribulk) endif - ! + return #endif diff --git a/components/eam/src/physics/cam/comsrf.F90 b/components/eam/src/physics/cam/comsrf.F90 index 9d38e117d8d..02ddbbb1e84 100644 --- a/components/eam/src/physics/cam/comsrf.F90 +++ b/components/eam/src/physics/cam/comsrf.F90 @@ -155,16 +155,16 @@ subroutine initialize_comsrf2 integer k,c ! level, constituent indices if(.not. (adiabatic .or. ideal_phys)) then - allocate (var(pcols,begchunk:endchunk)) - allocate (var30(pcols,begchunk:endchunk)) - allocate (oc(pcols,begchunk:endchunk)) - allocate (oadir(pcols,nvar_dirOA,begchunk:endchunk)) - allocate (ol(pcols,nvar_dirOL,begchunk:endchunk)) - var(:,:)=nan - var30(:,:)=nan - oc (:,:) = nan + allocate (var (pcols,begchunk:endchunk)) + allocate (var30 (pcols,begchunk:endchunk)) + allocate (oc (pcols,begchunk:endchunk)) + allocate (oadir (pcols,nvar_dirOA,begchunk:endchunk)) + allocate (ol (pcols,nvar_dirOL,begchunk:endchunk)) + var (:,:) = nan + var30 (:,:) = nan + oc (:,:) = nan oadir (:,:,:) = nan - ol (:,:,:) = nan + ol (:,:,:) = nan end if end subroutine initialize_comsrf2 diff --git a/components/eam/src/physics/cam/gw_common.F90 b/components/eam/src/physics/cam/gw_common.F90 index 36a1691f757..98743b2b847 100644 --- a/components/eam/src/physics/cam/gw_common.F90 +++ b/components/eam/src/physics/cam/gw_common.F90 @@ -745,7 +745,9 @@ subroutine gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, & end if end subroutine gw_drag_prof + !========================================================================== + subroutine gw_oro_interface(state, cam_in, sgh, pbuf, dtime, nm,& gwd_ls, gwd_bl, gwd_ss, gwd_fd,& ncleff_ls,ncd_bl, sncleff_ss,& @@ -760,14 +762,14 @@ subroutine gw_oro_interface(state, cam_in, sgh, pbuf, dtime, n use ppgrid, only: pcols,pver,pverp use physconst, only: gravit,rair,cpair,rh2o,zvir,pi use hycoef, only: etamid - ! + type(physics_state), intent(in) :: state ! physics state structure ! Standard deviation of orography. type(cam_in_t), intent(in) :: cam_in real(r8), intent(in) :: sgh(pcols) type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer real(r8), intent(in) :: dtime real(r8), intent(in) :: nm(state%ncol,pver) ! midpoint Brunt-Vaisalla frequency - ! + !options for the 4 schemes logical , intent(in) :: gwd_ls logical , intent(in) :: gwd_bl logical , intent(in) :: gwd_ss @@ -776,11 +778,11 @@ subroutine gw_oro_interface(state, cam_in, sgh, pbuf, dtime, n real(r8), intent(in) :: ncleff_ls real(r8), intent(in) :: ncd_bl real(r8), intent(in) :: sncleff_ss - ! + !vertical profile of the momentum tendencies real(r8), intent(out), optional :: utgw(state%ncol,pver) real(r8), intent(out), optional :: vtgw(state%ncol,pver) real(r8), intent(out), optional :: ttgw(state%ncol,pver) - ! + !output drag terms in 3D and surface real(r8), intent(out), optional :: dtaux3_ls(pcols,pver) real(r8), intent(out), optional :: dtauy3_ls(pcols,pver) real(r8), intent(out), optional :: dtaux3_bl(pcols,pver) @@ -807,157 +809,165 @@ subroutine gw_oro_interface(state, cam_in, sgh, pbuf, dtime, n !pblh input integer :: pblh_idx = 0 integer :: kpbl2d_in(pcols) + integer :: kpbl2d_reverse_in(pcols) real(r8), pointer :: pblh(:) real(r8) :: dx(pcols),dy(pcols) !needed index integer :: ncol integer :: i integer :: k - !local transfer variables - real(r8) :: dtaux3_ls_local(pcols,pver) - real(r8) :: dtauy3_ls_local(pcols,pver) - real(r8) :: dtaux3_bl_local(pcols,pver) - real(r8) :: dtauy3_bl_local(pcols,pver) - real(r8) :: dtaux3_ss_local(pcols,pver) - real(r8) :: dtauy3_ss_local(pcols,pver) - real(r8) :: dtaux3_fd_local(pcols,pver) - real(r8) :: dtauy3_fd_local(pcols,pver) - real(r8) :: dusfc_ls_local(pcols) - real(r8) :: dvsfc_ls_local(pcols) - real(r8) :: dusfc_bl_local(pcols) - real(r8) :: dvsfc_bl_local(pcols) - real(r8) :: dusfc_ss_local(pcols) - real(r8) :: dvsfc_ss_local(pcols) - real(r8) :: dusfc_fd_local(pcols) - real(r8) :: dvsfc_fd_local(pcols) - - ! - ncol=state%ncol - !convert heights above surface to heights above sea level - !obtain z,dz,dx,dy - !ztop and zbot are already reversed, start from bottom to top - kpbl2d_in=0_r8 - ! - ztop(1:ncol,1:pver)=0._r8 - zbot(1:ncol,1:pver)=0._r8 - zmid(1:ncol,1:pver)=0._r8 - ! - do k=1,pverp-1 - ! assign values for level top/bottom - ztop(1:ncol,k)=state%zi(1:ncol,pverp-k) - zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1) - end do - !transform adding the pressure - !transfer from surface to sea level - do k=1,pver - do i=1,ncol - ztop(i,k)=ztop(i,k)+state%phis(i)/gravit - zbot(i,k)=zbot(i,k)+state%phis(i)/gravit - zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit - !dz is from bottom to top already for gw_drag - dz(i,k)=ztop(i,k)-zbot(i,k) - end do - end do - !reverse to keep good format in scheme - ztop=ztop(:,pver:1:-1) - zbot=zbot(:,pver:1:-1) - !get the layer index of pblh in layer for input in drag scheme - pblh_idx = pbuf_get_index('pblh') - call pbuf_get_field(pbuf, pblh_idx, pblh) - do i=1,pcols - kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/gravit),pblh(i)) - end do - ! - !get grid size for dx,dy - call grid_size(state,dx,dy) - !interface for orographic drag - !if (gwd_fd.eq.0) then - call gwdo_gsd(& - u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& - qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& - pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& - ncleff_ls=ncleff_ls,ncd_bl=ncd_bl,sncleff_ss=sncleff_ss,& - rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& - dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& - dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& - dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& - dtaux3d_fd=dtaux3_fd(:ncol,pver:1:-1),dtauy3d_fd=dtauy3_fd(:ncol,pver:1:-1),& - dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& - dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& - dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& - dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& - xland=cam_in%landfrac,br=state%ribulk(:ncol),& - var2d=sgh(:ncol),oc12d=state%oc(:ncol),& - oa2d=state%oadir(:ncol,:),ol2d=state%ol(:ncol,:),& - znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& - cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& - dt=dtime,dx=dx,dy=dy,& - kpbl2d=kpbl2d_in,itimestep=dtime,gwd_opt=0,& - ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & - ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & - its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & - gwd_ls=gwd_ls,gwd_bl=gwd_bl,gwd_ss=gwd_ss,gwd_fd=gwd_fd ) - ! + + ncol=state%ncol + !convert heights above surface to heights above sea level + !obtain z,dz,dx,dy,and k for pblh + kpbl2d_in=0_r8 + kpbl2d_reverse_in=0_r8 + ztop=0._r8 + zbot=0._r8 + zmid=0._r8 + dusfc_ls=0._r8 + dvsfc_ls=0._r8 + dusfc_bl=0._r8 + dvsfc_bl=0._r8 + dusfc_ss=0._r8 + dvsfc_ss=0._r8 + dusfc_fd=0._r8 + dvsfc_fd=0._r8 + dtaux3_ls=0._r8 + dtaux3_bl=0._r8 + dtauy3_ls=0._r8 + dtauy3_bl=0._r8 + dtaux3_ss=0._r8 + dtaux3_fd=0._r8 + dtauy3_ss=0._r8 + dtauy3_fd=0._r8 + + do k=1,pver + do i=1,ncol + ! assign values for level top/bottom + ztop(i,k)=state%zi(i,k) + zbot(i,k)=state%zi(i,k+1) + enddo + end do + + !transform adding the pressure + !transfer from surface to sea level + do k=1,pver + do i=1,ncol + ztop(i,k)=ztop(i,k)+state%phis(i)/gravit + zbot(i,k)=zbot(i,k)+state%phis(i)/gravit + zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit + !dz is from bottom to top already for gw_drag + dz(i,k)=ztop(i,k)-zbot(i,k) + end do + end do + !get the layer index of pblh in layer for input in drag scheme + pblh_idx = pbuf_get_index('pblh') + call pbuf_get_field(pbuf, pblh_idx, pblh) + do i=1,pcols + kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/gravit),pblh(i)) + kpbl2d_reverse_in(i)=pverp-kpbl2d_in(i)!pverp-k + end do + + !get grid size for dx,dy + call grid_size(state,dx,dy) + !interface for orographic drag + call gwdo_gsd(& + u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& + qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& + pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& + ncleff_ls=ncleff_ls,ncd_bl=ncd_bl,sncleff_ss=sncleff_ss,& + rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& + dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& + dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& + dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& + dtaux3d_fd=dtaux3_fd(:ncol,pver:1:-1),dtauy3d_fd=dtauy3_fd(:ncol,pver:1:-1),& + dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& + dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& + dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& + dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& + xland=cam_in%landfrac,br=state%ribulk(:ncol),& + var2d=sgh(:ncol),oc12d=state%oc(:ncol),& + oa2d=state%oadir(:ncol,:),ol2d=state%ol(:ncol,:),& + znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& + cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& + dt=dtime,dx=dx,dy=dy,& + kpbl2d=kpbl2d_reverse_in,gwd_opt=0,& + ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & + ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & + its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & + gwd_ls=gwd_ls,gwd_bl=gwd_bl,gwd_ss=gwd_ss,gwd_fd=gwd_fd ) + end subroutine gw_oro_interface + !========================================================================== + function pblh_get_level_idx(height_array,pblheight) -implicit none -real(8),intent(in),dimension(pver) :: height_array -real(8),intent(in) :: pblheight -integer :: pblh_get_level_idx - -!local -integer :: i -logical :: found - -pblh_get_level_idx = -1 -found=.False. - -do i = 1, pver - if((pblheight >= height_array(i+1).and.pblheight = height_array(k+1).and.pblheight 300._r8) then - kpbl2 = k - IF (k == kpbl(i)) then - hpbl2 = hpbl(i)+10._r8 - ELSE - hpbl2 = za(i,k)+10._r8 - ENDIF - exit - ENDIF - enddo - - if(xland1(i).gt.0._r8 .and. 2._r8*var(i).le.hpbl(i))then - if(br1(i).gt.0._r8 .and. thvx(i,kpbl2)-thvx(i,kts) > 0._r8)then - cleff = sqrt(dxy(i)**2_r8 + dxyp(i)**2_r8) - cleff = (2.0_r8/sncleff) * max(dxmax_ss,cleff) - coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) - xlinv(i) = coefm(i) / cleff - govrth(i)=g/(0.5_r8*(thvx(i,kpbl2)+thvx(i,kts))) - XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) -! - if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then - tauwavex0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2_r8*ro(i,kvar)*u1(i,kvar) - tauwavex0=tauwavex0*ss_taper ! "Scale-awareness" - else - tauwavex0=0._r8 - endif -! - if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then - tauwavey0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2._r8*ro(i,kvar)*v1(i,kvar) - tauwavey0=tauwavey0*ss_taper ! "Scale-awareness" - else - tauwavey0=0._r8 - endif -! + do i=its,ite + hpbl2 = hpbl(i)+10._r8 + kpbl2 = kpbl(i) + kvar = 1 + do k=kts+1,MAX(kpbl(i),kts+1) + IF (za(i,k)>300._r8) then + kpbl2 = k + IF (k == kpbl(i)) then + hpbl2 = hpbl(i)+10._r8 + ELSE + hpbl2 = za(i,k)+10._r8 + ENDIF + exit + ENDIF + enddo - do k=kts,kpbl(i) !MIN(kpbl2+1,kte-1) - utendwave(i,k)=-1._r8*tauwavex0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 - vtendwave(i,k)=-1._r8*tauwavey0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 - enddo - endif - endif - enddo ! end i loop + if(xland1(i).gt.0._r8 .and. 2._r8*var(i).le.hpbl(i))then + if(br1(i).gt.0._r8 .and. thvx(i,kpbl2)-thvx(i,kts) > 0._r8)then + cleff = sqrt(dxy(i)**2_r8 + dxyp(i)**2_r8) + cleff = (2.0_r8/sncleff) * max(dxmax_ss,cleff) + coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) + xlinv(i) = coefm(i) / cleff + govrth(i)=g/(0.5_r8*(thvx(i,kpbl2)+thvx(i,kts))) + XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) + + if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then + tauwavex0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2_r8*ro(i,kvar)*u1(i,kvar) + tauwavex0=tauwavex0*ss_taper ! "Scale-awareness" + else + tauwavex0=0._r8 + endif - do k = kts,kte - do i = its,ite - dudt(i,k) = dudt(i,k) + utendwave(i,k) - dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) - dtaux2d_ss(i,k) = utendwave(i,k) - dtauy2d_ss(i,k) = vtendwave(i,k) - dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) - dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) - enddo + if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then + tauwavey0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2._r8*ro(i,kvar)*v1(i,kvar) + tauwavey0=tauwavey0*ss_taper ! "Scale-awareness" + else + tauwavey0=0._r8 + endif + + do k=kts,kpbl(i) !MIN(kpbl2+1,kte-1) + utendwave(i,k)=-1._r8*tauwavex0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + vtendwave(i,k)=-1._r8*tauwavey0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + enddo + endif + endif + enddo ! end i loop + + do k = kts,kte + do i = its,ite + dudt(i,k) = dudt(i,k) + utendwave(i,k) + dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) + dtaux2d_ss(i,k) = utendwave(i,k) + dtauy2d_ss(i,k) = vtendwave(i,k) + dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) + dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) enddo + enddo -ENDIF ! end if gsd_gwd_ss == .true. -!================================================================ -!add Beljaars et al. (2004, QJRMS, equ. 16) form drag: -!================================================================ -IF (gsd_gwd_fd.and.(ss_taper.GT.1.E-02) ) THEN + ENDIF ! end if gsd_gwd_ss == .true. + !================================================================ + !add Beljaars et al. (2004, QJRMS, equ. 16) form drag: + !================================================================ + IF (gsd_gwd_fd.and.(ss_taper.GT.1.E-02) ) THEN - utendform=0._r8 - vtendform=0._r8 - zq=0._r8 + utendform=0._r8 + vtendform=0._r8 + zq=0._r8 - IF (.not.gsd_gwd_ss.and.(ss_taper.GT.1.E-02) ) THEN + IF (.not.gsd_gwd_ss.and.(ss_taper.GT.1.E-02) ) THEN ! Defining layer height. This is already done above is small-scale GWD is used do k = kts,kte do i = its,ite @@ -1847,152 +1927,156 @@ subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & za(i,k) = 0.5_r8*(zq(i,k)+zq(i,k+1)) enddo enddo - ENDIF + ENDIF - DO i=its,ite + DO i=its,ite IF (xland1(i) .gt. 0..and.2._r8*var(i).gt.0) then - a1=0.00026615161_r8*var(i)**2_r8 - a2=a1*0.005363_r8 - DO k=kts,kte - wsp=SQRT(u1(i,k)**2_r8 + v1(i,k)**2_r8) - ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - utendform(i,k)=-0.0759_r8*wsp*u1(i,k)* & - EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper - vtendform(i,k)=-0.0759_r8*wsp*v1(i,k)* & - EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper - ! + a1=0.00026615161_r8*var(i)**2_r8 + a2=a1*0.005363_r8 + DO k=kts,kte + wsp=SQRT(u1(i,k)**2_r8 + v1(i,k)**2_r8) + ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + utendform(i,k)=-0.0759_r8*wsp*u1(i,k)* & + EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper + vtendform(i,k)=-0.0759_r8*wsp*v1(i,k)* & + EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper + ! ENDDO ENDIF - ENDDO - ! - do k = kts,kte + ENDDO + + do k = kts,kte do i = its,ite - dudt(i,k) = dudt(i,k) + utendform(i,k) - dvdt(i,k) = dvdt(i,k) + vtendform(i,k) - !limit drag tendency - !some tendency is likely to even overturn the wind, - !making wind reverse in 1 timestep and reverse again in next, - !this limitation may help to make model stable, - !and no more wind reversal due to drag, - !which is suppose to decelerate, not accelerate - utendform(i,k) = sign(min(abs(utendform(i,k)),abs(u1(i,k))/kdt),utendform(i,k)) - vtendform(i,k) = sign(min(abs(vtendform(i,k)),abs(v1(i,k))/kdt),vtendform(i,k)) - dtaux2d_fd(i,k) = utendform(i,k) - dtauy2d_fd(i,k) = vtendform(i,k) - dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) - dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) + dudt(i,k) = dudt(i,k) + utendform(i,k) + dvdt(i,k) = dvdt(i,k) + vtendform(i,k) + !limit drag tendency + !some tendency is likely to even overturn the wind, + !making wind reverse in 1 timestep and reverse again in next, + !this limitation may help to make model stable, + !and no more wind reversal due to drag, + !which is suppose to decelerate, not accelerate + utendform(i,k) = sign(min(abs(utendform(i,k)),abs(u1(i,k))/deltim),utendform(i,k)) + vtendform(i,k) = sign(min(abs(vtendform(i,k)),abs(v1(i,k))/deltim),vtendform(i,k)) + dtaux2d_fd(i,k) = utendform(i,k) + dtauy2d_fd(i,k) = vtendform(i,k) + dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) + dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) enddo enddo ENDIF ! end if gsd_gwd_fd == .true. -!======================================================= -! More for the large-scale gwd component -!======================================================= -IF (gsd_gwd_ls.and.(ls_taper.GT.1.E-02) ) THEN -! -! now compute vertical structure of the stress. -! - do k = kts,kpblmax - do i = its,ite - if (k .le. kbl(i)) taup(i,k) = taub(i) - enddo - enddo -! -!determination of the interface height -do i=its,ite -iint=.false. - do k=kpblmin,kte-1 - if (k.gt.kbl(i).and.usqj(1,k)-usqj(1,k-1).lt.0.and.(.not.iint)) then - iint=.true. - zl_hint(i)=zl(i,k+1) + !======================================================= + ! More for the large-scale gwd component + !======================================================= + IF (gsd_gwd_ls.and.(ls_taper.GT.1.E-02) ) THEN + ! + ! now compute vertical structure of the stress. + ! + do k = kts,kpblmax + do i = its,ite + if (k .le. kbl(i)) taup(i,k) = taub(i) + enddo + enddo + + if (scorer_on) then + ! + !determination of the interface height for scorer adjustment + ! + do i=its,ite + iint=.false. + do k=kpblmin,kte-1 + if (k.gt.kbl(i).and.usqj(i,k)-usqj(i,k-1).lt.0.and.(.not.iint)) then + iint=.true. + zl_hint(i)=zl(i,k+1) endif - enddo -enddo - do k = kpblmin, kte-1 ! vertical level k loop! - kp1 = k + 1 - do i = its,ite -! -! unstablelayer if ri < ric -! unstable layer if upper air vel comp along surf vel <=0 (crit lay) -! at (u-c)=0. crit layer exists and bit vector should be set (.le.) -! - if (k .ge. kbl(i)) then - !we modify the criteria for unstable layer - !that the lv is critical under 0.25 - !while we keep wave breaking ric for - !other larger lv - icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric_rig)& - .or. (velco(i,k) .le. 0.0_r8) - brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared - brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency - endif enddo -! - do i = its,ite - if (k .ge. kbl(i) .and. (.not. ldrag(i))) then - if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0_r8 ) then - temv = 1.0_r8 / velco(i,k) - tem1 = coefm(i)/(dxy(i)/ncleff)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5_r8 - hd = sqrt(taup(i,k) / tem1) - fro = brvf(i) * hd * temv - - ! - ! rim is the minimum-richardson number by shutts (1985) - ! - tem2 = sqrt(usqj(i,k)) - tem = 1._r8 + tem2 * fro - rim = usqj(i,k) * (1._r8-fro) / (tem * tem) - - ! - ! check stability to employ the 'saturation hypothesis' - ! of lindzen (1981) except at tropospheric downstream regions - ! - if (rim .le. ric) then ! saturation hypothesis! - if ((oa1(i) .le. 0._r8).or.(kp1 .ge. kpblmin )) then - temc = 2.0_r8 + 1.0_r8 / tem2 - hd = velco(i,k) * (2.0_r8*sqrt(temc)-temc) / brvf(i) - taup(i,kp1) = tem1 * hd * hd - ! - ! taup is restricted to monotoncally decrease - ! to avoid unexpected high taup with taup cal - taup(i,kp1)=min(tem1*hd*hd,taup(i,k)) - !add vertical decrease at low level below hint (Kim and Doyle 2005) - !where Ri first decreases - if (k.gt.klowtop(i).and.zl(i,k).le.zl_hint(i)) then - l1=(9.81_r8*bnv2(i,kp1)/velco(i,kp1)**2)!-(shr2_xjb(i,kp1)/velco(i,kp1)) - l2=(9.81_r8*bnv2(i,k)/velco(i,k)**2)!-(shr2_xjb(i,k)/velco(i,k)) - taup(i,kp1)=min(taup(i,k),taup(i,k)*(l1/l2),tem1*hd*hd) - endif + enddo + endif + + do k = kpblmin, kte-1 ! vertical level k loop! + kp1 = k + 1 + do i = its,ite + ! + ! unstablelayer if ri < ric + ! unstable layer if upper air vel comp along surf vel <=0 (crit lay) + ! at (u-c)=0. crit layer exists and bit vector should be set (.le.) + ! + if (k .ge. kbl(i)) then + !we modify the criteria for unstable layer + !that the lv is critical under 0.25 + !while we keep wave breaking ric for + !other larger lv + icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric_rig)& + .or. (velco(i,k) .le. 0.0_r8) + brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared + brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency + endif + enddo + + do i = its,ite + if (k .ge. kbl(i) .and. (.not. ldrag(i))) then + if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0_r8 ) then + temv = 1.0_r8 / velco(i,k) + tem1 = coefm(i)/(dxy(i)/ncleff)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5_r8 + hd = sqrt(taup(i,k) / tem1) + fro = brvf(i) * hd * temv + ! + ! rim is the minimum-richardson number by shutts (1985) + ! + tem2 = sqrt(usqj(i,k)) + tem = 1._r8 + tem2 * fro + rim = usqj(i,k) * (1._r8-fro) / (tem * tem) + + ! + ! check stability to employ the 'saturation hypothesis' + ! of lindzen (1981) except at tropospheric downstream regions + ! + if (rim .le. ric) then ! saturation hypothesis! + if ((oa1(i) .le. 0._r8).or.(kp1 .ge. kpblmin )) then + temc = 2.0_r8 + 1.0_r8 / tem2 + hd = velco(i,k) * (2.0_r8*sqrt(temc)-temc) / brvf(i) + taup(i,kp1) = tem1 * hd * hd + ! + ! taup is restricted to monotoncally decrease + ! to avoid unexpected high taup in calculation + ! + taup(i,kp1)=min(tem1*hd*hd,taup(i,k)) + ! + ! add vertical decrease at low level below hint (Kim and Doyle 2005) + ! where Ri first decreases + ! + if (scorer_on.and.k.gt.klowtop(i).and.zl(i,k).le.zl_hint(i).and.k.lt.kte-1) then + l1=(9.81_r8*bnv2(i,kp1)/velco(i,kp1)**2) + l2=(9.81_r8*bnv2(i,k)/velco(i,k)**2) + taup(i,kp1)=min(taup(i,k),taup(i,k)*(l1/l2),tem1*hd*hd) endif - else ! no wavebreaking! - taup(i,kp1) = taup(i,k) endif + else ! no wavebreaking! + taup(i,kp1) = taup(i,k) endif endif - enddo - enddo -! - - - if(lcap.lt.kte) then - do klcap = lcapp1,kte + endif + enddo + enddo - do i = its,ite - taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) - enddo + if(lcap.lt.kte) then + do klcap = lcapp1,kte + do i = its,ite + taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) enddo - endif + enddo + endif -ENDIF !END LARGE-SCALE TAU CALCULATION -!=============================================================== -!COMPUTE BLOCKING COMPONENT -!=============================================================== -IF (gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN + ENDIF !END LARGE-SCALE TAU CALCULATION + !=============================================================== + !COMPUTE BLOCKING COMPONENT + !=============================================================== + IF (gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN - do i = its,ite - if(.not.ldrag(i)) then -! -!------- determine the height of flow-blocking layer -! + do i = its,ite + if(.not.ldrag(i)) then + ! + !------- determine the height of flow-blocking layer + ! kblk = 0 pe = 0.0_r8 @@ -2003,9 +2087,9 @@ subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & !divided by g*ro is to turn del(pa) into height pe = pe + bnv2(i,k)*(zl(i,komax(i))-zl(i,k))*del(i,k)/g/ro(i,k) ke = 0.5_r8*((rcs*u1(i,k))**2._r8+(rcs*v1(i,k))**2._r8) -! -!---------- apply flow-blocking drag when pe >= ke -! + ! + !---------- apply flow-blocking drag when pe >= ke + ! if(pe.ge.ke) then kblk = k kblk = min(kblk,kbl(i)) @@ -2013,10 +2097,11 @@ subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & endif endif enddo + if(kblk.ne.0) then -! -!--------- compute flow-blocking stress -! + ! + !--------- compute flow-blocking stress + ! !dxmax_ls is different than the usual one !because the taper is very different @@ -2041,26 +2126,26 @@ subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & ! !taup(i,:) = taup(i,:) + taufb(i,:) ! Keep taup and taufb separate for now endif - endif - enddo + endif + enddo -ENDIF ! end blocking drag + ENDIF ! end blocking drag !=========================================================== -IF (gsd_gwd_ls.OR.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN + IF (gsd_gwd_ls.OR.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN + ! + ! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy + ! -! -! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy -! do k = kts,kte do i = its,ite taud_ls(i,k) = 1._r8 * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) taud_bl(i,k) = 1._r8 * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) enddo enddo -! -! limit de-acceleration (momentum deposition ) at top to 1/2 value -! the idea is some stuff must go out the 'top' -! + ! + ! limit de-acceleration (momentum deposition ) at top to 1/2 value + ! the idea is some stuff must go out the 'top' + ! do klcap = lcap,kte do i = its,ite @@ -2068,12 +2153,12 @@ subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & taud_bl(i,klcap) = taud_bl(i,klcap) * factop enddo enddo - -! -! if the gravity wave drag would force a critical line -! in the lower ksmm1 layers during the next deltim timestep, -! then only apply drag until that critical line is reached. -! + + ! + ! if the gravity wave drag would force a critical line + ! in the lower ksmm1 layers during the next deltim timestep, + ! then only apply drag until that critical line is reached. + ! do k = kts,kpblmax-1 do i = its,ite if (k .le. kbl(i)) then @@ -2083,7 +2168,6 @@ subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & endif enddo enddo -! do k = kts,kte do i = its,ite @@ -2092,7 +2176,7 @@ subroutine gwdo2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & !1.dudt < |c-u|/dt, so u-c cannot change sign(u^n+1 = u^n + du/dt * dt) !2.dudt shr_kind_r8 - use ppgrid, only: pcols,pver,pverp,nvar_dirOA,nvar_dirOL,begchunk,endchunk - use hycoef, only: hyai, hybi, hyam, hybm, etamid !get the znu,znw,p_top set to 0 + use ppgrid, only: pcols, pver, pverp, nvar_dirOA, nvar_dirOL, begchunk, endchunk + use hycoef, only: hyai, hybi, hyam, hybm, etamid use constituents, only: pcnst use physics_types, only: physics_state, physics_ptend, physics_ptend_init use spmd_utils, only: masterproc use cam_history, only: outfld, hist_fld_active use cam_logfile, only: iulog - use cam_abortutils, only: endrun + use cam_abortutils,only: endrun use ref_pres, only: do_molec_diff, ntop_molec, nbot_molec - use physconst, only: cpair,rh2o,zvir,pi,rearth,r_universal - !zvir is the ep1 in wrf,rearth is the radius of earth(m),r_universal is the gas constant + use physconst, only: cpair, rh2o, zvir, pi, rearth, r_universal!zvir is the ep1 in wrf,rearth is the radius of earth(m),r_universal is the gas constant ! These are the actual switches for different gravity wave sources. - use phys_control, only: use_gw_oro, use_gw_front,use_gw_convect,use_gw_energy_fix,use_od_ls,use_od_bl,use_od_ss,ncleff_ls,ncd_bl,sncleff_ss + ! The orographic control switches are also here + use phys_control, only: use_gw_oro, use_gw_front, use_gw_convect, use_gw_energy_fix, use_od_ls, use_od_bl, use_od_ss, ncleff_ls, ncd_bl, sncleff_ss ! Typical module header implicit none @@ -217,13 +217,13 @@ subroutine gw_init() use gw_oro, only: gw_oro_init use gw_front, only: gw_front_init use gw_convect, only: gw_convect_init - !! - use comsrf, only:var,var30,oc,oadir,ol,initialize_comsrf2 - use pio, only:file_desc_t - use startup_initialconds,only:topoGWD_file_get_id,setup_initialGWD,close_initial_fileGWD - use ncdio_atm, only:infld - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id,cam_grid_get_dim_names - !! + + use comsrf, only: var, var30, oc, oadir, ol, initialize_comsrf2 + use pio, only: file_desc_t + use startup_initialconds,only: topoGWD_file_get_id, setup_initialGWD, close_initial_fileGWD + use ncdio_atm, only: infld + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id,cam_grid_get_dim_names + !---------------------------Local storage------------------------------- integer :: l, k @@ -409,12 +409,17 @@ subroutine gw_init() use_od_ls.or.& use_od_bl.or.& use_od_ss) then - - if (effgw_oro == unset_r8) then + ! + if (use_gw_oro.and.effgw_oro == unset_r8) then call endrun("gw_drag_init: Orographic gravity waves enabled, & &but effgw_oro was not set.") end if - + ! + if (use_gw_oro.and.use_od_ls) then + call endrun("gw_drag_init: Both orographic gravity waves schemes are turned on, & + &please turn one off by setting use_gw_oro or use_od_ls as .false.") + end if + ! call gw_oro_init(errstring) if (trim(errstring) /= "") call endrun("gw_oro_init: "//errstring) @@ -429,6 +434,9 @@ subroutine gw_init() 'Zonal gravity wave surface stress') call addfld ('TAUGWY',horiz_only, 'A','N/m2', & 'Meridional gravity wave surface stress') + if (use_od_ls.or.& + use_od_bl.or.& + use_od_ss) then !added for orographic drag call addfld ('DTAUX3_LS',(/'lev'/),'A','m/s2','U tendency - ls orographic drag') call addfld ('DTAUY3_LS',(/'lev'/),'A','m/s2','V tendency - ls orographic drag') @@ -455,6 +463,7 @@ subroutine gw_init() call add_default ('DUSFC_SS ', 1,' ') call add_default ('DVSFC_SS ', 1,' ') !added for orographic drag output + endif if (history_amwg) then call add_default('TAUGWX ', 1, ' ') @@ -1020,13 +1029,15 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) dusfc_fd=dummx_fd,dvsfc_fd=dummy_fd) endif + ! ! Add the orographic tendencies to the spectrum tendencies ! Compute the temperature tendency from energy conservation ! (includes spectrum). ! both old and new gwd scheme will add the tendency to circulation - if (use_gw_oro.or. & - use_od_ls.or.& - use_od_bl.or.& + ! + if (use_gw_oro.or.& + use_od_ls .or.& + use_od_bl .or.& use_od_ss) then if(.not. use_gw_energy_fix) then !original @@ -1036,11 +1047,11 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) vtgw(:,k) = vtgw(:,k) * cam_in%landfrac(:ncol) ptend%v(:ncol,k) = ptend%v(:ncol,k) + vtgw(:,k) ptend%s(:ncol,k) = ptend%s(:ncol,k) + ttgw(:,k) & - -(ptend%u(:ncol,k) * (u(:,k) + ptend%u(:ncol,k)*0.5_r8*dt) & - +ptend%v(:ncol,k) * (v(:,k) + ptend%v(:ncol,k)*0.5_r8*dt)) + -(ptend%u(:ncol,k) * (u(:,k) + ptend%u(:ncol,k)*0.5_r8*dt) & + +ptend%v(:ncol,k) * (v(:,k) + ptend%v(:ncol,k)*0.5_r8*dt)) ttgw(:,k) = ttgw(:,k) & - -(ptend%u(:ncol,k) * (u(:,k) + ptend%u(:ncol,k)*0.5_r8*dt) & - +ptend%v(:ncol,k) * (v(:,k) + ptend%v(:ncol,k)*0.5_r8*dt)) + -(ptend%u(:ncol,k) * (u(:,k) + ptend%u(:ncol,k)*0.5_r8*dt) & + +ptend%v(:ncol,k) * (v(:,k) + ptend%v(:ncol,k)*0.5_r8*dt)) ttgw(:,k) = ttgw(:,k) / cpairv(:ncol, k, lchnk) end do else diff --git a/components/eam/src/physics/cam/physpkg.F90 b/components/eam/src/physics/cam/physpkg.F90 index 50ce79e1540..b2e231d3f17 100644 --- a/components/eam/src/physics/cam/physpkg.F90 +++ b/components/eam/src/physics/cam/physpkg.F90 @@ -1321,7 +1321,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & use cam_diagnostics,only: diag_deallocate, diag_surf - use comsrf, only: trefmxav, trefmnav, sgh, sgh30, fsds, var, var30,oc,oadir,ol + use comsrf, only: trefmxav, trefmnav, sgh, sgh30, fsds, var, var30, oc, oadir, ol use physconst, only: stebol, latvap #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf2 @@ -1433,12 +1433,12 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & call diag_surf(cam_in(c), cam_out(c), phys_state(c)%ps,trefmxav(1,c), trefmnav(1,c)) call t_stopf('diag_surf') ! for tranport of ogwd related parameters - if (use_od_ls.or.use_od_bl) then - phys_state(c)%var(:)=var(:,c) - phys_state(c)%var30(:)=var30(:,c) - phys_state(c)%oc(:)=oc(:,c) - phys_state(c)%oadir(:,:)=oadir(:,:,c) - phys_state(c)%ol(:,:)=ol(:,:,c) + if ( use_od_ls .or. use_od_bl ) then + phys_state(c)%var (:) =var (:,c) + phys_state(c)%var30(:) =var30 (:,c) + phys_state(c)%oc (:) =oc (:,c) + phys_state(c)%oadir(:,:) =oadir (:,:,c) + phys_state(c)%ol (:,:) =ol (:,:,c) endif ! call tphysac(ztodt, cam_in(c), & diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl b/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl index d79fc234beb..f36183d66e8 100755 --- a/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl +++ b/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl @@ -1,21 +1,10 @@ -load "/lcrc/group/e3sm/ac.xie7/Analysis/NCLep/self.ncl" begin -vars=(/"PHIS","SGH","SGH30","LANDFRAC","LANDM_COSLAT"/) ;; -fil1="final-180-ne30pg2-mod-v3.nc" -;fil2="USGS-gtopo30_ne30np4pg2_16xdel2.c20200108.nc" -;fil3="final-180-ne30pg2.nc" +fil1="USGS-gtopo30_ne30np4pg2_16xdel2_forOroDrag.c20241029.nc" fil2="USGS-gtopo30_ne30np4pg2_x6t-SGH.c20210614.nc" -fil3="final-180-ne30pg2-v3.nc" +fil3="final-180.nc" system("rm -r "+fil1) -system("cp -r "+fil3+" "+fil1) +system("cp -r "+fil2+" "+fil1) +system("ncks -A -v OA,OC,OL "+fil3+" "+fil1) ;; -ff1=addfile(fil1,"w") -ff2=addfile(fil2,"r") -;; -do i=0,4 -ff1->$vars(i)$=ff2->$vars(i)$ -end do - - end From c7e8ad158e2821d7804a50daad4d44bf7ab4bca6 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Mon, 4 Nov 2024 23:26:24 +0000 Subject: [PATCH 233/529] remove streaming option that is underutilizing gpusfor 12 ranks --- cime_config/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 0ff979c8f9c..f8bda3b422e 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3611,7 +3611,7 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors 131072 20 1 - 0:4,1:4,2:4,3:4:4:4,5:4,6:4,7:4 + 0 From e8ecab33f552fbc3836ba5e0b6a02fdd6a71a1bf Mon Sep 17 00:00:00 2001 From: xie7 Date: Mon, 28 Oct 2024 13:57:20 -0500 Subject: [PATCH 234/529] Chemistry output bug fix 1. The output of reaction rate of r_lch4 and r_lco_h are not output due to a bug, fixed it in the code. modified: components/eam/src/chemistry/mozart/rate_diags.F90 [BFB] --- components/eam/src/chemistry/mozart/rate_diags.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/components/eam/src/chemistry/mozart/rate_diags.F90 b/components/eam/src/chemistry/mozart/rate_diags.F90 index 457ede70307..4ad21392f54 100644 --- a/components/eam/src/chemistry/mozart/rate_diags.F90 +++ b/components/eam/src/chemistry/mozart/rate_diags.F90 @@ -126,7 +126,7 @@ subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk, pver, pdeldry, mbar rxt_rates(:ncol,:,rxt_tag_map(i)) = rxt_rates(:ncol,:,rxt_tag_map(i)) * m(:,:) call outfld( rate_names(i), rxt_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk ) - if ( .not. history_UCIgaschmbudget_2D .and. .not. history_UCIgaschmbudget_2D_levels) return + if (history_UCIgaschmbudget_2D .or. history_UCIgaschmbudget_2D_levels) then if (rate_names(i) .eq. 'r_lch4') then !kg/m2/sec @@ -166,6 +166,8 @@ subroutine rate_diags_calc( rxt_rates, vmr, m, ncol, lchnk, pver, pdeldry, mbar endif endif + + endif enddo end subroutine rate_diags_calc From e18f825615fe5b309790fc1b03753168e3fa8d0b Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Tue, 5 Nov 2024 10:56:59 -0600 Subject: [PATCH 235/529] Minor cleanup from making bld files consistent with Registry --- .../bld/namelist_files/namelist_definition_mpaso.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml index e2498597aa3..ce48de48d5e 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml @@ -1272,15 +1272,15 @@ Default: Defined in namelist_defaults.xml + category="coupling" group="coupling"> If and how MPAS-Ocean sends thermal forcing to GLC (MALI) in E3SM. This is used for ocean coupling with a melt parameterization for grounded marine ice-cliffs in MALI. This is primarily relevant to the Greenland Ice Sheet, but also relevant to the Antarctic Ice Sheet. 'none' means no coupling of thermal forcing. '2d' means thermal forcing at a prescribed depth is passed to GLC. That depth is controlled by 'config_2d_thermal_forcing_depth', and the resulting thermal forcing field is calculated in the field 'avgThermalForcingAtCritDepth'. -Valid values: 'off' or '2d' +Valid values: 'off', '2d' Default: Defined in namelist_defaults.xml + category="coupling" group="coupling"> Depth at which to pass 2d thermal forcing to the coupler for use in the GLC component. Note that mapping files for this field must be created with a mask to exclude ocean grid cells shallower than this value and thus must be regenerated if this value is changed. Valid values: any non-negative value From 9337b6095bc46ce77eb819eeb8692ce1b0aaf0c3 Mon Sep 17 00:00:00 2001 From: Abhishek Bagusetty Date: Wed, 6 Nov 2024 13:52:10 +0000 Subject: [PATCH 236/529] update the kokkos initialization according to EKAT --- .../homme/src/share/cxx/ExecSpaceDefs.cpp | 47 ++++++++++++++++--- 1 file changed, 40 insertions(+), 7 deletions(-) diff --git a/components/homme/src/share/cxx/ExecSpaceDefs.cpp b/components/homme/src/share/cxx/ExecSpaceDefs.cpp index 38db9f033d8..dbe82d8758b 100644 --- a/components/homme/src/share/cxx/ExecSpaceDefs.cpp +++ b/components/homme/src/share/cxx/ExecSpaceDefs.cpp @@ -32,13 +32,46 @@ namespace Homme { // own. As a side benefit, we'll end up running on GPU platforms optimally // without having to specify --kokkos-ndevices on the command line. void initialize_kokkos () { - // This is in fact const char*, but Kokkos::initialize requires char*. - std::vector args; - const char* silence = "--kokkos-disable-warnings"; - args.push_back(const_cast(silence)); + // Count up our devices. + // This is the only way to get the round-robin rank assignment Kokkos + // provides, as that algorithm is hardcoded in Kokkos::initialize(int& narg, + // char* arg[]). Once the behavior is exposed in the InitArguments version of + // initialize, we can remove this string code. + // If for some reason we're running on a GPU platform, have Cuda enabled, + // but are using a different execution space, this initialization is still + // OK. The rank gets a GPU assigned and simply will ignore it. + int nd = 1; +#ifdef HOMMEXX_ENABLE_GPU +# if defined KOKKOS_ENABLE_CUDA + const auto ret = cudaGetDeviceCount(&nd); + const bool ok = (ret == cudaSuccess); +# elif defined KOKKOS_ENABLE_HIP + const auto ret = hipGetDeviceCount(&nd); + const bool ok = (ret == hipSuccess); +# elif defined KOKKOS_ENABLE_SYCL + nd = 0; + auto gpu_devs = sycl::device::get_devices(sycl::info::device_type::gpu); + for (auto &dev : gpu_devs) { + if (dev.get_info() > 0) { + auto subDevs = dev.create_sub_devices(sycl::info::partition_affinity_domain::numa); + nd += subDevs.size(); + } else { + nd++; + } + } + const bool ok = true; +# endif + if (not ok) { + // It isn't a big deal if we can't get the device count. + nd = 1; + } +#endif // HOMMEXX_ENABLE_GPU - int narg = args.size(); - Kokkos::initialize(narg, args.data()); + auto const settings = Kokkos::InitializationSettings() + .set_map_device_id_by("mpi_rank") + .set_num_devices(nd) + .set_disable_warnings(true); + Kokkos::initialize(settings); } ThreadPreferences::ThreadPreferences () @@ -171,7 +204,7 @@ team_num_threads_vectors (const int num_parallel_iterations, #endif min_num_warps = std::min(min_num_warps, max_num_warps); - + return Parallel::team_num_threads_vectors_for_gpu( num_warps_device, num_threads_warp, min_num_warps, max_num_warps, From 580c3660e24219fdb355dceb9be36fdf9b5c9fcc Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 17 Oct 2024 19:13:25 -0500 Subject: [PATCH 237/529] remove tri grid land mesh on component side use only the point cloud it is enough for import/export --- components/elm/src/cpl/lnd_comp_mct.F90 | 307 +++++++--------------- components/elm/src/main/surfrdMod.F90 | 63 ----- components/elm/src/utils/domainMod.F90 | 4 - driver-moab/main/cplcomp_exchange_mod.F90 | 5 - driver-moab/shr/seq_comm_mct.F90 | 3 +- 5 files changed, 93 insertions(+), 289 deletions(-) diff --git a/components/elm/src/cpl/lnd_comp_mct.F90 b/components/elm/src/cpl/lnd_comp_mct.F90 index e533d5bcbc2..8d3ae5e2997 100644 --- a/components/elm/src/cpl/lnd_comp_mct.F90 +++ b/components/elm/src/cpl/lnd_comp_mct.F90 @@ -18,7 +18,6 @@ module lnd_comp_mct #ifdef HAVE_MOAB use seq_comm_mct, only: mlnid! id of moab land app - use seq_comm_mct, only: mb_land_mesh! true if land is full mesh (on the river mesh) use seq_comm_mct, only: num_moab_exports #ifdef MOABCOMP use seq_comm_mct , only: seq_comm_compare_mb_mct @@ -51,7 +50,6 @@ module lnd_comp_mct integer :: mpicom_lnd_moab ! used also for mpi-reducing the difference between moab tags and mct avs integer :: rank2 - logical :: samegrid_al ! #endif !--------------------------------------------------------------------------- @@ -314,13 +312,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call lnd_domain_mct( bounds, lsz, gsMap_lnd, dom_l ) #ifdef HAVE_MOAB -! find out samegrid_al or not; from infodata - samegrid_al = .true. - call seq_infodata_GetData(infodata , & - atm_gnam=atm_gnam , & - lnd_gnam=lnd_gnam ) - if (trim(atm_gnam) /= trim(lnd_gnam)) samegrid_al = .false. - mb_land_mesh = .not. samegrid_al ! global variable, saved in seq_comm call init_moab_land(bounds, LNDID) #endif call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsz) @@ -547,8 +538,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! loop over all fields in seq_flds_x2l_fields call mct_list_init(temp_list ,seq_flds_x2l_fields) size_list=mct_list_nitem (temp_list) - ent_type = 0 ! entity type is vertex for land, usually (bigrid case) - if (mb_land_mesh) ent_type = 1 + ent_type = 0 ! entity type is vertex for land, always if (rank2 .eq. 0) print *, num_moab_exports, trim(seq_flds_x2l_fields), ' lnd import check' do index_list = 1, size_list call mct_list_get(mctOStr,index_list,temp_list) @@ -846,7 +836,7 @@ subroutine init_moab_land(bounds, LNDID) use spmdmod , only: masterproc use iMOAB , only: iMOAB_CreateVertices, iMOAB_WriteMesh, iMOAB_RegisterApplication, & iMOAB_DefineTagStorage, iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, & - iMOAB_ResolveSharedEntities, iMOAB_CreateElements, iMOAB_UpdateMeshInfo + iMOAB_ResolveSharedEntities, iMOAB_UpdateMeshInfo type(bounds_type) , intent(in) :: bounds integer , intent(in) :: LNDID ! id of the land app @@ -893,200 +883,97 @@ subroutine init_moab_land(bounds, LNDID) vgids(n) = ldecomp%gdc2glo(bounds%begg+n-1) ! local to global ! end do gsize = ldomain%ni * ldomain%nj ! size of the total grid - ! if ldomain%nv > 3 , create mesh - - ! Case where land and river share mesh (tri-grid) - if (ldomain%nv .ge. 3 .and. .not.samegrid_al) then - ! number of vertices is nv * lsz ! - allocate(moab_vert_coords(lsz*dims*ldomain%nv)) - ! loop over ldomain - allocate(moabconn(ldomain%nv * lsz)) - do n = bounds%begg, bounds%endg - i = (n - bounds%begg) * ldomain%nv - do iv = 1, ldomain%nv - lonv = ldomain%mblonv(n, iv) * SHR_CONST_PI/180. - latv = ldomain%mblatv(n, iv) * SHR_CONST_PI/180. - - i = i + 1 ! iv-th vertex of cell n; i starts at 1 - moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) - moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) - moab_vert_coords(3*i )=SIN(latv) - moabconn(i) = i - enddo - enddo - ierr = iMOAB_CreateVertices(mlnid, lsz * 3 * ldomain%nv, dims, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB vertices in land model') - - mbtype = 2 ! triangle - if (ldomain%nv .eq. 4) mbtype = 3 ! quad - if (ldomain%nv .gt. 4) mbtype = 4 ! polygon - block_ID = 100 !some value - ierr = iMOAB_CreateElements( mlnid, lsz, mbtype, ldomain%nv, moabconn, block_ID ); - - - ! define some useful tags on cells - tagtype = 0 ! dense, integer - numco = 1 - tagname='GLOBAL_ID'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GLOBAL_ID tag ') - - ent_type = 1 ! element type - ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set GLOBAL_ID tag ') - - ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create - ! on the vertices; do not allocate other data array - ! Define and Set Fraction - tagname='frac'//C_NULL_CHAR - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create frac tag ') - - do i = 1, lsz - n = i-1 + bounds%begg - moab_vert_coords(i) = ldomain%frac(n) - enddo - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to set frac tag ') - - ! Define and Set area - tagname='area'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create area tag ') - do i = 1, lsz - n = i-1 + bounds%begg - moab_vert_coords(i) = ldomain%area(n)/(re*re) ! use the same doubles for second tag :) - enddo - - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) - if (ierr > 0 ) & - call endrun('Error: fail to set area tag ') - - ! Define aream - tagname='aream'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create aream tag ') - - deallocate(moabconn) - deallocate(vgids) - - - ! Now do the verticies - allocate(vgids(lsz*ldomain%nv)) ! - do n = 1, lsz - do i=1,ldomain%nv - vgids( (n-1)*ldomain%nv+i ) = (ldecomp%gdc2glo(bounds%begg+n-1)-1)*ldomain%nv+i ! local to global ! - end do - end do - ent_type = 0 ! vertices now - tagname = 'GLOBAL_ID'//C_NULL_CHAR - ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids ) - if (ierr > 0 ) & - call endrun('Error: fail to set global ID tag on vertices in land mesh ') - ierr = iMOAB_UpdateMeshInfo( mlnid ) - if (ierr > 0 ) & - call endrun('Error: fail to update mesh info ') - - ! Case where land and atmosphere share mesh - else ! old point cloud mesh - allocate(moab_vert_coords(lsz*dims)) - do i = 1, lsz - n = i-1 + bounds%begg - lonv = ldomain%lonc(n) *SHR_CONST_PI/180. - latv = ldomain%latc(n) *SHR_CONST_PI/180. - moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) - moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) - moab_vert_coords(3*i )=SIN(latv) - enddo - ierr = iMOAB_CreateVertices(mlnid, lsz*3, dims, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to create MOAB vertices in land model') - - tagtype = 0 ! dense, integer - numco = 1 - tagname='GLOBAL_ID'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to retrieve GLOBAL_ID tag ') - - ent_type = 0 ! vertex type - ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set GLOBAL_ID tag ') - - ierr = iMOAB_ResolveSharedEntities( mlnid, lsz, vgids ); - if (ierr > 0 ) & - call endrun('Error: fail to resolve shared entities') - - !there are no shared entities, but we will set a special partition tag, in order to see the - ! partitions ; it will be visible with a Pseudocolor plot in VisIt - tagname='partition'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create new partition tag ') - - vgids = iam - ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) - if (ierr > 0 ) & - call endrun('Error: fail to set partition tag ') - - ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create - ! on the vertices; do not allocate other data array - tagname='frac'//C_NULL_CHAR - tagtype = 1 ! dense, double - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create frac tag ') - - do i = 1, lsz - n = i-1 + bounds%begg - moab_vert_coords(i) = ldomain%frac(n) - enddo - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) - if (ierr > 0 ) & - call endrun('Error: fail to set frac tag ') - - tagname='area'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create area tag ') - do i = 1, lsz - n = i-1 + bounds%begg - moab_vert_coords(i) = ldomain%area(n)/(re*re) ! use the same doubles for second tag :) - enddo - - ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) - if (ierr > 0 ) & - call endrun('Error: fail to set area tag ') - - ! aream needed in cime_init for now. - tagname='aream'//C_NULL_CHAR - ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) - if (ierr > 0 ) & - call endrun('Error: fail to create aream tag ') - ! ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) - ! if (ierr > 0 ) & - ! call endrun('Error: fail to set aream tag ') - ierr = iMOAB_UpdateMeshInfo( mlnid ) - if (ierr > 0 ) & - call endrun('Error: fail to update mesh info ') - endif - ! add more domain fields that are missing from domain fields: lat, lon, mask, hgt - tagname = 'lat:lon:mask:hgt'//C_NULL_CHAR - tagtype = 1 ! dense, double + + allocate(moab_vert_coords(lsz*dims)) + do i = 1, lsz + n = i-1 + bounds%begg + lonv = ldomain%lonc(n) *SHR_CONST_PI/180. + latv = ldomain%latc(n) *SHR_CONST_PI/180. + moab_vert_coords(3*i-2)=COS(latv)*COS(lonv) + moab_vert_coords(3*i-1)=COS(latv)*SIN(lonv) + moab_vert_coords(3*i )=SIN(latv) + enddo + ierr = iMOAB_CreateVertices(mlnid, lsz*3, dims, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to create MOAB vertices in land model') + + tagtype = 0 ! dense, integer numco = 1 + tagname='GLOBAL_ID'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to retrieve GLOBAL_ID tag ') + + ent_type = 0 ! vertex type + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set GLOBAL_ID tag ') + + ierr = iMOAB_ResolveSharedEntities( mlnid, lsz, vgids ); + if (ierr > 0 ) & + call endrun('Error: fail to resolve shared entities') + + !there are no shared entities, but we will set a special partition tag, in order to see the + ! partitions ; it will be visible with a Pseudocolor plot in VisIt + tagname='partition'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create new partition tag ') + + vgids = iam + ierr = iMOAB_SetIntTagStorage ( mlnid, tagname, lsz , ent_type, vgids) + if (ierr > 0 ) & + call endrun('Error: fail to set partition tag ') + + ! use moab_vert_coords as a data holder for a frac tag and area tag that we will create + ! on the vertices; do not allocate other data array + tagname='frac'//C_NULL_CHAR + tagtype = 1 ! dense, double + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create frac tag ') + + do i = 1, lsz + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%frac(n) + enddo + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords) + if (ierr > 0 ) & + call endrun('Error: fail to set frac tag ') + + tagname='area'//C_NULL_CHAR ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) if (ierr > 0 ) & - call endrun('Error: fail to create lat:lon:mask:hgt tags ') + call endrun('Error: fail to create area tag ') + do i = 1, lsz + n = i-1 + bounds%begg + moab_vert_coords(i) = ldomain%area(n)/(re*re) ! use the same doubles for second tag :) + enddo + + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + if (ierr > 0 ) & + call endrun('Error: fail to set area tag ') + + ! aream needed in cime_init for now. + tagname='aream'//C_NULL_CHAR + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create aream tag ') + ! ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz , ent_type, moab_vert_coords ) + ! if (ierr > 0 ) & + ! call endrun('Error: fail to set aream tag ') + ierr = iMOAB_UpdateMeshInfo( mlnid ) + if (ierr > 0 ) & + call endrun('Error: fail to update mesh info ') + + ! add more domain fields that are missing from domain fields: lat, lon, mask, hgt + tagname = 'lat:lon:mask:hgt'//C_NULL_CHAR + tagtype = 1 ! dense, double + numco = 1 + ierr = iMOAB_DefineTagStorage(mlnid, tagname, tagtype, numco, tagindex ) + if (ierr > 0 ) & + call endrun('Error: fail to create lat:lon:mask:hgt tags ') ! moab_vert_coords is big enough in both case to hold enough data for us: lat, lon, mask do i = 1, lsz @@ -1098,9 +985,7 @@ subroutine init_moab_land(bounds, LNDID) tagname = 'lat:lon:mask'//C_NULL_CHAR ent_type = 0 ! point cloud usually - if (ldomain%nv .ge. 3 .and. .not.samegrid_al) then - ent_type = 1 ! cell in tri-grid case - endif + ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, lsz*3 , ent_type, moab_vert_coords) if (ierr > 0 ) & call endrun('Error: fail to set lat lon mask tag ') @@ -1255,11 +1140,7 @@ subroutine lnd_export_moab(EClock, bounds, lnd2atm_vars, lnd2glc_vars) end do tagname=trim(seq_flds_l2x_fields)//C_NULL_CHAR - if (samegrid_al) then - ent_type = 0 ! vertices, cells only if samegrid_al false - else - ent_type = 1 - endif + ent_type = 0 ! vertices only, from now on ierr = iMOAB_SetDoubleTagStorage ( mlnid, tagname, totalmbls , ent_type, l2x_lm(1,1) ) if (ierr > 0 ) & call shr_sys_abort( sub//' Error: fail to set moab l2x '// trim(seq_flds_l2x_fields) ) @@ -1452,11 +1333,7 @@ subroutine lnd_import_moab(EClock, bounds, atm2lnd_vars, glc2lnd_vars) call endrun('Error: fail to write the moab lnd mesh before import ') #endif tagname=trim(seq_flds_x2l_fields)//C_NULL_CHAR - if (samegrid_al) then - ent_type = 0 ! vertices, cells only if samegrid_al false - else - ent_type = 1 - endif + ent_type = 0 ! vertices ierr = iMOAB_GetDoubleTagStorage ( mlnid, tagname, totalmblsimp , ent_type, x2l_lm(1,1) ) if ( ierr > 0) then call endrun('Error: fail to get seq_flds_x2l_fields for land moab instance on component') diff --git a/components/elm/src/main/surfrdMod.F90 b/components/elm/src/main/surfrdMod.F90 index a8146e5a0f1..97a4fae62d4 100755 --- a/components/elm/src/main/surfrdMod.F90 +++ b/components/elm/src/main/surfrdMod.F90 @@ -20,11 +20,6 @@ module surfrdMod use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim, ncd_inqdid, ncd_inqdlen use pio -#ifdef HAVE_MOAB - use mct_mod , only : mct_gsMap - use decompMod , only : get_elmlevel_gsmap - ! use spmdMod , only : iam ! rank on the land communicator -#endif use spmdMod use topounit_varcon , only : max_topounits, has_topounit @@ -184,11 +179,6 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) ! pflotran:beg----------------------------- integer :: j, np, nv -#ifdef HAVE_MOAB - type(mct_gsMap), pointer :: gsMap - integer :: i, iv , iseg, ig, local ! ni, nj, nv, nseg, global ig - -#endif ! pflotran:end----------------------------- character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name @@ -258,59 +248,6 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) end if ! pflotran:end----------------------------------------------- - -#ifdef HAVE_MOAB - ! read xv and yv for MOAB to learn mesh verticies - if (ldomain%nv>=3 ) then - call get_elmlevel_gsmap (grlnd, gsMap) - allocate(rdata3d(nv,ni,nj)) ! transpose from c, as this is fortran - vname = 'xv' - ! this should be improved in a distributed read, that does not use full grid ni * nj * nv 720*360*4*8 ~ 8Mb - call ncd_io(ncid=ncid, varname=trim(vname), data=rdata3d, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: xv NOT on file'//errMsg(__FILE__, __LINE__)) - ! fill up the ldomain%mblonv(begg:endg, 1:nv) array - local = begg - do iseg = 1, gsMap%ngseg - if (gsMap%pe_loc(iseg) .eq. iam) then - do ig = gsMap%start(iseg), gsMap%start(iseg) + gsMap%length(iseg) - 1 - j = (ig-1)/ni + 1 - i = ig - ni*(j-1) - do iv = 1, nv - if (local .le. endg) then - ldomain%mblonv(local, iv ) = rdata3d(iv, i, j) - else - write (iulog, *), 'OVERFLOW', iseg, gsMap%pe_loc(iseg), gsMap%start(iseg), gsMap%length(iseg), local - endif - enddo - local = local + 1 - enddo - endif - enddo - ! repeat for mblatv - vname = 'yv' - call ncd_io(ncid=ncid, varname=trim(vname), data=rdata3d, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=trim(subname)//' ERROR: yv NOT on file'//errMsg(__FILE__, __LINE__)) - ! fill up the ldomain%lonv(begg:endg, 1:nv) array - local = begg - do iseg = 1, gsMap%ngseg - if (gsMap%pe_loc(iseg) .eq. iam) then - do ig = gsMap%start(iseg), gsMap%start(iseg) + gsMap%length(iseg) - 1 - j = (ig-1)/ni + 1 - i = ig - ni*(j-1) - do iv = 1, nv - if (local .le. endg) then - ldomain%mblatv(local, iv ) = rdata3d(iv, i, j) - endif - enddo - local = local + 1 - enddo - endif - enddo - ! deallocate what is not needed anymore (for half degree land model, ~8Mb) - deallocate(rdata3d) - - end if -#endif else call ncd_io(ncid=ncid, varname= 'AREA', flag='read', data=ldomain%area, & dim1name=grlnd, readvar=readvar) diff --git a/components/elm/src/utils/domainMod.F90 b/components/elm/src/utils/domainMod.F90 index 5ef3ae611cf..e8070997584 100755 --- a/components/elm/src/utils/domainMod.F90 +++ b/components/elm/src/utils/domainMod.F90 @@ -52,10 +52,6 @@ module domainMod integer :: nv ! number of vertices real(r8),pointer :: latv(:,:) ! latitude of grid cell's vertices (deg) real(r8),pointer :: lonv(:,:) ! longitude of grid cell's vertices (deg) -#ifdef HAVE_MOAB - real(r8),pointer :: mblatv(:,:) ! latitude of grid cell's vertices (deg) for MOAB - real(r8),pointer :: mblonv(:,:) ! longitude of grid cell's vertices (deg) for MOAB -#endif real(r8) :: lon0 ! the origin lon/lat (Most western/southern corner, if not globally covered grids; OR -180W(360E)/-90N) real(r8) :: lat0 ! the origin lon/lat (Most western/southern corner, if not globally covered grids; OR -180W(360E)/-90N) diff --git a/driver-moab/main/cplcomp_exchange_mod.F90 b/driver-moab/main/cplcomp_exchange_mod.F90 index 76737ad3141..259f6953cff 100644 --- a/driver-moab/main/cplcomp_exchange_mod.F90 +++ b/driver-moab/main/cplcomp_exchange_mod.F90 @@ -24,7 +24,6 @@ module cplcomp_exchange_mod use seq_comm_mct, only : mhpgid ! iMOAB app id for atm pgx grid, on atm pes use seq_comm_mct, only : atm_pg_active ! flag if PG mesh instanced use seq_comm_mct, only : mlnid , mblxid ! iMOAB app id for land , on land pes and coupler pes - use seq_comm_mct, only : mb_land_mesh ! if true mesh for land use seq_comm_mct, only : mphaid ! iMOAB app id for phys atm; comp atm is 5, phys 5+200 use seq_comm_mct, only : MPSIID, mbixid ! sea-ice on comp pes and on coupler pes use seq_comm_mct, only : mrofid, mbrxid ! iMOAB id of moab rof app on comp pes and on coupler too @@ -1520,16 +1519,12 @@ subroutine cplcomp_moab_Init(infodata,comp) ! we are now on joint pes, compute comm graph between lnd and coupler model typeA = 2 ! point cloud on component PEs, land - if (mb_land_mesh) then - typeA = 3 - endif typeB = 3 ! full mesh on coupler pes, we just read it if (mlnid >= 0) then ierr = iMOAB_GetMeshInfo ( mlnid, nvert, nvise, nbl, nsurf, nvisBC ) comp%mbApCCid = mlnid ! phys atm comp%mbGridType = typeA - 2 ! 0 or 1, pc or cells comp%mblsize = nvert(1) ! vertices - if (mb_land_mesh) comp%mblsize = nvise(1) ! cells endif ierr = iMOAB_ComputeCommGraph( mlnid, mblxid, mpicom_join, mpigrp_old, mpigrp_cplid, & typeA, typeB, id_old, id_join) diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index 44d29e91ad2..a13dd1faf5b 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -245,8 +245,7 @@ module seq_comm_mct integer, public :: mbintxar ! iMOAB id for intx mesh between atm and river integer, public :: mbintxlr ! iMOAB id for intx mesh between land and river integer, public :: mbintxrl ! iMOAB id for intx mesh between river and land - logical, public :: mb_land_mesh = .false. ! whether the land uses full FV mesh or not ; made true if domain mesh is read on comp land - + integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes !======================================================================= From cf993253ec6f281a9168c1421e177f2c516b0e5a Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Thu, 17 Oct 2024 19:29:20 -0500 Subject: [PATCH 238/529] forgot about this one --- components/elm/src/utils/domainMod.F90 | 33 -------------------------- 1 file changed, 33 deletions(-) diff --git a/components/elm/src/utils/domainMod.F90 b/components/elm/src/utils/domainMod.F90 index e8070997584..2c7771179d2 100755 --- a/components/elm/src/utils/domainMod.F90 +++ b/components/elm/src/utils/domainMod.F90 @@ -150,22 +150,6 @@ subroutine domain_init(domain,isgrid2d,ni,nj,nbeg,nend,elmlevel) endif end if ! pflotran:end----------------------------------------------------- -#ifdef HAVE_MOAB - if (domain%nv > 0 .and. domain%nv /= huge(1)) then - if(.not.associated(domain%mblonv)) then - allocate(domain%mblonv(nb:ne, 1:domain%nv), stat=ier) - if (ier /= 0) & - call shr_sys_abort('domain_init ERROR: allocate mblonv ') - domain%mblonv = nan - endif - if(.not.associated(domain%mblatv)) then - allocate(domain%mblatv(nb:ne, 1:domain%nv)) - if (ier /= 0) & - call shr_sys_abort('domain_init ERROR: allocate mblatv ') - domain%mblatv = nan - endif - end if -#endif if (present(elmlevel)) then domain%elmlevel = elmlevel @@ -261,23 +245,6 @@ subroutine domain_clean(domain) endif endif ! pflotran:beg----------------------------------------------------- -#ifdef HAVE_MOAB - if (domain%nv > 0 .and. domain%nv /= huge(1)) then - if (associated(domain%mblonv)) then - deallocate(domain%mblonv, stat=ier) - if (ier /= 0) & - call shr_sys_abort('domain_clean ERROR: deallocate mblonv ') - nullify(domain%mblonv) - endif - - if (associated(domain%mblatv)) then - deallocate(domain%mblatv, stat=ier) - if (ier /= 0) & - call shr_sys_abort('domain_clean ERROR: deallocate mblatv ') - nullify(domain%mblatv) - endif - endif -#endif else if (masterproc) then From 4165e3e1e94970da09af4a21fefb0f5854e8b892 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 21 Oct 2024 20:14:04 -0500 Subject: [PATCH 239/529] ocean import/export alignment --- components/mpas-ocean/driver/ocn_comp_mct.F | 827 +++++++++++++------- 1 file changed, 540 insertions(+), 287 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index d1b140563bb..686af1bbc5c 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -3146,15 +3146,19 @@ end subroutine datetime!}}} #ifdef HAVE_MOAB -! import method from moab -! copied from ocn_import_mct, will replace x2o_o AV with x2o_om array read locally - subroutine ocn_import_moab( Eclock, errorCode)!{{{ + +!*********************************************************************** +!BOP +! !IROUTINE: ocn_import_moab +! !INTERFACE: + + subroutine ocn_import_moab(Eclock, errorCode)!{{{ ! !DESCRIPTION: !----------------------------------------------------------------------- -! This routine receives message from cpl7 driver +! This routine receives message from moab driver ! -! The following fields are always received from the coupler: +! The following fields are always received from the driver: ! ! o taux -- zonal wind stress (taux) (W/m2 ) ! o tauy -- meridonal wind stress (tauy) (W/m2 ) @@ -3171,11 +3175,22 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ ! o ifrac -- ice fraction (%) ! o rofl -- river runoff flux (kg/m2/s) ! o rofi -- ice runoff flux (kg/m2/s) +! o rofDIN -- DIN runoff flux (kg/m2/s) +! o rofDIP -- DIP runoff flux (kg/m2/s) +! o rofDON -- DON runoff flux (kg/m2/s) +! o rofDOP -- DOP runoff flux (kg/m2/s) +! o rofDOC -- DOC runoff flux (kg/m2/s) +! o rofPP -- PP runoff flux (kg/m2/s) +! o rofDSi -- DSi runoff flux (kg/m2/s) +! o rofPOC -- POC runoff flux (kg/m2/s) +! o rofPN -- PN runoff flux (kg/m2/s) +! o rofDIC -- DIC runoff flux (kg/m2/s) +! o rofFe -- Fe runoff flux (kg/m2/s) ! ! The following fields are sometimes received from the coupler, ! depending on model options: ! -! o pbot -- bottom atm pressure (Pa) +! o pslv -- atmospheric pressure at sea level (Pa) ! o duu10n -- 10m wind speed squared (m^2/s^2) ! o co2prog-- bottom atm level prognostic co2 ! o co2diag-- bottom atm level diagnostic co2 @@ -3184,28 +3199,15 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ ! ! !REVISION HISTORY: ! same as module - + use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh ! !INPUT/OUTPUT PARAMETERS: + type(ESMF_Clock), intent(inout) :: EClock ! type(mct_aVect) , intent(inout) :: x2o_o ! instead, we will get x2o_om from MPOID ! !OUTPUT PARAMETERS: - use iMOAB, only : iMOAB_GetDoubleTagStorage, iMOAB_WriteMesh - !EOP - !BOC - !----------------------------------------------------------------------- - ! - ! local variables - !----------------------------------------------------------------------- - ! - ! local variables - ! - !----------------------------------------------------------------------- - integer :: ent_type, ierr - character(CXX) :: tagname - type(ESMF_Clock), intent(inout) :: EClock integer, intent(out) :: & errorCode ! returned error code @@ -3221,6 +3223,9 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ label, & message + integer :: ent_type, ierr + character(CXX) :: tagname + integer :: & i,n @@ -3232,6 +3237,7 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ config_use_DMSTracers_sea_ice_coupling, & config_use_MacroMoleculesTracers, & config_use_MacroMoleculesTracers_sea_ice_coupling, & + config_use_CFCTracers, & config_remove_ais_river_runoff, & config_remove_ais_ice_runoff, & config_cvmix_kpp_use_theory_wave @@ -3250,7 +3256,8 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ ecosysAuxiliary, & ecosysSeaIceCoupling, & DMSSeaIceCoupling, & - MacroMoleculesSeaIceCoupling + MacroMoleculesSeaIceCoupling, & + CFCAuxiliary integer, pointer :: nCellsSolve @@ -3278,10 +3285,22 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ iceFluxFeParticulateField, & iceFluxFeDissolvedField, & iceFluxDustField, & + riverFluxNO3Field, & + riverFluxPO4Field, & + riverFluxSiO3Field, & + riverFluxDOCField, & + riverFluxDONField, & + riverFluxDOPField, & + riverFluxDICField, & + riverFluxALKField, & + riverFluxFeField, & landIceFreshwaterFluxField, & landIceHeatFluxField, & landIceFractionField, & - windSpeed10mField + windSpeed10mField, & + significantWaveHeightField, & + peakWaveFrequencyField, & + peakWaveDirectionField !landIcePressureField type (field2DReal), pointer :: iceFluxPhytoCField, & @@ -3289,6 +3308,9 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ type (field2DReal), pointer :: landIceInterfaceTracersField + type (field2DReal), pointer :: stokesDriftZonalWavenumberField, & + stokesDriftMeridionalWavenumberField + real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional, & latentHeatFlux, sensibleHeatFlux, & longWaveHeatFluxUp, & @@ -3302,6 +3324,7 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ atmosphericPressure, iceFraction, & seaIcePressure, windSpeedSquared10m, & atmosphericCO2, atmosphericCO2_ALT_CO2, & + windSpeedSquared10mCFC, & iceFluxDIC, & iceFluxDON, & iceFluxNO3, & @@ -3313,26 +3336,44 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ iceFluxFeParticulate, & iceFluxFeDissolved, & iceFluxDust, & + riverFluxNO3, & + riverFluxPO4, & + riverFluxSiO3, & + riverFluxDOC, & + riverFluxDON, & + riverFluxDOP, & + riverFluxDIC, & + riverFluxALK, & + riverFluxFe, & landIceFreshwaterFlux, & landIceHeatFlux, & landIceFraction, & - windSpeed10m + areaCell, & + windSpeed10m, & + significantWaveHeight, & + peakWaveFrequency, & + peakWaveDirection !landIcePressure real (kind=RKIND), dimension(:), pointer :: latCell real (kind=RKIND), dimension(:,:), pointer :: iceFluxPhytoC, & - iceFluxDOC + iceFluxDOC, & + stokesDriftZonalWavenumber, & + stokesDriftMeridionalWavenumber real (kind=RKIND) :: removedRiverRunoffFluxThisProc, removedIceRunoffFluxThisProc real (kind=RKIND) :: removedRiverRunoffFluxReduced, removedIceRunoffFluxReduced real (kind=RKIND), dimension(:,:), pointer :: landIceInterfaceTracers + real (kind=RKIND) :: riverFactor + !----------------------------------------------------------------------- ! ! zero out padded cells ! +!----------------------------------------------------------------------- !----------------------------------------------------------------------- integer :: cur_ocn_stepno #ifdef MOABDEBUG @@ -3349,11 +3390,10 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ write(ocnLogUnit,*) 'Fail to write ocean state ' endif #endif + errorCode = 0 ! get moab tags from MPOID - - ent_type = 1 ! cells ! get all tags in one method tagname = trim(seq_flds_x2o_fields)//C_NULL_CHAR @@ -3361,7 +3401,6 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ if ( ierr /= 0 ) then write(ocnLogUnit,*) 'Fail to get MOAB fields ' endif - !----------------------------------------------------------------------- ! ! unpack and distribute wind stress, then convert to correct units @@ -3380,6 +3419,7 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ config_use_DMSTracers_sea_ice_coupling) call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers_sea_ice_coupling', & config_use_MacroMoleculesTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_use_CFCTracers', config_use_CFCTracers) call mpas_pool_get_config(domain % configs, 'config_remove_ais_river_runoff', config_remove_ais_river_runoff) call mpas_pool_get_config(domain % configs, 'config_remove_ais_ice_runoff', config_remove_ais_ice_runoff) call mpas_pool_get_config(domain % configs, 'config_cvmix_kpp_use_theory_wave', config_cvmix_kpp_use_theory_wave) @@ -3418,6 +3458,11 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ call mpas_pool_get_field(forcingPool, 'iceRunoffFlux', iceRunoffFluxField) call mpas_pool_get_field(forcingPool, 'removedRiverRunoffFlux', removedRiverRunoffFluxField) call mpas_pool_get_field(forcingPool, 'removedIceRunoffFlux', removedIceRunoffFluxField) + call mpas_pool_get_field(forcingPool, 'stokesDriftZonalWavenumber', stokesDriftZonalWavenumberField) + call mpas_pool_get_field(forcingPool, 'stokesDriftMeridionalWavenumber', stokesDriftMeridionalWavenumberField) + call mpas_pool_get_field(forcingPool, 'significantWaveHeight', significantWaveHeightField) + call mpas_pool_get_field(forcingPool, 'peakWaveFrequency', peakWaveFrequencyField) + call mpas_pool_get_field(forcingPool, 'peakWaveDirection', peakWaveDirectionField) call mpas_pool_get_field(forcingPool, 'landIceFreshwaterFlux', landIceFreshwaterFluxField) call mpas_pool_get_field(forcingPool, 'landIceHeatFlux', landIceHeatFluxField) @@ -3459,9 +3504,15 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ landIceInterfaceTracers => landIceInterfaceTracersField % array landIceFraction => landIceFractionField % array windSpeed10m => windSpeed10mField % array + stokesDriftZonalWavenumber => stokesDriftZonalWavenumberField % array + stokesDriftMeridionalWavenumber => stokesDriftMeridionalWavenumberField % array + significantWaveHeight => significantWaveHeightField % array + peakWaveFrequency => peakWaveFrequencyField % array + peakWaveDirection => peakWaveDirectionField % array !landIcePressure => landIcePressureField % array call mpas_pool_get_array(meshPool, 'latCell', latCell) + call mpas_pool_get_array(meshPool, 'areaCell', areaCell) ! BGC fields if (config_use_ecosysTracers) then @@ -3474,6 +3525,27 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ call mpas_pool_get_field(ecosysAuxiliary, 'atmosphericCO2_ALT_CO2', atmosphericCO2_ALT_CO2Field) atmosphericCO2_ALT_CO2 => atmosphericCO2_ALT_CO2Field % array + if (config_use_ecosysTracers_river_inputs_from_coupler) then + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxNO3' , riverFluxNO3Field) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxPO4' , riverFluxPO4Field) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDON' , riverFluxDONField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDOP' , riverFluxDOPField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxSiO3', riverFluxSiO3Field) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDOC' , riverFluxDOCField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDIC' , riverFluxDICField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxALK' , riverFluxALKField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxFe' , riverFluxFeField) + riverFluxNO3 => riverFluxNO3Field % array + riverFluxPO4 => riverFluxPO4Field % array + riverFluxDON => riverFluxDONField % array + riverFluxDOP => riverFluxDOPField % array + riverFluxSiO3 => riverFluxSiO3Field % array + riverFluxDOC => riverFluxDOCField % array + riverFluxDIC => riverFluxDICField % array + riverFluxALK => riverFluxALKField % array + riverFluxFe => riverFluxFeField % array + endif + call mpas_pool_get_config(domain % configs, 'config_ecosys_atm_co2_option', & config_ecosys_atm_co2_option) call mpas_pool_get_config(domain % configs, 'config_ecosys_atm_alt_co2_option', & @@ -3519,6 +3591,13 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ iceFluxDMSP => iceFluxDMSPField % array endif + ! CFC fields + if (config_use_CFCTracers) then + call mpas_pool_get_subpool(forcingPool, 'CFCAuxiliary', CFCAuxiliary) + call mpas_pool_get_field(CFCAuxiliary, 'windSpeedSquared10mCFC', windSpeedSquared10mField) + windSpeedSquared10mCFC => windSpeedSquared10mField % array + endif + if (config_remove_ais_river_runoff) then ! Initialize this field removedRiverRunoffFlux(:) = 0.0_RKIND @@ -3533,8 +3612,7 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ ! Initialize this field windSpeed10m(:) = 0.0_RKIND endif - -! replace 'x2o_o % rAttr(' to 'x2o_om(n, ' and ', n)' with ')' +! ! replace 'x2o_o % rAttr(' to 'x2o_om(n, ' and ', n)' with ')' do i = 1, nCellsSolve n = n + 1 if ( windStressZonalField % isActive ) then @@ -3618,6 +3696,32 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ iceFraction(i) = x2o_om(n, index_x2o_Si_ifrac) end if + if ( stokesDriftZonalWavenumberField % isActive ) then + stokesDriftZonalWavenumber(1,i) = x2o_om(n, index_x2o_Sw_ustokes_wavenumber_1) + stokesDriftZonalWavenumber(2,i) = x2o_om(n, index_x2o_Sw_ustokes_wavenumber_2) + stokesDriftZonalWavenumber(3,i) = x2o_om(n, index_x2o_Sw_ustokes_wavenumber_3) + stokesDriftZonalWavenumber(4,i) = x2o_om(n, index_x2o_Sw_ustokes_wavenumber_4) + stokesDriftZonalWavenumber(5,i) = x2o_om(n, index_x2o_Sw_ustokes_wavenumber_5) + stokesDriftZonalWavenumber(6,i) = x2o_om(n, index_x2o_Sw_ustokes_wavenumber_6) + end if + if ( stokesDriftMeridionalWavenumberField % isActive ) then + stokesDriftMeridionalWavenumber(1,i) = x2o_om(n, index_x2o_Sw_vstokes_wavenumber_1) + stokesDriftMeridionalWavenumber(2,i) = x2o_om(n, index_x2o_Sw_vstokes_wavenumber_2) + stokesDriftMeridionalWavenumber(3,i) = x2o_om(n, index_x2o_Sw_vstokes_wavenumber_3) + stokesDriftMeridionalWavenumber(4,i) = x2o_om(n, index_x2o_Sw_vstokes_wavenumber_4) + stokesDriftMeridionalWavenumber(5,i) = x2o_om(n, index_x2o_Sw_vstokes_wavenumber_5) + stokesDriftMeridionalWavenumber(6,i) = x2o_om(n, index_x2o_Sw_vstokes_wavenumber_6) + end if + if ( significantWaveHeightField % isActive ) then + significantWaveHeight(i) = x2o_om(n, index_x2o_Sw_Hs) + end if + if ( peakWaveFrequencyField % isActive ) then + peakWaveFrequency(i) = x2o_om(n, index_x2o_Sw_Fp) + end if + if ( peakWaveDirectionField % isActive ) then + peakWaveDirection(i) = x2o_om(n, index_x2o_Sw_Dp) + end if + if (config_cvmix_kpp_use_theory_wave) then if ( windSpeed10mField% isActive ) then windSpeed10m(i) = sqrt( x2o_om(n, index_x2o_So_duu10n)) @@ -3675,12 +3779,36 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ else if ( config_ecosys_atm_alt_co2_option == 'bdrc') then atmosphericCO2_ALT_CO2(i) = config_ecosys_atm_co2_constant_value else if ( config_ecosys_atm_alt_co2_option == 'bdrd') then - atmosphericCO2_ALT_CO2(i) = x2o_om(n, index_x2o_Sa_co2diag) + atmosphericCO2_ALT_CO2(i) = x2o_om(n, index_x2o_Sa_co2diag) else atmosphericCO2_ALT_CO2(i) = config_ecosys_atm_co2_constant_value end if end if + if (config_use_ecosysTracers_river_inputs_from_coupler) then + riverFluxNO3(i) = x2o_om(n, index_x2o_Foxx_rofDIN) + riverFluxPO4(i) = x2o_om(n, index_x2o_Foxx_rofDIP) + riverFluxDON(i) = x2o_om(n, index_x2o_Foxx_rofDON) + riverFluxDOP(i) = x2o_om(n, index_x2o_Foxx_rofDOP) + riverFluxSiO3(i) = x2o_om(n, index_x2o_Foxx_rofDSi) + riverFluxDOC(i) = x2o_om(n, index_x2o_Foxx_rofDOC) + riverFluxDIC(i) = x2o_om(n, index_x2o_Foxx_rofDIC) + riverFluxFe(i) = x2o_om(n, index_x2o_Foxx_rofFe ) + +! convert from kgNutrient/(m2-s) to mmol/m3 m/s + riverFactor = 1.e6_RKIND + riverFluxNO3(i) = riverFluxNO3(i)*riverFactor/14.007_RKIND + riverFluxPO4(i) = riverFluxPO4(i)*riverFactor/30.974_RKIND + riverFluxDON(i) = riverFluxDON(i)*riverFactor/14.007_RKIND + riverFluxDOP(i) = riverFluxDOP(i)*riverFactor/30.974_RKIND + riverFluxSiO3(i) = riverFluxSiO3(i)*riverFactor/28.085_RKIND + riverFluxDOC(i) = riverFluxDOC(i)*riverFactor/12.001_RKIND + riverFluxDIC(i) = riverFluxDIC(i)*riverFactor/12.001_RKIND + riverFluxFe(i) = riverFluxFe(i)*riverFactor/55.845_RKIND + + riverFluxALK(i) = riverFluxDIC(i) + endif + if (config_use_ecosysTracers_sea_ice_coupling) then if ( iceFluxPhytoCField % isActive ) then iceFluxPhytoC(1,i) = x2o_om(n, index_x2o_Fioi_algae1) @@ -3714,6 +3842,7 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ if ( iceFluxDOCField % isActive ) then iceFluxDOC(1,i) = x2o_om(n, index_x2o_Fioi_doc1) iceFluxDOC(2,i) = x2o_om(n, index_x2o_Fioi_doc2) + iceFluxDOC(3,i) = x2o_om(n, index_x2o_Fioi_doc3) endif if ( iceFluxDONField % isActive ) then iceFluxDON(i) = x2o_om(n, index_x2o_Fioi_don1) @@ -3730,6 +3859,13 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ endif endif + ! CFC fields + if (config_use_CFCTracers) then + if ( windSpeedSquared10mField % isActive ) then + windSpeedSquared10mCFC(i) = x2o_om(n, index_x2o_So_duu10n) + end if + end if + end do block_ptr => block_ptr % next @@ -3757,6 +3893,11 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ call mpas_pool_get_field(forcingPool, 'atmosphericPressure', atmosphericPressureField) call mpas_pool_get_field(forcingPool, 'seaIcePressure', seaIcePressureField) call mpas_pool_get_field(forcingPool, 'iceFraction', iceFractionField) + call mpas_pool_get_field(forcingPool, 'stokesDriftZonalWavenumber', stokesDriftZonalWavenumberField) + call mpas_pool_get_field(forcingPool, 'stokesDriftMeridionalWavenumber', stokesDriftMeridionalWavenumberField) + call mpas_pool_get_field(forcingPool, 'significantWaveHeight', significantWaveHeightField) + call mpas_pool_get_field(forcingPool, 'peakWaveFrequency', peakWaveFrequencyField) + call mpas_pool_get_field(forcingPool, 'peakWaveDirection', peakWaveDirectionField) call mpas_pool_get_field(forcingPool, 'landIceFreshwaterFlux', landIceFreshwaterFluxField) call mpas_pool_get_field(forcingPool, 'landIceHeatFlux', landIceHeatFluxField) @@ -3777,6 +3918,18 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ call mpas_pool_get_field(ecosysAuxiliary, 'atmosphericCO2', atmosphericCO2Field) call mpas_pool_get_field(ecosysAuxiliary, 'atmosphericCO2_ALT_CO2', atmosphericCO2_ALT_CO2Field) + if (config_use_ecosysTracers_river_inputs_from_coupler) then + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxNO3' , riverFluxNO3Field) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxPO4' , riverFluxPO4Field) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDON' , riverFluxDONField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDOP' , riverFluxDOPField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxSiO3', riverFluxSiO3Field) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDOC' , riverFluxDOCField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxDIC' , riverFluxDICField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxALK' , riverFluxALKField) + call mpas_pool_get_field(ecosysAuxiliary, 'riverFluxFe' , riverFluxFeField) + endif + if (config_use_ecosysTracers_sea_ice_coupling) then call mpas_pool_get_subpool(forcingPool, 'ecosysSeaIceCoupling', ecosysSeaIceCoupling) @@ -3800,6 +3953,12 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ call mpas_pool_get_field(DMSSeaIceCoupling, 'iceFluxDMSP', iceFluxDMSPField) endif + ! CFC fields + if (config_use_CFCTracers) then + call mpas_pool_get_subpool(forcingPool, 'CFCAuxiliary', CFCAuxiliary) + call mpas_pool_get_field(CFCAuxiliary, 'windSpeedSquared10mCFC', windSpeedSquared10mField) + endif + if ( windStressMeridionalField % isActive ) then call mpas_dmpar_exch_halo_field(windStressMeridionalField) end if @@ -3860,6 +4019,21 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ if ( iceFractionField % isActive ) then call mpas_dmpar_exch_halo_field(iceFractionField) end if + if ( stokesDriftZonalWavenumberField % isActive ) then + call mpas_dmpar_exch_halo_field(stokesDriftZonalWavenumberField) + end if + if ( stokesDriftMeridionalWavenumberField % isActive ) then + call mpas_dmpar_exch_halo_field(stokesDriftMeridionalWavenumberField) + end if + if ( significantWaveHeightField % isActive ) then + call mpas_dmpar_exch_halo_field(significantWaveHeightField) + end if + if ( peakWaveFrequencyField % isActive ) then + call mpas_dmpar_exch_halo_field(peakWaveFrequencyField) + end if + if ( peakWaveDirectionField % isActive ) then + call mpas_dmpar_exch_halo_field(peakWaveDirectionField) + end if if ( landIceFreshwaterFluxField % isActive ) then call mpas_dmpar_exch_halo_field(landIceFreshwaterFluxField) @@ -3894,6 +4068,36 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ call mpas_dmpar_exch_halo_field(atmosphericCO2_ALT_CO2Field) end if + if (config_use_ecosysTracers_river_inputs_from_coupler) then + if ( riverFluxNO3Field % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxNO3Field) + end if + if ( riverFluxPO4Field % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxPO4Field) + end if + if ( riverFluxDONField % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxDONField) + end if + if ( riverFluxDOPField % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxDOPField) + end if + if ( riverFluxSiO3Field % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxSiO3Field) + end if + if ( riverFluxDOCField % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxDOCField) + end if + if ( riverFluxDICField % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxDICField) + end if + if ( riverFluxALKField % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxALKField) + end if + if ( riverFluxFeField % isActive ) then + call mpas_dmpar_exch_halo_field(riverFluxFeField) + end if + endif + if (config_use_ecosysTracers_sea_ice_coupling) then if ( iceFluxPhytoCField % isActive ) then call mpas_dmpar_exch_halo_field(iceFluxPhytoCField) @@ -3939,302 +4143,348 @@ subroutine ocn_import_moab( Eclock, errorCode)!{{{ endif endif + ! CFC fields + if (config_use_CFCTracers .and. .not. config_use_ecosysTracers) then + if ( windSpeedSquared10mField % isActive ) then + call mpas_dmpar_exch_halo_field(windSpeedSquared10mField) + end if + endif + !----------------------------------------------------------------------- !EOC end subroutine ocn_import_moab!}}} +!*********************************************************************** +!BOP +! !IROUTINE: ocn_export_moab +! !INTERFACE: - subroutine ocn_export_moab(EClock) !{{{ - - ! !DESCRIPTION: - ! This routine calls the routines necessary to send mpas ocean fields to MOAB coupler - ! - use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh - !EOP - !BOC - type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver - ! - ! local variables - ! - !----------------------------------------------------------------------- - integer :: ent_type, ierr, cur_ocn_stepno - character(len=100) :: outfile, wopts, localmeshfile, lnum - character(CXX) :: tagname - - integer :: i, n - integer, pointer :: nCellsSolve, index_temperatureSurfaceValue, index_salinitySurfaceValue, & - index_avgZonalSurfaceVelocity, index_avgMeridionalSurfaceVelocity, & - index_avgZonalSSHGradient, index_avgMeridionalSSHGradient + subroutine ocn_export_moab(EClock) !{{{ - type (block_type), pointer :: block_ptr +! !DESCRIPTION: +! This routine calls the routines necessary to send MPASO fields to +! the MOAB driver +! +! !REVISION HISTORY: +! same as module + use iMOAB, only : iMOAB_SetDoubleTagStorage, iMOAB_WriteMesh +! !INPUT/OUTPUT PARAMETERS: - type (mpas_pool_type), pointer :: meshPool, & - forcingPool, & - statePool, & - tracersPool, & - ecosysAuxiliary, & - ecosysSeaIceCoupling, & - DMSSeaIceCoupling, & - MacroMoleculesSeaIceCoupling - - integer, dimension(:), pointer :: landIceMask - - real (kind=RKIND), dimension(:), pointer :: seaIceEnergy, accumulatedFrazilIceMass, frazilSurfacePressure, & - avgTotalFreshWaterTemperatureFlux, & - avgCO2_gas_flux, DMSFlux, surfaceUpwardCO2Flux, & - avgOceanSurfaceDIC, & - avgOceanSurfaceDON, & - avgOceanSurfaceNO3, & - avgOceanSurfaceSiO3, & - avgOceanSurfaceNH4, & - avgOceanSurfaceDMS, & - avgOceanSurfaceDMSP, & - avgOceanSurfaceDOCr, & - avgOceanSurfaceDOCSemiLabile, & - avgOceanSurfaceFeParticulate, & - avgOceanSurfaceFeDissolved, & - ssh, & - avgLandIceFreshwaterFlux, & - avgRemovedRiverRunoffFlux, & - avgRemovedIceRunoffFlux, & - avgLandIceHeatFlux, & - avgRemovedIceRunoffHeatFlux - - real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & - avgSSHGradient, avgOceanSurfacePhytoC, & - avgOceanSurfaceDOC, layerThickness - - real (kind=RKIND) :: surfaceFreezingTemp - - logical, pointer :: frazilIceActive, & - config_remove_ais_river_runoff, & - config_remove_ais_ice_runoff, & - config_use_ecosysTracers, & - config_use_DMSTracers, & - config_use_MacroMoleculesTracers, & - config_use_ecosysTracers_sea_ice_coupling, & - config_use_DMSTracers_sea_ice_coupling, & - config_use_MacroMoleculesTracers_sea_ice_coupling - - character (len=StrKIND), pointer :: config_land_ice_flux_mode - - logical :: keepFrazil - - - ! get configure options - call mpas_pool_get_package(domain % packages, 'frazilIceActive', frazilIceActive) - call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers', config_use_ecosysTracers) - call mpas_pool_get_config(domain % configs, 'config_land_ice_flux_mode', config_land_ice_flux_mode) - call mpas_pool_get_config(domain % configs, 'config_remove_ais_river_runoff', config_remove_ais_river_runoff) - call mpas_pool_get_config(domain % configs, 'config_remove_ais_ice_runoff', config_remove_ais_ice_runoff) - call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers', config_use_DMSTracers) - call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers', config_use_MacroMoleculesTracers) - call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers_sea_ice_coupling', & - config_use_ecosysTracers_sea_ice_coupling) - call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers_sea_ice_coupling', & - config_use_DMSTracers_sea_ice_coupling) - call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers_sea_ice_coupling', & - config_use_MacroMoleculesTracers_sea_ice_coupling) - - n = 0 - block_ptr => domain % blocklist - do while(associated(block_ptr)) - call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool) - call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) - call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool) + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver - call mpas_pool_get_subpool(statePool, 'tracers', tracersPool) +! !OUTPUT PARAMETERS: - call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + integer :: ent_type, ierr, cur_ocn_stepno + character(len=100) :: outfile, wopts, localmeshfile, lnum + character(CXX) :: tagname - call mpas_pool_get_dimension(forcingPool, 'index_avgTemperatureSurfaceValue', index_temperatureSurfaceValue) - call mpas_pool_get_dimension(forcingPool, 'index_avgSalinitySurfaceValue', index_salinitySurfaceValue) - call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityZonal', index_avgZonalSurfaceVelocity) - call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityMeridional', index_avgMeridionalSurfaceVelocity) - call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientZonal', index_avgZonalSSHGradient) - call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientMeridional', index_avgMeridionalSSHGradient) + integer :: i, n + integer, pointer :: nCellsSolve, index_temperatureSurfaceValue, index_salinitySurfaceValue, & + index_avgZonalSurfaceVelocity, index_avgMeridionalSurfaceVelocity, & + index_avgZonalSSHGradient, index_avgMeridionalSSHGradient + type (block_type), pointer :: block_ptr - call mpas_pool_get_array(statePool, 'ssh', ssh, 1) - call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1) + type (mpas_pool_type), pointer :: meshPool, & + forcingPool, & + statePool, & + tracersPool, & + ecosysAuxiliary, & + ecosysSeaIceCoupling, & + DMSSeaIceCoupling, & + MacroMoleculesSeaIceCoupling - call mpas_pool_get_array(forcingPool, 'landIceMask', landIceMask) - call mpas_pool_get_array(forcingPool, 'avgTracersSurfaceValue', avgTracersSurfaceValue) - call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity) - call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient) - call mpas_pool_get_array(forcingPool, 'avgTotalFreshWaterTemperatureFlux', avgTotalFreshWaterTemperatureFlux) - if ( frazilIceActive ) then - call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy) - call mpas_pool_get_array(forcingPool, 'frazilSurfacePressure', frazilSurfacePressure) - call mpas_pool_get_array(statePool, 'accumulatedFrazilIceMass', accumulatedFrazilIceMass, 1) - end if + integer, dimension(:), pointer :: landIceMask - if (trim(config_land_ice_flux_mode) == 'standalone' .or. trim(config_land_ice_flux_mode) == 'data') then - call mpas_pool_get_array(forcingPool, 'avgLandIceFreshwaterFlux', avgLandIceFreshwaterFlux) - call mpas_pool_get_array(forcingPool, 'avgLandIceHeatFlux', avgLandIceHeatFlux) - endif - if (config_remove_ais_river_runoff) then - call mpas_pool_get_array(forcingPool, 'avgRemovedRiverRunoffFlux', avgRemovedRiverRunoffFlux) - endif - if (config_remove_ais_ice_runoff) then - call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffFlux', avgRemovedIceRunoffFlux) - call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffHeatFlux', avgRemovedIceRunoffHeatFlux) - endif + real (kind=RKIND), dimension(:), pointer :: seaIceEnergy, accumulatedFrazilIceMass, frazilSurfacePressure, & + avgTotalFreshWaterTemperatureFlux, & + avgCO2_gas_flux, DMSFlux, surfaceUpwardCO2Flux, & + avgOceanSurfaceDIC, & + avgOceanSurfaceDON, & + avgOceanSurfaceNO3, & + avgOceanSurfaceSiO3, & + avgOceanSurfaceNH4, & + avgOceanSurfaceDMS, & + avgOceanSurfaceDMSP, & + avgOceanSurfaceDOCr, & + avgOceanSurfaceDOCSemiLabile, & + avgOceanSurfaceFeParticulate, & + avgOceanSurfaceFeDissolved, & + ssh, & + avgLandIceFreshwaterFlux, & + avgRemovedRiverRunoffFlux, & + avgRemovedIceRunoffFlux, & + avgLandIceHeatFlux, & + avgRemovedIceRunoffHeatFlux - ! BGC fields - if (config_use_ecosysTracers) then + real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, & + avgSSHGradient, avgOceanSurfacePhytoC, & + avgOceanSurfaceDOC, layerThickness - call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary) - call mpas_pool_get_array(ecosysAuxiliary, 'avgCO2_gas_flux', avgCO2_gas_flux) + real (kind=RKIND) :: surfaceFreezingTemp - end if + logical, pointer :: frazilIceActive, & + config_remove_ais_river_runoff, & + config_remove_ais_ice_runoff, & + config_use_ecosysTracers, & + config_use_DMSTracers, & + config_use_MacroMoleculesTracers, & + config_use_ecosysTracers_sea_ice_coupling, & + config_use_DMSTracers_sea_ice_coupling, & + config_use_MacroMoleculesTracers_sea_ice_coupling - if (config_use_ecosysTracers .and. config_use_ecosysTracers_sea_ice_coupling) then - call mpas_pool_get_subpool(forcingPool, 'ecosysSeaIceCoupling', ecosysSeaIceCoupling) + character (len=StrKIND), pointer :: config_land_ice_flux_mode - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfacePhytoC', avgOceanSurfacePhytoC) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDIC', avgOceanSurfaceDIC) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceNO3', avgOceanSurfaceNO3) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceSiO3', avgOceanSurfaceSiO3) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceNH4', avgOceanSurfaceNH4) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDOCr', avgOceanSurfaceDOCr) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDOCSemiLabile', avgOceanSurfaceDOCSemiLabile) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeParticulate', avgOceanSurfaceFeParticulate) - call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeDissolved', avgOceanSurfaceFeDissolved) - endif - if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then - call mpas_pool_get_subpool(forcingPool, 'DMSSeaIceCoupling', DMSSeaIceCoupling) + logical :: keepFrazil - call mpas_pool_get_array(DMSSeaIceCoupling, 'avgOceanSurfaceDMS', avgOceanSurfaceDMS) - call mpas_pool_get_array(DMSSeaIceCoupling, 'avgOceanSurfaceDMSP', avgOceanSurfaceDMSP) - endif - if (config_use_MacroMoleculesTracers .and. config_use_MacroMoleculesTracers_sea_ice_coupling) then - call mpas_pool_get_subpool(forcingPool, 'MacroMoleculesSeaIceCoupling', MacroMoleculesSeaIceCoupling) - call mpas_pool_get_array(MacroMoleculesSeaIceCoupling, 'avgOceanSurfaceDOC', avgOceanSurfaceDOC) - call mpas_pool_get_array(MacroMoleculesSeaIceCoupling, 'avgOceanSurfaceDON', avgOceanSurfaceDON) - endif - ! call mpas_pool_get_array(forcingPool, 'CO2Flux', CO2Flux) - ! call mpas_pool_get_array(forcingPool, 'DMSFlux', DMSFlux) - ! call mpas_pool_get_array(forcingPool, 'surfaceUpwardCO2Flux', surfaceUpwardCO2Flux) + ! get configure options + call mpas_pool_get_package(domain % packages, 'frazilIceActive', frazilIceActive) + call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers', config_use_ecosysTracers) + call mpas_pool_get_config(domain % configs, 'config_land_ice_flux_mode', config_land_ice_flux_mode) + call mpas_pool_get_config(domain % configs, 'config_remove_ais_river_runoff', config_remove_ais_river_runoff) + call mpas_pool_get_config(domain % configs, 'config_remove_ais_ice_runoff', config_remove_ais_ice_runoff) + call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers', config_use_DMSTracers) + call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers', config_use_MacroMoleculesTracers) + call mpas_pool_get_config(domain % configs, 'config_use_ecosysTracers_sea_ice_coupling', & + config_use_ecosysTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_use_DMSTracers_sea_ice_coupling', & + config_use_DMSTracers_sea_ice_coupling) + call mpas_pool_get_config(domain % configs, 'config_use_MacroMoleculesTracers_sea_ice_coupling', & + config_use_MacroMoleculesTracers_sea_ice_coupling) - do i = 1, nCellsSolve - n = n + 1 + n = 0 + block_ptr => domain % blocklist + do while(associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool) - o2x_om(n, index_o2x_So_t) = avgTracersSurfaceValue(index_temperatureSurfaceValue, i) - o2x_om(n, index_o2x_So_s) = avgTracersSurfaceValue(index_salinitySurfaceValue, i) - o2x_om(n, index_o2x_So_u) = avgSurfaceVelocity(index_avgZonalSurfaceVelocity, i) - o2x_om(n, index_o2x_So_v) = avgSurfaceVelocity(index_avgMeridionalSurfaceVelocity, i) + call mpas_pool_get_subpool(statePool, 'tracers', tracersPool) - o2x_om(n, index_o2x_So_ssh) = ssh(i) - o2x_om(n, index_o2x_So_dhdx) = avgSSHGradient(index_avgZonalSSHGradient, i) - o2x_om(n, index_o2x_So_dhdy) = avgSSHGradient(index_avgMeridionalSSHGradient, i) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) - o2x_om(n, index_o2x_Faoo_h2otemp) = avgTotalFreshWaterTemperatureFlux(i) * rho_sw * cp_sw + call mpas_pool_get_dimension(forcingPool, 'index_avgTemperatureSurfaceValue', index_temperatureSurfaceValue) + call mpas_pool_get_dimension(forcingPool, 'index_avgSalinitySurfaceValue', index_salinitySurfaceValue) + call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityZonal', index_avgZonalSurfaceVelocity) + call mpas_pool_get_dimension(forcingPool, 'index_avgSurfaceVelocityMeridional', index_avgMeridionalSurfaceVelocity) + call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientZonal', index_avgZonalSSHGradient) + call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientMeridional', index_avgMeridionalSSHGradient) - if (trim(config_land_ice_flux_mode) == 'standalone' .or. trim(config_land_ice_flux_mode) == 'data') then - o2x_om(n, index_o2x_Foxo_ismw) = avgLandIceFreshwaterFlux(i) - o2x_om(n, index_o2x_Foxo_ismh) = avgLandIceHeatFlux(i) - endif - if (config_remove_ais_river_runoff) then - o2x_om(n, index_o2x_Foxo_rrofl) = avgRemovedRiverRunoffFlux(i) - endif - if (config_remove_ais_ice_runoff) then - o2x_om(n, index_o2x_Foxo_rrofi) = avgRemovedIceRunoffFlux(i) - o2x_om(n, index_o2x_Foxo_rrofih) = avgRemovedIceRunoffHeatFlux(i) - endif + call mpas_pool_get_array(statePool, 'ssh', ssh, 1) + call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1) - if ( frazilIceActive ) then - ! negative when frazil ice can be melted - keepFrazil = .true. - if ( associated(landIceMask) ) then - if ( landIceMask(i) == 1 ) then - keepFrazil = .false. - end if - end if + call mpas_pool_get_array(forcingPool, 'landIceMask', landIceMask) + call mpas_pool_get_array(forcingPool, 'avgTracersSurfaceValue', avgTracersSurfaceValue) + call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity) + call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient) + call mpas_pool_get_array(forcingPool, 'avgTotalFreshWaterTemperatureFlux', avgTotalFreshWaterTemperatureFlux) - if ( keepFrazil ) then + if ( frazilIceActive ) then + call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy) + call mpas_pool_get_array(forcingPool, 'frazilSurfacePressure', frazilSurfacePressure) + call mpas_pool_get_array(statePool, 'accumulatedFrazilIceMass', accumulatedFrazilIceMass, 1) + end if - ! Calculate energy associated with frazil mass transfer to sea ice if frazil has accumulated - if ( accumulatedFrazilIceMass(i) > 0.0_RKIND ) then + ! Cryo fields + if (trim(config_land_ice_flux_mode) == 'standalone' .or. trim(config_land_ice_flux_mode) == 'data') then + call mpas_pool_get_array(forcingPool, 'avgLandIceFreshwaterFlux', avgLandIceFreshwaterFlux) + call mpas_pool_get_array(forcingPool, 'avgLandIceHeatFlux', avgLandIceHeatFlux) + endif + if (config_remove_ais_river_runoff) then + call mpas_pool_get_array(forcingPool, 'avgRemovedRiverRunoffFlux', avgRemovedRiverRunoffFlux) + endif + if (config_remove_ais_ice_runoff) then + call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffFlux', avgRemovedIceRunoffFlux) + call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoffHeatFlux', avgRemovedIceRunoffHeatFlux) + endif - seaIceEnergy(i) = accumulatedFrazilIceMass(i) * config_frazil_heat_of_fusion + ! BGC fields + if (config_use_ecosysTracers) then - ! Otherwise calculate the melt potential where avgTracersSurfaceValue represents only the - ! top layer of the ocean - else + call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary) + call mpas_pool_get_array(ecosysAuxiliary, 'avgCO2_gas_flux', avgCO2_gas_flux) - surfaceFreezingTemp = ocn_freezing_temperature(salinity=avgTracersSurfaceValue(index_salinitySurfaceValue, i), & - pressure=0.0_RKIND, inLandIceCavity=.false.) + end if - seaIceEnergy(i) = min(rho_sw*cp_sw*layerThickness(1, i)*( surfaceFreezingTemp + T0_Kelvin & - - avgTracersSurfaceValue(index_temperatureSurfaceValue, i) ), 0.0_RKIND ) + if (config_use_ecosysTracers .and. config_use_ecosysTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'ecosysSeaIceCoupling', ecosysSeaIceCoupling) - end if + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfacePhytoC', avgOceanSurfacePhytoC) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDIC', avgOceanSurfaceDIC) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceNO3', avgOceanSurfaceNO3) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceSiO3', avgOceanSurfaceSiO3) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceNH4', avgOceanSurfaceNH4) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDOCr', avgOceanSurfaceDOCr) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceDOCSemiLabile', avgOceanSurfaceDOCSemiLabile) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeParticulate', avgOceanSurfaceFeParticulate) + call mpas_pool_get_array(ecosysSeaIceCoupling, 'avgOceanSurfaceFeDissolved', avgOceanSurfaceFeDissolved) + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'DMSSeaIceCoupling', DMSSeaIceCoupling) - o2x_om(n, index_o2x_Fioo_q) = seaIceEnergy(i) / ocn_cpl_dt - o2x_om(n, index_o2x_Fioo_frazil) = accumulatedFrazilIceMass(i) / ocn_cpl_dt + call mpas_pool_get_array(DMSSeaIceCoupling, 'avgOceanSurfaceDMS', avgOceanSurfaceDMS) + call mpas_pool_get_array(DMSSeaIceCoupling, 'avgOceanSurfaceDMSP', avgOceanSurfaceDMSP) + endif + if (config_use_MacroMoleculesTracers .and. config_use_MacroMoleculesTracers_sea_ice_coupling) then + call mpas_pool_get_subpool(forcingPool, 'MacroMoleculesSeaIceCoupling', MacroMoleculesSeaIceCoupling) - else + call mpas_pool_get_array(MacroMoleculesSeaIceCoupling, 'avgOceanSurfaceDOC', avgOceanSurfaceDOC) + call mpas_pool_get_array(MacroMoleculesSeaIceCoupling, 'avgOceanSurfaceDON', avgOceanSurfaceDON) + endif +! call mpas_pool_get_array(forcingPool, 'CO2Flux', CO2Flux) +! call mpas_pool_get_array(forcingPool, 'DMSFlux', DMSFlux) +! call mpas_pool_get_array(forcingPool, 'surfaceUpwardCO2Flux', surfaceUpwardCO2Flux) - o2x_om(n, index_o2x_Fioo_q) = 0.0_RKIND - o2x_om(n, index_o2x_Fioo_frazil) = 0.0_RKIND - if (trim(config_land_ice_flux_mode) == 'standalone' .or. trim(config_land_ice_flux_mode) == 'data') then - o2x_om(n, index_o2x_Foxo_q_li) = accumulatedFrazilIceMass(i) * config_frazil_heat_of_fusion / ocn_cpl_dt - o2x_om(n, index_o2x_Foxo_frazil_li) = accumulatedFrazilIceMass(i) / ocn_cpl_dt - endif - end if +! replace 'o2x_o % rAttr(' with 'o2x_om(n, ' and ', n)' with ')' + do i = 1, nCellsSolve + n = n + 1 - ! Reset SeaIce Energy and Accumulated Frazil Ice - seaIceEnergy(i) = 0.0_RKIND - accumulatedFrazilIceMass(i) = 0.0_RKIND - frazilSurfacePressure(i) = 0.0_RKIND - end if + o2x_om(n, index_o2x_So_t) = avgTracersSurfaceValue(index_temperatureSurfaceValue, i) + o2x_om(n, index_o2x_So_s) = avgTracersSurfaceValue(index_salinitySurfaceValue, i) + o2x_om(n, index_o2x_So_u) = avgSurfaceVelocity(index_avgZonalSurfaceVelocity, i) + o2x_om(n, index_o2x_So_v) = avgSurfaceVelocity(index_avgMeridionalSurfaceVelocity, i) - ! BGC fields - if (config_use_ecosysTracers) then - ! convert from mmolC/m2/s to kg CO2/m2/s - o2x_om(n, index_o2x_Faoo_fco2_ocn) = avgCO2_gas_flux(i)*44.e-6_RKIND - endif - if (config_use_ecosysTracers .and. config_use_ecosysTracers_sea_ice_coupling) then - o2x_om(n, index_o2x_So_algae1) = max(0.0_RKIND,avgOceanSurfacePhytoC(1,i)) - o2x_om(n, index_o2x_So_algae2) = max(0.0_RKIND,avgOceanSurfacePhytoC(2,i)) - o2x_om(n, index_o2x_So_algae3) = max(0.0_RKIND,avgOceanSurfacePhytoC(3,i)) - o2x_om(n, index_o2x_So_dic1) = max(0.0_RKIND,avgOceanSurfaceDIC(i)) - o2x_om(n, index_o2x_So_doc1) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) - o2x_om(n, index_o2x_So_doc2) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) - o2x_om(n, index_o2x_So_doc3) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) - o2x_om(n, index_o2x_So_don1) = 0.0_RKIND - o2x_om(n, index_o2x_So_no3) = max(0.0_RKIND,avgOceanSurfaceNO3(i)) - o2x_om(n, index_o2x_So_sio3) = max(0.0_RKIND,avgOceanSurfaceSiO3(i)) - o2x_om(n, index_o2x_So_nh4) = max(0.0_RKIND,avgOceanSurfaceNH4(i)) - o2x_om(n, index_o2x_So_docr) = max(0.0_RKIND,avgOceanSurfaceDOCr(i)) - o2x_om(n, index_o2x_So_fep1) = max(0.0_RKIND,avgOceanSurfaceFeParticulate(i)) - o2x_om(n, index_o2x_So_fed1) = max(0.0_RKIND,avgOceanSurfaceFeDissolved(i)) - endif - if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then - o2x_om(n, index_o2x_So_dms) = max(0.0_RKIND,avgOceanSurfaceDMS(i)) - o2x_om(n, index_o2x_So_dmsp) = max(0.0_RKIND,avgOceanSurfaceDMSP(i)) - endif - if (config_use_MacroMoleculesTracers .and. config_use_MacroMoleculesTracers_sea_ice_coupling) then - o2x_om(n, index_o2x_So_doc1) = max(0.0_RKIND,avgOceanSurfaceDOC(1,i)) - o2x_om(n, index_o2x_So_doc2) = max(0.0_RKIND,avgOceanSurfaceDOC(2,i)) - o2x_om(n, index_o2x_So_don1) = max(0.0_RKIND,avgOceanSurfaceDON(i)) - endif + o2x_om(n, index_o2x_So_ssh) = ssh(i) + o2x_om(n, index_o2x_So_dhdx) = avgSSHGradient(index_avgZonalSSHGradient, i) + o2x_om(n, index_o2x_So_dhdy) = avgSSHGradient(index_avgMeridionalSSHGradient, i) - if ( trim(config_land_ice_flux_mode) .eq. 'standalone' .or. & - trim(config_land_ice_flux_mode) .eq. 'coupled' ) then - o2x_om(n, index_o2x_So_blt) = landIceBoundaryLayerTracers(indexBLT,i) - o2x_om(n, index_o2x_So_bls) = landIceBoundaryLayerTracers(indexBLS,i) - o2x_om(n, index_o2x_So_htv) = landIceTracerTransferVelocities(indexHeatTrans,i) - o2x_om(n, index_o2x_So_stv) = landIceTracerTransferVelocities(indexSaltTrans,i) - o2x_om(n, index_o2x_So_rhoeff) = 0.0_RKIND - endif - end do + o2x_om(n, index_o2x_Faoo_h2otemp) = avgTotalFreshWaterTemperatureFlux(i) * rho_sw * cp_sw - block_ptr => block_ptr % next - end do + ! Cryo fields + if (trim(config_land_ice_flux_mode) == 'standalone' .or. trim(config_land_ice_flux_mode) == 'data') then + o2x_om(n, index_o2x_Foxo_ismw) = avgLandIceFreshwaterFlux(i) + o2x_om(n, index_o2x_Foxo_ismh) = avgLandIceHeatFlux(i) + endif + if (config_remove_ais_river_runoff) then + o2x_om(n, index_o2x_Foxo_rrofl) = avgRemovedRiverRunoffFlux(i) + endif + if (config_remove_ais_ice_runoff) then + o2x_om(n, index_o2x_Foxo_rrofi) = avgRemovedIceRunoffFlux(i) + o2x_om(n, index_o2x_Foxo_rrofih) = avgRemovedIceRunoffHeatFlux(i) + endif + + if ( frazilIceActive ) then + ! negative when frazil ice can be melted + keepFrazil = .true. + if ( associated(landIceMask) ) then + if ( landIceMask(i) == 1 ) then + keepFrazil = .false. + end if + end if + + if ( keepFrazil ) then + ! Calculate energy associated with frazil mass transfer to sea ice if frazil has accumulated + if ( accumulatedFrazilIceMass(i) > 0.0_RKIND ) then + + seaIceEnergy(i) = accumulatedFrazilIceMass(i) * config_frazil_heat_of_fusion + + ! Otherwise calculate the melt potential where avgTracersSurfaceValue represents only the + ! top layer of the ocean + else + + surfaceFreezingTemp = ocn_freezing_temperature(salinity=avgTracersSurfaceValue(index_salinitySurfaceValue, i), & + pressure=0.0_RKIND, inLandIceCavity=.false.) + + seaIceEnergy(i) = min(rho_sw*cp_sw*layerThickness(1, i)*( surfaceFreezingTemp + T0_Kelvin & + - avgTracersSurfaceValue(index_temperatureSurfaceValue, i) ), 0.0_RKIND ) + + end if + + o2x_om(n, index_o2x_Fioo_q) = seaIceEnergy(i) / ocn_cpl_dt + o2x_om(n, index_o2x_Fioo_frazil) = accumulatedFrazilIceMass(i) / ocn_cpl_dt + + else + + o2x_om(n, index_o2x_Fioo_q) = 0.0_RKIND + o2x_om(n, index_o2x_Fioo_frazil) = 0.0_RKIND + if (trim(config_land_ice_flux_mode) == 'standalone' .or. trim(config_land_ice_flux_mode) == 'data') then + o2x_om(n, index_o2x_Foxo_q_li) = accumulatedFrazilIceMass(i) * config_frazil_heat_of_fusion / ocn_cpl_dt + o2x_om(n, index_o2x_Foxo_frazil_li) = accumulatedFrazilIceMass(i) / ocn_cpl_dt + endif + + end if + + ! Reset SeaIce Energy and Accumulated Frazil Ice + seaIceEnergy(i) = 0.0_RKIND + accumulatedFrazilIceMass(i) = 0.0_RKIND + frazilSurfacePressure(i) = 0.0_RKIND + end if + + ! BGC fields + if (config_use_ecosysTracers .and. index_o2x_Faoo_fco2_ocn /= 0) then + ! convert from mmolC/m2/s to kg CO2/m2/s + o2x_om(n, index_o2x_Faoo_fco2_ocn) = avgCO2_gas_flux(i)*44.e-6_RKIND + endif + if (config_use_ecosysTracers .and. config_use_ecosysTracers_sea_ice_coupling) then + o2x_om(n, index_o2x_So_algae1) = max(0.0_RKIND,avgOceanSurfacePhytoC(1,i)) + o2x_om(n, index_o2x_So_algae2) = max(0.0_RKIND,avgOceanSurfacePhytoC(2,i)) + o2x_om(n, index_o2x_So_algae3) = max(0.0_RKIND,avgOceanSurfacePhytoC(3,i)) + o2x_om(n, index_o2x_So_dic1) = max(0.0_RKIND,avgOceanSurfaceDIC(i)) + o2x_om(n, index_o2x_So_doc1) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) + o2x_om(n, index_o2x_So_doc2) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) + o2x_om(n, index_o2x_So_doc3) = max(0.0_RKIND,avgOceanSurfaceDOCSemiLabile(i)) + o2x_om(n, index_o2x_So_don1) = 0.0_RKIND + o2x_om(n, index_o2x_So_no3) = max(0.0_RKIND,avgOceanSurfaceNO3(i)) + o2x_om(n, index_o2x_So_sio3) = max(0.0_RKIND,avgOceanSurfaceSiO3(i)) + o2x_om(n, index_o2x_So_nh4) = max(0.0_RKIND,avgOceanSurfaceNH4(i)) + o2x_om(n, index_o2x_So_docr) = max(0.0_RKIND,avgOceanSurfaceDOCr(i)) + o2x_om(n, index_o2x_So_fep1) = max(0.0_RKIND,avgOceanSurfaceFeParticulate(i)) + o2x_om(n, index_o2x_So_fed1) = max(0.0_RKIND,avgOceanSurfaceFeDissolved(i)) + endif + if (config_use_DMSTracers .and. config_use_DMSTracers_sea_ice_coupling) then + o2x_om(n, index_o2x_So_dms) = max(0.0_RKIND,avgOceanSurfaceDMS(i)) + o2x_om(n, index_o2x_So_dmsp) = max(0.0_RKIND,avgOceanSurfaceDMSP(i)) + endif + if (config_use_MacroMoleculesTracers .and. config_use_MacroMoleculesTracers_sea_ice_coupling) then + o2x_om(n, index_o2x_So_doc1) = max(0.0_RKIND,avgOceanSurfaceDOC(1,i)) + o2x_om(n, index_o2x_So_doc2) = max(0.0_RKIND,avgOceanSurfaceDOC(2,i)) + o2x_om(n, index_o2x_So_doc3) = max(0.0_RKIND,avgOceanSurfaceDOC(3,i)) + o2x_om(n, index_o2x_So_don1) = 0.0_RKIND + endif +! o2x_om(n, index_o2x_Faoo_fco2_ocn) = CO2Flux(i) +! o2x_om(n, index_o2x_Faoo_fdms_ocn) = DMSFlux(i) +! o2x_om(n, index_o2x_Faoo_fco2_ocn) = surfaceUpwardCO2Flux(i) + +!JW o2x_om(n, index_o2x_So_blt) = landIceBoundaryLayerTemperature(i) +!JW o2x_om(n, index_o2x_So_bls) = landIceBoundaryLayerSalinity(i) +!JW o2x_om(n, index_o2x_So_htv) = landIceHeatTransferVelocity(i) +!JW o2x_om(n, index_o2x_So_stv) = landIceSaltTransferVelocity(i) + + if ( trim(config_land_ice_flux_mode) .eq. 'standalone' .or. & + trim(config_land_ice_flux_mode) .eq. 'coupled' ) then + o2x_om(n, index_o2x_So_blt) = landIceBoundaryLayerTracers(indexBLT,i) + o2x_om(n, index_o2x_So_bls) = landIceBoundaryLayerTracers(indexBLS,i) + o2x_om(n, index_o2x_So_htv) = landIceTracerTransferVelocities(indexHeatTrans,i) + o2x_om(n, index_o2x_So_stv) = landIceTracerTransferVelocities(indexSaltTrans,i) + o2x_om(n, index_o2x_So_rhoeff) = 0.0_RKIND + endif + + !Fyke: test + !write(stderrUnit,*) 'n=',n + !write(stderrUnit,*) 'o2x_om(n, index_o2x_So_blt)=',o2x_om(n, index_o2x_So_blt) + !write(stderrUnit,*) 'o2x_om(n, index_o2x_So_bls)=',o2x_om(n, index_o2x_So_bls) + !write(stderrUnit,*) 'o2x_om(n, index_o2x_So_htv)=',o2x_om(n, index_o2x_So_htv) + !write(stderrUnit,*) 'o2x_om(n, index_o2x_So_stv)=',o2x_om(n, index_o2x_So_stv) + !write(stderrUnit,*) 'o2x_om(n, index_o2x_So_rhoeff)=',o2x_om(n, index_o2x_So_rhoeff) + !o2x_om(n, index_o2x_So_blt) = 0._r8 + !o2x_om(n, index_o2x_So_bls) = 34.5_r8 + !o2x_om(n, index_o2x_So_htv) = 1.e-4_r8 + !o2x_om(n, index_o2x_So_stv) = 3.e-6_r8 + !o2x_om(n, index_o2x_So_rhoeff) = 1000._r8*9.81_r8*918._r8 !lithostatic pressure of 1km of ice + + end do + + block_ptr => block_ptr % next + end do ent_type = 1 ! cells ! set all tags in one method tagname = trim(seq_flds_o2x_fields)//C_NULL_CHAR @@ -4251,9 +4501,12 @@ subroutine ocn_export_moab(EClock) !{{{ wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR ierr = iMOAB_WriteMesh(MPOID, outfile, wopts) #endif - end subroutine ocn_export_moab!}}} -#endif +!----------------------------------------------------------------------- +!EOC + + end subroutine ocn_export_moab!}}} +#endif end module ocn_comp_mct !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| From 04b66a083a50e8339b6a8d6be4cb6e67364c0d55 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Mon, 21 Oct 2024 21:34:06 -0500 Subject: [PATCH 240/529] compare before importing --- components/mpas-ocean/driver/ocn_comp_mct.F | 26 ++++++++++++--------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 686af1bbc5c..f13e2c2e5c7 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -884,13 +884,7 @@ end subroutine xml_stream_get_attributes ! !----------------------------------------------------------------------- - call ocn_import_mct(x2o_o, errorCode) - if (errorCode /= 0) then - call mpas_log_write('Error in ocn_import_mct', MPAS_LOG_CRIT) - endif - #ifdef HAVE_MOAB - #ifdef MOABCOMP ! loop over all fields in seq_flds_x2o_fields call mct_list_init(temp_list ,seq_flds_x2o_fields) @@ -906,6 +900,14 @@ end subroutine xml_stream_get_attributes enddo call mct_list_clean(temp_list) #endif +#endif + + call ocn_import_mct(x2o_o, errorCode) + if (errorCode /= 0) then + call mpas_log_write('Error in ocn_import_mct', MPAS_LOG_CRIT) + endif + +#ifdef HAVE_MOAB call ocn_import_moab(Eclock, errorCode) if (errorCode /= 0) then @@ -1029,12 +1031,8 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ call mpas_get_timeInterval(timeStep, dt=dt) call mpas_reset_clock_alarm(domain_ptr % clock, coupleAlarmID, ierr=ierr) - ! Import state from coupler - call ocn_import_mct(x2o_o, ierr) - ! Import state from moab coupler -#ifdef HAVE_MOAB - +#ifdef HAVE_MOAB #ifdef MOABCOMP ! loop over all fields in seq_flds_x2o_fields call mct_list_init(temp_list ,seq_flds_x2o_fields) @@ -1049,6 +1047,12 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ enddo call mct_list_clean(temp_list) #endif +#endif + + ! Import state from coupler + call ocn_import_mct(x2o_o, ierr) + ! Import state from moab coupler +#ifdef HAVE_MOAB call ocn_import_moab(Eclock, ierr) if (ierr /= 0) then From 3742c4320538beb6d93c29c141417d589f550730 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 22 Oct 2024 20:40:16 -0500 Subject: [PATCH 241/529] set aream for rof when it is not computed by us it should be better to compute ourselves, if we have the mesh information this could be a performance sink --- driver-moab/main/component_mod.F90 | 33 +++++++++++++++++++++++++++++- driver-moab/main/prep_lnd_mod.F90 | 4 ++++ driver-moab/main/prep_rof_mod.F90 | 2 ++ driver-moab/shr/seq_comm_mct.F90 | 1 + 4 files changed, 39 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 3e8ba9042a5..5e261e48601 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -471,6 +471,8 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, ! character(1024) :: domain_file ! file containing domain info (set my input) use seq_comm_mct, only: mboxid ! iMOAB id for MPAS ocean migrated mesh to coupler pes use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes + use seq_comm_mct, only: mbrxid ! iMOAB id for rof migrated mesh to coupler pes + use seq_comm_mct, only: mb_rof_aream_computed #endif ! ! Arguments @@ -527,6 +529,9 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, dom_s%data%rAttr(km,:) = dom_s%data%rAttr(ka,:) #ifdef HAVE_MOAB + ! TODO should actually compute aream from mesh model + ! we do a lot of unnecessary gymnastics, and very inefficient, because we have a + ! different distribution compared to mct source grid atm tagtype = 1 ! dense, double tagname='aream'//C_NULL_CHAR nloc = mct_avect_lsize(dom_s%data) @@ -542,6 +547,8 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, write(logunit,*) subname,' error in setting the aream tag on atm ' call shr_sys_abort(subname//' ERROR in setting aream tag on atm ') endif + deallocate(gids) + deallocate(data1) ! project now aream on ocean (from atm) #endif call seq_map_map(mapper_Fa2o, av_s=dom_s%data, av_d=dom_d%data, fldlist='aream') @@ -597,7 +604,31 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, gsmap_s=gsmap_s, av_s=dom_s%data, avfld_s='aream', filefld_s='area_a', & string='rof2ocn ice aream initialization') call t_stopf('CPL:seq_map_readdata-rof2ocn_ice') - + ! this should be more efficient if we just compute aream on coupler side, from actual mesh that we have + ! we need to expose that method in iMOAB, which is local + ! what we do here, we get aream from the domain dom_rx, we just filled it above, with readdata + if(.not. mb_rof_aream_computed) then + + ! we do a lot of unnecessary gymnastics, and very inefficient, because we have a + ! different distribution compared to mct source grid atm + tagtype = 1 ! dense, double + tagname='aream'//C_NULL_CHAR + nloc = mct_avect_lsize(dom_s%data) + allocate(data1(nloc)) + data1 = dom_s%data%rAttr(ka,:) + ent_type = 1 ! element dense double tags + allocate(gids(nloc)) + gids = dom_s%data%iAttr(mct_aVect_indexIA(dom_s%data,"GlobGridNum"),:) + ! ! now set data on the coupler side too + ierr = iMOAB_SetDoubleTagStorageWithGid ( mbrxid, tagname, nloc, ent_type, & + data1, gids) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting the aream tag on rof ' + call shr_sys_abort(subname//' ERROR in setting aream tag on rof ') + endif + deallocate(gids) + deallocate(data1) + endif endif end if diff --git a/driver-moab/main/prep_lnd_mod.F90 b/driver-moab/main/prep_lnd_mod.F90 index 7bdb12376a3..097782f330d 100644 --- a/driver-moab/main/prep_lnd_mod.F90 +++ b/driver-moab/main/prep_lnd_mod.F90 @@ -18,6 +18,7 @@ module prep_lnd_mod use seq_comm_mct, only: mbrxid ! iMOAB id of moab rof on coupler pes (FV now) use seq_comm_mct, only: mbintxal ! iMOAB id for intx mesh between atm and lnd use seq_comm_mct, only: mbintxrl ! iMOAB id for intx mesh between river and land + use seq_comm_mct, only: mb_rof_aream_computed ! signal use seq_comm_mct, only: mbaxid ! iMOAB id for atm migrated mesh to coupler pes use seq_comm_mct, only: atm_pg_active ! whether the atm uses FV mesh or not ; made true if fv_nphys > 0 @@ -327,6 +328,9 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_ln fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) + + ! signal that the aream for rof has been computed + mb_rof_aream_computed = .true. if (ierr .ne. 0) then write(logunit,*) subname,' error in computing rl weights ' call shr_sys_abort(subname//' ERROR in computing rl weights ') diff --git a/driver-moab/main/prep_rof_mod.F90 b/driver-moab/main/prep_rof_mod.F90 index 83a8e331e91..2ab02f7bdea 100644 --- a/driver-moab/main/prep_rof_mod.F90 +++ b/driver-moab/main/prep_rof_mod.F90 @@ -30,6 +30,7 @@ module prep_rof_mod use component_type_mod, only: ocn ! used for context for projection towards ocean from rof ! use prep_lnd_mod, only: prep_lnd_get_mapper_Fr2l use map_lnd2rof_irrig_mod, only: map_lnd2rof_irrig + use seq_comm_mct, only: mb_rof_aream_computed ! signal use iso_c_binding #ifdef MOABCOMP @@ -417,6 +418,7 @@ subroutine prep_rof_init(infodata, lnd_c2_rof, atm_c2_rof, ocn_c2_rof) fNoBubble, monotonicity, volumetric, fInverseDistanceMap, & noConserve, validate, & trim(dofnameS), trim(dofnameT) ) + mb_rof_aream_computed = .true. ! signal if (ierr .ne. 0) then write(logunit,*) subname,' error in computing lr weights ' call shr_sys_abort(subname//' ERROR in computing lr weights ') diff --git a/driver-moab/shr/seq_comm_mct.F90 b/driver-moab/shr/seq_comm_mct.F90 index a13dd1faf5b..9c85df84d2b 100644 --- a/driver-moab/shr/seq_comm_mct.F90 +++ b/driver-moab/shr/seq_comm_mct.F90 @@ -247,6 +247,7 @@ module seq_comm_mct integer, public :: mbintxrl ! iMOAB id for intx mesh between river and land integer, public :: num_moab_exports ! iMOAB id for atm phys grid, on atm pes + logical, public :: mb_rof_aream_computed = .false. ! whether the aream for rof has been set or not !======================================================================= contains From 28f8501ba297814741eba7a7df41edf5f5e8b0f6 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Tue, 22 Oct 2024 20:54:44 -0500 Subject: [PATCH 242/529] index for aream --- driver-moab/main/component_mod.F90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/component_mod.F90 b/driver-moab/main/component_mod.F90 index 5e261e48601..c7a8f51b99e 100644 --- a/driver-moab/main/component_mod.F90 +++ b/driver-moab/main/component_mod.F90 @@ -615,7 +615,8 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, tagname='aream'//C_NULL_CHAR nloc = mct_avect_lsize(dom_s%data) allocate(data1(nloc)) - data1 = dom_s%data%rAttr(ka,:) + km = mct_aVect_indexRa(dom_s%data, "aream" ) + data1 = dom_s%data%rAttr(km,:) ent_type = 1 ! element dense double tags allocate(gids(nloc)) gids = dom_s%data%iAttr(mct_aVect_indexIA(dom_s%data,"GlobGridNum"),:) @@ -628,6 +629,14 @@ subroutine component_init_aream(infodata, rof_c2_ocn, samegrid_ao, samegrid_al, endif deallocate(gids) deallocate(data1) +#ifdef MOABDEBUG + ierr = iMOAB_WriteMesh(mbrxid, trim('recRofWithAream.h5m'//C_NULL_CHAR), & + trim(';PARALLEL=WRITE_PART'//C_NULL_CHAR)) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in writing rof mesh coupler ' + call shr_sys_abort(subname//' ERROR in writing rof mesh coupler ') + endif +#endif endif endif end if From 5c2c7143bd4de56970b4c97c73ab89c1b9e2d7c9 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 7 Nov 2024 19:27:39 +0000 Subject: [PATCH 243/529] AB env in aurora --- cime_config/machines/config_machines.xml | 67 ++++++++++++++++++++---- 1 file changed, 57 insertions(+), 10 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index f8bda3b422e..2d36ae36b28 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3598,21 +3598,65 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors 1 + + + - level_zero:gpu - - 0 - disable - disable - 1 - 4000MB - 0 - /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh + + 1 + 0 + + + + 1 + 1 + 1 + 131072 20 - 1 + cxi + disabled + 8388608 + + 240 + 240 + + disable + disable + + level_zero:gpu + 1 + + 4000MB + 0 + + /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh + + + 0 DISABLED @@ -3621,14 +3665,17 @@ export FI_CXI_DEFAULT_CQ_SIZE=131072 # try avoiding F90 MPI_BCAST errors 0 + verbose,granularity=thread,balanced 128M + threads 128M + -1 From 0b43211eec9d06880334983a09d6713ecf3f6244 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Fri, 8 Nov 2024 04:39:36 +0000 Subject: [PATCH 244/529] fixing ne256 build (works for ne30 too) for \failed to convert GOTPCREL\ --- cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake index d5a9a6494a2..c6afa7c2329 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake @@ -1,5 +1,5 @@ -string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -fsycl-device-code-split=per_kernel -fsycl-max-parallel-link-jobs=16") +string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -fsycl-device-code-split=per_kernel -fsycl-max-parallel-link-jobs=16 -Wl,--no-relax") if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() From cfa9936057a9c11c1e7aafcd7d849585b6e305f6 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Fri, 8 Nov 2024 08:57:10 -0800 Subject: [PATCH 245/529] update sbetr to remove redundant print to log This avoids redundant output to log file. [BFB] --- components/elm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/elm/src/external_models/sbetr b/components/elm/src/external_models/sbetr index 66260f4991d..08d8a8184a6 160000 --- a/components/elm/src/external_models/sbetr +++ b/components/elm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 66260f4991d61439d4cba92eb633590b09f97920 +Subproject commit 08d8a8184a605a23d4dce4f91a33d8f2bba29ae9 From ac93edec5ca099c6734cf2d16b117fdf2161ab19 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Sat, 9 Nov 2024 01:20:53 +0000 Subject: [PATCH 246/529] Update CMake for oneapi-ifxgpu runs Move -Xsycl-target-backend to link flags --- cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake | 3 ++- cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake index 6835515164f..c26a0161cb4 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake @@ -3,5 +3,6 @@ string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_c if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() -string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") +string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 ") +string(APPEND SYCL_EXE_LINKER_FLAGS " -Xsycl-target-backend \"-device 12.60.7\" ") string(APPEND CMAKE_CXX_FLAGS " -Xclang -fsycl-allow-virtual-functions") diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake index 6835515164f..c26a0161cb4 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake @@ -3,5 +3,6 @@ string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_c if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() -string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") +string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 ") +string(APPEND SYCL_EXE_LINKER_FLAGS " -Xsycl-target-backend \"-device 12.60.7\" ") string(APPEND CMAKE_CXX_FLAGS " -Xclang -fsycl-allow-virtual-functions") From 245ddc307f802a872f86504324d420b6720d86bc Mon Sep 17 00:00:00 2001 From: xie7 Date: Fri, 8 Nov 2024 20:15:43 -0800 Subject: [PATCH 247/529] Edit some variables in model 1.Make changes in model. modified: components/eam/src/physics/cam/comsrf.F90 modified: components/eam/src/physics/cam/gw_drag.F90 modified: components/eam/src/physics/cam/physics_types.F90 modified: components/eam/src/physics/cam/physpkg.F90 --- components/eam/bld/build-namelist | 6 +- .../namelist_files/namelist_definition.xml | 6 +- .../eam/src/control/startup_initialconds.F90 | 34 +- components/eam/src/physics/cam/clubb_intr.F90 | 4 +- components/eam/src/physics/cam/comsrf.F90 | 16 +- components/eam/src/physics/cam/gw_common.F90 | 1471 +-------- components/eam/src/physics/cam/gw_drag.F90 | 69 +- components/eam/src/physics/cam/od_common.F90 | 1497 +++++++++ .../eam/src/physics/cam/phys_control.F90 | 14 +- .../eam/src/physics/cam/physics_types.F90 | 12 - components/eam/src/physics/cam/physpkg.F90 | 4 +- .../clubb/advance_windm_edsclrm_module.F90 | 11 +- .../orographic_drag_toolkit/Makefile | 106 - .../topo_tool/orographic_drag_toolkit/README | 18 - .../Tempest-remap_generation.sh | 13 - .../cube_to_target.F90 | 2550 ---------------- .../orographic_drag_toolkit/make.ncl | 10 - .../orographic_drag_toolkit/ogwd_sub.F90 | 900 ------ .../orographic_drag_toolkit/reconstruct.F90 | 2675 ----------------- .../orographic_drag_toolkit/remap.F90 | 1562 ---------- .../topo_tool/orographic_drag_toolkit/run.sh | 6 - .../orographic_drag_toolkit/shr_kind_mod.F90 | 20 - .../orographic_drag_toolkit/transform.F90 | 351 --- 23 files changed, 1578 insertions(+), 9777 deletions(-) create mode 100644 components/eam/src/physics/cam/od_common.F90 delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/Makefile delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/README delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/Tempest-remap_generation.sh delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/cube_to_target.F90 delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/reconstruct.F90 delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/run.sh delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/shr_kind_mod.F90 delete mode 100755 components/eam/tools/topo_tool/orographic_drag_toolkit/transform.F90 diff --git a/components/eam/bld/build-namelist b/components/eam/bld/build-namelist index 45179324f77..293a03cdf3a 100755 --- a/components/eam/bld/build-namelist +++ b/components/eam/bld/build-namelist @@ -4104,9 +4104,9 @@ if ($waccm_phys or $cfg->get('nlev') >= 60) { } add_default($nl, 'pgwv', 'val'=>'32'); add_default($nl, 'gw_dc','val'=>'2.5D0'); -add_default($nl, 'ncleff_ls', 'val'=>'3.D0'); -add_default($nl, 'ncd_bl', 'val'=>'3.D0'); -add_default($nl, 'sncleff_ss','val'=>'1.D0'); +add_default($nl, 'od_ls_ncleff ','val'=>'3.D0'); +add_default($nl, 'od_bl_ncd ','val'=>'3.D0'); +add_default($nl, 'od_ss_sncleff','val'=>'1.D0'); if ($nl->get_value('use_gw_oro') =~ /$TRUE/io) { add_default($nl, 'effgw_oro'); diff --git a/components/eam/bld/namelist_files/namelist_definition.xml b/components/eam/bld/namelist_files/namelist_definition.xml index b3dc78cb9ed..93960ae115a 100644 --- a/components/eam/bld/namelist_files/namelist_definition.xml +++ b/components/eam/bld/namelist_files/namelist_definition.xml @@ -1102,19 +1102,19 @@ Whether or not to enable turbulent orographic form drag (TOFD). Default: set by build-namelist. - Tuning parameter of orographic GWD (oGWD). See use_od_ls. Default: set by build-namelist. - Tuning parameter of flow-blocking drag (FBD). See use_od_bl. Default: set by build-namelist. - Tuning parameter of small-scale GWD (sGWD). See use_od_ss. Default: set by build-namelist. diff --git a/components/eam/src/control/startup_initialconds.F90 b/components/eam/src/control/startup_initialconds.F90 index 6b8b4062f9d..a68195c731d 100644 --- a/components/eam/src/control/startup_initialconds.F90 +++ b/components/eam/src/control/startup_initialconds.F90 @@ -13,19 +13,19 @@ module startup_initialconds public :: initial_conds ! Read in initial conditions (dycore dependent) !added for orographic drag -public topoGWD_file_get_id -public setup_initialGWD -public close_initial_fileGWD -type(file_desc_t), pointer :: ncid_topoGWD +public topo_OD_file_get_id +public setup_initial_OD +public close_initial_file_OD +type(file_desc_t), pointer :: ncid_topo_OD !======================================================================= contains !======================================================================= -function topoGWD_file_get_id() - type(file_desc_t), pointer :: topoGWD_file_get_id - topoGWD_file_get_id => ncid_topoGWD -end function topoGWD_file_get_id +function topo_OD_file_get_id() + type(file_desc_t), pointer :: topo_OD_file_get_id + topo_OD_file_get_id => ncid_topo_OD +end function topo_OD_file_get_id subroutine initial_conds(dyn_in) @@ -74,7 +74,7 @@ end subroutine initial_conds !======================================================================= -subroutine setup_initialGWD() +subroutine setup_initial_OD() use filenames, only: bnd_topo use ioFileMod, only: getfil use cam_pio_utils, only: cam_pio_openfile @@ -86,17 +86,17 @@ subroutine setup_initialGWD() include 'netcdf.inc' !----------------------------------------------------------------------- character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk - allocate(ncid_topoGWD) + allocate(ncid_topo_OD) call getfil(bnd_topo, bnd_topo_loc) - call cam_pio_openfile(ncid_topoGWD, bnd_topo_loc, PIO_NOWRITE) -end subroutine setup_initialGWD + call cam_pio_openfile(ncid_topo_OD, bnd_topo_loc, PIO_NOWRITE) +end subroutine setup_initial_OD -subroutine close_initial_fileGWD +subroutine close_initial_file_OD use pio, only: pio_closefile - call pio_closefile(ncid_topoGWD) - deallocate(ncid_topoGWD) - nullify(ncid_topoGWD) -end subroutine close_initial_fileGWD + call pio_closefile(ncid_topo_OD) + deallocate(ncid_topo_OD) + nullify(ncid_topo_OD) +end subroutine close_initial_file_OD !======================================================================= diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index c9c3bcdfa2c..e44c3ab7fea 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -20,7 +20,7 @@ module clubb_intr use shr_kind_mod, only: r8=>shr_kind_r8 use shr_log_mod , only: errMsg => shr_log_errMsg use ppgrid, only: pver, pverp - use phys_control, only: phys_getopts,use_od_ss,use_od_fd,ncleff_ls,ncd_bl,sncleff_ss + use phys_control, only: phys_getopts, use_od_ss, use_od_fd, od_ls_ncleff, od_bl_ncd, od_ss_sncleff use physconst, only: rair, cpair, gravit, latvap, latice, zvir, rh2o, karman, & tms_orocnst, tms_z0fac, pi use cam_logfile, only: iulog @@ -2004,7 +2004,7 @@ subroutine clubb_tend_cam( & !sgh30 as the input for TOFD instead of sgh call gw_oro_interface(state,cam_in,sgh30,pbuf,hdtime,dummy_nm,& gwd_ls,gwd_bl,gwd_ss,gwd_fd,& - ncleff_ls,ncd_bl,sncleff_ss,& + od_ls_ncleff,od_bl_ncd,od_ss_sncleff,& dummy_utgw,dummy_vtgw,dummy_ttgw,& dtaux3_ls=dummx3_ls,dtauy3_ls=dummy3_ls,& dtaux3_bl=dummx3_bl,dtauy3_bl=dummy3_bl,& diff --git a/components/eam/src/physics/cam/comsrf.F90 b/components/eam/src/physics/cam/comsrf.F90 index 02ddbbb1e84..64e3750dd4e 100644 --- a/components/eam/src/physics/cam/comsrf.F90 +++ b/components/eam/src/physics/cam/comsrf.F90 @@ -32,7 +32,7 @@ module comsrf ! public initialize_comsrf ! Set the surface temperature and sea-ice fraction !!added for separate input of ogwd parareters in gw_drag - public initialize_comsrf2 + public initialize_comsrf_OD ! ! Public data ! @@ -55,10 +55,8 @@ module comsrf real(r8), allocatable:: prcsnw(:,:) ! cam tot snow precip real(r8), allocatable:: trefmxav(:,:) ! diagnostic: tref max over the day real(r8), allocatable:: trefmnav(:,:) ! diagnostic: tref min over the day - ! - public var,var30,oc,ol,oadir - real(r8), allocatable:: var(:,:) ! sgh - real(r8), allocatable:: var30(:,:) ! sgh30 + + public oc, ol, oadir real(r8), allocatable:: oc(:,:) ! Convexity real(r8), allocatable:: oadir(:,:,:) ! Asymmetry real(r8), allocatable:: ol(:,:,:) ! Effective length @@ -140,7 +138,7 @@ subroutine initialize_comsrf end if end subroutine initialize_comsrf - subroutine initialize_comsrf2 + subroutine initialize_comsrf_OD use cam_control_mod, only: ideal_phys, adiabatic !----------------------------------------------------------------------- ! @@ -155,17 +153,13 @@ subroutine initialize_comsrf2 integer k,c ! level, constituent indices if(.not. (adiabatic .or. ideal_phys)) then - allocate (var (pcols,begchunk:endchunk)) - allocate (var30 (pcols,begchunk:endchunk)) allocate (oc (pcols,begchunk:endchunk)) allocate (oadir (pcols,nvar_dirOA,begchunk:endchunk)) allocate (ol (pcols,nvar_dirOL,begchunk:endchunk)) - var (:,:) = nan - var30 (:,:) = nan oc (:,:) = nan oadir (:,:,:) = nan ol (:,:,:) = nan end if - end subroutine initialize_comsrf2 + end subroutine initialize_comsrf_OD end module comsrf diff --git a/components/eam/src/physics/cam/gw_common.F90 b/components/eam/src/physics/cam/gw_common.F90 index 98743b2b847..198c634f284 100644 --- a/components/eam/src/physics/cam/gw_common.F90 +++ b/components/eam/src/physics/cam/gw_common.F90 @@ -5,7 +5,6 @@ module gw_common ! parameterizations. ! use gw_utils, only: r8 -use ppgrid, only: nvar_dirOA,nvar_dirOL!pcols,pver,pverp, use cam_logfile, only: iulog implicit none @@ -17,7 +16,6 @@ module gw_common public :: gw_prof public :: momentum_energy_conservation public :: gw_drag_prof -public :: gw_oro_interface public :: pver, pgwv public :: dc @@ -29,7 +27,6 @@ module gw_common public :: kwv public :: gravit public :: rair -public :: gwdo_gsd,pblh_get_level_idx,grid_size ! This flag preserves answers for vanilla CAM by making a few changes (e.g. ! order of operations) when only orographic waves are on. @@ -747,1471 +744,5 @@ subroutine gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, & end subroutine gw_drag_prof !========================================================================== - -subroutine gw_oro_interface(state, cam_in, sgh, pbuf, dtime, nm,& - gwd_ls, gwd_bl, gwd_ss, gwd_fd,& - ncleff_ls,ncd_bl, sncleff_ss,& - utgw, vtgw, ttgw,& - dtaux3_ls,dtauy3_ls,dtaux3_bl,dtauy3_bl,& - dtaux3_ss,dtauy3_ss,dtaux3_fd,dtauy3_fd,& - dusfc_ls, dvsfc_ls ,dusfc_bl, dvsfc_bl,& - dusfc_ss, dvsfc_ss ,dusfc_fd, dvsfc_fd) - use physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index - use camsrfexch, only: cam_in_t - use ppgrid, only: pcols,pver,pverp - use physconst, only: gravit,rair,cpair,rh2o,zvir,pi - use hycoef, only: etamid - - type(physics_state), intent(in) :: state ! physics state structure ! Standard deviation of orography. - type(cam_in_t), intent(in) :: cam_in - real(r8), intent(in) :: sgh(pcols) - type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer - real(r8), intent(in) :: dtime - real(r8), intent(in) :: nm(state%ncol,pver) ! midpoint Brunt-Vaisalla frequency - !options for the 4 schemes - logical , intent(in) :: gwd_ls - logical , intent(in) :: gwd_bl - logical , intent(in) :: gwd_ss - logical , intent(in) :: gwd_fd - !tunable parameter from namelist - real(r8), intent(in) :: ncleff_ls - real(r8), intent(in) :: ncd_bl - real(r8), intent(in) :: sncleff_ss - !vertical profile of the momentum tendencies - real(r8), intent(out), optional :: utgw(state%ncol,pver) - real(r8), intent(out), optional :: vtgw(state%ncol,pver) - real(r8), intent(out), optional :: ttgw(state%ncol,pver) - !output drag terms in 3D and surface - real(r8), intent(out), optional :: dtaux3_ls(pcols,pver) - real(r8), intent(out), optional :: dtauy3_ls(pcols,pver) - real(r8), intent(out), optional :: dtaux3_bl(pcols,pver) - real(r8), intent(out), optional :: dtauy3_bl(pcols,pver) - real(r8), intent(out), optional :: dtaux3_ss(pcols,pver) - real(r8), intent(out), optional :: dtauy3_ss(pcols,pver) - real(r8), intent(out), optional :: dtaux3_fd(pcols,pver) - real(r8), intent(out), optional :: dtauy3_fd(pcols,pver) - real(r8), intent(out), optional :: dusfc_ls(pcols) - real(r8), intent(out), optional :: dvsfc_ls(pcols) - real(r8), intent(out), optional :: dusfc_bl(pcols) - real(r8), intent(out), optional :: dvsfc_bl(pcols) - real(r8), intent(out), optional :: dusfc_ss(pcols) - real(r8), intent(out), optional :: dvsfc_ss(pcols) - real(r8), intent(out), optional :: dusfc_fd(pcols) - real(r8), intent(out), optional :: dvsfc_fd(pcols) - ! - real(r8) :: ztop(pcols,pver) ! top interface height asl (m) - real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) - real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) - real(r8) :: dz(pcols,pver) ! model layer height - ! - !real(r8) :: g - !pblh input - integer :: pblh_idx = 0 - integer :: kpbl2d_in(pcols) - integer :: kpbl2d_reverse_in(pcols) - real(r8), pointer :: pblh(:) - real(r8) :: dx(pcols),dy(pcols) - !needed index - integer :: ncol - integer :: i - integer :: k - - ncol=state%ncol - !convert heights above surface to heights above sea level - !obtain z,dz,dx,dy,and k for pblh - kpbl2d_in=0_r8 - kpbl2d_reverse_in=0_r8 - ztop=0._r8 - zbot=0._r8 - zmid=0._r8 - dusfc_ls=0._r8 - dvsfc_ls=0._r8 - dusfc_bl=0._r8 - dvsfc_bl=0._r8 - dusfc_ss=0._r8 - dvsfc_ss=0._r8 - dusfc_fd=0._r8 - dvsfc_fd=0._r8 - dtaux3_ls=0._r8 - dtaux3_bl=0._r8 - dtauy3_ls=0._r8 - dtauy3_bl=0._r8 - dtaux3_ss=0._r8 - dtaux3_fd=0._r8 - dtauy3_ss=0._r8 - dtauy3_fd=0._r8 - - do k=1,pver - do i=1,ncol - ! assign values for level top/bottom - ztop(i,k)=state%zi(i,k) - zbot(i,k)=state%zi(i,k+1) - enddo - end do - - !transform adding the pressure - !transfer from surface to sea level - do k=1,pver - do i=1,ncol - ztop(i,k)=ztop(i,k)+state%phis(i)/gravit - zbot(i,k)=zbot(i,k)+state%phis(i)/gravit - zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit - !dz is from bottom to top already for gw_drag - dz(i,k)=ztop(i,k)-zbot(i,k) - end do - end do - !get the layer index of pblh in layer for input in drag scheme - pblh_idx = pbuf_get_index('pblh') - call pbuf_get_field(pbuf, pblh_idx, pblh) - do i=1,pcols - kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/gravit),pblh(i)) - kpbl2d_reverse_in(i)=pverp-kpbl2d_in(i)!pverp-k - end do - - !get grid size for dx,dy - call grid_size(state,dx,dy) - !interface for orographic drag - call gwdo_gsd(& - u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& - qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& - pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& - ncleff_ls=ncleff_ls,ncd_bl=ncd_bl,sncleff_ss=sncleff_ss,& - rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& - dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& - dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& - dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& - dtaux3d_fd=dtaux3_fd(:ncol,pver:1:-1),dtauy3d_fd=dtauy3_fd(:ncol,pver:1:-1),& - dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& - dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& - dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& - dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& - xland=cam_in%landfrac,br=state%ribulk(:ncol),& - var2d=sgh(:ncol),oc12d=state%oc(:ncol),& - oa2d=state%oadir(:ncol,:),ol2d=state%ol(:ncol,:),& - znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& - cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& - dt=dtime,dx=dx,dy=dy,& - kpbl2d=kpbl2d_reverse_in,gwd_opt=0,& - ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & - ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & - its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & - gwd_ls=gwd_ls,gwd_bl=gwd_bl,gwd_ss=gwd_ss,gwd_fd=gwd_fd ) - -end subroutine gw_oro_interface - -!========================================================================== - -function pblh_get_level_idx(height_array,pblheight) - implicit none - real(r8),intent(in),dimension(pver) :: height_array - real(r8),intent(in) :: pblheight - integer :: pblh_get_level_idx - !local - integer :: k - logical :: found - - pblh_get_level_idx = -1 - found=.false. - !get the pblh level index and return - do k = 1, pver - if((pblheight >= height_array(k+1).and.pblheight 300._r8) then - kpbl2 = k - IF (k == kpbl(i)) then - hpbl2 = hpbl(i)+10._r8 - ELSE - hpbl2 = za(i,k)+10._r8 - ENDIF - exit - ENDIF - enddo - - if(xland1(i).gt.0._r8 .and. 2._r8*var(i).le.hpbl(i))then - if(br1(i).gt.0._r8 .and. thvx(i,kpbl2)-thvx(i,kts) > 0._r8)then - cleff = sqrt(dxy(i)**2_r8 + dxyp(i)**2_r8) - cleff = (2.0_r8/sncleff) * max(dxmax_ss,cleff) - coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) - xlinv(i) = coefm(i) / cleff - govrth(i)=g/(0.5_r8*(thvx(i,kpbl2)+thvx(i,kts))) - XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) - - if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then - tauwavex0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2_r8*ro(i,kvar)*u1(i,kvar) - tauwavex0=tauwavex0*ss_taper ! "Scale-awareness" - else - tauwavex0=0._r8 - endif - - if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then - tauwavey0=0.5_r8*XNBV*xlinv(i)*(2._r8*MIN(var(i),varmax))**2._r8*ro(i,kvar)*v1(i,kvar) - tauwavey0=tauwavey0*ss_taper ! "Scale-awareness" - else - tauwavey0=0._r8 - endif - - do k=kts,kpbl(i) !MIN(kpbl2+1,kte-1) - utendwave(i,k)=-1._r8*tauwavex0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 - vtendwave(i,k)=-1._r8*tauwavey0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 - enddo - endif - endif - enddo ! end i loop - - do k = kts,kte - do i = its,ite - dudt(i,k) = dudt(i,k) + utendwave(i,k) - dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) - dtaux2d_ss(i,k) = utendwave(i,k) - dtauy2d_ss(i,k) = vtendwave(i,k) - dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) - dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) - enddo - enddo - - ENDIF ! end if gsd_gwd_ss == .true. - !================================================================ - !add Beljaars et al. (2004, QJRMS, equ. 16) form drag: - !================================================================ - IF (gsd_gwd_fd.and.(ss_taper.GT.1.E-02) ) THEN - - utendform=0._r8 - vtendform=0._r8 - zq=0._r8 - - IF (.not.gsd_gwd_ss.and.(ss_taper.GT.1.E-02) ) THEN - ! Defining layer height. This is already done above is small-scale GWD is used - do k = kts,kte - do i = its,ite - zq(i,k+1) = dz2(i,k)+zq(i,k) - enddo - enddo - - do k = kts,kte - do i = its,ite - za(i,k) = 0.5_r8*(zq(i,k)+zq(i,k+1)) - enddo - enddo - ENDIF - - DO i=its,ite - IF (xland1(i) .gt. 0..and.2._r8*var(i).gt.0) then - a1=0.00026615161_r8*var(i)**2_r8 - a2=a1*0.005363_r8 - DO k=kts,kte - wsp=SQRT(u1(i,k)**2_r8 + v1(i,k)**2_r8) - ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - utendform(i,k)=-0.0759_r8*wsp*u1(i,k)* & - EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper - vtendform(i,k)=-0.0759_r8*wsp*v1(i,k)* & - EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper - ! - ENDDO - ENDIF - ENDDO - - do k = kts,kte - do i = its,ite - dudt(i,k) = dudt(i,k) + utendform(i,k) - dvdt(i,k) = dvdt(i,k) + vtendform(i,k) - !limit drag tendency - !some tendency is likely to even overturn the wind, - !making wind reverse in 1 timestep and reverse again in next, - !this limitation may help to make model stable, - !and no more wind reversal due to drag, - !which is suppose to decelerate, not accelerate - utendform(i,k) = sign(min(abs(utendform(i,k)),abs(u1(i,k))/deltim),utendform(i,k)) - vtendform(i,k) = sign(min(abs(vtendform(i,k)),abs(v1(i,k))/deltim),vtendform(i,k)) - dtaux2d_fd(i,k) = utendform(i,k) - dtauy2d_fd(i,k) = vtendform(i,k) - dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) - dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) - enddo - enddo - ENDIF ! end if gsd_gwd_fd == .true. - !======================================================= - ! More for the large-scale gwd component - !======================================================= - IF (gsd_gwd_ls.and.(ls_taper.GT.1.E-02) ) THEN - ! - ! now compute vertical structure of the stress. - ! - do k = kts,kpblmax - do i = its,ite - if (k .le. kbl(i)) taup(i,k) = taub(i) - enddo - enddo - - if (scorer_on) then - ! - !determination of the interface height for scorer adjustment - ! - do i=its,ite - iint=.false. - do k=kpblmin,kte-1 - if (k.gt.kbl(i).and.usqj(i,k)-usqj(i,k-1).lt.0.and.(.not.iint)) then - iint=.true. - zl_hint(i)=zl(i,k+1) - endif - enddo - enddo - endif - - do k = kpblmin, kte-1 ! vertical level k loop! - kp1 = k + 1 - do i = its,ite - ! - ! unstablelayer if ri < ric - ! unstable layer if upper air vel comp along surf vel <=0 (crit lay) - ! at (u-c)=0. crit layer exists and bit vector should be set (.le.) - ! - if (k .ge. kbl(i)) then - !we modify the criteria for unstable layer - !that the lv is critical under 0.25 - !while we keep wave breaking ric for - !other larger lv - icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric_rig)& - .or. (velco(i,k) .le. 0.0_r8) - brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared - brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency - endif - enddo - - do i = its,ite - if (k .ge. kbl(i) .and. (.not. ldrag(i))) then - if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0_r8 ) then - temv = 1.0_r8 / velco(i,k) - tem1 = coefm(i)/(dxy(i)/ncleff)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5_r8 - hd = sqrt(taup(i,k) / tem1) - fro = brvf(i) * hd * temv - ! - ! rim is the minimum-richardson number by shutts (1985) - ! - tem2 = sqrt(usqj(i,k)) - tem = 1._r8 + tem2 * fro - rim = usqj(i,k) * (1._r8-fro) / (tem * tem) - - ! - ! check stability to employ the 'saturation hypothesis' - ! of lindzen (1981) except at tropospheric downstream regions - ! - if (rim .le. ric) then ! saturation hypothesis! - if ((oa1(i) .le. 0._r8).or.(kp1 .ge. kpblmin )) then - temc = 2.0_r8 + 1.0_r8 / tem2 - hd = velco(i,k) * (2.0_r8*sqrt(temc)-temc) / brvf(i) - taup(i,kp1) = tem1 * hd * hd - ! - ! taup is restricted to monotoncally decrease - ! to avoid unexpected high taup in calculation - ! - taup(i,kp1)=min(tem1*hd*hd,taup(i,k)) - ! - ! add vertical decrease at low level below hint (Kim and Doyle 2005) - ! where Ri first decreases - ! - if (scorer_on.and.k.gt.klowtop(i).and.zl(i,k).le.zl_hint(i).and.k.lt.kte-1) then - l1=(9.81_r8*bnv2(i,kp1)/velco(i,kp1)**2) - l2=(9.81_r8*bnv2(i,k)/velco(i,k)**2) - taup(i,kp1)=min(taup(i,k),taup(i,k)*(l1/l2),tem1*hd*hd) - endif - endif - else ! no wavebreaking! - taup(i,kp1) = taup(i,k) - endif - endif - endif - enddo - enddo - - if(lcap.lt.kte) then - do klcap = lcapp1,kte - do i = its,ite - taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) - enddo - enddo - endif - - ENDIF !END LARGE-SCALE TAU CALCULATION - !=============================================================== - !COMPUTE BLOCKING COMPONENT - !=============================================================== - IF (gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN - - do i = its,ite - if(.not.ldrag(i)) then - ! - !------- determine the height of flow-blocking layer - ! - kblk = 0 - pe = 0.0_r8 - - do k = kte, kpblmin, -1 - if(kblk.eq.0 .and. k.le.komax(i)) then - !flow block appears within the reference level - !compare potential energy and kinetic energy - !divided by g*ro is to turn del(pa) into height - pe = pe + bnv2(i,k)*(zl(i,komax(i))-zl(i,k))*del(i,k)/g/ro(i,k) - ke = 0.5_r8*((rcs*u1(i,k))**2._r8+(rcs*v1(i,k))**2._r8) - ! - !---------- apply flow-blocking drag when pe >= ke - ! - if(pe.ge.ke) then - kblk = k - kblk = min(kblk,kbl(i)) - zblk = zl(i,kblk)-zl(i,kts) - endif - endif - enddo - - if(kblk.ne.0) then - ! - !--------- compute flow-blocking stress - ! - - !dxmax_ls is different than the usual one - !because the taper is very different - !dxy is a length scale mostly in the direction of the flow to the ridge - !so it is good and not needed for an uneven grid area - !ref Lott and Miller (1997) original scheme - cd = max(2.0_r8-1.0_r8/od(i),0.0_r8) - ! - !tuning of the drag magnitude - cd=ncd*cd - ! - taufb(i,kts) = 0.5_r8 * roll(i) * coefm(i) / max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) & - * olp(i) * zblk * ulow(i)**2 - !changed grid box area into dy*dy - tautem = taufb(i,kts)/float(kblk-kts) - do k = kts+1, kblk - taufb(i,k) = taufb(i,k-1) - tautem - enddo - - ! - !----------sum orographic GW stress and flow-blocking stress - ! - !taup(i,:) = taup(i,:) + taufb(i,:) ! Keep taup and taufb separate for now - endif - endif - enddo - - ENDIF ! end blocking drag -!=========================================================== - IF (gsd_gwd_ls.OR.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN - ! - ! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy - ! - - do k = kts,kte - do i = its,ite - taud_ls(i,k) = 1._r8 * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) - taud_bl(i,k) = 1._r8 * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) - enddo - enddo - ! - ! limit de-acceleration (momentum deposition ) at top to 1/2 value - ! the idea is some stuff must go out the 'top' - ! - - do klcap = lcap,kte - do i = its,ite - taud_ls(i,klcap) = taud_ls(i,klcap) * factop - taud_bl(i,klcap) = taud_bl(i,klcap) * factop - enddo - enddo - - ! - ! if the gravity wave drag would force a critical line - ! in the lower ksmm1 layers during the next deltim timestep, - ! then only apply drag until that critical line is reached. - ! - do k = kts,kpblmax-1 - do i = its,ite - if (k .le. kbl(i)) then - if((taud_ls(i,k)+taud_bl(i,k)).ne.0._r8) & - dtfac(i) = min(dtfac(i),abs(velco(i,k) & - /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) - endif - enddo - enddo - - do k = kts,kte - do i = its,ite - taud_ls(i,k) = taud_ls(i,k) * dtfac(i) * ls_taper - !apply limiter for ogwd - !1.dudt < |c-u|/dt, so u-c cannot change sign(u^n+1 = u^n + du/dt * dt) - !2.dudttopoGWD_file_get_id() - call infld('SGH' ,ncid_topoGWD,dim1name,dim2name, 1,pcols,begchunk,& - endchunk, var, found, gridname='physgrid') - call infld('SGH30',ncid_topoGWD,dim1name,dim2name, 1,pcols,begchunk,& - endchunk, var30, found, gridname='physgrid') - call infld('OC', ncid_topoGWD,dim1name,dim2name, 1,pcols,begchunk, & - endchunk, oc, found, gridname='physgrid') + ! + call initialize_comsrf_OD() + call setup_initial_OD() + ncid_topo_OD=>topo_OD_file_get_id() + call infld('OC', ncid_topo_OD, dim1name, dim2name, 1, pcols, begchunk, & + endchunk, oc , found, gridname='physgrid') !keep the same interval of OA,OL - call infld('OA', ncid_topoGWD,dim1name,'nvar_dirOA',dim2name,1,pcols,1,nvar_dirOA,begchunk, & - endchunk, oadir(:,:,:), found, gridname='physgrid') - call infld('OL', ncid_topoGWD,dim1name,'nvar_dirOL',dim2name,1,pcols,1,nvar_dirOL,begchunk, & - endchunk, ol, found, gridname='physgrid') - if(.not. found) call endrun('ERROR: GWD topo file readerr') + call infld('OA', ncid_topo_OD,dim1name, 'nvar_dirOA', dim2name, 1, pcols, 1, nvar_dirOA, begchunk, & + endchunk, oadir(:,:,:), found, gridname='physgrid') + call infld('OL', ncid_topo_OD,dim1name, 'nvar_dirOL', dim2name, 1, pcols, 1, nvar_dirOL, begchunk, & + endchunk, ol , found, gridname='physgrid') + if(.not. found) call endrun('ERROR: OD topo file readerr') ! - call close_initial_fileGWD() + call close_initial_file_OD() endif ! ! Set model flags. @@ -664,14 +660,15 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) use camsrfexch, only: cam_in_t ! Location-dependent cpair use physconst, only: cpairv + use od_common, only: oro_drag_interface use gw_common, only: gw_prof, momentum_energy_conservation, & - gw_drag_prof,gw_oro_interface + gw_drag_prof use gw_oro, only: gw_oro_src use gw_front, only: gw_cm_src use gw_convect, only: gw_beres_src use dycore, only: dycore_is - use phys_grid, only: get_rlat_all_p - use physconst, only: gravit,rair + use phys_grid, only: get_rlat_all_p + use physconst, only: gravit,rair !------------------------------Arguments-------------------------------- type(physics_state), intent(in) :: state ! physics state structure ! Standard deviation of orography. @@ -1015,18 +1012,18 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) vtgw=0.0_r8 ttgw=0.0_r8 ! - call gw_oro_interface( state,cam_in,sgh,pbuf,dt,nm,& - gwd_ls,gwd_bl,gwd_ss,gwd_fd,& - ncleff_ls,ncd_bl,sncleff_ss,& - utgw,vtgw,ttgw,& - dtaux3_ls=dtaux3_ls,dtauy3_ls=dtauy3_ls,& - dtaux3_bl=dtaux3_bl,dtauy3_bl=dtauy3_bl,& - dtaux3_ss=dtaux3_ss,dtauy3_ss=dtauy3_ss,& - dtaux3_fd=dummx3_fd,dtauy3_fd=dummy3_fd,& - dusfc_ls=dusfc_ls,dvsfc_ls=dvsfc_ls,& - dusfc_bl=dusfc_bl,dvsfc_bl=dvsfc_bl,& - dusfc_ss=dusfc_ss,dvsfc_ss=dvsfc_ss,& - dusfc_fd=dummx_fd,dvsfc_fd=dummy_fd) + call oro_drag_interface(state,cam_in,sgh,pbuf,dt,nm,& + gwd_ls,gwd_bl,gwd_ss,gwd_fd,& + od_ls_ncleff,od_bl_ncd,od_ss_sncleff,& + utgw,vtgw,ttgw,& + dtaux3_ls=dtaux3_ls,dtauy3_ls=dtauy3_ls,& + dtaux3_bl=dtaux3_bl,dtauy3_bl=dtauy3_bl,& + dtaux3_ss=dtaux3_ss,dtauy3_ss=dtauy3_ss,& + dtaux3_fd=dummx3_fd,dtauy3_fd=dummy3_fd,& + dusfc_ls=dusfc_ls,dvsfc_ls=dvsfc_ls,& + dusfc_bl=dusfc_bl,dvsfc_bl=dvsfc_bl,& + dusfc_ss=dusfc_ss,dvsfc_ss=dvsfc_ss,& + dusfc_fd=dummx_fd,dvsfc_fd=dummy_fd) endif ! diff --git a/components/eam/src/physics/cam/od_common.F90 b/components/eam/src/physics/cam/od_common.F90 new file mode 100644 index 00000000000..d548e32b379 --- /dev/null +++ b/components/eam/src/physics/cam/od_common.F90 @@ -0,0 +1,1497 @@ +module od_common + +! +! This module contains code common to different orographic drag +! parameterizations. +! It includes 4 parts: +! orographic gravity wave drag (Xie et al.,2020), +! flow-blocking drag (Xie et al.,2020), +! small-scale orographic gravity wave drag (Tsiringakis et al. 2017), +! turbulent orographic form drag (Beljaars et al.,2004). +! +use gw_utils, only: r8 +use ppgrid, only: nvar_dirOA,nvar_dirOL +use cam_logfile, only: iulog + +implicit none +private +save + +! Public interface. +public :: oro_drag_interface +public :: od_gsd,pblh_get_level_idx,grid_size + +contains + +!========================================================================== + +subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm,& + gwd_ls, gwd_bl, gwd_ss, gwd_fd, & + od_ls_ncleff, od_bl_ncd,od_ss_sncleff,& + utgw, vtgw, ttgw, & + dtaux3_ls,dtauy3_ls,dtaux3_bl,dtauy3_bl, & + dtaux3_ss,dtauy3_ss,dtaux3_fd,dtauy3_fd, & + dusfc_ls, dvsfc_ls ,dusfc_bl, dvsfc_bl, & + dusfc_ss, dvsfc_ss ,dusfc_fd, dvsfc_fd) + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index + use camsrfexch, only: cam_in_t + use ppgrid, only: pcols,pver,pverp + use physconst, only: gravit,rair,cpair,rh2o,zvir,pi + use hycoef, only: etamid + + type(physics_state), intent(in) :: state ! physics state structure ! Standard deviation of orography. + type(cam_in_t), intent(in) :: cam_in + real(r8), intent(in) :: sgh(pcols) + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + real(r8), intent(in) :: dtime + real(r8), intent(in) :: nm(state%ncol,pver) ! midpoint Brunt-Vaisalla frequency + !options for the 4 schemes + logical , intent(in) :: gwd_ls + logical , intent(in) :: gwd_bl + logical , intent(in) :: gwd_ss + logical , intent(in) :: gwd_fd + !tunable parameter from namelist + real(r8), intent(in) :: od_ls_ncleff + real(r8), intent(in) :: od_bl_ncd + real(r8), intent(in) :: od_ss_sncleff + !vertical profile of the momentum tendencies + real(r8), intent(out), optional :: utgw(state%ncol,pver) + real(r8), intent(out), optional :: vtgw(state%ncol,pver) + real(r8), intent(out), optional :: ttgw(state%ncol,pver) + !output drag terms in 3D and surface + real(r8), intent(out), optional :: dtaux3_ls(pcols,pver) + real(r8), intent(out), optional :: dtauy3_ls(pcols,pver) + real(r8), intent(out), optional :: dtaux3_bl(pcols,pver) + real(r8), intent(out), optional :: dtauy3_bl(pcols,pver) + real(r8), intent(out), optional :: dtaux3_ss(pcols,pver) + real(r8), intent(out), optional :: dtauy3_ss(pcols,pver) + real(r8), intent(out), optional :: dtaux3_fd(pcols,pver) + real(r8), intent(out), optional :: dtauy3_fd(pcols,pver) + real(r8), intent(out), optional :: dusfc_ls(pcols) + real(r8), intent(out), optional :: dvsfc_ls(pcols) + real(r8), intent(out), optional :: dusfc_bl(pcols) + real(r8), intent(out), optional :: dvsfc_bl(pcols) + real(r8), intent(out), optional :: dusfc_ss(pcols) + real(r8), intent(out), optional :: dvsfc_ss(pcols) + real(r8), intent(out), optional :: dusfc_fd(pcols) + real(r8), intent(out), optional :: dvsfc_fd(pcols) + ! + real(r8) :: ztop(pcols,pver) ! top interface height asl (m) + real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) + real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) + real(r8) :: dz(pcols,pver) ! model layer height + ! + !real(r8) :: g + !pblh input + integer :: pblh_idx = 0 + integer :: kpbl2d_in(pcols) + integer :: kpbl2d_reverse_in(pcols) + real(r8), pointer :: pblh(:) + real(r8) :: dx(pcols),dy(pcols) + !needed index + integer :: ncol + integer :: i + integer :: k + + ncol=state%ncol + !convert heights above surface to heights above sea level + !obtain z,dz,dx,dy,and k for pblh + kpbl2d_in=0_r8 + kpbl2d_reverse_in=0_r8 + ztop=0._r8 + zbot=0._r8 + zmid=0._r8 + dusfc_ls=0._r8 + dvsfc_ls=0._r8 + dusfc_bl=0._r8 + dvsfc_bl=0._r8 + dusfc_ss=0._r8 + dvsfc_ss=0._r8 + dusfc_fd=0._r8 + dvsfc_fd=0._r8 + dtaux3_ls=0._r8 + dtaux3_bl=0._r8 + dtauy3_ls=0._r8 + dtauy3_bl=0._r8 + dtaux3_ss=0._r8 + dtaux3_fd=0._r8 + dtauy3_ss=0._r8 + dtauy3_fd=0._r8 + + do k=1,pver + do i=1,ncol + ! assign values for level top/bottom + ztop(i,k)=state%zi(i,k) + zbot(i,k)=state%zi(i,k+1) + enddo + end do + + !transform adding the pressure + !transfer from surface to sea level + do k=1,pver + do i=1,ncol + ztop(i,k)=ztop(i,k)+state%phis(i)/gravit + zbot(i,k)=zbot(i,k)+state%phis(i)/gravit + zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit + !dz is from bottom to top already for gw_drag + dz(i,k)=ztop(i,k)-zbot(i,k) + end do + end do + !get the layer index of pblh in layer for input in drag scheme + pblh_idx = pbuf_get_index('pblh') + call pbuf_get_field(pbuf, pblh_idx, pblh) + do i=1,pcols + kpbl2d_in(i)=pblh_get_level_idx(zbot(i,:)-(state%phis(i)/gravit),pblh(i)) + kpbl2d_reverse_in(i)=pverp-kpbl2d_in(i)!pverp-k + end do + + !get grid size for dx,dy + call grid_size(state,dx,dy) + !interface for orographic drag + call od_gsd(& + u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& + qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& + pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& + od_ls_ncleff=od_ls_ncleff,od_bl_ncd=od_bl_ncd,od_ss_sncleff=od_ss_sncleff,& + rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& + dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& + dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& + dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& + dtaux3d_fd=dtaux3_fd(:ncol,pver:1:-1),dtauy3d_fd=dtauy3_fd(:ncol,pver:1:-1),& + dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& + dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& + dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& + dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& + xland=cam_in%landfrac,br=state%ribulk(:ncol),& + var2d=sgh(:ncol),oc12d=state%oc(:ncol),& + oa2d=state%oadir(:ncol,:),ol2d=state%ol(:ncol,:),& + znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& + cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& + dt=dtime,dx=dx,dy=dy,& + kpbl2d=kpbl2d_reverse_in,gwd_opt=0,& + ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & + ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & + its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & + gwd_ls=gwd_ls,gwd_bl=gwd_bl,gwd_ss=gwd_ss,gwd_fd=gwd_fd ) + +end subroutine oro_drag_interface + +!========================================================================== + +function pblh_get_level_idx(height_array,pblheight) + implicit none + real(r8),intent(in),dimension(pver) :: height_array + real(r8),intent(in) :: pblheight + integer :: pblh_get_level_idx + !local + integer :: k + logical :: found + + pblh_get_level_idx = -1 + found=.false. + !get the pblh level index and return + do k = 1, pver + if((pblheight >= height_array(k+1).and.pblheight 300._r8) then + kpbl2 = k + IF (k == kpbl(i)) then + hpbl2 = hpbl(i)+10._r8 + ELSE + hpbl2 = za(i,k)+10._r8 + ENDIF + exit + ENDIF + enddo + + if(xland1(i).gt.0._r8 .and. 2._r8*var(i).le.hpbl(i))then + if(br1(i).gt.0._r8 .and. thvx(i,kpbl2)-thvx(i,kts) > 0._r8)then + cleff = sqrt(dxy(i)**2_r8 + dxyp(i)**2_r8) + cleff = (2.0_r8/sncleff) * max(dxmax_ss,cleff) + coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) + xlinv(i) = coefm(i) / cleff + govrth(i)=g/(0.5_r8*(thvx(i,kpbl2)+thvx(i,kts))) + bnrf=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) + + if(abs(bnrf/u1(i,kpbl2)).gt.xlinv(i))then + tauwavex0=0.5_r8*bnrf*xlinv(i)*(2._r8*MIN(var(i),varmax))**2_r8*ro(i,kvar)*u1(i,kvar) + tauwavex0=tauwavex0*ss_taper ! "Scale-awareness" + else + tauwavex0=0._r8 + endif + + if(abs(bnrf/v1(i,kpbl2)).gt.xlinv(i))then + tauwavey0=0.5_r8*bnrf*xlinv(i)*(2._r8*MIN(var(i),varmax))**2._r8*ro(i,kvar)*v1(i,kvar) + tauwavey0=tauwavey0*ss_taper ! "Scale-awareness" + else + tauwavey0=0._r8 + endif + + do k=kts,kpbl(i) !MIN(kpbl2+1,kte-1) + utendwave(i,k)=-1._r8*tauwavex0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + vtendwave(i,k)=-1._r8*tauwavey0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + enddo + endif + endif + enddo ! end i loop + + do k = kts,kte + do i = its,ite + dudt(i,k) = dudt(i,k) + utendwave(i,k) + dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) + dtaux2d_ss(i,k) = utendwave(i,k) + dtauy2d_ss(i,k) = vtendwave(i,k) + dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) + dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) + enddo + enddo + + ENDIF ! end if gsd_gwd_ss == .true. + !================================================================ + !add Beljaars et al. (2004, QJRMS, equ. 16) form drag: + !================================================================ + IF (gsd_gwd_fd.and.(ss_taper.GT.1.E-02) ) THEN + + utendform=0._r8 + vtendform=0._r8 + zq=0._r8 + + if (.not.gsd_gwd_ss.and.(ss_taper.GT.1.E-02) ) THEN + ! Defining layer height. This is already done above is small-scale GWD is used + do k = kts,kte + do i = its,ite + zq(i,k+1) = dz2(i,k)+zq(i,k) + enddo + enddo + + do k = kts,kte + do i = its,ite + za(i,k) = 0.5_r8*(zq(i,k)+zq(i,k+1)) + enddo + enddo + endif + + do i=its,ite + if (xland1(i) .gt. 0..and.2._r8*var(i).gt.0) then + ! refer to Beljaars (2004) eq.16. + a1=0.00026615161_r8*var(i)**2_r8 + a2=a1*0.005363_r8 + do k=kts,kte + wsp=SQRT(u1(i,k)**2_r8 + v1(i,k)**2_r8) + ! refer to Beljaars (2004) eq.16. + ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + utendform(i,k)=-0.0759_r8*wsp*u1(i,k)* & + EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper + vtendform(i,k)=-0.0759_r8*wsp*v1(i,k)* & + EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper + ! + enddo + endif + enddo + + do k = kts,kte + do i = its,ite + dudt(i,k) = dudt(i,k) + utendform(i,k) + dvdt(i,k) = dvdt(i,k) + vtendform(i,k) + !limit drag tendency + !some tendency is likely to even overturn the wind, + !making wind reverse in 1 timestep and reverse again in next, + !this limitation may help to make model stable, + !and no more wind reversal due to drag, + !which is suppose to decelerate, not accelerate + utendform(i,k) = sign(min(abs(utendform(i,k)),abs(u1(i,k))/deltim),utendform(i,k)) + vtendform(i,k) = sign(min(abs(vtendform(i,k)),abs(v1(i,k))/deltim),vtendform(i,k)) + dtaux2d_fd(i,k) = utendform(i,k) + dtauy2d_fd(i,k) = vtendform(i,k) + dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) + dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) + enddo + enddo + ENDIF ! end if gsd_gwd_fd == .true. + !======================================================= + ! More for the large-scale gwd component + !======================================================= + IF (gsd_gwd_ls.and.(ls_taper.GT.1.E-02) ) THEN + ! + ! now compute vertical structure of the stress. + ! + do k = kts,kpblmax + do i = its,ite + if (k .le. kbl(i)) taup(i,k) = taub(i) + enddo + enddo + + if (scorer_on) then + ! + !determination of the interface height for scorer adjustment + ! + do i=its,ite + iint=.false. + do k=kpblmin,kte-1 + if (k.gt.kbl(i).and.usqj(i,k)-usqj(i,k-1).lt.0.and.(.not.iint)) then + iint=.true. + zl_hint(i)=zl(i,k+1) + endif + enddo + enddo + endif + + do k = kpblmin, kte-1 ! vertical level k loop! + kp1 = k + 1 + do i = its,ite + ! + ! unstablelayer if ri < ric + ! unstable layer if upper air vel comp along surf vel <=0 (crit lay) + ! at (u-c)=0. crit layer exists and bit vector should be set (.le.) + ! + if (k .ge. kbl(i)) then + !we modify the criteria for unstable layer + !that the lv is critical under 0.25 + !while we keep wave breaking ric for + !other larger lv + icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric_rig)& + .or. (velco(i,k) .le. 0.0_r8) + brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared + brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency + endif + enddo + + do i = its,ite + if (k .ge. kbl(i) .and. (.not. ldrag(i))) then + if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0_r8 ) then + temv = 1.0_r8 / velco(i,k) + tem1 = coefm(i)/(dxy(i)/ncleff)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5_r8 + hd = sqrt(taup(i,k) / tem1) + fro = brvf(i) * hd * temv + ! + ! rim is the minimum-richardson number by shutts (1985) + ! + tem2 = sqrt(usqj(i,k)) + tem = 1._r8 + tem2 * fro + rim = usqj(i,k) * (1._r8-fro) / (tem * tem) + + ! + ! check stability to employ the 'saturation hypothesis' + ! of lindzen (1981) except at tropospheric downstream regions + ! + if (rim .le. ric) then ! saturation hypothesis! + if ((oa1(i) .le. 0._r8).or.(kp1 .ge. kpblmin )) then + temc = 2.0_r8 + 1.0_r8 / tem2 + hd = velco(i,k) * (2.0_r8*sqrt(temc)-temc) / brvf(i) + taup(i,kp1) = tem1 * hd * hd + ! + ! taup is restricted to monotoncally decrease + ! to avoid unexpected high taup in calculation + ! + taup(i,kp1)=min(tem1*hd*hd,taup(i,k)) + ! + ! add vertical decrease at low level below hint (Kim and Doyle 2005) + ! where Ri first decreases + ! + if (scorer_on.and.k.gt.klowtop(i).and.zl(i,k).le.zl_hint(i).and.k.lt.kte-1) then + l1=(9.81_r8*bnv2(i,kp1)/velco(i,kp1)**2) + l2=(9.81_r8*bnv2(i,k)/velco(i,k)**2) + taup(i,kp1)=min(taup(i,k),taup(i,k)*(l1/l2),tem1*hd*hd) + endif + endif + else ! no wavebreaking! + taup(i,kp1) = taup(i,k) + endif + endif + endif + enddo + enddo + + if(lcap.lt.kte) then + do klcap = lcapp1,kte + do i = its,ite + taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) + enddo + enddo + endif + + ENDIF !END LARGE-SCALE TAU CALCULATION + !=============================================================== + !COMPUTE BLOCKING COMPONENT + !=============================================================== + IF (gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN + + do i = its,ite + if(.not.ldrag(i)) then + ! + !------- determine the height of flow-blocking layer + ! + kblk = 0 + pe = 0.0_r8 + + do k = kte, kpblmin, -1 + if(kblk.eq.0 .and. k.le.komax(i)) then + !flow block appears within the reference level + !compare potential energy and kinetic energy + !divided by g*ro is to turn del(pa) into height + pe = pe + bnv2(i,k)*(zl(i,komax(i))-zl(i,k))*del(i,k)/g/ro(i,k) + ke = 0.5_r8*((rcs*u1(i,k))**2._r8+(rcs*v1(i,k))**2._r8) + ! + !---------- apply flow-blocking drag when pe >= ke + ! + if(pe.ge.ke) then + kblk = k + kblk = min(kblk,kbl(i)) + zblk = zl(i,kblk)-zl(i,kts) + endif + endif + enddo + + if(kblk.ne.0) then + ! + !--------- compute flow-blocking stress + ! + + !dxmax_ls is different than the usual one + !because the taper is very different + !dxy is a length scale mostly in the direction of the flow to the ridge + !so it is good and not needed for an uneven grid area + !ref Lott and Miller (1997) original scheme + cd = max(2.0_r8-1.0_r8/od(i),0.0_r8) + ! + !tuning of the drag magnitude + cd=ncd*cd + ! + taufb(i,kts) = 0.5_r8 * roll(i) * coefm(i) / max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) & + * olp(i) * zblk * ulow(i)**2 + !changed grid box area into dy*dy + tautem = taufb(i,kts)/float(kblk-kts) + do k = kts+1, kblk + taufb(i,k) = taufb(i,k-1) - tautem + enddo + + ! + !----------sum orographic GW stress and flow-blocking stress + ! + !taup(i,:) = taup(i,:) + taufb(i,:) ! Keep taup and taufb separate for now + endif + endif + enddo + + ENDIF ! end blocking drag +!=========================================================== + IF (gsd_gwd_ls.OR.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN + ! + ! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy + ! + + do k = kts,kte + do i = its,ite + taud_ls(i,k) = 1._r8 * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) + taud_bl(i,k) = 1._r8 * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) + enddo + enddo + ! + ! limit de-acceleration (momentum deposition ) at top to 1/2 value + ! the idea is some stuff must go out the 'top' + ! + + do klcap = lcap,kte + do i = its,ite + taud_ls(i,klcap) = taud_ls(i,klcap) * factop + taud_bl(i,klcap) = taud_bl(i,klcap) * factop + enddo + enddo + + ! + ! if the gravity wave drag would force a critical line + ! in the lower ksmm1 layers during the next deltim timestep, + ! then only apply drag until that critical line is reached. + ! + do k = kts,kpblmax-1 + do i = its,ite + if (k .le. kbl(i)) then + if((taud_ls(i,k)+taud_bl(i,k)).ne.0._r8) & + dtfac(i) = min(dtfac(i),abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo + enddo + + do k = kts,kte + do i = its,ite + taud_ls(i,k) = taud_ls(i,k) * dtfac(i) * ls_taper + !apply limiter for ogwd + !1.dudt < |c-u|/dt, so u-c cannot change sign(u^n+1 = u^n + du/dt * dt) + !2.dudt shr_kind_r8 - use reconstruct - use ogwd_sub - implicit none -# include - - !************************************** - ! - ! USER SETTINGS BELOW - ! - !************************************** - ! - ! - ! if smoothed PHIS is available SGH needs to be recomputed to account for the sub-grid-scale - ! variability introduced by the smoothing - ! -logical :: lsmooth_terr = .FALSE. -!logical :: lsmooth_terr = .TRUE. - ! - ! PHIS is smoothed by other software/dynamical core - ! - logical :: lexternal_smooth_terr = .FALSE. ! lexternal_smooth_terr = .FALSE. is NOT supported currently -!logical :: lexternal_smooth_terr = .TRUE. - ! - ! set PHIS=0.0 if LANDFRAC<0.01 - ! - logical :: lzero_out_ocean_point_phis = .TRUE.!.FALSE. -!logical :: lzero_out_ocean_point_phis = .FALSE. - ! - ! For internal smoothing (experimental at this point) - ! =================================================== - ! - ! if smoothing is internal (lexternal_smooth_terr=.FALSE.) choose coarsening factor - ! - ! recommendation: 2*(target resolution)/(0.03 degree) - ! - ! factor must be an even integer - ! - integer, parameter :: factor = 60 !coarse grid = 2.25 degrees - integer, parameter :: norder = 2 - integer, parameter :: nmono = 0 - integer, parameter :: npd = 1 - ! - !********************************************************************** - ! - ! END OF USER SETTINS BELOW - ! (do not edit beyond this point unless you know what you are doing!) - ! - !********************************************************************** - ! - integer :: im, jm, ncoarse - integer :: ncube !dimension of cubed-sphere grid - - real(r8), allocatable, dimension(:) :: landm_coslat, landfrac, terr, sgh30 - real(r8), allocatable, dimension(:) :: terr_coarse !for internal smoothing - - integer :: alloc_error,dealloc_error - integer :: i,j,n,k,index - integer*2, allocatable, dimension(:,:) :: iterr ! terrain data for 30-sec tile - integer ncid,status, dimlatid,dimlonid, landid, topoid ! for netCDF USGS data file - integer :: srcid,dstid, jm_dbg ! for netCDF weight file - integer, dimension(2) :: src_grid_dims ! for netCDF weight file - - integer :: dimid - - logical :: ldbg - real(r8), allocatable, dimension(:) :: lon , lat - real(r8), allocatable, dimension(:) :: lon_landm , lat_landm - real(r8), allocatable, dimension(:) :: area - integer :: im_landm, jm_landm - integer :: lonid, latid, phisid - ! - ! constants - ! - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: pih = 0.50*pi - REAL (r8), PARAMETER :: deg2rad = pi/180.0 - - real(r8) :: wt,dlat - integer :: ipanel,icube,jcube - real(r8), allocatable, dimension(:,:,:) :: weight,terr_cube,landfrac_cube,sgh30_cube - real(r8), allocatable, dimension(:,:,:) :: landm_coslat_cube - integer, allocatable, dimension(:,:) :: idx,idy,idp - integer :: npatch, isub,jsub, itmp, iplm1,jmin,jmax - real(r8) :: sum,dx,scale,dmax,arad,jof,term,s1,c1,clon,iof,dy,s2,c2,dist - ! - ! for linear interpolation - ! - real(r8) :: lambda,theta,wx,wy,offset - integer :: ilon,ilat,ip1,jp1 - ! - ! variable for regridding - ! - integer :: src_grid_dim ! for netCDF weight file - integer :: n_a,n_b,n_s,n_aid,n_bid,n_sid - integer :: count - real(r8), allocatable, dimension(:) :: landfrac_target, terr_target, sgh30_target, sgh_target - real(r8), allocatable, dimension(:) :: oc_target - real(r8), allocatable, dimension(:,:) :: oa_target,ol_target - real(r8) :: terr_if - real(r8), allocatable, dimension(:) :: lat_terr,lon_terr - integer :: nvar_dirOA,nvar_dirOL - integer,allocatable,dimension(:) :: indexb !max indice dimension - real(r8),allocatable,dimension(:,:,:) :: terrout - real(r8),allocatable,dimension(:,:) :: dxy - - real(r8), allocatable, dimension(:) :: landm_coslat_target, area_target - ! - ! this is only used if target grid is a lat-lon grid - ! - integer , parameter :: im_target = 360 , jm_target = 180 - ! - ! this is only used if target grid is not a lat-lon grid - ! - real(r8), allocatable, dimension(:) :: lon_target, lat_target - ! - ! new - ! - integer :: ntarget, ntarget_id, ncorner, ncorner_id, nrank, nrank_id - integer :: ntarget_smooth - real(r8), allocatable, dimension(:,:):: target_corner_lon, target_corner_lat - real(r8), allocatable, dimension(:) :: target_center_lon, target_center_lat, target_area -real(r8), allocatable, dimension(:,:):: target_corner_lon_deg,target_corner_lat_deg - integer :: ii,ip,jx,jy,jp - real(r8), dimension(:), allocatable :: xcell, ycell, xgno, ygno - real(r8), dimension(:), allocatable :: gauss_weights,abscissae - integer, parameter :: ngauss = 3 - integer :: jmax_segments,jall - real(r8) :: tmp - - real(r8), allocatable, dimension(:,:) :: weights_all - integer , allocatable, dimension(:,:) :: weights_eul_index_all - integer , allocatable, dimension(:) :: weights_lgr_index_all - integer :: ix,iy - ! - ! volume of topography - ! - real(r8) :: vol_target, vol_target_un, area_target_total,vol_source,vol_tmp - integer :: nlon,nlon_smooth,nlat,nlat_smooth - logical :: ltarget_latlon,lpole - real(r8), allocatable, dimension(:,:) :: terr_smooth - ! - ! for internal filtering - ! - real(r8), allocatable, dimension(:,:) :: weights_all_coarse - integer , allocatable, dimension(:,:) :: weights_eul_index_all_coarse - integer , allocatable, dimension(:) :: weights_lgr_index_all_coarse - real(r8), allocatable, dimension(:) :: area_target_coarse - real(r8), allocatable, dimension(:,:) :: da_coarse,da - real(r8), allocatable, dimension(:,:) :: recons,centroids - integer :: nreconstruction - - integer :: jmax_segments_coarse,jall_coarse,ncube_coarse - real(r8) :: all_weights - character(len=512) :: target_grid_file - character(len=512) :: input_topography_file - character(len=512) :: output_topography_file - character(len=512) :: smoothed_topography_file -real(r8) :: xxt,yyt,zzt -!real(r8),allocatable,dimension(:) :: xbar,ybar,zbar -real(r8),dimension(32768) :: xhds,yhds,zhds,hds,xbar,ybar,zbar,lon_bar,lat_bar -real(r8) :: rad,xx2,yy2,zz2,ix2,iy2,ip2 -real(r8) :: lonii,latii -character*20 :: indice - ! - nvar_dirOA=2+1!4 !2+1!4!36 - nvar_dirOL=180 - ! - ! turn extra debugging on/off - ! - ldbg = .FALSE. - - nreconstruction = 1 - ! - call parse_arguments(target_grid_file , input_topography_file , & - output_topography_file, smoothed_topography_file, & - lsmooth_terr ) - ! - !********************************************************* - ! - ! read in target grid - ! - !********************************************************* - ! - status = nf_open(trim(target_grid_file), 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, ntarget) - WRITE(*,*) "dimension of target grid: ntarget=",ntarget - - status = NF_INQ_DIMID(ncid, 'grid_corners', ncorner_id) - status = NF_INQ_DIMLEN(ncid, ncorner_id, ncorner) - WRITE(*,*) "maximum number of corners: ncorner=",ncorner - - status = NF_INQ_DIMID(ncid, 'grid_rank', nrank_id);status = NF_INQ_DIMLEN(ncid, nrank_id, nrank) - WRITE(*,*) "grid rank: nrank=",nrank - IF (nrank==2) THEN - WRITE(*,*) "target grid is a lat-lon grid" - ltarget_latlon = .TRUE. - status = NF_INQ_DIMID(ncid, 'nlon', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon) - status = NF_INQ_DIMID(ncid, 'nlat', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat) - status = NF_INQ_DIMID(ncid, 'lpole', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, lpole) - WRITE(*,*) "nlon=",nlon,"nlat=",nlat - IF (lpole) THEN - WRITE(*,*) "center of most Northern grid cell is lat=90; similarly for South pole" - ELSE - WRITE(*,*) "center of most Northern grid cell is NOT lat=90; similarly for South pole" - END IF - ELSE IF (nrank==1) THEN - ltarget_latlon = .FALSE. - ELSE - WRITE(*,*) "nrank out of range",nrank - STOP - ENDIF - - allocate ( target_corner_lon(ncorner,ntarget),stat=alloc_error) - allocate ( target_corner_lat(ncorner,ntarget),stat=alloc_error) - allocate ( target_corner_lon_deg(ncorner,ntarget),stat=alloc_error) - allocate ( target_corner_lat_deg(ncorner,ntarget),stat=alloc_error) - status = NF_INQ_VARID(ncid, 'grid_corner_lon', lonid) - status = NF_GET_VAR_DOUBLE(ncid, lonid,target_corner_lon) - ! - target_corner_lon_deg=target_corner_lon - ! - IF (maxval(target_corner_lon)>10.0) target_corner_lon = deg2rad*target_corner_lon - - status = NF_INQ_VARID(ncid, 'grid_corner_lat', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_corner_lat) - ! - target_corner_lat_deg=target_corner_lat - ! - IF (maxval(target_corner_lat)>10.0) target_corner_lat = deg2rad*target_corner_lat - ! - ! for writing remapped data on file at the end of the program - ! - allocate ( target_center_lon(ntarget),stat=alloc_error) - allocate ( target_center_lat(ntarget),stat=alloc_error) - allocate ( target_area (ntarget),stat=alloc_error)!dbg - - status = NF_INQ_VARID(ncid, 'grid_center_lon', lonid) - status = NF_GET_VAR_DOUBLE(ncid, lonid,target_center_lon) - - status = NF_INQ_VARID(ncid, 'grid_center_lat', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_center_lat) - - status = NF_INQ_VARID(ncid, 'grid_area', latid) - status = NF_GET_VAR_DOUBLE(ncid, latid,target_area) - - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - !**************************************************** - ! - ! get dimension of cubed-sphere grid - ! - !**************************************************** - ! - WRITE(*,*) "get dimension of cubed-sphere data from file" - !status = nf_open('USGS-topo-cube3000.nc', 0, ncid) - status = nf_open(trim(input_topography_file), 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - status = NF_INQ_DIMID(ncid, 'grid_size', dimid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimid, n) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - ncube = INT(SQRT(DBLE(n/6))) - WRITE(*,*) "cubed-sphere dimension: ncube = ",ncube - WRITE(*,*) "average grid-spacing at the Equator (degrees):" ,90.0/ncube - - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - !**************************************************** - ! - ! compute weights for remapping - ! - !**************************************************** - ! - jall = ncube*ncube*12*10 !anticipated number of weights (cab be tweaked) - jmax_segments = 100000 !can be tweaked - - allocate (weights_all(jall,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index_all(jall,3),stat=alloc_error ) - allocate (weights_lgr_index_all(jall),stat=alloc_error ) - CALL overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& - jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) - ! - !**************************************************** - ! - ! read cubed-sphere 3km data - ! - !**************************************************** - ! - WRITE(*,*) "read cubed-sphere 3km data from file" - status = nf_open('USGS-topo-cube3000.nc', 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - - status = NF_INQ_DIMID(ncid, 'grid_size', dimid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_INQ_DIMLEN(ncid, dimid, n) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - ncube = INT(SQRT(DBLE(n/6))) - WRITE(*,*) "cubed-sphere dimension, ncube: ",ncube - - allocate ( landm_coslat(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'LANDM_COSLAT', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landm_coslat) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landm_coslat",MINVAL(landm_coslat),MAXVAL(landm_coslat) - ! - ! read LANDFRAC - ! - allocate ( landfrac(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'LANDFRAC', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,landfrac) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of landfrac",MINVAL(landfrac),MAXVAL(landfrac) - ! - ! read terr - ! - allocate ( terr(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'terr', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,terr) - - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of terr",MINVAL(terr),MAXVAL(terr) - allocate ( lat_terr(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for lat_terr' - stop - end if - status = NF_INQ_VARID(ncid, 'lat', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - status = NF_GET_VAR_DOUBLE(ncid, landid,lat_terr) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of lat",MINVAL(lat_terr),MAXVAL(lat_terr) - - allocate ( lon_terr(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for lon_terr' - stop - end if - status = NF_INQ_VARID(ncid, 'lon', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,lon_terr) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of lon",MINVAL(lon_terr),MAXVAL(lon_terr) - ! - ! - ! - allocate ( sgh30(n),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - - status = NF_INQ_VARID(ncid, 'SGH30', landid) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - - status = NF_GET_VAR_DOUBLE(ncid, landid,sgh30) - IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status) - WRITE(*,*) "min/max of sgh30",MINVAL(sgh30),MAXVAL(sgh30) - - print *,"close file" - status = nf_close (ncid) - if (status .ne. NF_NOERR) call handle_err(status) - - WRITE(*,*) 'done reading in LANDM_COSLAT data from netCDF file' - ! - !********************************************************* - ! - ! do actual remapping - ! - !********************************************************* - ! - allocate (terr_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for terr_target' - stop - end if - allocate (landfrac_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac_target' - stop - end if - allocate (landm_coslat_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac_target' - stop - end if - allocate (sgh30_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh30_target' - stop - end if - allocate (area_target(ntarget),stat=alloc_error ) - terr_target = 0.0 - landfrac_target = 0.0 - sgh30_target = 0.0 - landm_coslat_target = 0.0 - area_target = 0.0 - - tmp = 0.0 - do count=1,jall - i = weights_lgr_index_all(count) - wt = weights_all(count,1) - area_target (i) = area_target(i) + wt - end do - - - do count=1,jall - i = weights_lgr_index_all(count) - - ix = weights_eul_index_all(count,1) - iy = weights_eul_index_all(count,2) - ip = weights_eul_index_all(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix - - wt = weights_all(count,1) - terr_target (i) = terr_target (i) + wt*terr (ii)/area_target(i) - landfrac_target (i) = landfrac_target (i) + wt*landfrac (ii)/area_target(i) - landm_coslat_target(i) = landm_coslat_target(i) + wt*landm_coslat(ii)/area_target(i) - sgh30_target (i) = sgh30_target (i) + wt*sgh30 (ii)/area_target(i) - tmp = tmp+wt*terr(ii) - end do - ! - write(*,*) "tmp", tmp - WRITE(*,*) "max difference between target grid area and remapping software area",& - MAXVAL(target_area-area_target) - - do count=1,ntarget - if (terr_target(count)>8848.0) then - ! - ! max height is higher than Mount Everest - ! - write(*,*) "FATAL error: max height is higher than Mount Everest!" - write(*,*) "terr_target",count,terr_target(count) - write(*,*) "(lon,lat) locations of vertices of cell with excessive max height::" - do i=1,ncorner - write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) - end do - STOP - else if (terr_target(count)<-423.0) then - ! - ! min height is lower than Dead Sea - ! - write(*,*) "FATAL error: min height is lower than Dead Sea!" - write(*,*) "terr_target",count,terr_target(count) - write(*,*) "(lon,lat) locations of vertices of cell with excessive min height::" - do i=1,ncorner - write(*,*) target_corner_lon(i,count),target_corner_lat(i,count) - end do - STOP - else - - end if - end do - WRITE(*,*) "Elevation data passed min/max consistency check!" - WRITE(*,*) - - WRITE(*,*) "min/max of unsmoothed terr_target : ",MINVAL(terr_target ),MAXVAL(terr_target ) - WRITE(*,*) "min/max of landfrac_target : ",MINVAL(landfrac_target),MAXVAL(landfrac_target) - WRITE(*,*) "min/max of landm_coslat_target : ",& - MINVAL(landm_coslat_target),MAXVAL(landm_coslat_target) - WRITE(*,*) "min/max of var30_target : ",MINVAL(sgh30_target ),MAXVAL(sgh30_target ) - ! - ! compute mean height (globally) of topography about sea-level for target grid unfiltered elevation - ! - vol_target_un = 0.0 - area_target_total = 0.0 - DO i=1,ntarget - area_target_total = area_target_total+area_target(i) - vol_target_un = vol_target_un+terr_target(i)*area_target(i) - END DO - WRITE(*,*) "mean height (globally) of topography about sea-level for target grid unfiltered elevation",& - vol_target_un/area_target_total - - ! - ! diagnostics - ! - vol_source = 0.0 - allocate ( dA(ncube,ncube),stat=alloc_error ) - CALL EquiangularAllAreas(ncube, dA) - DO jp=1,6 - DO jy=1,ncube - DO jx=1,ncube - ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx - vol_source = vol_source+terr(ii)*dA(jx,jy) - END DO - END DO - END DO - WRITE(*,*) "volume of input cubed-sphere terrain :",vol_source - WRITE(*,*) "average elevation of input cubed-sphere terrain:",vol_source/(4.0*pi) - - DEALLOCATE(dA) - ! - ! - ! - allocate (sgh_target(ntarget),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for sgh_target' - stop - end if - ! - ! compute variance with respect to cubed-sphere data - ! - WRITE(*,*) "compute variance with respect to 3km cubed-sphere data: SGH" - - IF (lsmooth_terr) THEN - WRITE(*,*) "smoothing PHIS" - IF (lexternal_smooth_terr) THEN - WRITE(*,*) "using externally generated smoothed topography" - - status = nf_open(trim(smoothed_topography_file), 0, ncid) - IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - status = nf_close(ncid) - !status = nf_open('phis-smooth.nc', 0, ncid) - !IF (STATUS .NE. NF_NOERR) CALL HANDLE_ERR(STATUS) - ! - IF (.NOT.ltarget_latlon) THEN - ! - !********************************************************* - ! - ! read in smoothed topography - ! - !********************************************************* - ! - status = NF_INQ_DIMID (ncid, 'ncol', ntarget_id ) - status = NF_INQ_DIMLEN(ncid, ntarget_id , ntarget_smooth) - IF (ntarget.NE.ntarget_smooth) THEN - WRITE(*,*) "mismatch in smoothed data-set and target grid specification" - WRITE(*,*) ntarget, ntarget_smooth - STOP - END IF - status = NF_INQ_VARID(ncid, 'PHIS', phisid) - ! - ! overwrite terr_target with smoothed version - ! - status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_target) - terr_target = terr_target/9.80616 - ELSE - ! - ! read in smoothed lat-lon topography - ! - status = NF_INQ_DIMID(ncid, 'lon', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlon_smooth) - status = NF_INQ_DIMID(ncid, 'lat', ntarget_id) - status = NF_INQ_DIMLEN(ncid, ntarget_id, nlat_smooth) - IF (nlon.NE.nlon_smooth.OR.nlat.NE.nlat_smooth) THEN - WRITE(*,*) "smoothed topography dimensions do not match target grid dimensions" - WRITE(*,*) "target grid : nlon ,nlat =",nlon,nlat - WRITE(*,*) "smoothed topo: nlon_smooth,nlat_smooth =",nlon_smooth,nlat_smooth - STOP - END IF - ALLOCATE(terr_smooth(nlon_smooth,nlat_smooth),stat=alloc_error) - status = NF_INQ_VARID(ncid, 'PHIS', phisid) - status = NF_GET_VAR_DOUBLE(ncid, phisid,terr_smooth) - ! - ! overwrite terr_target with smoothed version - ! - ii=1 - DO j=1,nlat - DO i=1,nlon - terr_target(ii) = terr_smooth(i,j)/9.80616 - ii=ii+1 - END DO - END DO - DEALLOCATE(terr_smooth) - END IF - ELSE - WRITE(*,*) "unstested software - uncomment this line of you know what you are doing!" - STOP - ! - !***************************************************** - ! - ! smoothing topography internally - ! - !***************************************************** - ! - WRITE(*,*) "internally smoothing orography" - ! CALL smooth(terr_target,ntarget,target_corner_lon,target_corner_lat) - ! - ! smooth topography internally - ! - ncoarse = n/(factor*factor) - ! - ! - ! - ncube_coarse = ncube/factor - WRITE(*,*) "resolution of coarse grid", 90.0/ncube_coarse - allocate ( terr_coarse(ncoarse),stat=alloc_error ) - if( alloc_error /= 0 ) then - print*,'Program could not allocate space for landfrac' - stop - end if - WRITE(*,*) "coarsening" - allocate ( dA_coarse(ncube_coarse,ncube_coarse),stat=alloc_error ) - CALL coarsen(terr,terr_coarse,factor,n,dA_coarse) - ! - ! - ! - vol_tmp = 0.0 - DO jp=1,6 - DO jy=1,ncube_coarse - DO jx=1,ncube_coarse - ii = (jp-1)*ncube_coarse*ncube_coarse+(jy-1)*ncube_coarse+jx - vol_tmp = vol_tmp+terr_coarse(ii)*dA_coarse(jx,jy) - END DO - END DO - END DO - WRITE(*,*) "volume of coarsened cubed-sphere terrain :",vol_source - WRITE(*,*) "difference between coarsened cubed-sphere data and input cubed-sphere data",& - vol_tmp-vol_source - - - - WRITE(*,*) "done coarsening" - - nreconstruction = 1 - IF (norder>1) THEN - IF (norder == 2) THEN - nreconstruction = 3 - ELSEIF (norder == 3) THEN - nreconstruction = 6 - END IF - ALLOCATE(recons (nreconstruction, ncoarse), STAT=status) - ALLOCATE(centroids(nreconstruction, ncoarse), STAT=status) - CALL get_reconstruction(terr_coarse,norder, nmono, recons, npd,da_coarse,& - ncube_coarse+1,nreconstruction,centroids) - SELECT CASE (nmono) - CASE (0) - WRITE(*,*) "coarse grid reconstructions are not filtered with shape-preesrving filter" - CASE (1) - WRITE(*,*) "coarse grid reconstructions are filtered with shape-preserving filter" - CASE DEFAULT - WRITE(*,*) "nmono out of range: ",nmono - STOP - END SELECT - SELECT CASE (0) - CASE (0) - WRITE(*,*) "coarse grid reconstructions are not filtered with positive definite filter" - CASE (1) - WRITE(*,*) "coarse grid reconstructions filtered with positive definite filter" - CASE DEFAULT - WRITE(*,*) "npd out of range: ",npd - STOP - END SELECT - END IF - - jall_coarse = (ncube*ncube*12) !anticipated number of weights - jmax_segments_coarse = jmax_segments!/factor ! - WRITE(*,*) "anticipated",jall_coarse - allocate (weights_all_coarse(jall_coarse,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index_all_coarse(jall_coarse,3),stat=alloc_error ) - allocate (weights_lgr_index_all_coarse(jall_coarse),stat=alloc_error ) - ! - ! - ! - CALL overlap_weights(weights_lgr_index_all_coarse,weights_eul_index_all_coarse,weights_all_coarse,& - jall_coarse,ncube_coarse,ngauss,ntarget,ncorner,jmax_segments_coarse,target_corner_lon,& - target_corner_lat,nreconstruction) - - WRITE(*,*) "MIN/MAX of area-weight [0:1]: ",& - MINVAL(weights_all_coarse(:,1)),MAXVAL(weights_all_coarse(:,1)) - ! - ! compute new weights - ! - - ! - ! do mapping - ! - terr_target = 0.0 - tmp = 0.0 - allocate ( area_target_coarse(ntarget),stat=alloc_error) - all_weights = 0.0 - area_target_coarse = 0.0 - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - wt = weights_all_coarse(count,1) - area_target_coarse (i) = area_target_coarse(i) + wt - all_weights = all_weights+wt - end do - WRITE(*,*) "sum of all weights (coarse to target) minus area of sphere : ",all_weights-4.0*pi - WRITE(*,*) "MIN/MAX of area_target_coarse [0:1]:",& - MINVAL(area_target_coarse),MAXVAL(area_target_coarse) - IF (norder==1) THEN - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - wt = weights_all_coarse(count,1) - - terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) - tmp = tmp+wt*terr_coarse(ii) - end do - ELSE IF (norder==2) THEN - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - IF (i>jall_coarse.OR.i<1) THEN - WRITE(*,*) i,jall_coarse - STOP - END IF - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& - ! - ! all constant terms - ! - terr_coarse(ii) & - - recons(1,ii)*centroids(1,ii) & - - recons(2,ii)*centroids(2,ii) & - ! - ! + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& - ! + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& - ! - ! + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& - )+& - ! - ! linear terms - ! - weights_all_coarse(count,2)*(& - - recons(1,ii)& - - ! - recons(3,ii)*2.0*centroids(1,ii)& - ! - recons(5,ii)* centroids(2,ii)& - )+& - ! - weights_all_coarse(count,3)*(& - recons(2,ii)& - ! - ! - recons(4,ii)*2.0*centroids(2,ii)& - ! - recons(5,ii)* centroids(1,ii)& - )& - ! - ! quadratic terms - ! - ! weights_all_coarse(count,4)*recons(3,ii)+& - ! weights_all_coarse(count,5)*recons(4,ii)+& - ! weights_all_coarse(count,6)*recons(5,ii) - )/area_target_coarse(i) - end do - DEALLOCATE(centroids) - DEALLOCATE(recons) - DEALLOCATE(weights_all_coarse) - - ELSE IF (norder==3) THEN - ! recons(4,:) = 0.0 - ! recons(5,:) = 0.0 - do count=1,jall_coarse - i = weights_lgr_index_all_coarse(count) - IF (i>jall_coarse.OR.i<1) THEN - WRITE(*,*) i,jall_coarse - STOP - END IF - ix = weights_eul_index_all_coarse(count,1) - iy = weights_eul_index_all_coarse(count,2) - ip = weights_eul_index_all_coarse(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube_coarse*ncube_coarse+(iy-1)*ncube_coarse+ix - - ! terr_target(i) = terr_target(i) + wt*terr_coarse(ii)/area_target_coarse(i) - - ! WRITE(*,*) count,area_target_coarse(i) - ! terr_target(i) = terr_target(i) + area_target_coarse(i) - ! - terr_target(i) = terr_target(i) + (weights_all_coarse(count,1)*(& - - - ! centroids(5,ii))/area_target_coarse(i)) - ! centroids(1,ii)/area_target_coarse(i)) - ! /area_target_coarse(i)) - - - - - ! - ! all constant terms - ! - terr_coarse(ii) & - - recons(1,ii)*centroids(1,ii) & - - recons(2,ii)*centroids(2,ii) & - ! - + recons(3,ii)*(2.0*centroids(1,ii)**2-centroids(3,ii))& - + recons(4,ii)*(2.0*centroids(2,ii)**2-centroids(4,ii))& - ! - + recons(5,ii)*(2.0*centroids(1,ii)*centroids(2,ii)-centroids(5,ii))& - )+& - ! - ! linear terms - ! - weights_all_coarse(count,2)*(& - - recons(1,ii)& - - - recons(3,ii)*2.0*centroids(1,ii)& - - recons(5,ii)* centroids(2,ii)& - )+& - ! - weights_all_coarse(count,3)*(& - recons(2,ii)& - ! - - recons(4,ii)*2.0*centroids(2,ii)& - - recons(5,ii)* centroids(1,ii)& - )+& - ! - ! quadratic terms - ! - weights_all_coarse(count,4)*recons(3,ii)+& - weights_all_coarse(count,5)*recons(4,ii)+& - weights_all_coarse(count,6)*recons(5,ii))/area_target_coarse(i) - end do - DEALLOCATE(centroids) - DEALLOCATE(recons) - DEALLOCATE(weights_all_coarse) - END IF - DEALLOCATE(area_target_coarse) - WRITE(*,*) "done smoothing" - END IF - ! - ! compute mean height (globally) of topography about sea-level for target grid filtered elevation - ! - vol_target = 0.0 - DO i=1,ntarget - vol_target = vol_target+terr_target(i)*area_target(i) - ! if (ABS(area_target(i)-area_target_coarse(i))>0.000001) THEN - ! WRITE(*,*) "xxx",area_target(i),area_target_coarse(i),area_target(i)-area_target_coarse(i) - ! STOP - ! END IF - END DO - WRITE(*,*) "mean height (globally) of topography about sea-level for target grid filtered elevation",& - vol_target/area_target_total - WRITE(*,*) "percentage change in mean height between filtered and unfiltered elevations",& - 100.0*(vol_target-vol_target_un)/vol_target_un - WRITE(*,*) "percentage change in mean height between input cubed-sphere and unfiltered elevations",& - 100.0*(vol_source-vol_target_un)/vol_source - - END IF - ! - ! Done internal smoothing - ! - WRITE(*,*) "min/max of terr_target : ",MINVAL(terr_target),MAXVAL(terr_target) - - if (lzero_out_ocean_point_phis) then - WRITE(*,*) "if ocean mask PHIS=0.0" - end if - - - sgh_target=0.0 - do count=1,jall - i = weights_lgr_index_all(count)!! - ! - ix = weights_eul_index_all(count,1) - iy = weights_eul_index_all(count,2) - ip = weights_eul_index_all(count,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - - wt = weights_all(count,1) - - if (lzero_out_ocean_point_phis.AND.landfrac_target(i).lt.0.01_r8) then - terr_target(i) = 0.0_r8 !5*terr_target(i) - end if - sgh_target(i) = sgh_target(i)+wt*((terr_target(i)-terr(ii))**2)/area_target(i) - end do - - - - - ! - ! zero out small values - ! - DO i=1,ntarget - IF (landfrac_target(i)<.001_r8) landfrac_target(i) = 0.0 - IF (sgh_target(i)<0.5) sgh_target(i) = 0.0 - IF (sgh30_target(i)<0.5) sgh30_target(i) = 0.0 - END DO - sgh_target = SQRT(sgh_target) - sgh30_target = SQRT(sgh30_target) - -!for centroid of mass -!wt is useful proxy for dA -print*,"cal oa" -allocate(oa_target(ntarget,nvar_dirOA),stat=alloc_error) -call OAdir(terr,ntarget,ncube,n,nvar_dirOA,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,target_center_lon,target_center_lat,lon_terr,lat_terr,area_target,oa_target)!OAx,OAy) -!call OAorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,lon_terr,lat_terr,area_target,oa_target) -!par -!OC - print*,"cal oc" - allocate(oc_target(ntarget),stat=alloc_error) - oc_target=0.0_r8 - call OC(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,area_target,sgh_target,terr_target,oc_target) - -!OL - print*,"cal ol" - allocate(ol_target(ntarget,nvar_dirOL),stat=alloc_error) - ol_target=0.0_r8 - !call OLorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,lon_terr,lat_terr,area_target,sgh_target,target_center_lat,target_center_lon,target_corner_lat_deg,target_corner_lon_deg,ol_target) - allocate(indexb(ntarget),stat=alloc_error) - indexb=0.0_r8 - do count=1,jall - i = weights_lgr_index_all(count) - indexb(i)=indexb(i)+1 - enddo - allocate(terrout(4,ntarget,maxval(indexb)),stat=alloc_error) - allocate(dxy(ntarget,nvar_dirOL),stat=alloc_error) - call OLdir(terr,ntarget,ncube,n,jall,nlon,nlat,maxval(indexb),nvar_dirOL,weights_lgr_index_all,weights_eul_index_all(:,1),weights_eul_index_all(:,2),weights_eul_index_all(:,3),weights_all,landfrac_target,target_center_lon,target_center_lat,target_corner_lon_deg,target_corner_lat_deg,lon_terr,lat_terr,sgh_target,area_target,ol_target,terrout,dxy) -!par - - WRITE(*,*) "min/max of sgh_target : ",MINVAL(sgh_target),MAXVAL(sgh_target) - WRITE(*,*) "min/max of sgh30_target : ",MINVAL(sgh30_target),MAXVAL(sgh30_target) - - DEALLOCATE(terr,weights_all,weights_eul_index_all,landfrac,landm_coslat) - - - - IF (ltarget_latlon) THEN -!#if 0 -! CALL wrtncdf_rll(nlon,nlat,lpole,ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& -! landm_coslat_target,target_center_lon,target_center_lat,.true.) -!#endif -print*,"output rll" - CALL wrtncdf_rll(nlon,nlat,nvar_dirOA,nvar_dirOL,maxval(indexb),lpole,ntarget,terr_target,landfrac_target,sgh_target,sgh30_target, oc_target,oa_target,ol_target,terrout,dxy,& - landm_coslat_target,target_center_lon,target_center_lat,.false.,output_topography_file) - - ELSE -!#if 0 -! CALL wrtncdf_unstructured(ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,& -! landm_coslat_target,target_center_lon,target_center_lat) -!#endif - print*,"output unstructure" - CALL wrtncdf_unstructured(nvar_dirOA,nvar_dirOL,maxval(indexb),ntarget,terr_target,landfrac_target,sgh_target,sgh30_target,oc_target,oa_target,ol_target,terrout,dxy,landm_coslat_target,target_center_lon,target_center_lat,output_topography_file) - END IF - - DEALLOCATE(terr_target,landfrac_target,sgh30_target,sgh_target,landm_coslat_target) -DEALLOCATE(oc_target) - -end program convterr - -! -! -! -!#if 0 -!subroutine wrtncdf_unstructured(n,terr,landfrac,sgh,sgh30,landm_coslat,lon,lat) -!#endif -subroutine wrtncdf_unstructured(nvar_dirOA,nvar_dirOL,indexb,n,terr,landfrac,sgh,sgh30,oc_in,oa_in,ol_in,terrout,dxy_in,landm_coslat,lon,lat,output) - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: n - real(r8),dimension(n) , intent(in) :: terr, landfrac,sgh,sgh30,lon, lat, landm_coslat - ! - ! Local variables - ! - character (len=512) :: fout ! NetCDF output file - - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: terrid,nid - integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid - integer :: status ! return value for error control of netcdf routin - integer :: i,j - integer, dimension(2) :: nc_lat_vid,nc_lon_vid - character (len=8) :: datestring - integer :: nc_gridcorn_id, lat_vid, lon_vid - - real(r8), parameter :: fillvalue = 1.d36 - integer, intent(in) :: nvar_dirOA,nvar_dirOL,indexb - character(len=512) :: output - integer :: ocid,varid,var2id,indexbid,terroutid(4) - integer :: oaid,olid,dxyid - integer :: oa1id,oa2id,oa3id,oa4id - integer :: ol1id,ol2id,ol3id,ol4id - integer, dimension(2) :: ocdim - integer, dimension(3) :: oadim,oldim,terroutdim - real(r8),dimension(n) , intent(in) :: oc_in - real(r8),dimension(n,nvar_dirOA) , intent(in) :: oa_in - real(r8),dimension(n,nvar_dirOL) , intent(in) :: ol_in - real(r8),dimension(4,n,indexb),intent(in) :: terrout - real(r8),dimension(n,nvar_dirOL),intent(in) :: dxy_in - character*20,dimension(4) :: terroutchar - real(r8),dimension(n) :: oc - real(r8),dimension(n,nvar_dirOA) :: oa - real(r8),dimension(n,nvar_dirOL) :: ol - real(r8),dimension(n,nvar_dirOL) :: dxy - character*20 :: numb - write(numb,"(i0.1)") nvar_dirOL - print*,"dir number", nvar_dirOL - !fout='final-'//adjustl(trim(numb))//'.nc' - fout=output - oc=oc_in - oa=oa_in - ol=ol_in - dxy=dxy_in - ! - ! Create NetCDF file for output - ! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create dimensions for output - ! - status = nf_def_dim (foutid, 'ncol', n, nid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'nvar_dirOA', nvar_dirOA, varid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'nvar_dirOL', nvar_dirOL, var2id) - if (status .ne. NF_NOERR) call handle_err(status) - !status = nf_def_dim (foutid, 'indexb',23, indexbid) - status = nf_def_dim (foutid, 'indexb', indexb, indexbid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create variable for output - ! - print *,"Create variable for output" - status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 1, nid, terrid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 1, nid, landfracid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'SGH', NF_DOUBLE, 1, nid, sghid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 1, nid, sgh30id) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 1, nid, landm_coslatid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, nid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, nid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_var (foutid,'OC', NF_DOUBLE, 1, nid, ocid) - oadim(1)=nid - oadim(2)=varid - status = nf_def_var (foutid,'OA', NF_DOUBLE, 2, oadim, oaid) - oldim(1)=nid - oldim(2)=var2id - status = nf_def_var (foutid,'OL', NF_DOUBLE, 2, oldim, olid) -!#if 0 -! terroutdim(1)=nid -! terroutdim(2)=indexbid -! !name -! terroutchar(1)="terr" -! terroutchar(2)="terrx" -! terroutchar(3)="terry" -! terroutchar(4)="wt" -! do i=1,4 -! status = nf_def_var (foutid, terroutchar(i), NF_DOUBLE, 2, & -! terroutdim, terroutid(i)) -! enddo -! !dxy -! status = nf_def_var (foutid,'dxy', NF_DOUBLE, 2, oldim, dxyid) -!#endif - ! - ! Create attributes for output variables - ! - status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') - status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') - status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) - ! status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from USGS 30-sec data') - - status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & - 'standard deviation of 3km cubed-sphere elevation and target grid elevation') - status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') - ! status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & - 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') - status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') - ! status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') - status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') - ! status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') - - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 50, 'USGS 30-sec dataset binned to ncube3000 (cube-sphere) grid') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,oaid,'note', 40, '(2)+1 in nvar_dirOA to avoid bug in io') -!#if 0 -! do i=1,4 -! status = nf_put_att_double (foutid, terroutid(i),& -! 'missing_value', nf_double, 1,fillvalue) -! status = nf_put_att_double (foutid, terroutid(i),& -! '_FillValue' , nf_double, 1,fillvalue) -! enddo -!#endif - ! - ! End define mode for output file - ! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Write variable for output - ! - print*,"writing oc data",MINVAL(oc),MAXVAL(oc) - status = nf_put_var_double (foutid, ocid, oc) - if (status .ne. NF_NOERR) call handle_err(status) - !oa,ol - print*,"writing oa data",MINVAL(oa),MAXVAL(oa) - status = nf_put_var_double (foutid, oaid, oa) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"writing ol data",MINVAL(ol),MAXVAL(ol) - status = nf_put_var_double (foutid, olid, ol) - if (status .ne. NF_NOERR) call handle_err(status) -!#if 0 -! do i=1,4 -! status = nf_put_att_double (foutid, terroutid(i),& -! 'missing_value', nf_double, 1,fillvalue) -! status = nf_put_att_double (foutid, terroutid(i),& -! '_FillValue' , nf_double, 1,fillvalue) -! print*,"writing"//terroutchar(i)//" data",& -! MINVAL(terrout(i,:,:)),MAXVAL(terrout(i,:,:)) -! status = nf_put_var_double (foutid, terroutid(i), terrout(i,:,:)) -! if (status .ne. NF_NOERR) call handle_err(status) -! enddo -!#endif -!#if 0 -! print*,"writing dxy data",MINVAL(dxy),MAXVAL(dxy) -! status = nf_put_var_double (foutid, dxyid, dxy) -! if (status .ne. NF_NOERR) call handle_err(status) -!#endif - print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) - status = nf_put_var_double (foutid, terrid, terr*9.80616) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" - - print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) - status = nf_put_var_double (foutid, landfracid, landfrac) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing landfrac data" - - print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) - status = nf_put_var_double (foutid, sghid, sgh) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh data" - - print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) - status = nf_put_var_double (foutid, sgh30id, sgh30) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - - print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) - status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - ! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, lat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lon) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" - ! - ! Close output file - ! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -end subroutine wrtncdf_unstructured -! -!************************************************************** -! -! if target grid is lat-lon output structured -! -!************************************************************** -! - -!#if 0 -!subroutine wrtncdf_rll(nlon,nlat,lpole,n,terr_in,landfrac_in,sgh_in,sgh30_in,landm_coslat_in,lon,lat,lprepare_fv_smoothing_routine) -!#endif -subroutine wrtncdf_rll(nlon,nlat,nvar_dirOA,nvar_dirOL,indexb,lpole,n,terr_in,landfrac_in,sgh_in,sgh30_in,oc_in,oa_in,ol_in,terrout,dxy_in,landm_coslat_in,lon,lat,lprepare_fv_smoothing_routine,output) - - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - -# include - - ! - ! Dummy arguments - ! - integer, intent(in) :: n,nlon,nlat,nvar_dirOA,nvar_dirOL,indexb - ! - ! lprepare_fv_smoothing_routine is to make a NetCDF file that can be used with the CAM-FV smoothing software - ! - logical , intent(in) :: lpole,lprepare_fv_smoothing_routine - real(r8),dimension(n) , intent(in) :: terr_in, landfrac_in,sgh_in,sgh30_in,lon, lat, landm_coslat_in - real(r8),dimension(n) , intent(in) :: oc_in - real(r8),dimension(n,nvar_dirOA) , intent(in) :: oa_in - real(r8),dimension(n,nvar_dirOL) , intent(in) :: ol_in - real(r8),dimension(4,n,indexb),intent(in) :: terrout - real(r8),dimension(n,nvar_dirOL),intent(in) :: dxy_in - character*20,dimension(4) :: terroutchar - character(len=512),intent(in) :: output - ! - ! Local variables - ! - character (len=512):: fout ! NetCDF output file - integer :: foutid ! Output file id - integer :: lonid, lonvid - integer :: latid, latvid - integer :: terrid,nid - integer :: ocid,varid,var2id,indexbid,terroutid(4) - integer :: oaid,olid,dxyid - integer :: oa1id,oa2id,oa3id,oa4id - integer :: ol1id,ol2id,ol3id,ol4id - integer :: terrdim,landfracid,sghid,sgh30id,landm_coslatid - integer :: status ! return value for error control of netcdf routin - integer :: i,j - integer, dimension(2) :: nc_lat_vid,nc_lon_vid - character (len=8) :: datestring - integer :: nc_gridcorn_id, lat_vid, lon_vid - real(r8), parameter :: fillvalue = 1.d36 - real(r8) :: ave - - real(r8),dimension(nlon) :: lonar ! longitude array - real(r8),dimension(nlat) :: latar ! latitude array - - integer, dimension(2) :: htopodim,landfdim,sghdim,sgh30dim,landmcoslatdim -integer, dimension(2) :: ocdim -integer, dimension(3) :: oadim,oldim,terroutdim - real(r8),dimension(n) :: terr, landfrac,sgh,sgh30,landm_coslat - real(r8),dimension(n) :: oc - real(r8),dimension(n,nvar_dirOA) :: oa - real(r8),dimension(n,nvar_dirOL) :: ol - real(r8),dimension(n,nvar_dirOL) :: dxy - character*20 :: numb -!print*,"nlon nlat n",nlon, nlat, n - IF (nlon*nlat.NE.n) THEN - WRITE(*,*) "inconsistent input for wrtncdf_rll" - STOP - END IF - ! - ! we assume that the unstructured layout of the lat-lon grid is ordered in latitude rows, that is, - ! unstructured index n is given by - ! - ! n = (j-1)*nlon+i - ! - ! where j is latitude index and i longitude index - ! - do i = 1,nlon - lonar(i)= lon(i) - enddo - do j = 1,nlat - latar(j)= lat((j-1)*nlon+1) - enddo - - terr = terr_in - sgh=sgh_in - sgh30 =sgh30_in - landfrac = landfrac_in - landm_coslat = landm_coslat_in - oc=oc_in - oa=oa_in - ol=ol_in - dxy=dxy_in - - if (lpole) then - write(*,*) "average pole control volume" - ! - ! North pole - terr - ! - ave = 0.0 - do i=1,nlon - ave = ave + terr_in(i) - end do - terr(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + terr_in(i) - end do - terr(n-(nlon+1):n) = ave/DBLE(nlon) - !oc - ! North pole - terr - ave = 0.0 - do i=1,nlon - ave = ave + oc_in(i) - end do - oc(1:nlon) = ave/DBLE(nlon) - ! South pole - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + oc_in(i) - end do - oc(n-(nlon+1):n) = ave/DBLE(nlon) - !oa - ! North pole - terr -do j =1,nvar_dirOA - ave = 0.0 - do i=1,nlon - ave = ave + oa_in(i,j) - end do - oa(1:nlon,j) = ave/DBLE(nlon) - ! South pole - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + oa_in(i,j) - end do - oa(n-(nlon+1):n,j) = ave/DBLE(nlon) -enddo - !ol -!#if 0 -! North pole - terr -do j =1,nvar_dirOL - ave = 0.0 - do i=1,nlon - ave = ave + ol_in(i,j) - end do - ol(1:nlon,j) = ave/DBLE(nlon) - ! South pole - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + ol_in(j,i) - end do - ol(n-(nlon+1):n,j) = ave/DBLE(nlon) -enddo -!#endif - - ! - ! North pole - sgh - ! - ave = 0.0 - do i=1,nlon - ave = ave + sgh_in(i) - end do - sgh(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + sgh_in(i) - end do - sgh(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - sgh30 - ! - ave = 0.0 - do i=1,nlon - ave = ave + sgh30_in(i) - end do - sgh30(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + sgh30_in(i) - end do - sgh30(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - landfrac - ! - ave = 0.0 - do i=1,nlon - ave = ave + landfrac_in(i) - end do - landfrac(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + landfrac_in(i) - end do - landfrac(n-(nlon+1):n) = ave/DBLE(nlon) - - ! - ! North pole - landm_coslat - ! - ave = 0.0 - do i=1,nlon - ave = ave + landm_coslat_in(i) - end do - landm_coslat(1:nlon) = ave/DBLE(nlon) - ! - ! South pole - ! - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + landm_coslat_in(i) - end do - landm_coslat(n-(nlon+1):n) = ave/DBLE(nlon) - -!dxy - do j=1,4 - ave = 0.0 - do i=n-(nlon+1),n - ave = ave + dxy(j,i) - end do - dxy(j,n-(nlon+1):n) = ave/DBLE(nlon) - enddo -!dxy - end if - ! - write(numb,"(i0.1)") nvar_dirOL - print*,"dir number", nvar_dirOL - - - !fout='final-'//adjustl(trim(numb))//'.nc' - fout=output - ! - ! Create NetCDF file for output - ! - print *,"Create NetCDF file for output" - status = nf_create (fout, NF_64BIT_OFFSET , foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create dimensions for output - ! - print *,"Create dimensions for output" - status = nf_def_dim (foutid, 'lon', nlon, lonid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'lat', nlat, latid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'nvar_dirOA', nvar_dirOA, varid) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'nvar_dirOL', nvar_dirOL, var2id) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_def_dim (foutid, 'indexb', indexb, indexbid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Create variable for output - ! - print *,"Create variable for output" - ocdim(1)=lonid - ocdim(2)=latid - status = nf_def_var (foutid,'OC', NF_DOUBLE, 2, ocdim, ocid) - oadim(1)=lonid - oadim(2)=latid - oadim(3)=varid - status = nf_def_var (foutid,'OA', NF_DOUBLE, 3, oadim, oaid) - oldim(1)=lonid - oldim(2)=latid - oldim(3)=var2id - status = nf_def_var (foutid,'OL', NF_DOUBLE, 3, oldim, olid) - terroutdim(1)=lonid - terroutdim(2)=latid - terroutdim(3)=indexbid - !name - terroutchar(1)="terr" - terroutchar(2)="terrx" - terroutchar(3)="terry" - terroutchar(4)="wt" -!#if 0 - do i=1,4 - status = nf_def_var (foutid, terroutchar(i), NF_DOUBLE, 3, & - terroutdim, terroutid(i)) - enddo -!#endif - !dxy - status = nf_def_var (foutid,'dxy', NF_DOUBLE, 3, oldim, dxyid) -!#endif - -!#if 0 -! status = nf_def_var (foutid,'OL1', NF_DOUBLE, 2, ocdim, ol1id) -! status = nf_def_var (foutid,'OL2', NF_DOUBLE, 2, ocdim, ol2id) -! status = nf_def_var (foutid,'OL3', NF_DOUBLE, 2, ocdim, ol3id) -! status = nf_def_var (foutid,'OL4', NF_DOUBLE, 2, ocdim, ol4id) -! status = nf_def_var (foutid,'OA1', NF_DOUBLE, 2, ocdim, oa1id) -! status = nf_def_var (foutid,'OA2', NF_DOUBLE, 2, ocdim, oa2id) -! status = nf_def_var (foutid,'OA3', NF_DOUBLE, 2, ocdim, oa3id) -! status = nf_def_var (foutid,'OA4', NF_DOUBLE, 2, ocdim, oa4id) -!#endif - - htopodim(1)=lonid - htopodim(2)=latid - - if (lprepare_fv_smoothing_routine) then - status = nf_def_var (foutid,'htopo', NF_DOUBLE, 2, htopodim, terrid) - else - status = nf_def_var (foutid,'PHIS', NF_DOUBLE, 2, htopodim, terrid) - end if - if (status .ne. NF_NOERR) call handle_err(status) - - landfdim(1)=lonid - landfdim(2)=latid - - if (lprepare_fv_smoothing_routine) then - status = nf_def_var (foutid,'ftopo', NF_DOUBLE, 2, landfdim, landfracid) - else - status = nf_def_var (foutid,'LANDFRAC', NF_DOUBLE, 2, landfdim, landfracid) - end if - - if (status .ne. NF_NOERR) call handle_err(status) - - sghdim(1)=lonid - sghdim(2)=latid - - status = nf_def_var (foutid,'SGH', NF_DOUBLE, 2, sghdim, sghid) - if (status .ne. NF_NOERR) call handle_err(status) - - sgh30dim(1)=lonid - sgh30dim(2)=latid - - status = nf_def_var (foutid,'SGH30', NF_DOUBLE, 2, sgh30dim, sgh30id) - if (status .ne. NF_NOERR) call handle_err(status) - - landmcoslatdim(1)=lonid - landmcoslatdim(2)=latid - - status = nf_def_var (foutid,'LANDM_COSLAT', NF_DOUBLE, 2, landmcoslatdim, landm_coslatid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lat', NF_DOUBLE, 1, latid, latvid) - if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_def_var (foutid,'lon', NF_DOUBLE, 1, lonid, lonvid) - if (status .ne. NF_NOERR) call handle_err(status) - - ! - ! Create attributes for output variables - ! - status = nf_put_att_text (foutid,terrid,'long_name', 21, 'surface geopotential') - status = nf_put_att_text (foutid,terrid,'units', 5, 'm2/s2') - status = nf_put_att_text (foutid,terrid,'filter', 35, 'area averaged from ncube3000 data') - status = nf_put_att_double (foutid, terrid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, terrid, '_FillValue' , nf_double, 1, fillvalue) - - - status = nf_put_att_double (foutid, sghid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sghid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sghid, 'long_name' , 48, & - 'standard deviation of 3km cubed-sphere elevation and target grid elevation') - status = nf_put_att_text (foutid, sghid, 'units' , 1, 'm') - status = nf_put_att_text (foutid, sghid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, sgh30id, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, sgh30id, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, sgh30id, 'long_name' , 49, & - 'standard deviation of 30s elevation from 3km cubed-sphere cell average height') - status = nf_put_att_text (foutid, sgh30id, 'units' , 1, 'm') - status = nf_put_att_text (foutid, sgh30id, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landm_coslatid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landm_coslatid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landm_coslatid, 'long_name' , 23, 'smoothed land fraction') - status = nf_put_att_text (foutid, landm_coslatid, 'filter' , 4, 'none') - - status = nf_put_att_double (foutid, landfracid, 'missing_value', nf_double, 1, fillvalue) - status = nf_put_att_double (foutid, landfracid, '_FillValue' , nf_double, 1, fillvalue) - status = nf_put_att_text (foutid, landfracid, 'long_name', 21, 'gridbox land fraction') - status = nf_put_att_text (foutid, landfracid, 'filter', 40, 'area averaged from 30-sec USGS raw data') - - - status = nf_put_att_text (foutid,latvid,'long_name', 8, 'latitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,latvid,'units', 13, 'degrees_north') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,latvid,'units', 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,lonvid,'long_name', 9, 'longitude') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,lonvid,'units', 12, 'degrees_east') - if (status .ne. NF_NOERR) call handle_err(status) - ! status = nf_put_att_text (foutid,lonvid,'units' , 21, 'cell center locations') - ! if (status .ne. NF_NOERR) call handle_err(status) - - status = nf_put_att_text (foutid,NF_GLOBAL,'source', 27, 'USGS 30-sec dataset GTOPO30') - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,NF_GLOBAL,'title', 24, '30-second USGS topo data') - if (status .ne. NF_NOERR) call handle_err(status) - call DATE_AND_TIME(DATE=datestring) - status = nf_put_att_text (foutid,NF_GLOBAL,'history',25, 'Written on date: ' // datestring ) - if (status .ne. NF_NOERR) call handle_err(status) - status = nf_put_att_text (foutid,oaid,'note', 40, '(2)+1 in nvar_dirOA to avoid bug in io') - do i=1,4 - status = nf_put_att_double (foutid, terroutid(i),& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, terroutid(i),& - '_FillValue' , nf_double, 1,fillvalue) - enddo - - status = nf_put_att_double (foutid, oa1id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, oa1id,& - '_FillValue' , nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, oa2id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, oa2id,& - '_FillValue' , nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, oa3id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, oa3id,& - '_FillValue' , nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, oa4id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, oa4id,& - '_FillValue' , nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol1id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol1id,& - '_FillValue' , nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol2id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol2id,& - '_FillValue' , nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol3id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol3id,& - '_FillValue' , nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol4id,& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, ol4id,& - '_FillValue' , nf_double, 1,fillvalue) - ! - ! End define mode for output file - ! - status = nf_enddef (foutid) - if (status .ne. NF_NOERR) call handle_err(status) - ! - ! Write variable for output -print*,"writing oc data",MINVAL(oc),MAXVAL(oc) -status = nf_put_var_double (foutid, ocid, oc) -if (status .ne. NF_NOERR) call handle_err(status) -!oa,ol -print*,"writing oa data",MINVAL(oa),MAXVAL(oa) -status = nf_put_var_double (foutid, oaid, oa) -if (status .ne. NF_NOERR) call handle_err(status) -print*,"writing ol data",MINVAL(ol),MAXVAL(ol) -status = nf_put_var_double (foutid, olid, ol) - -!============ -#if 0 -print*,"writing oa1 data",MINVAL(oa),MAXVAL(oa) -status = nf_put_var_double (foutid, oa1id, oa(:,1)) -if (status .ne. NF_NOERR) call handle_err(status) -print*,"writing ol1 data",MINVAL(ol),MAXVAL(ol) -status = nf_put_var_double (foutid, ol1id, ol(:,1)) -print*,"writing oa2 data",MINVAL(oa),MAXVAL(oa) -status = nf_put_var_double (foutid, oa2id, oa(:,2)) -if (status .ne. NF_NOERR) call handle_err(status) -print*,"writing ol2 data",MINVAL(ol),MAXVAL(ol) -status = nf_put_var_double (foutid, ol2id, ol(:,2)) -print*,"writing oa3 data",MINVAL(oa),MAXVAL(oa) -status = nf_put_var_double (foutid, oa3id, oa(:,3)) -if (status .ne. NF_NOERR) call handle_err(status) -print*,"writing ol3 data",MINVAL(ol),MAXVAL(ol) -status = nf_put_var_double (foutid, ol3id, ol(:,3)) -print*,"writing oa4 data",MINVAL(oa),MAXVAL(oa) -status = nf_put_var_double (foutid, oa4id, oa(:,4)) -if (status .ne. NF_NOERR) call handle_err(status) -print*,"writing ol4 data",MINVAL(ol),MAXVAL(ol) -status = nf_put_var_double (foutid, ol4id, ol(:,4)) -#endif -!=========== - - -if (status .ne. NF_NOERR) call handle_err(status) -!#if 0 - do i=1,4 - status = nf_put_att_double (foutid, terroutid(i),& - 'missing_value', nf_double, 1,fillvalue) - status = nf_put_att_double (foutid, terroutid(i),& - '_FillValue' , nf_double, 1,fillvalue) - print*,"writing"//terroutchar(i)//" data",& - MINVAL(terrout(i,:,:)),MAXVAL(terrout(i,:,:)) - status = nf_put_var_double (foutid, terroutid(i), terrout(i,:,:)) - if (status .ne. NF_NOERR) call handle_err(status) - enddo -!#endif - -!#if 0 - print*,"writing dxy data",MINVAL(dxy),MAXVAL(dxy) - status = nf_put_var_double (foutid, dxyid, dxy) - if (status .ne. NF_NOERR) call handle_err(status) -!#endif - ! - print*,"writing terrain data",MINVAL(terr),MAXVAL(terr) - if (lprepare_fv_smoothing_routine) then - status = nf_put_var_double (foutid, terrid, terr) - else - status = nf_put_var_double (foutid, terrid, terr*9.80616) - end if - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing terrain data" - - print*,"writing landfrac data",MINVAL(landfrac),MAXVAL(landfrac) - status = nf_put_var_double (foutid, landfracid, landfrac) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing landfrac data" - - print*,"writing sgh data",MINVAL(sgh),MAXVAL(sgh) - status = nf_put_var_double (foutid, sghid, sgh) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh data" - - print*,"writing sgh30 data",MINVAL(sgh30),MAXVAL(sgh30) - status = nf_put_var_double (foutid, sgh30id, sgh30) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - - print*,"writing landm_coslat data",MINVAL(landm_coslat),MAXVAL(landm_coslat) - status = nf_put_var_double (foutid, landm_coslatid, landm_coslat) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing sgh30 data" - ! - print*,"writing lat data" - status = nf_put_var_double (foutid, latvid, latar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lat data" - - print*,"writing lon data" - status = nf_put_var_double (foutid, lonvid, lonar) - if (status .ne. NF_NOERR) call handle_err(status) - print*,"done writing lon data" - ! - ! Close output file - ! - print *,"close file" - status = nf_close (foutid) - if (status .ne. NF_NOERR) call handle_err(status) -end subroutine wrtncdf_rll -!************************************************************************ -!!handle_err -!************************************************************************ -! -!!ROUTINE: handle_err -!!DESCRIPTION: error handler -!-------------------------------------------------------------------------- - -subroutine handle_err(status) - - implicit none - -# include - - integer status - - if (status .ne. nf_noerr) then - print *, nf_strerror(status) - stop 'Stopped' - endif - -end subroutine handle_err - - -SUBROUTINE coarsen(f,fcoarse,nf,n,dA_coarse) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (R8), DIMENSION(n) , INTENT(IN) :: f - REAL (R8), DIMENSION(n/nf), INTENT(OUT) :: fcoarse - INTEGER, INTENT(in) :: n,nf - REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf),INTENT(OUT) :: dA_coarse - !must be an even number - ! - ! local workspace - ! - ! ncube = INT(SQRT(DBLE(n/6))) - - REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6))),INT(SQRT(DBLE(n/6)))):: dA - REAL (R8) :: sum, sum_area,tmp - INTEGER :: jx,jy,jp,ii,ii_coarse,coarse_ncube,ncube - INTEGER :: jx_coarse,jy_coarse,jx_s,jy_s - - - ! REAL(R8), DIMENSION(INT(SQRT(DBLE(n/6)))/nf,INT(SQRT(DBLE(n/6)))/nf) :: dAtmp - - ncube = INT(SQRT(DBLE(n/6))) - coarse_ncube = ncube/nf - - IF (ABS(DBLE(ncube)/DBLE(nf)-coarse_ncube)>0.000001) THEN - WRITE(*,*) "ncube/nf must be an integer" - WRITE(*,*) "ncube and nf: ",ncube,nf - STOP - END IF - - da_coarse = 0.0 - - WRITE(*,*) "compute all areas" - CALL EquiangularAllAreas(ncube, dA) - ! CALL EquiangularAllAreas(coarse_ncube, dAtmp)!dbg - tmp = 0.0 - DO jp=1,6 - DO jy_coarse=1,coarse_ncube - DO jx_coarse=1,coarse_ncube - ! - ! inner loop - ! - sum = 0.0 - sum_area = 0.0 - DO jy_s=1,nf - jy = (jy_coarse-1)*nf+jy_s - DO jx_s=1,nf - jx = (jx_coarse-1)*nf+jx_s - ii = (jp-1)*ncube*ncube+(jy-1)*ncube+jx - sum = sum +f(ii)*dA(jx,jy) - sum_area = sum_area+dA(jx,jy) - ! WRITE(*,*) "jx,jy",jx,jy - END DO - END DO - tmp = tmp+sum_area - da_coarse(jx_coarse,jy_coarse) = sum_area - ! WRITE(*,*) "jx_coarse,jy_coarse",jx_coarse,jy_coarse,& - ! da_coarse(jx_coarse,jy_coarse)-datmp(jx_coarse,jy_coarse) - ii_coarse = (jp-1)*coarse_ncube*coarse_ncube+(jy_coarse-1)*coarse_ncube+jx_coarse - fcoarse(ii_coarse) = sum/sum_area - END DO - END DO - END DO - WRITE(*,*) "coarsened surface area",tmp-4.0*3.141592654 -END SUBROUTINE COARSEN - -SUBROUTINE overlap_weights(weights_lgr_index_all,weights_eul_index_all,weights_all,& - jall,ncube,ngauss,ntarget,ncorner,jmax_segments,target_corner_lon,target_corner_lat,nreconstruction) - use shr_kind_mod, only: r8 => shr_kind_r8 - use remap - IMPLICIT NONE - - - INTEGER, INTENT(INOUT) :: jall !anticipated number of weights - INTEGER, INTENT(IN) :: ncube, ngauss, ntarget, jmax_segments, ncorner, nreconstruction - - INTEGER, DIMENSION(jall,3), INTENT(OUT) :: weights_eul_index_all - REAL(R8), DIMENSION(jall,nreconstruction) , INTENT(OUT) :: weights_all - INTEGER, DIMENSION(jall) , INTENT(OUT) :: weights_lgr_index_all - - REAL(R8), DIMENSION(ncorner,ntarget), INTENT(IN) :: target_corner_lon, target_corner_lat - - INTEGER, DIMENSION(ncorner+1) :: ipanel_array, ipanel_tmp - REAL(R8), DIMENSION(ncorner) :: lat, lon - REAL(R8), DIMENSION(0:ncube+2):: xgno, ygno - REAL(R8), DIMENSION(0:ncorner+1) :: xcell, ycell - - REAL(R8), DIMENSION(ngauss) :: gauss_weights, abscissae - - REAL(R8) :: da, tmp, alpha, beta - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: pih = 0.50*pi - INTEGER :: i, j,ncorner_this_cell,k,ip,ipanel,ii,jx,jy,jcollect - integer :: alloc_error - - REAL (r8), PARAMETER :: rad2deg = 180.0/pi - - real(r8), allocatable, dimension(:,:) :: weights - integer , allocatable, dimension(:,:) :: weights_eul_index - - - LOGICAL:: ldbg = .FAlSE. - - INTEGER :: jall_anticipated - - jall_anticipated = jall - - ipanel_array = -99 - ! - da = pih/DBLE(ncube) - xgno(0) = -bignum - DO i=1,ncube+1 - xgno(i) = TAN(-piq+(i-1)*da) - END DO - xgno(ncube+2) = bignum - ygno = xgno - - CALL glwp(ngauss,gauss_weights,abscissae) - - - allocate (weights(jmax_segments,nreconstruction),stat=alloc_error ) - allocate (weights_eul_index(jmax_segments,2),stat=alloc_error ) - - tmp = 0.0 - jall = 1 - DO i=1,ntarget - WRITE(*,*) "cell",i," ",100.0*DBLE(i)/DBLE(ntarget),"% done" - ! - !--------------------------------------------------- - ! - ! determine how many vertices the cell has - ! - !--------------------------------------------------- - ! - CALL remove_duplicates_latlon(ncorner,target_corner_lon(:,i),target_corner_lat(:,i),& - ncorner_this_cell,lon,lat,1.0E-10,ldbg) - - IF (ldbg) THEN - WRITE(*,*) "number of vertices ",ncorner_this_cell - WRITE(*,*) "vertices locations lon,",lon(1:ncorner_this_cell)*rad2deg - WRITE(*,*) "vertices locations lat,",lat(1:ncorner_this_cell)*rad2deg - DO j=1,ncorner_this_cell - WRITE(*,*) lon(j)*rad2deg, lat(j)*rad2deg - END DO - WRITE(*,*) " " - END IF - ! - !--------------------------------------------------- - ! - ! determine how many and which panels the cell spans - ! - !--------------------------------------------------- - ! - DO j=1,ncorner_this_cell - CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ipanel_tmp(j), .TRUE.) - IF (ldbg) WRITE(*,*) "ipanel for corner ",j," is ",ipanel_tmp(j) - END DO - ipanel_tmp(ncorner_this_cell+1) = ipanel_tmp(1) - ! make sure to include possible overlap areas not on the face the vertices are located - IF (MINVAL(lat(1:ncorner_this_cell))<-pi/6.0) THEN - ! include South-pole panel in search - ipanel_tmp(ncorner_this_cell+1) = 5 - IF (ldbg) WRITE(*,*) "add panel 5 to search" - END IF - IF (MAXVAL(lat(1:ncorner_this_cell))>pi/6.0) THEN - ! include North-pole panel in search - ipanel_tmp(ncorner_this_cell+1) = 6 - IF (ldbg) WRITE(*,*) "add panel 6 to search" - END IF - ! - ! remove duplicates in ipanel_tmp - ! - CALL remove_duplicates_integer(ncorner_this_cell+1,ipanel_tmp(1:ncorner_this_cell+1),& - k,ipanel_array(1:ncorner_this_cell+1)) - ! - !--------------------------------------------------- - ! - ! loop over panels with possible overlap areas - ! - !--------------------------------------------------- - ! - DO ip = 1,k - ipanel = ipanel_array(ip) - DO j=1,ncorner_this_cell - ii = ipanel - CALL CubedSphereABPFromRLL(lon(j), lat(j), alpha, beta, ii,.FALSE.) - IF (j==1) THEN - jx = CEILING((alpha + piq) / da) - jy = CEILING((beta + piq) / da) - END IF - xcell(ncorner_this_cell+1-j) = TAN(alpha) - ycell(ncorner_this_cell+1-j) = TAN(beta) - END DO - xcell(0) = xcell(ncorner_this_cell) - ycell(0) = ycell(ncorner_this_cell) - xcell(ncorner_this_cell+1) = xcell(1) - ycell(ncorner_this_cell+1) = ycell(1) - - jx = MAX(MIN(jx,ncube+1),0) - jy = MAX(MIN(jy,ncube+1),0) - - CALL compute_weights_cell(xcell(0:ncorner_this_cell+1),ycell(0:ncorner_this_cell+1),& - jx,jy,nreconstruction,xgno,ygno,& - 1, ncube+1, 1,ncube+1, tmp,& - ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& - ncube,0,ncorner_this_cell,ldbg) - - weights_all(jall:jall+jcollect-1,1:nreconstruction) = weights(1:jcollect,1:nreconstruction) - - weights_eul_index_all(jall:jall+jcollect-1,1:2) = weights_eul_index(1:jcollect,:) - weights_eul_index_all(jall:jall+jcollect-1, 3) = ipanel - weights_lgr_index_all(jall:jall+jcollect-1 ) = i - - jall = jall+jcollect - IF (jall>jall_anticipated) THEN - WRITE(*,*) "more weights than anticipated" - WRITE(*,*) "increase jall" - STOP - END IF - IF (ldbg) WRITE(*,*) "jcollect",jcollect - END DO - END DO - jall = jall-1 - WRITE(*,*) "sum of all weights divided by surface area of sphere =",tmp/(4.0*pi) - WRITE(*,*) "actual number of weights",jall - WRITE(*,*) "anticipated number of weights",jall_anticipated - IF (jall>jall_anticipated) THEN - WRITE(*,*) "anticipated number of weights < actual number of weights" - WRITE(*,*) "increase jall!" - STOP - END IF - WRITE(*,*) MINVAL(weights_all(1:jall,1)),MAXVAL(weights_all(1:jall,1)) - IF (ABS(tmp/(4.0*pi))-1.0>0.001) THEN - WRITE(*,*) "sum of all weights does not match the surface area of the sphere" - WRITE(*,*) "sum of all weights is : ",tmp - WRITE(*,*) "surface area of sphere: ",4.0*pi - STOP - END IF -END SUBROUTINE overlap_weights - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromRLL -! -! Description: -! Determine the (alpha,beta,panel) coordinate of a point on the sphere from -! a given regular lat lon coordinate. -! -! Parameters: -! lon - Coordinate longitude -! lat - Coordinate latitude -! alpha (OUT) - Alpha coordinate -! beta (OUT) - Beta coordinate -! ipanel (OUT) - Face panel -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel, ldetermine_panel) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (R8), INTENT(IN) :: lon, lat - REAL (R8), INTENT(OUT) :: alpha, beta - INTEGER :: ipanel - LOGICAL, INTENT(IN) :: ldetermine_panel - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rotate_cube = 0.0 - - ! Local variables - REAL (R8) :: xx, yy, zz, pm - REAL (R8) :: sx, sy, sz - INTEGER :: ix, iy, iz - - ! Translate to (x,y,z) space - xx = COS(lon-rotate_cube) * COS(lat) - yy = SIN(lon-rotate_cube) * COS(lat) - zz = SIN(lat) - - pm = MAX(ABS(xx), ABS(yy), ABS(zz)) - - ! Check maximality of the x coordinate - IF (pm == ABS(xx)) THEN - IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF - ELSE - ix = 0 - ENDIF - - ! Check maximality of the y coordinate - IF (pm == ABS(yy)) THEN - IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF - ELSE - iy = 0 - ENDIF - - ! Check maximality of the z coordinate - IF (pm == ABS(zz)) THEN - IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF - ELSE - iz = 0 - ENDIF - - ! Panel assignments - IF (ldetermine_panel) THEN - IF (iz == 1) THEN - ipanel = 6; sx = yy; sy = -xx; sz = zz - - ELSEIF (iz == -1) THEN - ipanel = 5; sx = yy; sy = xx; sz = -zz - - ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN - ipanel = 1; sx = yy; sy = zz; sz = xx - - ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN - ipanel = 3; sx = -yy; sy = zz; sz = -xx - - ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN - ipanel = 2; sx = -xx; sy = zz; sz = yy - - ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN - ipanel = 4; sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' - WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' - WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' - STOP - ENDIF - ELSE - IF (ipanel == 6) THEN - sx = yy; sy = -xx; sz = zz - ELSEIF (ipanel == 5) THEN - sx = yy; sy = xx; sz = -zz - ELSEIF (ipanel == 1) THEN - sx = yy; sy = zz; sz = xx - ELSEIF (ipanel == 3) THEN - sx = -yy; sy = zz; sz = -xx - ELSEIF (ipanel == 2) THEN - sx = -xx; sy = zz; sz = yy - ELSEIF (ipanel == 4) THEN - sx = xx; sy = zz; sz = -yy - ELSE - WRITE(*,*) "ipanel out of range",ipanel - STOP - END IF - END IF - - ! Use panel information to calculate (alpha, beta) coords - alpha = ATAN(sx / sz) - beta = ATAN(sy / sz) - -END SUBROUTINE CubedSphereABPFromRLL - -!------------------------------------------------------------------------------ -! SUBROUTINE EquiangularAllAreas -! -! Description: -! Compute the area of all cubed sphere grid cells, storing the results in -! a two dimensional array. -! -! Parameters: -! icube - Resolution of the cubed sphere -! dA (OUT) - Output array containing the area of all cubed sphere grid cells -!------------------------------------------------------------------------------ -SUBROUTINE EquiangularAllAreas(icube, dA) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - INTEGER, INTENT(IN) :: icube - REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA - - ! Local variables - INTEGER :: k, k1, k2 - REAL (r8) :: a1, a2, a3, a4 - REAL (r8), DIMENSION(icube+1,icube+1) :: ang - REAL (r8), DIMENSION(icube+1) :: gp - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - - !#ifdef DBG - REAL (r8) :: dbg1 !DBG - !#endif - - ! Recall that we are using equi-angular spherical gridding - ! Compute the angle between equiangular cubed sphere projection grid lines. - DO k = 1, icube+1 - gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) - ENDDO - - DO k2=1,icube+1 - DO k1=1,icube+1 - ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) - ENDDO - ENDDO - - DO k2=1,icube - DO k1=1,icube - a1 = ang(k1 , k2 ) - a2 = pi - ang(k1+1, k2 ) - a3 = pi - ang(k1 , k2+1) - a4 = ang(k1+1, k2+1) - ! area = r*r*(-2*pi+sum(interior angles)) - DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 - ENDDO - ENDDO - - !#ifdef DBG - ! Only for debugging - test consistency - dbg1 = 0.0 !DBG - DO k2=1,icube - DO k1=1,icube - dbg1 = dbg1 + DA(k1,k2) !DBG - ENDDO - ENDDO - write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG - !#endif -END SUBROUTINE EquiangularAllAreas - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereRLLFromABP -! -! Description: -! Determine the lat lon coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! lon (OUT) - Calculated longitude -! lat (OUT) - Calculated latitude -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: lon, lat - ! Local variables - REAL (r8) :: xx, yy, zz, rotate_cube - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - rotate_cube = 0.0 - ! Convert to cartesian coordinates - CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - ! Convert back to lat lon - lat = ASIN(zz) - if (xx==0.0.and.yy==0.0) THEN - lon = 0.0 - else - lon = ATAN2(yy, xx) +rotate_cube - IF (lon<0.0) lon=lon+2.0*pi - IF (lon>2.0*pi) lon=lon-2.0*pi - end if -END SUBROUTINE CubedSphereRLLFromABP - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereXYZFromABP -! -! Description: -! Determine the Cartesian coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! xx (OUT) - Calculated x coordinate -! yy (OUT) - Calculated y coordinate -! zz (OUT) - Calculated z coordinate -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: xx, yy, zz - ! Local variables - REAL (r8) :: a1, b1, pm - REAL (r8) :: sx, sy, sz - - ! Convert to Cartesian coordinates - a1 = TAN(alpha) - b1 = TAN(beta) - - sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - ! Panel assignments - IF (ipanel == 6) THEN - yy = sx; xx = -sy; zz = sz - ELSEIF (ipanel == 5) THEN - yy = sx; xx = sy; zz = -sz - ELSEIF (ipanel == 1) THEN - yy = sx; zz = sy; xx = sz - ELSEIF (ipanel == 3) THEN - yy = -sx; zz = sy; xx = -sz - ELSEIF (ipanel == 2) THEN - xx = -sx; zz = sy; yy = sz - ELSEIF (ipanel == 4) THEN - xx = sx; zz = sy; yy = -sz - ELSE - WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' - WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' - STOP - ENDIF -END SUBROUTINE CubedSphereXYZFromABP - - -SUBROUTINE remove_duplicates_integer(n_in,f_in,n_out,f_out) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - integer,dimension(n_in), intent(in) :: f_in - integer, intent(out) :: n_out - integer,dimension(n_in), intent(out) :: f_out - ! - ! local work space - ! - integer :: k,i,j - ! - ! remove duplicates in ipanel_tmp - ! - k = 1 - f_out(1) = f_in(1) - outer: do i=2,n_in - do j=1,k - ! if (f_out(j) == f_in(i)) then - if (ABS(f_out(j)-f_in(i))<1.0E-10) then - ! Found a match so start looking again - cycle outer - end if - end do - ! No match found so add it to the output - k = k + 1 - f_out(k) = f_in(i) - end do outer - n_out = k -END SUBROUTINE remove_duplicates_integer - -SUBROUTINE remove_duplicates_latlon(n_in,lon_in,lat_in,n_out,lon_out,lat_out,tiny,ldbg) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - real(r8),dimension(n_in), intent(inout) :: lon_in,lat_in - real, intent(in) :: tiny - integer, intent(out) :: n_out - real(r8),dimension(n_in), intent(out) :: lon_out,lat_out - logical :: ldbg - ! - ! local work space - ! - integer :: k,i,j - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: pih = 0.50*pi - ! - ! for pole points: make sure the longitudes are identical so that algorithm below works properly - ! - do i=2,n_in - if (abs(lat_in(i)-pih) ' - print *, ' ' - print *, 'REQUIRED ARGUMENTS: ' - print *, ' --target-grid Target grid descriptor in SCRIP format ' - print *, ' --input-topography Input USGS topography on cube sphere ' - print *, ' --output-topography Output topography on target grid ' - print *, ' ' - print *, 'OPTIONAL ARGUMENTS: ' - print *, ' --smoothed-topography Input smoothed topography (for surface ' - print *, ' roughness calculation). If present, ' - print *, ' output will contain estimate of subgrid' - print *, ' surface roughness (SGH). Note that the ' - print *, ' variance in elevation from the 30s to ' - print *, ' 3km grid (SGH30) is also downscaled, ' - print *, ' but does not depend on the smoothing. ' - print *, ' ' - print *, 'DESCRIPTION: ' - print *, 'This code performs rigorous remapping of topography variables on a cubed- ' - print *, 'sphere grid to any target grid. The code is documented in: ' - print *, ' ' - print *, ' Lauritzen, Nair and Ullrich, 2010, J. Comput. Phys. ' - print *, ' ' - print *, 'AUTHOR: ' - print *, ' Peter Hjort Lauritzen (pel@ucar.edu), AMP/CGD/NESL/NCAR ' - print *, ' ' -end subroutine usage diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl b/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl deleted file mode 100755 index f36183d66e8..00000000000 --- a/components/eam/tools/topo_tool/orographic_drag_toolkit/make.ncl +++ /dev/null @@ -1,10 +0,0 @@ -begin -;; -fil1="USGS-gtopo30_ne30np4pg2_16xdel2_forOroDrag.c20241029.nc" -fil2="USGS-gtopo30_ne30np4pg2_x6t-SGH.c20210614.nc" -fil3="final-180.nc" -system("rm -r "+fil1) -system("cp -r "+fil2+" "+fil1) -system("ncks -A -v OA,OC,OL "+fil3+" "+fil1) -;; -end diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 b/components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 deleted file mode 100755 index 0ffb3c0bfec..00000000000 --- a/components/eam/tools/topo_tool/orographic_drag_toolkit/ogwd_sub.F90 +++ /dev/null @@ -1,900 +0,0 @@ -Module ogwd_sub -use shr_kind_mod, only: r8 => shr_kind_r8 -!use transform - -contains -!#if 0 -subroutine OAdir(terr,ntarget,ncube,n,nvar_dir,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,lon_cen,lat_cen,lon_terr,lat_terr,area_target,oa_target) -!use shr_kind_mod, only: r8 => shr_kind_r8 -IMPLICIT NONE -integer ,intent(in) :: ncube,ntarget,n,nvar_dir,jall,weights_lgr_index_all(jall) -integer ,intent(in) :: weights_eul_index_all1(jall),& - weights_eul_index_all2(jall),& - weights_eul_index_all3(jall) -real(r8),intent(in) :: weights_all(jall,1),landfrac_target(ntarget) -real(r8),intent(in) :: terr(n) -!real(r8),intent(in) :: lon_cen(ntarget),& -real(r8),intent(inout) :: lon_cen(ntarget),& - lat_cen(ntarget),& - area_target(ntarget) -real(r8),intent(in) :: lon_terr(n),lat_terr(n) -real(r8),intent(out) :: oa_target(ntarget,nvar_dir) -!local -integer :: count,i,ix,iy,ip,ii,ip2,ip3 -real(r8) :: xxterr,yyterr,zzterr,ix2,iy2,xx3,yy3,zz3,ix3,iy3 -real(r8) :: wt,xhds(ntarget),yhds(ntarget),zhds(ntarget),hds(ntarget),OAx_var(ntarget),OAy_var(ntarget),OAz_var(ntarget),OA_var(ntarget) -real(r8) :: xbar(ntarget),ybar(ntarget),zbar(ntarget),lon_bar(ntarget),lat_bar(ntarget) -real(r8) :: rad,theta1 -real(r8) :: OAlon(ntarget),OAlat(ntarget),OArad(ntarget),OAx1,OAy1,OAz1 - -real(r8) :: terr_anom(n),terr_avg(ntarget),weights_ano(jall),area_target_ano(ntarget) - -xhds=0.0_r8 -yhds=0.0_r8 -zhds=0.0_r8 -hds=0.0_r8 - -xbar=0.0_r8 -ybar=0.0_r8 -zbar=0.0_r8 -lon_bar=0.0_r8 -lat_bar=0.0_r8 -OA_var=0.0_r8 -OAx_var=0.0_r8 -OAy_var=0.0_r8 -OAz_var=0.0_r8 - - -!#if 0 -terr_anom=0.0_r8 -terr_avg=0.0_r8 -do count=1,jall - i = weights_lgr_index_all(count) - ix = weights_eul_index_all1(count)!,1) - iy = weights_eul_index_all2(count)!,2) - ip = weights_eul_index_all3(count) - ! convert to 1D indexing of cubed-sphere - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - wt = weights_all(count,1) - ! - terr_avg(i)=terr_avg(i)+(wt/area_target(i))*terr(ii) - !terr(ii)*wt!(wt/area_target(i))*terr(ii) -enddo - -do count=1,jall - i = weights_lgr_index_all(count) - ix = weights_eul_index_all1(count)!,1) - iy = weights_eul_index_all2(count)!,2) - ip = weights_eul_index_all3(count) - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix - terr_anom(ii)=terr(ii)-terr_avg(i) -! -enddo -where(terr_anom.le.0) terr_anom=0.0_r8 - -do count=1,jall - i = weights_lgr_index_all(count) - ix = weights_eul_index_all1(count)!,1) - iy = weights_eul_index_all2(count)!,2) - ip = weights_eul_index_all3(count)!,3) - ! - ! convert to 1D indexing of cubed-sphere - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - wt = weights_all(count,1) - rad=4.0_r8*atan(1.0_r8)/180.0_r8 - call CubedSphereABPFromRLL(lon_terr(ii)*rad,lat_terr(ii)*rad,ix2,iy2,ip2,.true.) - call CubedSphereXYZFromABP(ix2,iy2,ip2,xxterr,yyterr,zzterr) -!#if 0 - xhds(i)=xhds(i)+xxterr*terr_anom(ii)*wt - yhds(i)=yhds(i)+yyterr*terr_anom(ii)*wt - zhds(i)=zhds(i)+zzterr*terr_anom(ii)*wt - hds(i) =hds(i)+terr_anom(ii)*wt - - !masscenter for every coarse grid - !on Cartesian coord - !looking the h as ro - xbar(i)=xhds(i)/hds(i) - ybar(i)=yhds(i)/hds(i) - zbar(i)=zhds(i)/hds(i) - - call CubedSphereABPFromRLL(lon_cen(i)*rad,lat_cen(i)*rad,& - ix3,iy3,ip3,.true.) - call CubedSphereXYZFromABP(ix3,iy3,ip3,xx3,yy3,zz3) - !under Cartesian, the variability of the scale in the wind - !direction is the sqrt(x^2+y^2+z^2), the scale of the orthogonal - !3 directions - !then it is only a matter of using the original formula - !in the single direction - OA_var(i)=OA_var(i)+wt/area_target(i)& - *((xxterr-xx3)**2+(yyterr-yy3)**2+(zzterr-zz3)**2) - OAx_var(i)=OAx_var(i)+(wt/area_target(i))*(xxterr-xx3)**2 - OAy_var(i)=OAy_var(i)+(wt/area_target(i))*(yyterr-yy3)**2 - OAz_var(i)=OAz_var(i)+(wt/area_target(i))*(zzterr-zz3)**2 - OAx1=(xx3-xbar(i))/sqrt(OAx_var(i))!OA_var(i)) - OAy1=(yy3-ybar(i))/sqrt(OAy_var(i))!OA_var(i)) - OAz1=(zz3-zbar(i))/sqrt(OAz_var(i))!OA_var(i)) - !assuming a small change in lon_cen to lon_bar - !so it does not matter whether lon_cen or lon_bar - !thus we change onto lat-lon grid vector in target gridcell -#if 0 - OArad(i)= OAx1*sin(lat_cen(i)*rad)*cos(lon_cen(i)*rad)& - +OAy1*sin(lat_cen(i)*rad)*sin(lon_cen(i)*rad)& - +OAz1*cos(lat_cen(i)*rad) - OAlat(i)= OAx1*cos(lat_cen(i)*rad)*cos(lon_cen(i)*rad)& - +OAy1*cos(lat_cen(i)*rad)*sin(lon_cen(i)*rad)& - -OAz1*sin(lat_cen(i)*rad) - OAlon(i)=-OAx1*sin(lon_cen(i)*rad)& - +OAy1*cos(lon_cen(i)*rad) -#endif - !all lat_cen must use (90-lat_cen) since we only have - !latitude rather than colatitude - !this is equivalent to using induction formula sin(90-lat)=cos(lat) - !latitude is opposite of colatitude, thus OAlat is negative - OAlat(i)=-(OAx1*sin(lat_cen(i)*rad)*cos(lon_cen(i)*rad)& - +OAy1*sin(lat_cen(i)*rad)*sin(lon_cen(i)*rad)& - -OAz1*cos(lat_cen(i)*rad)) - OAlon(i)= -OAx1*sin(lon_cen(i)*rad)& - +OAy1*cos(lon_cen(i)*rad) -#if 0 - theta1=0. - oa_target(i,1) = OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) - theta1=90. - oa_target(i,2) = OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) - theta1=45. - oa_target(i,3)= OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) - theta1=360.-45. - oa_target(i,4)= OAlon(i)*cos(theta1*rad)+OAlat(i)*sin(theta1*rad) -#endif -!#if 0 - !reverse in order to be - !(2,ntarget),OAx,OAy - oa_target(i,1) = OAlon(i) - oa_target(i,2) = OAlat(i) - -!#endif - !landfrac may cause coastal area par to diminish - !oa_target(i,:) = oa_target(i,:)*landfrac_target(i) -enddo - !takeout abnormal values -!#if 0 - where(abs(oa_target)<.001_r8.or.& - abs(oa_target).gt.1e+7) oa_target=0.0_r8 - !where(abs(oa_target).gt.1) oa_target=1.0_r8 - where(oa_target.ne.oa_target) oa_target=0.0_r8 - -!#endif -end subroutine OAdir -!============================================================ -subroutine OAorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,lon_terr,lat_terr,area_target,oa_target) -!use shr_kind_mod, only: r8 => shr_kind_r8 -IMPLICIT NONE -integer ,intent(in) :: ncube,ntarget,n,jall,weights_lgr_index_all(jall),weights_eul_index_all1(jall),weights_eul_index_all2(jall),weights_eul_index_all3(jall) -real(r8),intent(in) :: weights_all(jall,1),terr(n) -real(r8),intent(in) :: landfrac_target(ntarget),lon_terr(n),lat_terr(n),area_target(ntarget) -real(r8),intent(out) :: oa_target(ntarget,4) -!local -real(r8) :: xh(ntarget),yh(ntarget),height(ntarget),modexcoords(ntarget),modeycoords(ntarget),avgx(ntarget),avgy(ntarget),varx(ntarget),vary(ntarget),OAx,OAy,theta1,rad -integer(r8) :: count,i,ix,iy,ip,ii -real(r8) :: wt - - xh=0.0_r8 - yh=0.0_r8 - height=0.0_r8 - modexcoords=0.0_r8 - modeycoords=0.0_r8 - avgx=0.0_r8 - avgy=0.0_r8 - varx=0.0_r8 - vary=0.0_r8 - OAx=0.0_r8 - OAy=0.0_r8 - theta1=0.0_r8 - rad=0.0_r8 - -do count=1,jall - i = weights_lgr_index_all(count) - ix = weights_eul_index_all1(count)!,1) - iy = weights_eul_index_all2(count)!,2) - ip = weights_eul_index_all3(count)!,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - wt = weights_all(count,1) - !for OA - avgx(i)=avgx(i)+wt/area_target(i)*lon_terr(ii) - avgy(i)=avgy(i)+wt/area_target(i)*lat_terr(ii) -enddo - - -do count=1,jall - i = weights_lgr_index_all(count) - ix = weights_eul_index_all1(count)!,1) - iy = weights_eul_index_all2(count)!,2) - ip = weights_eul_index_all3(count)!,3) - ! - ! convert to 1D indexing of cubed-sphere - ! - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - wt = weights_all(count,1) - !mode for both dim - xh(i)=xh(i)+wt/area_target(i)*lon_terr(ii)*terr(ii) - yh(i)=yh(i)+wt/area_target(i)*lat_terr(ii)*terr(ii) - height(i)=height(i)+wt/area_target(i)*terr(ii) - modexcoords(i)=xh(i)/(height(i))!+1e-14) - modeycoords(i)=yh(i)/(height(i))!+1e-14) - - varx(i)=varx(i)+(wt/area_target(i))*(lon_terr(ii)-avgx(i))**2 - vary(i)=vary(i)+(wt/area_target(i))*(lat_terr(ii)-avgy(i))**2 - !OAx,OAy - OAx=landfrac_target(i)*(avgx(i)-modexcoords(i))/sqrt(varx(i)) - OAy=landfrac_target(i)*(avgy(i)-modeycoords(i))/sqrt(vary(i)) - - rad=4.0*atan(1.0)/180.0 - theta1=0. - oa_target(i,1) = OAx*cos(theta1*rad)+OAy*sin(theta1*rad) - theta1=90. - oa_target(i,2) = OAx*cos(theta1*rad)+OAy*sin(theta1*rad) - theta1=45. - oa_target(i,3)= OAx*cos(theta1*rad)+OAy*sin(theta1*rad) - theta1=360.-45. - oa_target(i,4)= OAx*cos(theta1*rad)+OAy*sin(theta1*rad) - oa_target(i,:)= oa_target(i,:)*landfrac_target(i) -enddo - !takeout abnormal values - where(abs(oa_target)<.001_r8.or.abs(oa_target).gt.1e+7) oa_target=0.0 - where(abs(oa_target).gt.1) oa_target=0.0 - where(oa_target.ne.oa_target) oa_target=0.0 -end subroutine OAorig -!#endif -!=================================== -subroutine OC(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,area_target,sgh_target,terr_target,oc_target) -!use shr_kind_mod, only: r8 => shr_kind_r8 -IMPLICIT NONE -integer ,intent(in) :: ncube,ntarget,n,jall,weights_lgr_index_all(jall),weights_eul_index_all1(jall),weights_eul_index_all2(jall),weights_eul_index_all3(jall) -real(r8),intent(in) :: weights_all(jall,1) -real(r8),intent(in) :: landfrac_target(ntarget),area_target(ntarget),sgh_target(ntarget),terr_target(ntarget),terr(n) -real(r8),intent(out) :: oc_target(ntarget) -!local -integer :: count,i,ix,iy,ip,ii -real(r8) :: wt - - oc_target=0.0_r8 - do count=1,jall - i = weights_lgr_index_all(count) - ix = weights_eul_index_all1(count)!,1) - iy = weights_eul_index_all2(count)!,2) - ip = weights_eul_index_all3(count)!,3) - ! convert to 1D indexing of cubed-sphere - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - wt = weights_all(count,1) - oc_target(i) = oc_target(i)+(wt/area_target(i))*((terr_target(i)-terr(ii))**4)/(sgh_target(i)**4) - oc_target(i) = oc_target(i) * landfrac_target(i) - enddo - - where(abs(oc_target)<.001_r8.or.abs(oc_target).gt.1e+7) oc_target=0.0_r8 - where(abs(sgh_target).eq.0.0_r8) oc_target=0.0_r8 - where(oc_target<0.0_r8) oc_target=0.0_r8 -end subroutine OC -!======================== -subroutine OLorig(terr,ntarget,ncube,n,jall,weights_lgr_index_all,weights_eul_index_all1,weights_eul_index_all2,weights_eul_index_all3,weights_all,landfrac_target,lon_terr,lat_terr,area_target,sgh_target,target_center_lat,target_center_lon,target_corner_lat_deg,target_corner_lon_deg,ol_target) -!use shr_kind_mod, only: r8 => shr_kind_r8 -IMPLICIT NONE -integer,intent(in) :: ncube,ntarget,n,jall,weights_lgr_index_all(jall),weights_eul_index_all1(jall),weights_eul_index_all2(jall),weights_eul_index_all3(jall) -real(r8),intent(in) :: weights_all(jall,1) -real(r8),intent(in) :: landfrac_target(ntarget),area_target(ntarget),sgh_target(ntarget),terr(n),lon_terr(n),lat_terr(n) -real(r8),intent(in) :: target_center_lat(ntarget),target_center_lon(ntarget),target_corner_lat_deg(4,ntarget),target_corner_lon_deg(4,ntarget) -real(r8),intent(out) :: ol_target(ntarget,4) -!local -integer :: count,i,ix,iy,ip,ii -real(r8) :: wt,terr_if,Nw(4,ntarget),area_target_par(4,ntarget),j - - - ol_target=0.0_r8 - Nw=0.0_r8 - area_target_par=0.0_r8 - - do count=1,jall - i = weights_lgr_index_all(count) - ix = weights_eul_index_all1(count)!,1) - iy = weights_eul_index_all2(count)!,2) - ip = weights_eul_index_all3(count)!,3) - ! convert to 1D indexing of cubed-sphere - ii = (ip-1)*ncube*ncube+(iy-1)*ncube+ix! - wt = weights_all(count,1) - !determine terr_if - terr_if=0._r8 - if (terr(ii).GT.(1116.2-0.878*sgh_target(i))) terr_if=1. - ! (1): the lower left corner - ! (2): the lower right corner - ! (3): the upper right corner - ! (4): the upper left corner - !OL1 - if (lat_terr(ii) &!(ii)& - .GT.(target_corner_lat_deg(1,i)+target_center_lat(i))/2..and. & - lat_terr(ii) &!(ii)& - .LT.(target_corner_lat_deg(4,i)+target_center_lat(i))/2.) then - Nw(1,i)=Nw(1,i)+wt*terr_if - area_target_par(1,i)=area_target_par(1,i)+wt - endif - - !OL2 - if (lon_terr(ii) &!(ii)& - .GT.(target_corner_lon_deg(1,i)+target_center_lon(i))/2..and. & - lon_terr(ii) &!(ii)& - .LT.(target_corner_lon_deg(3,i)+target_center_lon(i))/2.) then - Nw(2,i)=Nw(2,i)+wt*terr_if - area_target_par(2,i)=area_target_par(2,i)+wt - end if - - - !OL3 - if (lon_terr(ii) &!(ii)& - .LT.target_center_lon(i).and. & - lat_terr(ii) &!(ii)& - .LT.target_center_lat(i).or. & - lon_terr(ii) &!(ii)& - .GT.target_center_lon(i).and. & - lat_terr(ii) &!(ii)& - .GT.target_center_lat(i)) then - Nw(3,i)=Nw(3,i)+wt*terr_if - area_target_par(3,i)=area_target_par(3,i)+wt - end if - - - !OL4 - if (lat_terr(ii) & !(ii)& - .GT.target_center_lat(i).and. & - lon_terr(ii) & !(ii)& - .LT.target_center_lon(i).or. & - lat_terr(ii) & !(ii)& - .LT.target_center_lat(i).and. & - lon_terr(ii) & !(ii)& - .GT.target_center_lon(i)) then - Nw(4,i)=Nw(4,i)+wt*terr_if - area_target_par(4,i)=area_target_par(4,i)+wt - end if - - !Nw(4,i)=Nw(4,i)+wt*terr_if - !area_target_par(4,i)=area_target_par(4,i)+wt - - - - do j=1,4 - ol_target(i,j)=Nw(j,i)/(area_target_par(j,i)+1e-14)!Nt(i)!/2.) - enddo - ol_target(i,:)=ol_target(i,:)*landfrac_target(i) - end do - where(abs(ol_target)<.001_r8.or.abs(ol_target).gt.1e+7) ol_target=0.0_r8 -end subroutine OLorig -!#endif -!===================== -!=================================================================== -!===================== -!#if 0 -subroutine OLgrid(terr,terrx,terry,wt,b,a,n,theta_in,hc,OLout) -!use physconst, only: rh2o,zvir,pi,rearth -!use abortutils -!Xie add -IMPLICIT NONE -integer,intent(in) :: n -real(r8),intent(in) :: hc,wt(n),terr(n),a,b,theta_in!a dy,b dx -real(r8),intent(in) :: terrx(n),terry(n) -real(r8),intent(out) :: OLout -real(r8) :: theta,theta1,theta2,rad,interval -real(r8) :: terr_count(n),terr_whole_count(n),cx(n),c1,c2 -!local -integer :: i -real(r8) :: j - terr_count=0.0_r8 - terr_whole_count=0.0_r8 - c1=0.0_r8 - c2=0.0_r8 - cx=0.0_r8 - !determine an acute theta in the triangle - !or minus 180 equilvalent acute angle - !then turn into radian - rad=4.0_r8*atan(1.0_r8)/180.0_r8 - interval=0.0_r8 - - !initialize - theta1=0.0_r8 - theta2=0.0_r8 - !set inside -360~360 - !this adds robustness of the scheme to different angle - theta1=MOD(theta_in,360._r8) - !set negative axis into 0~360 - if (theta1.ge.-360._r8.and.theta1.lt.0._r8) then - theta1=theta1+360._r8 - endif - !now we have only 0~360 angle - if (theta1.ge. 0._r8.and.theta1.le. 90._r8) then - theta=theta1*rad - theta2=theta1 - else if (theta1.gt. 90._r8.and.theta1.le. 180._r8) then - theta=(180._r8-theta1)*rad - theta2=180._r8-theta1 - else if (theta1.gt. 180._r8.and.theta1.le. 270._r8) then - theta=(theta1-180._r8)*rad - theta2=theta1-180._r8 - !we only use 0~180, so this makes similar to 1st and 2nd quadrant - else if (theta1.gt. 270._r8.and.theta1.le. 360._r8) then - theta=(360._r8-theta1)*rad - theta2=360._r8-theta1 - !we only use 0~180, so this makes similar to 1st and 2nd quadrant - endif - !we use theta2 to judge instead - !theta2=theta1 - !theta1=theta2 - !we restrict the angle in the first and second quadrant - !the third and fourth for OL are similar when theta is - !transformed by minus pi(180) - !two parallel lines are included - !xsin(theta)-ycos(theta)=c1 - !xsin(theta)-ycos(theta)=c2 - !xsin(theta)-ycos(theta)=cx,min(c1,c2) 0) .AND. (j < ncube_reconstruct)) THEN - beta = gp(j) - beta_next = gp(j+1) - ELSEIF (j == -1) THEN - beta = -piq - (gp(3) + piq) - beta_next = -piq - (gp(2) + piq) - ELSEIF (j == 0) THEN - beta = -piq - (gp(2) + piq) - beta_next = -piq - ELSEIF (j == ncube_reconstruct) THEN - beta = piq - beta_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (j == ncube_reconstruct+1) THEN - beta = piq + (piq - gp(ncube_reconstruct-1)) - beta_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - - DO i = -1, ncube_reconstruct+1 - IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN - alpha = gp(i) - alpha_next = gp(i+1) - ELSEIF (i == -1) THEN - alpha = -piq - (gp(3) + piq) - alpha_next = -piq - (gp(2) + piq) - ELSEIF (i == 0) THEN - alpha = -piq - (gp(2) + piq) - alpha_next = -piq - ELSEIF (i == ncube_reconstruct) THEN - alpha = piq - alpha_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (i == ncube_reconstruct+1) THEN - alpha = piq + (piq - gp(ncube_reconstruct-1)) - alpha_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - abp_centroid(1,i,j) = & - I_10_ab(alpha_next,beta_next)-I_10_ab(alpha ,beta_next)+& - I_10_ab(alpha ,beta )-I_10_ab(alpha_next,beta ) -! - ASINH(COS(alpha_next) * TAN(beta_next)) & -! + ASINH(COS(alpha_next) * TAN(beta)) & -! + ASINH(COS(alpha) * TAN(beta_next)) & -! - ASINH(COS(alpha) * TAN(beta)) - - abp_centroid(2,i,j) = & - I_01_ab(alpha_next,beta_next)-I_01_ab(alpha ,beta_next)+& - I_01_ab(alpha ,beta )-I_01_ab(alpha_next,beta ) -! - ASINH(TAN(alpha_next) * COS(beta_next)) & -! + ASINH(TAN(alpha_next) * COS(beta)) & -! + ASINH(TAN(alpha) * COS(beta_next)) & -! - ASINH(TAN(alpha) * COS(beta)) - - !ADD PHL START - IF (order>2) THEN - ! TAN(alpha)^2 component - abp_centroid(3,i,j) =& - I_20_ab(alpha_next,beta_next)-I_20_ab(alpha ,beta_next)+& - I_20_ab(alpha ,beta )-I_20_ab(alpha_next,beta ) - - ! TAN(beta)^2 component - abp_centroid(4,i,j) = & - I_02_ab(alpha_next,beta_next)-I_02_ab(alpha ,beta_next)+& - I_02_ab(alpha ,beta )-I_02_ab(alpha_next,beta ) - - ! TAN(alpha) TAN(beta) component - abp_centroid(5,i,j) = & - I_11_ab(alpha_next,beta_next)-I_11_ab(alpha ,beta_next)+& - I_11_ab(alpha ,beta )-I_11_ab(alpha_next,beta ) - ENDIF - !ADD PHL END - ENDDO - ENDDO - -! -! PHL outcommented below -! - ! High order calculations -! IF (order > 2) THEN -! DO k = 1, nlon -! DO i = 1, int_nx(nlat,k)-1 -! IF ((int_itype(i,k) > 4) .AND. (int_np(1,i,k) == 1)) THEN -! abp_centroid(3, int_a(i,k), int_b(i,k)) = & -! abp_centroid(3, int_a(i,k), int_b(i,k)) + int_wt_2a(i,k) -! abp_centroid(4, int_a(i,k), int_b(i,k)) = & -! abp_centroid(4, int_a(i,k), int_b(i,k)) + int_wt_2b(i,k) -! abp_centroid(5, int_a(i,k), int_b(i,k)) = & -! abp_centroid(5, int_a(i,k), int_b(i,k)) + int_wt_2c(i,k) -! ENDIF -! ENDDO -! ENDDO -! ENDIF - - ! Normalize with element areas - DO j = -1, ncube_reconstruct+1 - IF ((j > 0) .AND. (j < ncube_reconstruct)) THEN - beta = gp(j) - beta_next = gp(j+1) - ELSEIF (j == -1) THEN - beta = -piq - (gp(3) + piq) - beta_next = -piq - (gp(2) + piq) - ELSEIF (j == 0) THEN - beta = -piq - (gp(2) + piq) - beta_next = -piq - ELSEIF (j == ncube_reconstruct) THEN - beta = piq - beta_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (j == ncube_reconstruct+1) THEN - beta = piq + (piq - gp(ncube_reconstruct-1)) - beta_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - DO i = -1, ncube_reconstruct+1 - IF ((i > 0) .AND. (i < ncube_reconstruct)) THEN - alpha = gp(i) - alpha_next = gp(i+1) - ELSEIF (i == -1) THEN - alpha = -piq - (gp(3) + piq) - alpha_next = -piq - (gp(2) + piq) - ELSEIF (i == 0) THEN - alpha = -piq - (gp(2) + piq) - alpha_next = -piq - ELSEIF (i == ncube_reconstruct) THEN - alpha = piq - alpha_next = piq + (piq - gp(ncube_reconstruct-1)) - ELSEIF (i == ncube_reconstruct+1) THEN - alpha = piq + (piq - gp(ncube_reconstruct-1)) - alpha_next = piq + (piq - gp(ncube_reconstruct-2)) - ENDIF - - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - area = DAcube(i,j) - ELSE - area = EquiangularElementArea(alpha, alpha_next - alpha, & - beta, beta_next - beta) - ENDIF - - abp_centroid(1,i,j) = abp_centroid(1,i,j) / area - abp_centroid(2,i,j) = abp_centroid(2,i,j) / area - - IF (order > 2) THEN - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - abp_centroid(3,i,j) = abp_centroid(3,i,j) / area - abp_centroid(4,i,j) = abp_centroid(4,i,j) / area - abp_centroid(5,i,j) = abp_centroid(5,i,j) / area - ENDIF - ENDIF - ENDDO - ENDDO - - WRITE(*,*) '...Done computing ABP element centroids' - - END SUBROUTINE ComputeABPElementCentroids - -!------------------------------------------------------------------------------ -! FUNCTION EvaluateABPReconstruction -! -! Description: -! Evaluate the sub-grid scale reconstruction at the given point. -! -! Parameters: -! fcubehalo - Array of element values -! recons - Array of reconstruction coefficients -! a - Index of element in alpha direction (1 <= a <= ncube_reconstruct-1) -! b - Index of element in beta direction (1 <= b <= ncube_reconstruct-1) -! p - Panel index of element -! alpha - Alpha coordinate of evaluation point -! beta - Beta coordinate of evaluation point -! order - Order of the reconstruction -! value (OUT) - Result of function evaluation at given point -!------------------------------------------------------------------------------ - SUBROUTINE EvaluateABPReconstruction( & - fcubehalo, recons, a, b, p, alpha, beta, order, value) - IMPLICIT NONE - - ! Dummy variables - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(IN) :: recons - INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p - REAL (KIND=dbl_kind), INTENT(IN) :: alpha, beta - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), INTENT(OUT) :: value - - ! Evaluate constant order terms - value = fcubehalo(a,b,p) - - ! Evaluate linear order terms - IF (order > 1) THEN - value = value + recons(1,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) - value = value + recons(2,a,b,p) * (TAN(beta) - abp_centroid(2,a,b)) - ENDIF - - ! Evaluate second order terms - IF (order > 2) THEN - value = value + recons(3,a,b,p) * & - (abp_centroid(1,a,b)**2 - abp_centroid(3,a,b)) - value = value + recons(4,a,b,p) * & - (abp_centroid(2,a,b)**2 - abp_centroid(4,a,b)) - value = value + recons(5,a,b,p) * & - (abp_centroid(1,a,b) * abp_centroid(2,a,b) - & - abp_centroid(5,a,b)) - - value = value + recons(3,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b))**2 - value = value + recons(4,a,b,p) * (TAN(beta) - abp_centroid(2,a,b))**2 - value = value + recons(5,a,b,p) * (TAN(alpha) - abp_centroid(1,a,b)) & - * (TAN(beta) - abp_centroid(2,a,b)) - ENDIF - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ABPHaloMinMax -! -! Description: -! Calculate the minimum and maximum values of the cell-averaged function -! around the given element. -! -! Parameters: -! fcubehalo - Cell-averages for the cubed sphere -! a - Local element alpha index -! b - Local element beta index -! p - Local element panel index -! min_val (OUT) - Minimum value in the halo -! max_val (OUT) - Maximum value in the halo -! nomiddle - whether to not include the middle cell (index a,b) in the search. -! -! NOTE: Since this routine is not vectorized, it will likely be called MANY times. -! To speed things up, make sure to pass the first argument as the ENTIRE original -! array, not as a subset of it, since repeatedly cutting up that array and creating -! an array temporary (on some compilers) is VERY slow. -! ex: -! CALL APBHaloMinMax(zarg, a, ...) !YES -! CALL ABPHaloMinMax(zarg(-1:ncube_reconstruct+1,-1:ncube_reconstruct+1,:)) !NO -- slow -!------------------------------------------------------------------------------ - SUBROUTINE ABPHaloMinMax(fcubehalo, a, b, p, min_val, max_val, nomiddle) - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: a, b, p - REAL (KIND=dbl_kind), INTENT(OUT) :: min_val, max_val - LOGICAL, INTENT(IN) :: nomiddle - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, il, jl, inew, jnew - REAL (KIND=dbl_kind) :: value - - min_val = fcubehalo(a,b,p) - max_val = fcubehalo(a,b,p) - value = fcubehalo(a,b,p) - - DO il = a-1,a+1 - DO jl = b-1,b+1 - - i = il - j = jl - - inew = i - jnew = j - - IF (nomiddle .AND. i==a .AND. j==b) CYCLE - - !Interior - IF ((i > 0) .AND. (i < ncube_reconstruct) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - value = fcubehalo(i,j,p) - - ELSE - - - !The next 4.0 regions are cases in which a,b themselves lie in the panel's halo, and the cell's "halo" (in this usage the 8.0 cells surrounding it) might wrap around into another part of the halo. This happens for (a,b) = {(1,:0),(ncube_reconstruct-1,:0),(1,ncube_reconstruct:),(ncube_reconstruct-1,ncube_reconstruct:)} and for the transposes thereof ({(:0,1), etc.}). In these cases (i,j) could lie in the "Corners" where nothing should lie. We correct this by moving i,j to its appropriate position on the "facing" halo, and then the remainder of the routine then moves it onto the correct face. - -101 FORMAT("ERROR cannot find (i,j) = (", I4, ", ", I4, ") for (a,b,p) = ", I4, ",", I4, ",", I4, ")") -102 FORMAT("i,j,p = ", 3I4, " moved to " 2I4, " (CASE ", I1, ")") - !NOTE: we need the general case to be able to properly handle (0,0), (ncube_reconstruct,0), etc. Note that we don't need to bother with (0,0), etc. when a, b lie in the interior, since both sides of the (0,0) cell are already accounted for by this routine. - !LOWER LEFT - IF (i < 1 .AND. j < 1) THEN - IF (a < 1) THEN !(a,b) centered on left halo, cross to lower halo - inew = 1-j - jnew = i - ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to left halo - jnew = 1-i - inew = j - END IF -! WRITE(*,102) i, j, p, inew, jnew, 1 - !LOWER RIGHT - ELSE IF (i > ncube_reconstruct-1 .AND. j < 1) THEN - IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to lower halo - inew = ncube_reconstruct-1+j - jnew = ncube_reconstruct-i - ELSE IF (b < 1) THEN !(a,b) centered on lower halo, cross to right halo - jnew = 1+(i-ncube_reconstruct) - inew = ncube_reconstruct-j - END IF -! WRITE(*,102) i, j, p, inew, jnew, 2 - !UPPER LEFT - ELSE IF (i < 1 .AND. j > ncube_reconstruct-1) THEN - IF (a < 1) THEN! (a,b) centered on left halo, cross to upper halo - inew = 1-(j-ncube_reconstruct) - jnew = ncube_reconstruct-i - ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to left halo - inew = ncube_reconstruct-j - jnew = ncube_reconstruct-1-i - END IF -! WRITE(*,102) i, j, p, inew, jnew, 3 - !UPPER RIGHT - ELSE IF (i > ncube_reconstruct-1 .AND. j > ncube_reconstruct-1) THEN - IF (a > ncube_reconstruct-1) THEN !(a,b) centered on right halo, cross to upper halo - inew = ncube_reconstruct-1-(ncube_reconstruct-j) - jnew = i - ELSE IF (b > ncube_reconstruct-1) THEN !(a,b) centered on upper halo, cross to right halo - inew = j - jnew = ncube_reconstruct-1-(ncube_reconstruct-i) - END IF -! WRITE(*,102) i, j, p, inew, jnew, 4 - END IF - - i = inew - j = jnew - - - !Lower halo ("halo" meaning the panel's halo, not the nine-cell halo - IF ((i < 1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,4) - ELSEIF (p == 2) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,1) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,2) - ELSEIF (p == 4) THEN - value = fcubehalo(ncube_reconstruct-1+i,j,3) - ELSEIF (p == 5) THEN - value = fcubehalo(j,1-i,4) - ELSEIF (p == 6) THEN - value = fcubehalo(ncube_reconstruct-j,ncube_reconstruct-1+i,4) - ENDIF - - !Upper halo - ELSEIF ((i > ncube_reconstruct-1) .AND. (j > 0) .AND. (j < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,2) - ELSEIF (p == 2) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,3) - ELSEIF (p == 3) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,4) - ELSEIF (p == 4) THEN - value = fcubehalo(i-ncube_reconstruct+1,j,1) - ELSEIF (p == 5) THEN - value = fcubehalo(ncube_reconstruct-j,i-ncube_reconstruct+1,2) - ELSEIF (p == 6) THEN - value = fcubehalo(j,2*ncube_reconstruct-i-1,2) - ENDIF - - !Left halo - ELSEIF ((j < 1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i,ncube_reconstruct-1+j,5) - ELSEIF (p == 2) THEN - value = fcubehalo(ncube_reconstruct-1+j,ncube_reconstruct-i,5) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-i,1-j,5) - ELSEIF (p == 4) THEN - value = fcubehalo(1-j,i,5) - ELSEIF (p == 5) THEN - value = fcubehalo(ncube_reconstruct-i,1-j,3) - ELSEIF (p == 6) THEN - value = fcubehalo(i,ncube_reconstruct-1+j,1) - ENDIF - - !Right halo - ELSEIF ((j > ncube_reconstruct-1) .AND. (i > 0) .AND. (i < ncube_reconstruct)) THEN - IF (p == 1) THEN - value = fcubehalo(i,j-ncube_reconstruct+1,6) - ELSEIF (p == 2) THEN - value = fcubehalo(2*ncube_reconstruct-j-1,i,6) - ELSEIF (p == 3) THEN - value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,6) - ELSEIF (p == 4) THEN - value = fcubehalo(j-ncube_reconstruct+1,ncube_reconstruct-i,6) - ELSEIF (p == 5) THEN - value = fcubehalo(i,j-ncube_reconstruct+1,1) - ELSEIF (p == 6) THEN - value = fcubehalo(ncube_reconstruct-i, 2*ncube_reconstruct-j-1,3) - ENDIF - - ENDIF - - END IF - min_val = MIN(min_val, value) - max_val = MAX(max_val, value) - ENDDO - ENDDO - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE MonotonizeABPGradient -! -! Description: -! Apply a monotonic filter to the calculated ABP gradient. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! selective - whether to apply a simple form of selective limiting, - !which assumes that if a point is larger/smaller than ALL of its - !surrounding points, that the extremum is physical, and that - !filtering should not be applied to it. -! -! Remarks: -! This monotonizing scheme is based on the monotone scheme for unstructured -! grids of Barth and Jespersen (1989). -!------------------------------------------------------------------------------ - SUBROUTINE MonotonizeABPGradient(fcubehalo, order, recons, selective) - -! USE selective_limiting - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - LOGICAL, INTENT(IN) :: selective - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n, skip - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi - REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & - gamma - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - -! -! xxxxx -! -! IF (selective) THEN -! CALL smoothness2D(fcubehalo, gamma, 2) -! WRITE(*,*) 'gamma range: max ', MAXVAL(gamma), " min ", MINVAL(gamma) -! DO i=1,ncube_reconstruct-1 -! WRITE(*,*) gamma(i, i, 3) -! ENDDO -! skip = 0 -! END IF - - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - - - IF (selective) THEN - - CALL ABPHaloMinMax(gamma, i, j, k, gamma_min, gamma_max, .FALSE.) - - IF (gamma_max/(gamma_min + tiny) < lammax) THEN - skip = skip + 1 - CYCLE - END IF - - END IF - - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - ENDIF - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - IF (order > 2) THEN - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - ENDDO - ENDDO - ENDDO - - IF (selective) WRITE(*,*) 'skipped ', skip, ' points out of ', 6*(ncube_reconstruct-1)**2 - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE PosDefABPGradient -! -! Description: -! Scale the reconstructions so they are positive definite -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! This monotonizing scheme is based on the monotone scheme for unstructured -! grids of Barth and Jespersen (1989), but simpler. This simply finds the -! minimum and then scales the reconstruction so that it is 0. -!------------------------------------------------------------------------------ - SUBROUTINE PosDefABPGradient(fcubehalo, order, recons) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi - REAL (KIND=dbl_kind) :: disc, mx, my, lam, gamma_min, gamma_max - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: & - gamma - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - - !If the average value in the cell is 0.0, then we should skip - !all of the scaling and just set the reconstruction to 0.0 -! IF (ABS(fcubehalo(i,j,k)) < tiny) THEN -! recons(:,i,j,k) = 0.0 -! CYCLE -! END IF - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - - !This allowance for miniscule negative values appearing around the cell being - !filtered/limited. Before this, negative values would be caught in adjust_limiter - !and would stop the model. Doing this only causes minor negative values; no blowing - !up is observed. The rationale is the same as for the monotone filter, which does - !allow miniscule negative values due to roundoff error --- of the order E-10 --- - !in flux-form methods (and E-17 in the s-L method, indicating that roundoff error - !is more severe in the flux-form method, as we expect since we are often subtracting - !2.0 values which are very close together. - local_min = MIN(0.0,local_min) - local_max = bignum !prevents scaling upward; for positive - !definite limiting we don't care about the upper bound - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), & - local_min, local_max, min_phi) - ENDDO - ENDIF - ENDIF - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - IF (order > 2) THEN - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - - ENDDO - ENDDO - ENDDO - - - END SUBROUTINE PosDefABPGradient - -!------------------------------------------------------------------------------ -! SUBROUTINE MonotonizeABPGradient_New -! -! Description: -! Apply a monotonic filter to the calculated ABP gradient. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! This monotonizing scheme is similar to the one in MonotonizeABPGradient, -! except the second order derivatives are limited after the first order -! derivatives. -!------------------------------------------------------------------------------ - SUBROUTINE MonotonizeABPGradient_New(fcubehalo, order, recons) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, linval - REAL (KIND=dbl_kind) :: disc, mx, my - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max, .FALSE.) - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point, only taking into - ! account the linear component of the reconstruction. - value = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - CALL AdjustLimiter( & - value, fcubehalo(i,j,k), local_min, local_max, min_phi) - ENDDO - ENDDO - - ! Apply monotone limiter to all reconstruction coefficients - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - ! For the third order method, the minima and maxima may occur along - ! the line segments given by du/dx = 0 and du/dy = 0. Also check - ! for the presence of a maxima / minima of the quadratic within - ! the domain. - IF (order == 3) THEN - ! Reset the limiter - min_phi = one - - ! Calculate discriminant, which we use to determine the absolute - ! minima/maxima of the paraboloid - disc = recons(5,i,j,k)**2 - 4.0 * recons(4,i,j,k) * recons(3,i,j,k) - - ! Check if the quadratic is minimized within the element - IF (ABS(disc) > tiny) THEN - mx = - recons(5,i,j,k) * recons(2,i,j,k) & - + 2.0 * recons(4,i,j,k) * recons(1,i,j,k) - my = - recons(5,i,j,k) * recons(1,i,j,k) & - + 2.0 * recons(3,i,j,k) * recons(2,i,j,k) - - mx = mx / disc + abp_centroid(1,i,j) - my = my / disc + abp_centroid(2,i,j) - - IF ((mx - TAN(gp(i)) > -tiny) .AND. & - (mx - TAN(gp(i+1)) < tiny) .AND. & - (my - TAN(gp(j)) > -tiny) .AND. & - (my - TAN(gp(j+1)) < tiny) & - ) THEN - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDIF - ENDIF - - ! Check all potential minimizer points along element boundaries - IF (ABS(recons(5,i,j,k)) > tiny) THEN - - ! Left/right edge, intercept with du/dx = 0 - DO m = i, i+1 - my = - recons(1,i,j,k) - 2.0 * recons(3,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / recons(5,i,j,k) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - - ! Top/bottom edge, intercept with du/dy = 0 - DO n = j, j+1 - mx = - recons(2,i,j,k) - 2.0 * recons(4,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / recons(5,i,j,k) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Top/bottom edge, intercept with du/dx = 0 - IF (ABS(recons(3,i,j,k)) > tiny) THEN - DO n = j, j+1 - mx = - recons(1,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(n)) - abp_centroid(2,i,j)) - - mx = mx / (2.0 * recons(3,i,j,k)) + abp_centroid(1,i,j) - - IF ((mx < TAN(gp(i))) .OR. (mx > TAN(gp(i+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, ATAN(mx), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (mx - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! Left/right edge, intercept with du/dy = 0 - IF (ABS(recons(4,i,j,k)) > tiny) THEN - DO m = i, i+1 - my = - recons(2,i,j,k) - recons(5,i,j,k) * & - (TAN(gp(m)) - abp_centroid(1,i,j)) - - my = my / (2.0 * recons(4,i,j,k)) + abp_centroid(2,i,j) - - IF ((my < TAN(gp(j))) .OR. (my > TAN(gp(j+1)))) THEN - CYCLE - ENDIF - - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), ATAN(my), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (my - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDIF - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), & - order, value) - - linval = & - fcubehalo(i,j,k) & - + recons(1,i,j,k) * (TAN(gp(m)) - abp_centroid(1,i,j)) & - + recons(2,i,j,k) * (TAN(gp(n)) - abp_centroid(2,i,j)) - - IF (linval < local_min) THEN - linval = local_min - ENDIF - IF (linval > local_max) THEN - linval = local_max - ENDIF - - CALL AdjustLimiter( & - value, linval, local_min, local_max, min_phi) - ENDDO - ENDDO - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - WRITE (*,*) '2: ', min_phi - - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - recons(3,i,j,k) = min_phi * recons(3,i,j,k) - recons(4,i,j,k) = min_phi * recons(4,i,j,k) - recons(5,i,j,k) = min_phi * recons(5,i,j,k) - ENDIF - ENDDO - ENDDO - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_NEL -! -! Description: -! Construct a non-equidistant linear reconstruction of the gradient -! within each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_NEL(fcubehalo, recons, order) - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: alpha1, alpha2, beta1, beta2 - REAL (KIND=dbl_kind) :: dx_left, dx_right, top_value, bot_value - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - - recons(1,i,j,p) = & - (+ fcubehalo(i-1,j,p) * dx_right**2 & - - fcubehalo(i+1,j,p) * dx_left**2 & - - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(2,i,j,p) = & - (+ fcubehalo(i,j-1,p) * dx_right**2 & - - fcubehalo(i,j+1,p) * dx_left**2 & - - fcubehalo(i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - IF (order > 2) THEN - dx_left = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - dx_right = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - - recons(3,i,j,p) = & - (+ fcubehalo(i-1,j,p) * dx_right & - - fcubehalo(i+1,j,p) * dx_left & - - fcubehalo(i,j,p) * (dx_right - dx_left)) / & - (dx_right * dx_left * (dx_left - dx_right)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(4,i,j,p) = & - (+ fcubehalo(i,j-1,p) * dx_right & - - fcubehalo(i,j+1,p) * dx_left & - - fcubehalo(i,j,p) * (dx_right - dx_left)) / & - (dx_right * dx_left * (dx_left - dx_right)) - ENDIF - ENDDO - ENDDO - - IF (order > 2) THEN - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - dx_left = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) - dx_right = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) - - top_value = & - (+ fcubehalo(i-1,j+1,p) * dx_right**2 & - - fcubehalo(i+1,j+1,p) * dx_left**2 & - - fcubehalo(i,j+1,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) - dx_right = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) - - bot_value = & - (+ fcubehalo(i-1,j-1,p) * dx_right**2 & - - fcubehalo(i+1,j-1,p) * dx_left**2 & - - fcubehalo(i,j-1,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - dx_left = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - dx_right = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(5,i,j,p) = & - (+ bot_value * dx_right**2 & - - top_value * dx_left**2 & - - recons(1,i,j,p) * (dx_right**2 - dx_left**2)) / & - (dx_right * dx_left * (dx_right - dx_left)) - - ENDDO - ENDDO - ENDIF - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_NEP -! -! Description: -! Construct a non-equidistant parabolic reconstruction of the gradient -! within each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_NEP(fcubehalo, recons, order) - - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: x1, x2, x4, x5, y1, y2, y3, y4, y5 - - REAL (KIND=dbl_kind), DIMENSION(5) :: t, pa, denom - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! X-direction reconstruction - x1 = abp_centroid(1,i-2,j) - abp_centroid(1,i,j) - x2 = abp_centroid(1,i-1,j) - abp_centroid(1,i,j) - x4 = abp_centroid(1,i+1,j) - abp_centroid(1,i,j) - x5 = abp_centroid(1,i+2,j) - abp_centroid(1,i,j) - - !IF (i == 1) THEN - ! x1 = piq - !ELSEIF (i == ncube_reconstruct-1) THEN - ! x5 = -piq - !ENDIF - - y1 = fcubehalo(i-2,j,p) - y2 = fcubehalo(i-1,j,p) - y3 = fcubehalo(i,j,p) - y4 = fcubehalo(i+1,j,p) - y5 = fcubehalo(i+2,j,p) - - denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 - denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 - denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 - denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 - - t(1) = x5 * x4 * x2 - t(2) = x5 * x4 * x1 - t(4) = x5 * x2 * x1 - t(5) = x4 * x2 * x1 - t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) - - pa(1) = x2 * x4 + x2 * x5 + x4 * x5 - pa(2) = x1 * x4 + x1 * x5 + x4 * x5 - pa(4) = x1 * x2 + x1 * x5 + x2 * x5 - pa(5) = x1 * x2 + x1 * x4 + x2 * x4 - pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) - - recons(1,i,j,p) = & - + y1 * t(1) / denom(1) & - + y2 * t(2) / denom(2) & - - y3 * t(3) & - + y4 * t(4) / denom(4) & - + y5 * t(5) / denom(5) - - IF (order > 2) THEN - recons(3,i,j,p) = & - - y1 * pa(1) / denom(1) & - - y2 * pa(2) / denom(2) & - + y3 * pa(3) & - - y4 * pa(4) / denom(4) & - - y5 * pa(5) / denom(5) - ENDIF - - ! Y-direction reconstruction - x1 = abp_centroid(2,i,j-2) - abp_centroid(2,i,j) - x2 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - x4 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - x5 = abp_centroid(2,i,j+2) - abp_centroid(2,i,j) - - !IF (j == 1) THEN - ! x1 = piq - !ELSEIF (j == ncube_reconstruct-1) THEN - ! x5 = -piq - !ENDIF - - y1 = fcubehalo(i,j-2,p) - y2 = fcubehalo(i,j-1,p) - y3 = fcubehalo(i,j,p) - y4 = fcubehalo(i,j+1,p) - y5 = fcubehalo(i,j+2,p) - - denom(1) = (x2 - x1) * (x4 - x1) * (x5 - x1) * x1 - denom(2) = (x1 - x2) * (x4 - x2) * (x5 - x2) * x2 - denom(4) = (x1 - x4) * (x2 - x4) * (x5 - x4) * x4 - denom(5) = (x1 - x5) * (x2 - x5) * (x4 - x5) * x5 - - t(1) = x5 * x4 * x2 - t(2) = x5 * x4 * x1 - t(4) = x5 * x2 * x1 - t(5) = x4 * x2 * x1 - t(3) = (t(1) + t(2) + t(4) + t(5)) / (x1 * x2 * x4 * x5) - - pa(1) = x2 * x4 + x2 * x5 + x4 * x5 - pa(2) = x1 * x4 + x1 * x5 + x4 * x5 - pa(4) = x1 * x2 + x1 * x5 + x2 * x5 - pa(5) = x1 * x2 + x1 * x4 + x2 * x4 - pa(3) = (pa(1) + pa(2) + pa(4) + pa(5)) / (2.0 * x1 * x2 * x4 * x5) - - recons(2,i,j,p) = & - + y1 * t(1) / denom(1) & - + y2 * t(2) / denom(2) & - - y3 * t(3) & - + y4 * t(4) / denom(4) & - + y5 * t(5) / denom(5) - - IF (order > 2) THEN - recons(4,i,j,p) = & - - y1 * pa(1) / denom(1) & - - y2 * pa(2) / denom(2) & - + y3 * pa(3) & - - y4 * pa(4) / denom(4) & - - y5 * pa(5) / denom(5) - recons(5,i,j,p) = 0.0 - ENDIF - - ENDDO - ENDDO - IF (order > 2) THEN - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - x1 = abp_centroid(1,i-1,j+1) - abp_centroid(1,i,j+1) - x2 = abp_centroid(1,i+1,j+1) - abp_centroid(1,i,j+1) - - y2 = (+ fcubehalo(i-1,j+1,p) * x2**2 & - - fcubehalo(i+1,j+1,p) * x1**2 & - - fcubehalo(i,j+1,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - x1 = abp_centroid(1,i-1,j-1) - abp_centroid(1,i,j-1) - x2 = abp_centroid(1,i+1,j-1) - abp_centroid(1,i,j-1) - - y1 = (+ fcubehalo(i-1,j-1,p) * x2**2 & - - fcubehalo(i+1,j-1,p) * x1**2 & - - fcubehalo(i,j-1,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - x1 = abp_centroid(2,i,j-1) - abp_centroid(2,i,j) - x2 = abp_centroid(2,i,j+1) - abp_centroid(2,i,j) - - recons(5,i,j,p) = & - (+ y1 * x2**2 & - - y2 * x1**2 & - - recons(1,i,j,p) * (x2**2 - x1**2)) / & - (x2 * x1 * (x2 - x1)) - - ENDDO - ENDDO - ENDIF - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_PLM -! -! Description: -! Construct a piecewise linear reconstruction of the gradient within -! each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_PLM(fcubehalo, recons, order) - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: width - - ! ABP width between elements - width = pih / DBLE(ncube_reconstruct-1) - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! df/dx - recons(1,i,j,p) = (fcubehalo(i+1,j,p) - fcubehalo(i-1,j,p)) / & - (2.0 * width) - - ! df/dy - recons(2,i,j,p) = (fcubehalo(i,j+1,p) - fcubehalo(i,j-1,p)) / & - (2.0 * width) - - ! Stretching - recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) - recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) - - ! Third order scheme - IF (order > 2) THEN - ! d^2f/dx^2 - recons(3,i,j,p) = & - (fcubehalo(i+1,j,p) - 2.0 * fcubehalo(i,j,p) & - + fcubehalo(i-1,j,p)) / (width * width) - - ! d^2f/dy^2 - recons(4,i,j,p) = & - (fcubehalo(i,j+1,p) - 2.0 * fcubehalo(i,j,p) & - + fcubehalo(i,j-1,p)) / (width * width) - - ! d^2f/dxdy - recons(5,i,j,p) = & - (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & - - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & - ) / (4.0 * width * width) - - ! Stretching - recons(3,i,j,p) = & - (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & - + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 - - recons(4,i,j,p) = & - (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & - + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 - - recons(5,i,j,p) = recons(5,i,j,p) / & - ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) - - ! Scaling - recons(3,i,j,p) = 0.5 * recons(3,i,j,p) - recons(4,i,j,p) = 0.5 * recons(4,i,j,p) - - ENDIF - ENDDO - ENDDO - ENDDO - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient_PPM -! -! Description: -! Construct a piecewise parabolic reconstruction of the gradient within -! each element on an ABP grid. -! -! Parameters: -! fcubehalo - Scalar field on the ABP grid to use in reconstruction -! recons (OUT) - Array of reconstructed coefficients for total elements -! order - Order of the scheme (2 or 3) -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient_PPM(fcubehalo, recons, order) - - -! USE CubedSphereTrans -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), INTENT(IN) :: fcubehalo - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(OUT) :: recons - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind) :: width - - ! ABP width between elements - width = pih / DBLE(ncube_reconstruct-1) - - DO p = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - ! df/dalfa - recons(1,i,j,p) = & - (+ fcubehalo(i+2,j,p) - 8.0 * fcubehalo(i+1,j,p) & - + 8.0 * fcubehalo(i-1,j,p) - fcubehalo(i-2,j,p)) / & - (- 12.0 * width) - - ! df/dbeta - recons(2,i,j,p) = & - (+ fcubehalo(i,j+2,p) - 8.0 * fcubehalo(i,j+1,p) & - + 8.0 * fcubehalo(i,j-1,p) - fcubehalo(i,j-2,p)) / & - (- 12.0 * width) - - ! Stretching - recons(1,i,j,p) = recons(1,i,j,p) / (one + abp_centroid(1,i,j)**2) - recons(2,i,j,p) = recons(2,i,j,p) / (one + abp_centroid(2,i,j)**2) - - ! Third order scheme - IF (order > 2) THEN - ! d^2f/dx^2 - recons(3,i,j,p) = (- fcubehalo(i+2,j,p) & - + 16_dbl_kind * fcubehalo(i+1,j,p) & - - 30_dbl_kind * fcubehalo(i,j,p) & - + 16_dbl_kind * fcubehalo(i-1,j,p) & - - fcubehalo(i-2,j,p) & - ) / (12_dbl_kind * width**2) - - ! d^2f/dy^2 - recons(4,i,j,p) = (- fcubehalo(i,j+2,p) & - + 16_dbl_kind * fcubehalo(i,j+1,p) & - - 30_dbl_kind * fcubehalo(i,j,p) & - + 16_dbl_kind * fcubehalo(i,j-1,p) & - - fcubehalo(i,j-2,p) & - ) / (12_dbl_kind * width**2) - - ! d^2f/dxdy - recons(5,i,j,p) = & - (+ fcubehalo(i+1,j+1,p) - fcubehalo(i-1,j+1,p) & - - fcubehalo(i+1,j-1,p) + fcubehalo(i-1,j-1,p) & - ) / (4.0 * width * width) - - ! Stretching - recons(3,i,j,p) = & - (- 2.0 * abp_centroid(1,i,j) * (one + abp_centroid(1,i,j)**2) * recons(1,i,j,p) & - + recons(3,i,j,p)) / (one + abp_centroid(1,i,j)**2)**2 - - recons(4,i,j,p) = & - (- 2.0 * abp_centroid(2,i,j) * (one + abp_centroid(2,i,j)**2) * recons(2,i,j,p) & - + recons(4,i,j,p)) / (one + abp_centroid(2,i,j)**2)**2 - - recons(5,i,j,p) = recons(5,i,j,p) / & - ((one + abp_centroid(1,i,j)**2) * (one + abp_centroid(2,i,j)**2)) - - ! Scaling - recons(3,i,j,p) = 0.5 * recons(3,i,j,p) - recons(4,i,j,p) = 0.5 * recons(4,i,j,p) - ENDIF - ENDDO - ENDDO - ENDDO - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE ReconstructABPGradient -! -! Description: -! Compute the reconstructed gradient in gnomonic coordinates for each -! ABP element. -! -! Parameters: -! fcube - Scalar field on the cubed sphere to use in reconstruction -! halomethod - Method for computing halo elements -! (0) Piecewise constant -! (1) Piecewise linear -! (3) Piecewise cubic -! recons_method - Method for computing the sub-grid scale gradient -! (0) Non-equidistant linear reconstruction -! (1) Non-equidistant parabolic reconstruction -! (2) Piecewise linear reconstruction with stretching -! (3) Piecewise parabolic reconstruction with stretching -! order - Order of the method being applied -! kmono - Apply monotone limiting (1) or not (0) -! recons (INOUT) - Array of reconstructed coefficients -!------------------------------------------------------------------------------ - SUBROUTINE ReconstructABPGradient( & - fcube, halomethod, recons_method, order, kmono, recons, kpd, kscheme) - -! USE InterpolateCSLL_Utils - - IMPLICIT NONE - - REAL (KIND=dbl_kind), & - DIMENSION(1:ncube_reconstruct-1, 1:ncube_reconstruct-1, 6), INTENT(IN) :: fcube - - INTEGER (KIND=int_kind), INTENT(IN) :: halomethod, recons_method - INTEGER (KIND=int_kind), INTENT(IN) :: order, kmono, kpd, kscheme - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, p - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6) :: fcubehalo - - ! Report status - WRITE (*,*) '...Performing sub-grid scale reconstruction on ABP grid' - - ! Compute element haloes - WRITE(*,*) "fill cubed-sphere halo for reconstruction" - DO p = 1, 6 - IF (halomethod == 0) THEN - CALL CubedSphereFillHalo(fcube, fcubehalo, p, ncube_reconstruct, 2) - - ELSEIF (halomethod == 1) THEN - CALL CubedSphereFillHalo_Linear(fcube, fcubehalo, p, ncube_reconstruct) - - ELSEIF (halomethod == 3) THEN - !halomethod is always 3 in the standard CSLAM setup - CALL CubedSphereFillHalo_Cubic(fcube, fcubehalo, p, ncube_reconstruct) - ELSE - WRITE (*,*) 'Fatal Error: In ReconstructABPGradient' - WRITE (*,*) 'Invalid halo method: ', halomethod - WRITE (*,*) 'Halo method must be 0, 1 or 3.' - STOP - ENDIF - ENDDO - - ! Nonequidistant linear reconstruction - IF (recons_method == 1) THEN - CALL ReconstructABPGradient_NEL(fcubehalo, recons, order) - - ! Nonequidistant parabolic reconstruction (JCP paper) - ELSEIF (recons_method == 2) THEN - WRITE(*,*) "Nonequidistant parabolic reconstruction" - CALL ReconstructABPGradient_NEP(fcubehalo, recons, order) - - ! Piecewise linear reconstruction with rotation - ELSEIF (recons_method == 3) THEN - CALL ReconstructABPGradient_PLM(fcubehalo, recons, order) - - ! Piecewise parabolic reconstruction with rotation - ELSEIF (recons_method == 4) THEN - CALL ReconstructABPGradient_PPM(fcubehalo, recons, order) - - ELSE - WRITE(*,*) 'Fatal Error: In ReconstructABPGradient' - WRITE(*,*) 'Specified recons_method out of range. Given: ', recons_method - WRITE(*,*) 'Valid values: 1, 2, 3, 4' - STOP - ENDIF - - ! Apply monotone filtering - SELECT CASE (kmono) - CASE (0) !Do nothing - WRITE(*,*) "no filter applied to the reconstruction" - CASE (1) - - !Simplest filter: just scales the recon so it's extreme value - !is no bigger than the original values of this point and its neighbors - CALL MonotonizeABPGradient(fcubehalo, order, recons, .FALSE.) - - CASE (2) - - !Applies a more sophisticated Van Leer limiter (or, to be consistent, a filter) - CALL VanLeerLimit(fcubehalo, order, recons) - - CASE (3) - - !Applies a selective filter - CALL MonotonizeABPGradient(fcubehalo, order, recons, .TRUE.) - - CASE (4) - - !A filter that filters the linear part first - CALL MonotonizeABPGradient_New(fcubehalo, order, recons) - - CASE DEFAULT - WRITE(*,*) "Limiter kmono = ", kmono, " does not exist." - STOP 1201 - - END SELECT - - !Apply positive-definite filtering, if desired. This should - !ONLY be applied to the S-L method, since the flux-form - !method needs something different done. (In particular, using - !positive-definite reconstructions does not ensure that a flux- - !form scheme is positive definite, since we could get negatives - !when subtracting the resulting fluxes.) - !HOWEVER...we will allow this to be enabled, for testing purposes - IF ( (kpd > 0 .AND. kscheme == 2) .OR. (kpd == 2 .AND. kscheme == 4) ) THEN - WRITE(*,*) "applying positive deifnite constraint" - CALL PosDefABPGradient(fcubehalo, order, recons) - END IF - - - END SUBROUTINE - - - -!------------------------------------------------------------------------------ -!------------------------------------------------------------------------------ -! SUBROUTINE AdjustLimiter -! -! Description: -! Adjust the slope limiter based on new point values. -! -! Parameters: -! value - Point value -! element_value - Value at the center of the element -! local_max - Local maximum value of the function (from neighbours) -! local_min - Local minimum value of the function (to neighbours) -! min_phi (INOUT) - Slope limiter -!------------------------------------------------------------------------------ - SUBROUTINE AdjustLimiter(value, element_value, local_min, local_max, min_phi) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), INTENT(IN) :: value, element_value - REAL (KIND=dbl_kind), INTENT(IN) :: local_min, local_max - REAL (KIND=dbl_kind), INTENT(INOUT) :: min_phi - - ! Local variables - REAL (KIND=dbl_kind) :: phi = 0.0 - - IF ((local_min > element_value ) .OR. (local_max < element_value )) THEN - WRITE (*,*) 'Fatal Error: In AdjustLimiter' - WRITE (*,*) 'Local min: ', local_min, ' max: ', local_max - WRITE (*,*) 'Elemn: ', element_value - STOP - ENDIF - - ! Check against the minimum bound on the reconstruction - IF (value - element_value > tiny * value) THEN - phi = (local_max - element_value) / & - (value - element_value) - - min_phi = MIN(min_phi, phi) - - ! Check against the maximum bound on the reconstruction - ELSEIF (value - element_value < -tiny * value) THEN - phi = (local_min - element_value) / & - (value - element_value) - - min_phi = MIN(min_phi, phi) - - ENDIF - - IF (min_phi < 0.0) THEN - WRITE (*,*) 'Fatal Error: In AdjustLimiter' - WRITE (*,*) 'Min_Phi: ', min_phi - WRITE (*,*) 'Phi: ', phi - WRITE (*,*) 'Value: ', value - WRITE (*,*) 'Elemn: ', element_value - WRITE (*,*) 'Val-E: ', value - element_value - STOP - ENDIF - - END SUBROUTINE - -!------------------------------------------------------------------------------ -! SUBROUTINE VanLeerLimit -! -! Description: -! Apply a 2D Van Leer-type limiter to a reconstruction. This acts ONLY -! on the linear part of the reconstruction , if any. If passed a PCoM -! reconstruction, this just returns without altering the recon. -! -! Parameters: -! fcubehalo - Scalar field on the cubed sphere to use in reconstruction -! order - Order of the reconstruction -! recons (INOUT) - Array of reconstructed coefficients -! -! Remarks: -! The Van Leer Limiter described here is given on pages 328--329 -! of Dukowicz and Baumgardner (2000). There are no guarantees -! on what it will do to PPM. -!------------------------------------------------------------------------------ - SUBROUTINE VanLeerLimit(fcubehalo, order, recons) - - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(-1:ncube_reconstruct+1, -1:ncube_reconstruct+1, 6), & - INTENT(IN) :: fcubehalo - - INTEGER (KIND=int_kind), INTENT(IN) :: order - - REAL (KIND=dbl_kind), DIMENSION(:,:,:,:), INTENT(INOUT) :: recons - - ! Local variables - INTEGER (KIND=int_kind) :: i, j, k, m, n - - REAL (KIND=dbl_kind) :: local_min, local_max, value, phi, min_phi, & - recon_min, recon_max - - ! The first-order piecewise constant scheme is monotone by construction - IF (order == 1) THEN - RETURN - ENDIF - - ! Apply monotone limiting - DO k = 1, 6 - DO j = 1, ncube_reconstruct-1 - DO i = 1, ncube_reconstruct-1 - CALL ABPHaloMinMax(fcubehalo, i, j, k, local_min, local_max,.FALSE.) - - ! Initialize the limiter - min_phi = one - - ! For the second-order calculation, the minima and maxima will occur - ! at the corner points of the element. For the Van Leer limiter, we - !wish to find BOTH of the reconstruction extrema. - recon_min = bignum - recon_max = -bignum - - DO m = i, i+1 - DO n = j, j+1 - - ! Evaluate the function at each corner point - CALL EvaluateABPReconstruction( & - fcubehalo, recons, i, j, k, gp(m), gp(n), order, value) - recon_min = MIN(recon_min, value) - recon_max = MAX(recon_max, value) - - ENDDO - ENDDO - - !This is equation 27 in Dukowicz and Baumgardner 2000 - min_phi = MIN(one, MAX(0.0, (local_min - fcubehalo(i,j,k))/(recon_min - fcubehalo(i,j,k))), & - MAX(0.0, (local_max - fcubehalo(i,j,k))/(recon_max - fcubehalo(i,j,k))) ) - - IF ((min_phi < -tiny) .OR. (min_phi > one + tiny)) THEN - WRITE (*,*) 'Fatal Error: In MonotonizeABPGradient' - WRITE (*,*) 'Slope limiter out of range: ', min_phi - STOP - ENDIF - - ! Apply monotone limiter to all reconstruction coefficients - recons(1,i,j,k) = min_phi * recons(1,i,j,k) - recons(2,i,j,k) = min_phi * recons(2,i,j,k) - - END DO - END DO - END DO - - - - - END SUBROUTINE VanLeerLimit - - !------------------------------------------------------------------------------ - ! SUBROUTINE EquiangularElementArea - ! - ! Description: - ! Compute the area of a single equiangular cubed sphere grid cell. - ! - ! Parameters: - ! alpha - Alpha coordinate of lower-left corner of grid cell - ! da - Delta alpha - ! beta - Beta coordinate of lower-left corner of grid cell - ! db - Delta beta - !------------------------------------------------------------------------------ - REAL(KIND=dbl_kind) FUNCTION EquiangularElementArea(alpha, da, beta, db) - - IMPLICIT NONE - -! REAL (kind=dbl_kind) :: EquiangularElementArea - REAL (kind=dbl_kind) :: alpha, da, beta, db - REAL (kind=dbl_kind) :: a1, a2, a3, a4 - - ! Calculate interior grid angles - a1 = EquiangularGridAngle(alpha , beta ) - a2 = pi - EquiangularGridAngle(alpha+da, beta ) - a3 = pi - EquiangularGridAngle(alpha , beta+db) - a4 = EquiangularGridAngle(alpha+da, beta+db) - - ! Area = r*r*(-2*pi+sum(interior angles)) - EquiangularElementArea = -pi2 + a1 + a2 + a3 + a4 - - END FUNCTION EquiangularElementArea - - !------------------------------------------------------------------------------ - ! FUNCTION EquiangularGridAngle - ! - ! Description: - ! Compute the angle between equiangular cubed sphere projection grid lines. - ! - ! Parameters: - ! alpha - Alpha coordinate of evaluation point - ! beta - Beta coordinate of evaluation point - !------------------------------------------------------------------------------ - REAL(KIND=dbl_kind) FUNCTION EquiangularGridAngle(alpha, beta) - IMPLICIT NONE - REAL (kind=dbl_kind) :: alpha, beta - EquiangularGridAngle = ACOS(-SIN(alpha) * SIN(beta)) - END FUNCTION EquiangularGridAngle - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! halo region around the specified panel. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -! nhalo - Number of halo/ghost elements around each panel -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo(parg, zarg, np, ncube, nhalo) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube,nhalo - - ! Local variables - INTEGER (KIND=int_kind) :: jh,jhy - - !zarg = 0.0 !DBG - zarg(1:ncube-1,1:ncube-1,np) = parg(1:ncube-1,1:ncube-1,np) - - zarg(1-nhalo:0,1-nhalo:0,np) = 0.0 - zarg(1-nhalo:0,ncube:ncube+nhalo-1,np) = 0.0 - zarg(ncube:ncube+nhalo-1,1-nhalo:0,np) = 0.0 - zarg(ncube:ncube+nhalo-1,ncube:ncube+nhalo-1,np) = 0.0 - - ! Equatorial panels - IF (np==1) THEN - DO jh=1,nhalo - zarg(ncube+jh-1,1:ncube-1 ,1) = parg(jh ,1:ncube-1 ,2) !exchange right - zarg(1-jh ,1:ncube-1 ,1) = parg(ncube-jh ,1:ncube-1 ,4) !exchange left - zarg(1:ncube-1 ,1-jh ,1) = parg(1:ncube-1 ,ncube-jh ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,1) = parg(1:ncube-1 ,jh ,6) !exchange over - ENDDO - - ELSE IF (np==2) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,2) = parg(ncube-jh,1:ncube-1 ,1) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,2) = parg(jh ,1:ncube-1 ,3) !exchange right - zarg(1:ncube-1 ,1-jh ,2) = parg(ncube-jh,ncube-1:1:-1,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,2) = parg(ncube-jh,1:ncube-1 ,6) !exchange over - ENDDO - - ELSE IF (np==3) THEN - DO jh=1,nhalo - zarg(ncube+jh-1,1:ncube-1 ,3) = parg(jh ,1:ncube-1,4) !exchange right - zarg(1-jh ,1:ncube-1 ,3) = parg(ncube-jh ,1:ncube-1,2) !exchange left - zarg(1:ncube-1 ,1-jh ,3) = parg(ncube-1:1:-1,jh ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,3) = parg(ncube-1:1:-1,ncube-jh ,6) !exchange over - ENDDO - - ELSE IF (np==4) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,4) = parg(ncube-jh,1:ncube-1 ,3) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,4) = parg(jh ,1:ncube-1 ,1) !exchange right - zarg(1:ncube-1 ,1-jh ,4) = parg(jh ,1:ncube-1 ,5) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,4) = parg(jh ,ncube-1:1:-1,6) !exchange over - ENDDO - - ! Bottom panel - ELSE IF (np==5) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,5) = parg(1:ncube-1 ,jh ,4) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,5) = parg(ncube-1:1:-1,jh ,2) !exchange right - zarg(1:ncube-1 ,1-jh ,5) = parg(ncube-1:1:-1,jh ,3) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,5) = parg(1:ncube-1 ,jh ,1) !exchange over - ENDDO - - ! Top panel - ELSE IF (np==6) THEN - DO jh=1,nhalo - zarg(1-jh ,1:ncube-1 ,6) = parg(ncube-1:1:-1,ncube-jh,4) !exchange left - zarg(ncube+jh-1,1:ncube-1 ,6) = parg(1:ncube-1 ,ncube-jh,2) !exchange right - zarg(1:ncube-1 ,1-jh ,6) = parg(1:ncube-1 ,ncube-jh,1) !exchange below - zarg(1:ncube-1 ,ncube+jh-1,6) = parg(ncube-1:1:-1,ncube-jh,3) !exchange over - ENDDO - - ELSE - WRITE (*,*) 'Fatal error: In CubedSphereFillHalo' - WRITE (*,*) 'Invalid panel id ', np - STOP - ENDIF - - END SUBROUTINE CubedSphereFillHalo - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo_Linear -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! 2-element halo region around the specified panel. Use linear order -! interpolation to translate between panels. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo_Linear(parg, zarg, np, ncube) - -! USE CubedSphereTrans ! Cubed sphere transforms - - IMPLICIT NONE - - INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube - - ! Local variables - INTEGER (KIND=int_kind) :: ii, iref, jj, ipanel, imin, imax - REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta - - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg - - ! Use 0.0 order interpolation to begin - CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) - - zarg(:,:,np) = yarg(:,:,np) - - ! Calculate the overlapping alpha coordinates - width = pih / DBLE(ncube-1) - - DO jj = 1, nhalo - DO ii = 0, ncube - prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq - beta = - width * (DBLE(jj-1) + 0.5) - piq - - CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & - newalpha(ii,jj), newbeta) - ENDDO - ENDDO - - ! Now apply linear interpolation to obtain edge components - DO jj = 1, nhalo - ! Reset the reference index - iref = 2 - - ! Interpolation can be applied to more elements after first band - IF (jj == 1) THEN - imin = 1 - imax = ncube-1 - ELSE - imin = 0 - imax = ncube - ENDIF - - ! Apply linear interpolation - DO ii = imin, imax - DO WHILE ((iref .NE. ncube-1) .AND. & - (newalpha(ii,jj) > prealpha(iref,jj))) - iref = iref + 1 - ENDDO - - IF ((newalpha(ii,jj) > prealpha(iref-1,jj)) .AND. & - (newalpha(ii,jj) .LE. prealpha(iref ,jj))) & - THEN - a = (newalpha(ii,jj) - prealpha(iref-1,jj)) / & - (prealpha(iref,jj) - prealpha(iref-1,jj)) - - IF ((a < 0.0) .OR. (a > one)) THEN - WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' - WRITE (*,*) 'a out of bounds' - STOP - ENDIF - - ! Bottom edge of panel - zarg(ii, 1-jj, np) = & - (one - a) * yarg(iref-1, 1-jj, np) + & - a * yarg(iref, 1-jj, np) - - ! Left edge of panel - zarg(1-jj, ii, np) = & - (one - a) * yarg(1-jj, iref-1, np) + & - a * yarg(1-jj, iref, np) - - ! Top edge of panel - zarg(ii, ncube+jj-1, np) = & - (one - a) * yarg(iref-1, ncube+jj-1, np) + & - a * yarg(iref, ncube+jj-1, np) - - ! Right edge of panel - zarg(ncube+jj-1, ii, np) = & - (one - a) * yarg(ncube+jj-1, iref-1, np) + & - a * yarg(ncube+jj-1, iref, np) - - ELSE - WRITE (*,*) 'FAIL in CubedSphereFillHalo_Linear' - WRITE (*,*) 'ii: ', ii, ' jj: ', jj - WRITE (*,*) 'newalpha: ', newalpha(ii,jj) - WRITE (*,*) 'prealpha: ', prealpha(iref-1,jj), '-', prealpha(iref,jj) - STOP - ENDIF - ENDDO - ENDDO - - ! Fill in corner bits - zarg(0, 0, np) = & - 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & - zarg(-1,0,np) + zarg(0,-1,np)) - zarg(0, ncube, np) = & - 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & - zarg(-1,ncube,np) + zarg(1,ncube,np)) - zarg(ncube, 0, np) = & - 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & - zarg(ncube,-1,np) + zarg(ncube,1,np)) - zarg(ncube, ncube, np) = & - 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & - zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) - - END SUBROUTINE CubedSphereFillHalo_Linear - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereFillHalo_Cubic -! -! Description: -! Recompute the cubed sphere data storage array, with the addition of a -! 2-element halo region around the specified panel. Use higher order -! interpolation to translate between panels. -! -! Parameters: -! parg - Current panel values -! zarg (OUT) - Calculated panel values with halo/ghost region -! np - Panel number -! ncube - Dimension of the cubed sphere (# of grid lines) -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereFillHalo_Cubic(parg, zarg, np, ncube) - -! USE CubedSphereTrans ! Cubed sphere transforms -! USE MathUtils ! Has function for 1D cubic interpolation - - IMPLICIT NONE - - INTEGER (KIND=int_kind), PARAMETER :: nhalo = 2 - - REAL (KIND=dbl_kind), DIMENSION(ncube-1, ncube-1, 6), INTENT(IN) :: parg - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6), & - INTENT(OUT) :: zarg - - INTEGER (KIND=int_kind), INTENT(IN) :: np, ncube - - ! Local variables - INTEGER (KIND=int_kind) :: ii, iref, ibaseref, jj, ipanel, imin, imax - REAL (KIND=dbl_kind) :: width, lon, lat, beta, a, newbeta - - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: prealpha - REAL (KIND=dbl_kind), DIMENSION(0:ncube, nhalo) :: newalpha - REAL (KIND=dbl_kind), DIMENSION(1:4) :: C, D, X - - REAL (KIND=dbl_kind), & - DIMENSION(1-nhalo:ncube+nhalo-1, 1-nhalo:ncube+nhalo-1, 6) :: yarg - - ! Use 0.0 order interpolation to begin - CALL CubedSphereFillHalo(parg, yarg, np, ncube, nhalo) - - zarg(:,:,np) = yarg(:,:,np) - - ! Calculate the overlapping alpha coordinates - width = pih / DBLE(ncube-1) - - DO jj = 1, nhalo - DO ii = 0, ncube - ! - ! alpha,beta for the cell center (extending the panel) - ! - prealpha(ii, jj) = width * (DBLE(ii-1) + 0.5) - piq - beta = - width * (DBLE(jj-1) + 0.5) - piq - - CALL CubedSphereABPFromABP(prealpha(ii,jj), beta, 1, 5, & - newalpha(ii,jj), newbeta) - ENDDO - ENDDO - - ! Now apply cubic interpolation to obtain edge components - DO jj = 1, nhalo - ! Reset the reference index, which gives the element in newalpha that - ! is closest to ii, looking towards larger values of alpha. - iref = 2 - - ! Interpolation can be applied to more elements after first band -! IF (jj == 1) THEN -! imin = 1 -! imax = ncube-1 -! ELSE - imin = 0 - imax = ncube -! ENDIF - - ! Apply cubic interpolation - DO ii = imin, imax - DO WHILE ((iref .NE. ncube-1) .AND. & - (newalpha(ii,jj) > prealpha(iref,jj))) - iref = iref + 1 - ENDDO - - ! Smallest index for cubic interpolation - apply special consideration - IF (iref == 2) THEN - ibaseref = iref-1 - - ! Largest index for cubic interpolation - apply special consideration - ELSEIF (iref == ncube-1) THEN - ibaseref = iref-3 - - ! Normal range - ELSE - ibaseref = iref-2 - ENDIF - - ! Bottom edge of panel - zarg(ii, 1-jj, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ibaseref:ibaseref+3, 1-jj, np)) - - ! Left edge of panel - zarg(1-jj, ii, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(1-jj, ibaseref:ibaseref+3, np)) - - ! Top edge of panel - zarg(ii, ncube+jj-1, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ibaseref:ibaseref+3, ncube+jj-1, np)) - - ! Right edge of panel - zarg(ncube+jj-1, ii, np) = & - CUBIC_EQUISPACE_INTERP( & - width, newalpha(ii,jj) - prealpha(ibaseref,jj), & - yarg(ncube+jj-1, ibaseref:ibaseref+3, np)) - - ENDDO - ENDDO - - ! Fill in corner bits - zarg(0, 0, np) = & - 0.25 * (zarg(1,0,np) + zarg(0,1,np) + & - zarg(-1,0,np) + zarg(0,-1,np)) - zarg(0, ncube, np) = & - 0.25 * (zarg(0,ncube-1,np) + zarg(0,ncube+1,np) + & - zarg(-1,ncube,np) + zarg(1,ncube,np)) - zarg(ncube, 0, np) = & - 0.25 * (zarg(ncube-1,0,np) + zarg(ncube+1,0,np) + & - zarg(ncube,-1,np) + zarg(ncube,1,np)) - zarg(ncube, ncube, np) = & - 0.25 * (zarg(ncube-1,ncube,np) + zarg(ncube+1,ncube,np) + & - zarg(ncube,ncube-1,np) + zarg(ncube,ncube+1,np)) - - END SUBROUTINE CubedSphereFillHalo_Cubic - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromABP -! -! Description: -! Determine the (alpha,beta,idest) coordinate of a source point on -! panel isource. -! -! Parameters: -! alpha_in - Alpha coordinate in -! beta_in - Beta coordinate in -! isource - Source panel -! idest - Destination panel -! alpha_out (OUT) - Alpha coordinate out -! beta_out (OUT) - Beta coordiante out -!------------------------------------------------------------------------------ - SUBROUTINE CubedSphereABPFromABP(alpha_in, beta_in, isource, idest, & - alpha_out, beta_out) - - IMPLICIT NONE - - REAL (KIND=dbl_kind), INTENT(IN) :: alpha_in, beta_in - INTEGER (KIND=int_kind), INTENT(IN) :: isource, idest - REAL (KIND=dbl_kind), INTENT(OUT) :: alpha_out, beta_out - - ! Local variables - REAL (KIND=dbl_kind) :: a1, b1 - REAL (KIND=dbl_kind) :: xx, yy, zz - REAL (KIND=dbl_kind) :: sx, sy, sz - - ! Convert to relative Cartesian coordinates - a1 = TAN(alpha_in) - b1 = TAN(beta_in) - - sz = (one + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - - ! Convert to full Cartesian coordinates - IF (isource == 6) THEN - yy = sx; xx = -sy; zz = sz - - ELSEIF (isource == 5) THEN - yy = sx; xx = sy; zz = -sz - - ELSEIF (isource == 1) THEN - yy = sx; zz = sy; xx = sz - - ELSEIF (isource == 3) THEN - yy = -sx; zz = sy; xx = -sz - - ELSEIF (isource == 2) THEN - xx = -sx; zz = sy; yy = sz - - ELSEIF (isource == 4) THEN - xx = sx; zz = sy; yy = -sz - - ELSE - WRITE(*,*) 'Fatal Error: Source panel invalid in CubedSphereABPFromABP' - WRITE(*,*) 'panel = ', isource - STOP - ENDIF - - ! Convert to relative Cartesian coordinates on destination panel - IF (idest == 6) THEN - sx = yy; sy = -xx; sz = zz - - ELSEIF (idest == 5) THEN - sx = yy; sy = xx; sz = -zz - - ELSEIF (idest == 1) THEN - sx = yy; sy = zz; sz = xx - - ELSEIF (idest == 3) THEN - sx = -yy; sy = zz; sz = -xx - - ELSEIF (idest == 2) THEN - sx = -xx; sy = zz; sz = yy - - ELSEIF (idest == 4) THEN - sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: Dest panel invalid in CubedSphereABPFromABP' - WRITE(*,*) 'panel = ', idest - STOP - ENDIF - IF (sz < 0) THEN - WRITE(*,*) 'Fatal Error: In CubedSphereABPFromABP' - WRITE(*,*) 'Invalid relative Z coordinate' - STOP - ENDIF - - ! Use panel information to calculate (alpha, beta) coords - alpha_out = ATAN(sx / sz) - beta_out = ATAN(sy / sz) - - END SUBROUTINE - - -!------------------------------------------------------------------------------ -! FUNCTION CUBIC_EQUISPACE_INTERP -! -! Description: -! Apply cubic interpolation on the specified array of values, where all -! points are equally spaced. -! -! Parameters: -! dx - Spacing of points -! x - X coordinate where interpolation is to be applied -! y - Array of 4 values = f(x + k * dx) where k = 0,1,2,3 -!------------------------------------------------------------------------------ - FUNCTION CUBIC_EQUISPACE_INTERP(dx, x, y) - - IMPLICIT NONE - - REAL (KIND=dbl_kind) :: CUBIC_EQUISPACE_INTERP - REAL (KIND=dbl_kind) :: dx, x - REAL (KIND=dbl_kind), DIMENSION(1:4) :: y - - CUBIC_EQUISPACE_INTERP = & - (-y(1) / (6.0 * dx**3)) * (x - dx) * (x - 2.0 * dx) * (x - 3.0 * dx) + & - ( y(2) / (2.0 * dx**3)) * (x) * (x - 2.0 * dx) * (x - 3.0 * dx) + & - (-y(3) / (2.0 * dx**3)) * (x) * (x - dx) * (x - 3.0 * dx) + & - ( y(4) / (6.0 * dx**3)) * (x) * (x - dx) * (x - 2.0 * dx) - - END FUNCTION CUBIC_EQUISPACE_INTERP - -! FUNCTION I_10_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind) :: I_10_AB -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! I_10_ab = -ASINH(COS(alpha) * TAN(beta)) -! END FUNCTION I_10_AB -!! -! -! REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! I_01_ab = -ASINH(COS(beta) * TAN(alpha)) -! END FUNCTION I_01_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) -! END FUNCTION I_20_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) -! END FUNCTION I_02_AB -! -! REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) -! IMPLICIT NONE -! REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta -! -! I_11_ab = -SQRT(1.0+TAN(alpha)**2+TAN(beta)**2) -! END FUNCTION I_11_AB -! - - -END MODULE reconstruct - diff --git a/components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 b/components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 deleted file mode 100755 index ed87b29c5a6..00000000000 --- a/components/eam/tools/topo_tool/orographic_drag_toolkit/remap.F90 +++ /dev/null @@ -1,1562 +0,0 @@ -MODULE remap - INTEGER, PARAMETER :: & - int_kind = KIND(1), & - real_kind = SELECTED_REAL_KIND(p=14,r=100),& - dbl_kind = selected_real_kind(13) - - INTEGER :: nc,nhe - -! LOGICAL, PARAMETER:: ldbgr_r = .FALSE. - LOGICAL :: ldbgr - LOGICAL :: ldbg_global - - REAL(kind=real_kind), PARAMETER :: & - one = 1.0 ,& - aa = 1.0 ,& - tiny= 1.0E-9 ,& - bignum = 1.0E20 - REAL (KIND=dbl_kind), parameter :: fuzzy_width = 10.0*tiny !CAM-SE add - - contains - - - subroutine compute_weights_cell(xcell_in,ycell_in,jx,jy,nreconstruction,xgno,ygno,& - jx_min, jx_max, jy_min, jy_max,tmp,& - ngauss,gauss_weights,abscissae,weights,weights_eul_index,jcollect,jmax_segments,& - nc_in,nhe_in,nvertex,ldbg) - - implicit none - integer (kind=int_kind) , intent(in):: nreconstruction, jx,jy,ngauss,jmax_segments - real (kind=real_kind) , dimension(0:nvertex+1) :: xcell_in,ycell_in -! real (kind=real_kind) , dimension(0:5), intent(in):: xcell_in,ycell_in - integer (kind=int_kind), intent(in) :: nc_in,nhe_in,nvertex - logical, intent(in) :: ldbg - ! - ! ipanel is just for debugging - ! - integer (kind=int_kind), intent(in) :: jx_min, jy_min, jx_max, jy_max - real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: xgno - real (kind=real_kind), dimension(-nhe_in:nc_in+2+nhe_in), intent(in) :: ygno - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - ! - ! boundaries of domain - ! - real (kind=real_kind):: tmp - ! - ! Number of Eulerian sub-cell integrals for the cell in question - ! - integer (kind=int_kind), intent(out) :: jcollect - ! - ! local workspace - ! - ! - ! max number of line segments is: - ! - ! (number of longitudes)*(max average number of crossings per line segment = 3)*ncube*2 - ! - real (kind=real_kind) , & - dimension(jmax_segments,nreconstruction), intent(out) :: weights - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(out) :: weights_eul_index - - real (kind=real_kind), dimension(0:3) :: x,y - integer (kind=int_kind),dimension(0:5) :: jx_eul, jy_eul - integer (kind=int_kind) :: jsegment,i - ! - ! variables for registering crossings with Eulerian latitudes and longitudes - ! - integer (kind=int_kind) :: jcross_lat, iter - ! - ! max. crossings per side is 2*nhe - ! - real (kind=real_kind), & - dimension(jmax_segments,2) :: r_cross_lat - integer (kind=int_kind), & - dimension(jmax_segments,2) :: cross_lat_eul_index - real (kind=real_kind) , dimension(1:nvertex) :: xcell,ycell - - real (kind=real_kind) :: eps - - ldbg_global = ldbg - ldbgr = ldbg - - nc = nc_in - nhe = nhe_in - - xcell = xcell_in(1:nvertex) - ycell = ycell_in(1:nvertex) - - - ! - ! this is to avoid ill-conditioning problems - ! - eps = 1.0E-9 - - jsegment = 0 - weights = 0.0D0 - jcross_lat = 0 - ! - !********************** - ! - ! Integrate cell sides - ! - !********************** - - - IF (jx<-nhe.OR.jx>nc+1+nhe.OR.jy<-nhe.OR.jy>nc+1+nhe) THEN - WRITE(*,*) "jx,jy,-nhe,nc+1+nhe",jx,jy,-nhe,nc+1+nhe - STOP - END IF - - - call side_integral(xcell,ycell,nvertex,jsegment,jmax_segments,& - weights,weights_eul_index,nreconstruction,jx,jy,xgno,ygno,jx_min, jx_max, jy_min, jy_max,& - ngauss,gauss_weights,abscissae,& - jcross_lat,r_cross_lat,cross_lat_eul_index) - - ! - !********************** - ! - ! Do inner integrals - ! - !********************** - ! - call compute_inner_line_integrals_lat_nonconvex(r_cross_lat,cross_lat_eul_index,& - jcross_lat,jsegment,jmax_segments,xgno,jx_min, jx_max, jy_min, jy_max,& - weights,weights_eul_index,& - nreconstruction,ngauss,gauss_weights,abscissae) - ! - ! collect line-segment that reside in the same Eulerian cell - ! - if (jsegment>0) then - call collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) - ! - ! DBG - ! - tmp=0.0 - do i=1,jcollect - tmp=tmp+weights(i,1) - enddo - - IF (abs(tmp)>0.01) THEN - WRITE(*,*) "sum of weights too large",tmp - !stop - END IF - IF (tmp<-1.0E-9) THEN - WRITE(*,*) "sum of weights is negative - negative area?",tmp,jx,jy - ! ldbgr=.TRUE. - !stop - !!turn this off for phys grid as that of E3SM - END IF - else - jcollect = 0 - end if - end subroutine compute_weights_cell - - - ! - !**************************************************************************** - ! - ! organize data and store it - ! - !**************************************************************************** - ! - subroutine collect(weights,weights_eul_index,nreconstruction,jcollect,jsegment,jmax_segments) - implicit none - integer (kind=int_kind) , intent(in) :: nreconstruction - real (kind=real_kind) , dimension(jmax_segments,nreconstruction), intent(inout) :: weights - integer (kind=int_kind), dimension(jmax_segments,2 ), intent(inout) :: weights_eul_index - integer (kind=int_kind), INTENT(OUT ) :: jcollect - integer (kind=int_kind), INTENT(IN ) :: jsegment,jmax_segments - ! - ! local workspace - ! - integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k,h - logical :: ltmp - - real (kind=real_kind) , dimension(jmax_segments,nreconstruction) :: weights_out - integer (kind=int_kind), dimension(jmax_segments,2 ) :: weights_eul_index_out - - weights_out = 0.0D0 - weights_eul_index_out = -100 - - imin = MINVAL(weights_eul_index(1:jsegment,1)) - imax = MAXVAL(weights_eul_index(1:jsegment,1)) - jmin = MINVAL(weights_eul_index(1:jsegment,2)) - jmax = MAXVAL(weights_eul_index(1:jsegment,2)) - - ltmp = .FALSE. - - jcollect = 1 - - do j=jmin,jmax - do i=imin,imax - do k=1,jsegment - if (weights_eul_index(k,1)==i.AND.weights_eul_index(k,2)==j) then - weights_out(jcollect,1:nreconstruction) = & - weights_out(jcollect,1:nreconstruction) + weights(k,1:nreconstruction) - ltmp = .TRUE. - h = k - endif - enddo - if (ltmp) then - weights_eul_index_out(jcollect,:) = weights_eul_index(h,:) - jcollect = jcollect+1 - endif - ltmp = .FALSE. - enddo - enddo - jcollect = jcollect-1 - weights = weights_out - weights_eul_index = weights_eul_index_out - end subroutine collect - ! - !***************************************************************************************** - ! - ! - ! - !***************************************************************************************** - ! - subroutine compute_inner_line_integrals_lat(r_cross_lat,cross_lat_eul_index,& - jcross_lat,jsegment,jmax_segments,xgno,jx_min,jx_max,jy_min, jy_max,weights,weights_eul_index,& - nreconstruction,ngauss,gauss_weights,abscissae)!phl add jx_min etc. - implicit none - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - ! - ! variables for registering crossings with Eulerian latitudes and longitudes - ! - integer (kind=int_kind), intent(in):: jcross_lat, jmax_segments,nreconstruction,ngauss - integer (kind=int_kind), intent(inout):: jsegment - ! - ! max. crossings per side is 2*nhe - ! - real (kind=real_kind), & - dimension(jmax_segments,2), intent(in):: r_cross_lat - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(in):: cross_lat_eul_index - integer (kind=int_kind), intent(in) ::jx_min, jx_max, jy_min, jy_max - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: xgno - real (kind=real_kind) , & - dimension(jmax_segments,nreconstruction), intent(inout) :: weights - integer (kind=int_kind), & - dimension(jmax_segments,2), intent(inout) :: weights_eul_index - real (kind=real_kind) , dimension(nreconstruction) :: weights_tmp - - integer (kind=int_kind) :: imin, imax, jmin, jmax, i,j,k, isgn, h, eul_jx, eul_jy - integer (kind=int_kind) :: idx_start_y,idx_end_y - logical :: ltmp,lcontinue - real (kind=real_kind), dimension(2) :: rstart,rend,rend_tmp - real (kind=real_kind), dimension(2) :: xseg, yseg -5 FORMAT(10e14.6) - - - if (jcross_lat>0) then - do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) - ! - ! find "first" crossing with Eulerian cell i - ! - do k=1,jcross_lat - if (cross_lat_eul_index(k,2)==i) exit - enddo - do j=k+1,jcross_lat - ! - ! find "second" crossing with Eulerian cell i - ! - if (cross_lat_eul_index(j,2)==i) then - if (r_cross_lat(k,1)0) then - do i=MINVAL(cross_lat_eul_index(1:jcross_lat,2)),MAXVAL(cross_lat_eul_index(1:jcross_lat,2)) - ! WRITE(*,*) "looking at latitude ",i !xxxx - count = 1 - ! - ! find all crossings with Eulerian latitude i - ! - do k=1,jcross_lat - if (cross_lat_eul_index(k,2)==i) then - ! WRITE(*,*) "other crossings with latitude",i ," is ",k!xxxx - r_cross_lat_seg (count,:) = r_cross_lat (k,:) - cross_lat_eul_index_seg(count,:) = cross_lat_eul_index(k,:) - - IF (ldbg_global) then - WRITE(*,*) r_cross_lat_seg(count,1),r_cross_lat_seg(count,2) - WRITE(*,*) " " - END IF - count = count+1 - end if - enddo - count = count-1 - IF (ABS((count/2)-DBLE(count)/2.0)1000) THEN - WRITE(*,*) "search not converging",iter - STOP - END IF - lsame_cell_x = (x(2).GE.xgno(jx_eul).AND.x(2).LE.xgno(jx_eul+1)) - lsame_cell_y = (y(2).GE.ygno(jy_eul).AND.y(2).LE.ygno(jy_eul+1)) -! IF (ldbgr) WRITE(*,*) "lsame_cell_x,lsame_cell_y=",lsame_cell_x,lsame_cell_y - IF (lsame_cell_x.AND.lsame_cell_y) THEN - ! - !**************************** - ! - ! same cell integral - ! - !**************************** - ! -! IF (ldbgr) WRITE(*,*) "same cell integral",jx_eul,jy_eul - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = x(2); yseg(2) = y(2) - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - lcontinue = .FALSE. - ! - ! prepare for next side if (x(2),y(2)) is on a grid line - ! - IF (x(2).EQ.xgno(jx_eul+1).AND.x(3)>xgno(jx_eul+1)) THEN - ! - ! cross longitude jx_eul+1 - ! -! IF (ldbgr) WRITE(*,*) "cross longitude",jx_eul+1 - jx_eul=jx_eul+1 - ELSE IF (x(2).EQ.xgno(jx_eul ).AND.x(3)ygno(jy_eul+1)) THEN - ! - ! register crossing with latitude: line-segments point Northward - ! - jcross_lat = jcross_lat + 1 - jy_eul = jy_eul + 1 -! IF (ldbgr) WRITE(*,*) "cross latitude",jy_eul - cross_lat_eul_index(jcross_lat,1) = jx_eul - cross_lat_eul_index(jcross_lat,2) = jy_eul - r_cross_lat(jcross_lat,1) = x(2) - r_cross_lat(jcross_lat,2) = y(2) - ELSE IF (y(2).EQ.ygno(jy_eul ).AND.y(3)y(1) else "0" - ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" - ! - !******************************************************************************* - ! - ! there is at least one crossing with latitudes but no crossing with longitudes - ! - !******************************************************************************* - ! - yeul = ygno(jy_eul+ysgn1) - IF (x(1).EQ.x(2)) THEN - ! - ! line segment is parallel to longitude (infinite slope) - ! -! IF (ldbgr) WRITE(*,*) "line segment parallel to longitude" - xcross = x(1) - ELSE - slope = (y(2)-y(1))/(x(2)-x(1)) - xcross = x_cross_eul_lat(x(1),y(1),yeul,slope) - ! - ! constrain crossing to be "physically" possible - ! - xcross = MIN(MAX(xcross,xgno(jx_eul)),xgno(jx_eul+1)) - - -! IF (ldbgr) WRITE(*,*) "cross latitude" - ! - ! debugging - ! - IF (xcross.GT.xgno(jx_eul+1).OR.xcross.LT.xgno(jx_eul)) THEN - WRITE(*,*) "xcross is out of range",jx,jy - WRITE(*,*) "xcross-xgno(jx_eul+1), xcross-xgno(jx_eul))",& - xcross-xgno(jx_eul+1), xcross-ygno(jx_eul) - STOP - END IF - END IF - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 - ! - ! register crossing with latitude - ! - jcross_lat = jcross_lat+1 - cross_lat_eul_index(jcross_lat,1) = jx_eul - if (ysgn2>0) then - cross_lat_eul_index(jcross_lat,2) = jy_eul - else - cross_lat_eul_index(jcross_lat,2) = jy_eul+1 - end if - r_cross_lat(jcross_lat,1) = xcross - r_cross_lat(jcross_lat,2) = yeul - ELSE IF (lsame_cell_y) THEN -! IF (ldbgr) WRITE(*,*) "same cell y" - ! - !******************************************************************************* - ! - ! there is at least one crossing with longitudes but no crossing with latitudes - ! - !******************************************************************************* - ! - xsgn1 = (1+INT(SIGN(1.0D0,x(2)-x(1))))/2 !"1" if x(2)>x(1) else "0" - xsgn2 = INT(SIGN(1.0D0,x(2)-x(1))) !"1" if x(2)>x(1) else "-1" - xeul = xgno(jx_eul+xsgn1) -! IF (ldbgr) WRITE(*,*) " crossing longitude",jx_eul+xsgn1 - IF (ABS(x(2)-x(1))x(1) else "0" - xsgn2 = (INT(SIGN(1.0D0,x(2)-x(1)))) !"1" if x(2)>x(1) else "0" - xeul = xgno(jx_eul+xsgn1) - ysgn1 = (1+INT(SIGN(1.0D0,y(2)-y(1))))/2 !"1" if y(2)>y(1) else "0" - ysgn2 = INT(SIGN(1.0D0,y(2)-y(1))) !"1" if y(2)>y(1) else "-1" - yeul = ygno(jy_eul+ysgn1) - - slope = (y(2)-y(1))/(x(2)-x(1)) - IF (ABS(x(2)-x(1))0.AND.xcross.LE.xeul).OR.(xsgn2<0.AND.xcross.GE.xeul)) THEN - ! - ! cross latitude - ! -! IF (ldbgr) WRITE(*,*) "crossing latitude",jy_eul+ysgn1 - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xcross; yseg(2) = yeul - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xcross; y(1) = yeul; jy_eul = jy_eul+ysgn2 - ! - ! register crossing with latitude - ! - jcross_lat = jcross_lat+1 - cross_lat_eul_index(jcross_lat,1) = jx_eul - if (ysgn2>0) then - cross_lat_eul_index(jcross_lat,2) = jy_eul - else - cross_lat_eul_index(jcross_lat,2) = jy_eul+1 - end if - r_cross_lat(jcross_lat,1) = xcross - r_cross_lat(jcross_lat,2) = yeul - ELSE - ! - ! cross longitude - ! -! IF (ldbgr) WRITE(*,*) "crossing longitude",jx_eul+xsgn1 - xseg(1) = x(1); yseg(1) = y(1); xseg(2) = xeul; yseg(2) = ycross - jx_eul_tmp = jx_eul; jy_eul_tmp = jy_eul; - ! - ! prepare for next iteration - ! - x(0) = x(1); y(0) = y(1); x(1) = xeul; y(1) = ycross; jx_eul = jx_eul+xsgn2 - END IF - - END IF - END IF - ! - ! register line-segment (don't register line-segment if outside of panel) - ! - if (jx_eul_tmp>=jx_min.AND.jy_eul_tmp>=jy_min.AND.& - jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1) then - ! jx_eul_tmp<=jx_max-1.AND.jy_eul_tmp<=jy_max-1.AND.side_count<3) then - jsegment=jsegment+1 - weights_eul_index(jsegment,1) = jx_eul_tmp - weights_eul_index(jsegment,2) = jy_eul_tmp - call get_weights_gauss(weights(jsegment,1:nreconstruction),& - xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) - -! if (ldbg_global) then -! OPEN(unit=40, file='side_integral.dat',status='old',access='append') -! WRITE(40,*) xseg(1),yseg(1) -! WRITE(40,*) xseg(2),yseg(2) -! WRITE(40,*) " " -! CLOSE(40) -! end if - - - jdbg=jdbg+1 - - if (xseg(1).EQ.xseg(2))then - slope = bignum - else if (abs(yseg(1) -yseg(2))0) THEN - compute_slope = (y(2)-y(1))/(x(2)-x(1)) - else - compute_slope = bignum - end if - end function compute_slope - - real (kind=real_kind) function y_cross_eul_lon(x,y,xeul,slope) - implicit none - real (kind=real_kind), intent(in) :: x,y - real (kind=real_kind) , intent(in) :: xeul,slope - ! line: y=a*x+b - real (kind=real_kind) :: a,b - b = y-slope*x - y_cross_eul_lon = slope*xeul+b - end function y_cross_eul_lon - - real (kind=real_kind) function x_cross_eul_lat(x,y,yeul,slope) - implicit none - real (kind=real_kind), intent(in) :: x,y - real (kind=real_kind) , intent(in) :: yeul,slope - - if (fuzzy(ABS(slope),fuzzy_width)>0) THEN - x_cross_eul_lat = x+(yeul-y)/slope - ELSE - ! WRITE(*,*) "WARNING: slope is epsilon - ABORT" - x_cross_eul_lat = bignum - END IF - end function x_cross_eul_lat - - subroutine get_weights_exact(weights,xseg,yseg,nreconstruction) -! use cslam_analytic_mod, only: I_00, I_10, I_01, I_20, I_02, I_11 - implicit none - integer (kind=int_kind), intent(in) :: nreconstruction - real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights - real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg - ! - ! compute weights - ! - real (kind=real_kind) :: tmp,slope,b,integral,dx2,xc - integer (kind=int_kind) :: i -! weights(:) = -half*(xseg(1)*yseg(2)-xseg(2)*yseg(1)) !dummy for testing - - weights(1) = ((I_00(xseg(2),yseg(2))-I_00(xseg(1),yseg(1)))) - if (ABS(weights(1))>1.0) THEN - WRITE(*,*) "1 exact weights(jsegment)",weights(1),xseg,yseg - stop - end if - if (nreconstruction>1) then - weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) - weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) - endif - if (nreconstruction>3) then - weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) - weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) - weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) - endif - - end subroutine get_weights_exact - - - - subroutine get_weights_gauss(weights,xseg,yseg,nreconstruction,ngauss,gauss_weights,abscissae) - implicit none - integer (kind=int_kind), intent(in) :: nreconstruction,ngauss - real (kind=real_kind), dimension(nreconstruction), intent(out) :: weights - real (kind=real_kind), dimension(2 ), intent(in) :: xseg,yseg - real (kind=real_kind) :: slope - ! - ! compute weights - ! - ! - ! for Gaussian quadrature - ! - real (kind=real_kind), dimension(ngauss), intent(in) :: gauss_weights, abscissae - - ! if line-segment parallel to x or y use exact formulaes else use qudrature - ! - real (kind=real_kind) :: tmp,b,integral,dx2,xc,x,y - integer (kind=int_kind) :: i - - - - -! if (fuzzy(abs(xseg(1) -xseg(2)),fuzzy_width)==0)then - if (xseg(1).EQ.xseg(2))then - weights = 0.0D0 - else if (abs(yseg(1) -yseg(2))1) then - weights(2) = ((I_10(xseg(2),yseg(2))-I_10(xseg(1),yseg(1)))) - weights(3) = ((I_01(xseg(2),yseg(2))-I_01(xseg(1),yseg(1)))) - endif - if (nreconstruction>3) then - weights(4) = ((I_20(xseg(2),yseg(2))-I_20(xseg(1),yseg(1)))) - weights(5) = ((I_02(xseg(2),yseg(2))-I_02(xseg(1),yseg(1)))) - weights(6) = ((I_11(xseg(2),yseg(2))-I_11(xseg(1),yseg(1)))) - endif - else - - - slope = (yseg(2)-yseg(1))/(xseg(2)-xseg(1)) - b = yseg(1)-slope*xseg(1) - dx2 = 0.5D0*(xseg(2)-xseg(1)) - if (ldbgr) WRITE(*,*) "dx2 and slope in gauss weight",dx2,slope - xc = 0.5D0*(xseg(1)+xseg(2)) - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_00(x,y) - enddo - weights(1) = integral*dx2 - if (nreconstruction>1) then - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_10(x,y) - enddo - weights(2) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_01(x,y) - enddo - weights(3) = integral*dx2 - endif - if (nreconstruction>3) then - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_20(x,y) - enddo - weights(4) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_02(x,y) - enddo - weights(5) = integral*dx2 - integral = 0.0D0 - do i=1,ngauss - x = xc+abscissae(i)*dx2 - y = slope*x+b - integral = integral+gauss_weights(i)*F_11(x,y) - enddo - weights(6) = integral*dx2 - endif - end if - end subroutine get_weights_gauss - - real (kind=real_kind) function F_00(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_00 =y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_00 - - real (kind=real_kind) function F_10(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_10 =x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_10 - - real (kind=real_kind) function F_01(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_01 =-1.0D0/(SQRT(1.0D0+x*x+y*y)) - end function F_01 - - real (kind=real_kind) function F_20(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_20 =x*x*y/((1.0D0+x*x)*SQRT(1.0D0+x*x+y*y)) - end function F_20 - - real (kind=real_kind) function F_02(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,alpha, tmp - - x = x_in - y = y_in - - alpha = ATAN(x) - tmp=y*COS(alpha) - F_02 =-y/SQRT(1.0D0+x*x+y*y)+log(tmp+sqrt(tmp*tmp+1)) - - ! - ! cos(alpha) = 1/sqrt(1+x*x) - ! - end function F_02 - - real (kind=real_kind) function F_11(x_in,y_in) - implicit none - real (kind=real_kind), intent(in) :: x_in,y_in - real (kind=real_kind) :: x,y,tmp - - x = x_in - y = y_in - - F_11 =-x/(SQRT(1.0D0+x*x+y*y)) - end function F_11 - - subroutine which_eul_cell(x,j_eul,gno) - implicit none - integer (kind=int_kind) , intent(inout) :: j_eul - real (kind=real_kind), dimension(3) , intent(in) :: x - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl -! real (kind=real_kind), intent(in) :: eps - - real (kind=real_kind) :: d1,d2,d3,d1p1 - logical :: lcontinue - integer :: iter - - - ! - ! this is not needed in transport code search - ! -! IF (x(1)gno(nc+2+nhe)) j_eul=nc+1+nhe -! RETURN - -! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added - - lcontinue = .TRUE. - iter = 0 - IF (ldbgr) WRITE(*,*) "from which_eul_cell",x(1),x(2),x(3) - DO WHILE (lcontinue) - iter = iter+1 - IF (x(1).GE.gno(j_eul).AND.x(1).LT.gno(j_eul+1)) THEN - lcontinue = .FALSE. - ! - ! special case when x(1) is on top of grid line - ! - IF (x(1).EQ.gno(j_eul)) THEN -! IF (ABS(x(1)-gno(j_eul))1000.OR.j_eul<-nhe.OR.j_eul>nc+2+nhe) THEN - WRITE(*,*) "search in which_eul_cell not converging!", iter,j_eul - WRITE(*,*) "input", x - WRITE(*,*) "gno", gno(nc),gno(nc+1),gno(nc+2),gno(nc+3) - STOP - END IF - END DO - END subroutine which_eul_cell - - - subroutine truncate_vertex(x,j_eul,gno) - implicit none - integer (kind=int_kind) , intent(inout) :: j_eul - real (kind=real_kind) , intent(inout) :: x - real (kind=real_kind), dimension(-nhe:nc+2+nhe), intent(in) :: gno !phl -! real (kind=real_kind), intent(in) :: eps - - logical :: lcontinue - integer :: iter - real (kind=real_kind) :: xsgn,dist,dist_new,tmp - - ! - ! this is not needed in transport code search - ! -! IF (xgno(nc+2+nhe)) j_eul=nc+1+nhe -! -! RETURN - - - lcontinue = .TRUE. - iter = 0 - dist = bignum -! j_eul = MIN(MAX(j_eul,-nhe),nc+1+nhe) !added - xsgn = INT(SIGN(1.0_dbl_kind,x-gno(j_eul))) - DO WHILE (lcontinue) - iter = iter+1 - tmp = x-gno(j_eul) - dist_new = ABS(tmp) - IF (dist_new>dist) THEN - lcontinue = .FALSE. -! ELSE IF (ABS(tmp)<1.0E-11) THEN - ELSE IF (ABS(tmp)<1.0E-9) THEN -! ELSE IF (ABS(tmp)<1.0E-4) THEN - x = gno(j_eul) - lcontinue = .FALSE. - ELSE - j_eul = j_eul+xsgn - dist = dist_new - END IF - IF (iter>10000) THEN - WRITE(*,*) "truncate vertex not converging" - STOP - END IF - END DO - END subroutine truncate_vertex - - - - -!******************************************************************************** -! -! Gauss-Legendre quadrature -! -! Tabulated values -! -!******************************************************************************** -subroutine gauss_points(n,weights,points) - implicit none - real (kind=real_kind), dimension(n), intent(out) :: weights, points - integer (kind=int_kind) , intent(in ) :: n - - select case (n) -! CASE(1) -! abscissae(1) = 0.0D0 -! weights(1) = 2.0D0 - case(2) - points(1) = -sqrt(1.0D0/3.0D0) - points(2) = sqrt(1.0D0/3.0D0) - weights(1) = 1.0D0 - weights(2) = 1.0D0 - case(3) - points(1) = -0.774596669241483377035853079956D0 - points(2) = 0.0D0 - points(3) = 0.774596669241483377035853079956D0 - weights(1) = 0.555555555555555555555555555556D0 - weights(2) = 0.888888888888888888888888888889D0 - weights(3) = 0.555555555555555555555555555556D0 - case(4) - points(1) = -0.861136311594052575223946488893D0 - points(2) = -0.339981043584856264802665659103D0 - points(3) = 0.339981043584856264802665659103D0 - points(4) = 0.861136311594052575223946488893D0 - weights(1) = 0.347854845137453857373063949222D0 - weights(2) = 0.652145154862546142626936050778D0 - weights(3) = 0.652145154862546142626936050778D0 - weights(4) = 0.347854845137453857373063949222D0 - case(5) - points(1) = -(1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) - points(2) = -(1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) - points(3) = 0.0D0 - points(4) = (1.0D0/3.0D0)*sqrt(5.0D0-2.0D0*sqrt(10.0D0/7.0D0)) - points(5) = (1.0D0/3.0D0)*sqrt(5.0D0+2.0D0*sqrt(10.0D0/7.0D0)) - weights(1) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 - weights(2) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 - weights(3) = 128.0D0/225.0D0 - weights(4) = (322.0D0+13.0D0*sqrt(70.0D0))/900.0D0 - weights(5) = (322.0D0-13.0D0*sqrt(70.0D0))/900.0D0 - case default - write(*,*) 'n out of range in glwp of module gll. n=',n - write(*,*) '0 0.0D0) THEN - signum = 1.0D0 - ELSEIF (x < 0.0D0) THEN - signum = -1.0D0 - ELSE - signum = 0.0D0 - ENDIF - end function - -!------------------------------------------------------------------------------ -! FUNCTION SIGNUM_FUZZY -! -! Description: -! Gives the sign of the given real number, returning zero if x is within -! a small amount from zero. -!------------------------------------------------------------------------------ - function signum_fuzzy(x) - implicit none - - real (kind=real_kind) :: signum_fuzzy - real (kind=real_kind) :: x - - IF (x > fuzzy_width) THEN - signum_fuzzy = 1.0D0 - ELSEIF (x < fuzzy_width) THEN - signum_fuzzy = -1.0D0 - ELSE - signum_fuzzy = 0.0D0 - ENDIF - end function - - function fuzzy(x,epsilon) - implicit none - - integer (kind=int_kind) :: fuzzy - real (kind=real_kind), intent(in) :: epsilon - real (kind=real_kind) :: x - - IF (ABS(x)epsilon) THEN - fuzzy = 1 - ELSE !IF (x < fuzzy_width) THEN - fuzzy = -1 - ENDIF - end function - -! -! see, e.g., http://local.wasp.uwa.edu.au/~pbourke/geometry/lineline2d/ -! -subroutine check_lines_cross(x1,x2,x3,x4,y1,y2,y3,y4,lcross) - implicit none - real (kind=real_kind), INTENT(IN) :: x1,x2,x3,x4,y1,y2,y3,y4 - LOGICAL, INTENT(OUT) :: lcross - ! - ! local workspace - ! - real (kind=real_kind) :: cp,tx,ty - - cp = (y4-y3)*(x2-x1)-(x4-x3)*(y2-y1) - IF (ABS(cp)-tiny.AND.tx<1.0D0+tiny.AND.& - ty>-tiny.AND.ty<1.0D0+tiny) THEN - lcross = .TRUE. - ELSE - lcross = .FALSE. -! WRITE(*,*) "not parallel but not crossing,",tx,ty - ENDIF - ENDIF -end subroutine check_lines_cross - - - REAL (KIND=dbl_kind) FUNCTION I_00(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y - - x = x_in/aa - y = y_in/aa -! x = x_in -! y = y_in - I_00 = ATAN(x*y/SQRT(one+x*x+y*y)) - END FUNCTION I_00 - - REAL (KIND=dbl_kind) FUNCTION I_10(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y,tmp - - x = x_in/aa - y = y_in/aa - tmp = ATAN(x) - I_10 = -ASINH(y*COS(tmp)) - ! - ! = -arcsinh(y/sqrt(1+x^2)) - ! - END FUNCTION I_10 - - REAL (KIND=dbl_kind) FUNCTION I_10_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - I_10_ab = -ASINH(COS(alpha) * TAN(beta)) - END FUNCTION I_10_AB - - REAL (KIND=dbl_kind) FUNCTION I_01(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y!,beta - - x = x_in/aa - y = y_in/aa -! beta = ATAN(y) -! I_01 = -ASINH(x*COS(beta)) - I_01 = -ASINH(x/SQRT(1+y*y)) - END FUNCTION I_01 - - REAL (KIND=dbl_kind) FUNCTION I_01_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - I_01_ab = -ASINH(COS(beta) * TAN(alpha)) - END FUNCTION I_01_AB - - REAL (KIND=dbl_kind) FUNCTION I_20(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta - - x = x_in/aa - y = y_in/aa -! alpha = aa*ATAN(x) -! beta = aa*ATAN(y) - - tmp = one+y*y - -! I_20 = y*ASINH(COS(beta)*x)+ACOS(SIN(alpha)*SIN(beta)) - I_20 = y*ASINH(x/SQRT(tmp))+ACOS(x*y/(SQRT((one+x*x)*tmp))) - END FUNCTION I_20 - - REAL (KIND=dbl_kind) FUNCTION I_20_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_20_ab = TAN(beta)*ASINH(COS(beta)*TAN(alpha))+ACOS(SIN(alpha)*SIN(beta)) - END FUNCTION I_20_AB - - REAL (KIND=dbl_kind) FUNCTION I_02(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y, tmp!,alpha,beta - - x = x_in/aa - y = y_in/aa -! alpha = aa*ATAN(x) -! beta = aa*ATAN(y) - - tmp=one+x*x - - I_02 = x*ASINH(y/SQRT(tmp))+ACOS(x*y/SQRT(tmp*(1+y*y))) - END FUNCTION I_02 - - REAL (KIND=dbl_kind) FUNCTION I_02_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_02_ab = TAN(alpha)*ASINH(TAN(beta)*COS(alpha))+ACOS(SIN(alpha)*SIN(beta)) - END FUNCTION I_02_AB - - - REAL (KIND=dbl_kind) FUNCTION I_11(x_in,y_in) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: x_in,y_in - REAL (KIND=dbl_kind) :: x,y - - x = x_in/aa - y = y_in/aa - - I_11 = -SQRT(1+x*x+y*y) - END FUNCTION I_11 - - REAL (KIND=dbl_kind) FUNCTION I_11_ab(alpha,beta) - IMPLICIT NONE - REAL (KIND=dbl_kind), INTENT(IN) :: alpha,beta - - I_11_ab = -SQRT(one+TAN(alpha)**2+TAN(beta)**2) - END FUNCTION I_11_AB -!------------------------------------------------------------------------------ -! FUNCTION ASINH -! -! Description: -! Hyperbolic arcsin function -!------------------------------------------------------------------------------ - FUNCTION ASINH(x) - IMPLICIT NONE - - REAL (KIND=dbl_kind) :: ASINH - REAL (KIND=dbl_kind) :: x - - ASINH = LOG(x + SQRT(x * x + one)) - END FUNCTION - - - !******************************************************************************** - ! - ! Gauss-Legendre quadrature - ! - ! Tabulated values - ! - !******************************************************************************** - SUBROUTINE glwp(n,weights,abscissae) - IMPLICIT NONE - REAL (KIND=dbl_kind), DIMENSION(n), INTENT(OUT) :: weights, abscissae - INTEGER (KIND=int_kind) , INTENT(IN ) :: n - - SELECT CASE (n) - CASE(1) - abscissae(1) = 0.0 - weights(1) = 2.0 - CASE(2) - abscissae(1) = -SQRT(1.0/3.0) - abscissae(2) = SQRT(1.0/3.0) - weights(1) = 1.0 - weights(2) = 1.0 - CASE(3) - abscissae(1) = -0.774596669241483377035853079956_dbl_kind - abscissae(2) = 0.0 - abscissae(3) = 0.774596669241483377035853079956_dbl_kind - weights(1) = 0.555555555555555555555555555556_dbl_kind - weights(2) = 0.888888888888888888888888888889_dbl_kind - weights(3) = 0.555555555555555555555555555556_dbl_kind - CASE(4) - abscissae(1) = -0.861136311594052575223946488893_dbl_kind - abscissae(2) = -0.339981043584856264802665659103_dbl_kind - abscissae(3) = 0.339981043584856264802665659103_dbl_kind - abscissae(4) = 0.861136311594052575223946488893_dbl_kind - weights(1) = 0.347854845137453857373063949222_dbl_kind - weights(2) = 0.652145154862546142626936050778_dbl_kind - weights(3) = 0.652145154862546142626936050778_dbl_kind - weights(4) = 0.347854845137453857373063949222_dbl_kind - CASE(5) - abscissae(1) = -(1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) - abscissae(2) = -(1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) - abscissae(3) = 0.0 - abscissae(4) = (1.0/3.0)*SQRT(5.0-2.0*SQRT(10.0/7.0)) - abscissae(5) = (1.0/3.0)*SQRT(5.0+2.0*SQRT(10.0/7.0)) - weights(1) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(2) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(3) = 128.0_dbl_kind/225.0_dbl_kind - weights(4) = (322.0_dbl_kind+13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - weights(5) = (322.0_dbl_kind-13.0_dbl_kind*SQRT(70.0_dbl_kind))/900.0_dbl_kind - CASE DEFAULT - WRITE(*,*) 'n out of range in glwp of module gll. n=',n - WRITE(*,*) '0 shr_kind_r8 -contains -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereABPFromRLL -! -! Description: -! Determine the (alpha,beta,panel) coordinate of a point on the sphere from -! a given regular lat lon coordinate. -! -! Parameters: -! lon - Coordinate longitude -! lat - Coordinate latitude -! alpha (OUT) - Alpha coordinate -! beta (OUT) - Beta coordinate -! ipanel (OUT) - Face panel -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereABPFromRLL(lon, lat, alpha, beta, ipanel, ldetermine_panel) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (R8), INTENT(IN) :: lon, lat - REAL (R8), INTENT(OUT) :: alpha, beta - INTEGER :: ipanel - LOGICAL, INTENT(IN) :: ldetermine_panel - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - REAL (r8), PARAMETER :: rotate_cube = 0.0 - - ! Local variables - REAL (R8) :: xx, yy, zz, pm - REAL (R8) :: sx, sy, sz - INTEGER :: ix, iy, iz - - ! Translate to (x,y,z) space - xx = COS(lon-rotate_cube) * COS(lat) - yy = SIN(lon-rotate_cube) * COS(lat) - zz = SIN(lat) - - pm = MAX(ABS(xx), ABS(yy), ABS(zz)) - - ! Check maximality of the x coordinate - IF (pm == ABS(xx)) THEN - IF (xx > 0) THEN; ix = 1; ELSE; ix = -1; ENDIF - ELSE - ix = 0 - ENDIF - - ! Check maximality of the y coordinate - IF (pm == ABS(yy)) THEN - IF (yy > 0) THEN; iy = 1; ELSE; iy = -1; ENDIF - ELSE - iy = 0 - ENDIF - - ! Check maximality of the z coordinate - IF (pm == ABS(zz)) THEN - IF (zz > 0) THEN; iz = 1; ELSE; iz = -1; ENDIF - ELSE - iz = 0 - ENDIF - - ! Panel assignments - IF (ldetermine_panel) THEN - IF (iz == 1) THEN - ipanel = 6; sx = yy; sy = -xx; sz = zz - - ELSEIF (iz == -1) THEN - ipanel = 5; sx = yy; sy = xx; sz = -zz - - ELSEIF ((ix == 1) .AND. (iy /= 1)) THEN - ipanel = 1; sx = yy; sy = zz; sz = xx - - ELSEIF ((ix == -1) .AND. (iy /= -1)) THEN - ipanel = 3; sx = -yy; sy = zz; sz = -xx - - ELSEIF ((iy == 1) .AND. (ix /= -1)) THEN - ipanel = 2; sx = -xx; sy = zz; sz = yy - - ELSEIF ((iy == -1) .AND. (ix /= 1)) THEN - ipanel = 4; sx = xx; sy = zz; sz = -yy - - ELSE - WRITE(*,*) 'Fatal Error: CubedSphereABPFromRLL failed' - WRITE(*,*) '(xx, yy, zz) = (', xx, ',', yy, ',', zz, ')' - WRITE(*,*) 'pm =', pm, ' (ix, iy, iz) = (', ix, ',', iy, ',', iz, ')' - STOP - ENDIF - ELSE - IF (ipanel == 6) THEN - sx = yy; sy = -xx; sz = zz - ELSEIF (ipanel == 5) THEN - sx = yy; sy = xx; sz = -zz - ELSEIF (ipanel == 1) THEN - sx = yy; sy = zz; sz = xx - ELSEIF (ipanel == 3) THEN - sx = -yy; sy = zz; sz = -xx - ELSEIF (ipanel == 2) THEN - sx = -xx; sy = zz; sz = yy - ELSEIF (ipanel == 4) THEN - sx = xx; sy = zz; sz = -yy - ELSE - WRITE(*,*) "ipanel out of range",ipanel - STOP - END IF - END IF - - ! Use panel information to calculate (alpha, beta) coords - alpha = ATAN(sx / sz) - beta = ATAN(sy / sz) - -END SUBROUTINE CubedSphereABPFromRLL - -!------------------------------------------------------------------------------ -! SUBROUTINE EquiangularAllAreas -! -! Description: -! Compute the area of all cubed sphere grid cells, storing the results in -! a two dimensional array. -! -! Parameters: -! icube - Resolution of the cubed sphere -! dA (OUT) - Output array containing the area of all cubed sphere grid cells -!------------------------------------------------------------------------------ -SUBROUTINE EquiangularAllAreas(icube, dA) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - INTEGER, INTENT(IN) :: icube - REAL (r8), DIMENSION(icube,icube), INTENT(OUT) :: dA - - ! Local variables - INTEGER :: k, k1, k2 - REAL (r8) :: a1, a2, a3, a4 - REAL (r8), DIMENSION(icube+1,icube+1) :: ang - REAL (r8), DIMENSION(icube+1) :: gp - - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - - !#ifdef DBG - REAL (r8) :: dbg1 !DBG - !#endif - - ! Recall that we are using equi-angular spherical gridding - ! Compute the angle between equiangular cubed sphere projection grid lines. - DO k = 1, icube+1 - gp(k) = -piq + (pi/DBLE(2*(icube))) * DBLE(k-1) - ENDDO - - DO k2=1,icube+1 - DO k1=1,icube+1 - ang(k1,k2) =ACOS(-SIN(gp(k1)) * SIN(gp(k2))) - ENDDO - ENDDO - - DO k2=1,icube - DO k1=1,icube - a1 = ang(k1 , k2 ) - a2 = pi - ang(k1+1, k2 ) - a3 = pi - ang(k1 , k2+1) - a4 = ang(k1+1, k2+1) - ! area = r*r*(-2*pi+sum(interior angles)) - DA(k1,k2) = -2.0*pi+a1+a2+a3+a4 - ENDDO - ENDDO - - !#ifdef DBG - ! Only for debugging - test consistency - dbg1 = 0.0 !DBG - DO k2=1,icube - DO k1=1,icube - dbg1 = dbg1 + DA(k1,k2) !DBG - ENDDO - ENDDO - write(*,*) 'DAcube consistency: ',dbg1-4.0*pi/6.0 !DBG - !#endif -END SUBROUTINE EquiangularAllAreas - - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereRLLFromABP -! -! Description: -! Determine the lat lon coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! lon (OUT) - Calculated longitude -! lat (OUT) - Calculated latitude -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereRLLFromABP(alpha, beta, ipanel, lon, lat) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: lon, lat - ! Local variables - REAL (r8) :: xx, yy, zz, rotate_cube - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: piq = 0.25*pi - - rotate_cube = 0.0 - ! Convert to cartesian coordinates - CALL CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - ! Convert back to lat lon - lat = ASIN(zz) - if (xx==0.0.and.yy==0.0) THEN - lon = 0.0 - else - lon = ATAN2(yy, xx) +rotate_cube - IF (lon<0.0) lon=lon+2.0*pi - IF (lon>2.0*pi) lon=lon-2.0*pi - end if -END SUBROUTINE CubedSphereRLLFromABP - -!------------------------------------------------------------------------------ -! SUBROUTINE CubedSphereXYZFromABP -! -! Description: -! Determine the Cartesian coordinate of a point on a sphere given its -! (alpha,beta,panel) coordinate. -! -! Parameters: -! alpha - Alpha coordinate -! beta - Beta coordinate -! panel - Cubed sphere panel id -! xx (OUT) - Calculated x coordinate -! yy (OUT) - Calculated y coordinate -! zz (OUT) - Calculated z coordinate -!------------------------------------------------------------------------------ -SUBROUTINE CubedSphereXYZFromABP(alpha, beta, ipanel, xx, yy, zz) - use shr_kind_mod, only: r8 => shr_kind_r8 - IMPLICIT NONE - - REAL (r8), INTENT(IN) :: alpha, beta - INTEGER , INTENT(IN) :: ipanel - REAL (r8), INTENT(OUT) :: xx, yy, zz - ! Local variables - REAL (r8) :: a1, b1, pm - REAL (r8) :: sx, sy, sz - - ! Convert to Cartesian coordinates - a1 = TAN(alpha) - b1 = TAN(beta) - - sz = (1.0 + a1 * a1 + b1 * b1)**(-0.5) - sx = sz * a1 - sy = sz * b1 - ! Panel assignments - IF (ipanel == 6) THEN - yy = sx; xx = -sy; zz = sz - ELSEIF (ipanel == 5) THEN - yy = sx; xx = sy; zz = -sz - ELSEIF (ipanel == 1) THEN - yy = sx; zz = sy; xx = sz - ELSEIF (ipanel == 3) THEN - yy = -sx; zz = sy; xx = -sz - ELSEIF (ipanel == 2) THEN - xx = -sx; zz = sy; yy = sz - ELSEIF (ipanel == 4) THEN - xx = sx; zz = sy; yy = -sz - ELSE - WRITE(*,*) 'Fatal Error: Panel out of range in CubedSphereXYZFromABP' - WRITE(*,*) '(alpha, beta, panel) = (', alpha, ',', beta, ',', ipanel, ')' - STOP - ENDIF -END SUBROUTINE CubedSphereXYZFromABP - - -SUBROUTINE remove_duplicates_integer(n_in,f_in,n_out,f_out) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - integer,dimension(n_in), intent(in) :: f_in - integer, intent(out) :: n_out - integer,dimension(n_in), intent(out) :: f_out - ! - ! local work space - ! - integer :: k,i,j - ! - ! remove duplicates in ipanel_tmp - ! - k = 1 - f_out(1) = f_in(1) - outer: do i=2,n_in - do j=1,k - ! if (f_out(j) == f_in(i)) then - if (ABS(f_out(j)-f_in(i))<1.0E-10) then - ! Found a match so start looking again - cycle outer - end if - end do - ! No match found so add it to the output - k = k + 1 - f_out(k) = f_in(i) - end do outer - n_out = k -END SUBROUTINE remove_duplicates_integer - -SUBROUTINE remove_duplicates_latlon(n_in,lon_in,lat_in,n_out,lon_out,lat_out,tiny,ldbg) - use shr_kind_mod, only: r8 => shr_kind_r8 - integer, intent(in) :: n_in - real(r8),dimension(n_in), intent(inout) :: lon_in,lat_in - real, intent(in) :: tiny - integer, intent(out) :: n_out - real(r8),dimension(n_in), intent(out) :: lon_out,lat_out - logical :: ldbg - ! - ! local work space - ! - integer :: k,i,j - REAL (r8), PARAMETER :: pi = 3.14159265358979323846264338327 - REAL (r8), PARAMETER :: pih = 0.50*pi - ! - ! for pole points: make sure the longitudes are identical so that algorithm below works properly - ! - do i=2,n_in - if (abs(lat_in(i)-pih) Date: Thu, 7 Nov 2024 14:32:03 -0700 Subject: [PATCH 248/529] progress --- components/eam/src/physics/cam/shoc.F90 | 529 ------- .../eamxx/src/physics/shoc/CMakeLists.txt | 1 - .../eamxx/src/physics/shoc/shoc_iso_c.f90 | 1358 ----------------- .../eamxx/src/physics/shoc/shoc_iso_f.f90 | 532 ------- .../shoc/{ => tests/infra}/shoc_f90.cpp | 0 .../shoc/{ => tests/infra}/shoc_f90.hpp | 0 .../{ => tests/infra}/shoc_functions_f90.cpp | 0 .../{ => tests/infra}/shoc_functions_f90.hpp | 0 .../shoc/{ => tests/infra}/shoc_ic_cases.cpp | 0 .../shoc/{ => tests/infra}/shoc_ic_cases.hpp | 0 .../shoc/{ => tests/infra}/shoc_main_wrap.cpp | 0 .../shoc/{ => tests/infra}/shoc_main_wrap.hpp | 0 .../shoc/tests/shoc_unit_tests_common.hpp | 3 - 13 files changed, 2423 deletions(-) delete mode 100644 components/eamxx/src/physics/shoc/shoc_iso_f.f90 rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_f90.cpp (100%) rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_f90.hpp (100%) rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_functions_f90.cpp (100%) rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_functions_f90.hpp (100%) rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_ic_cases.cpp (100%) rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_ic_cases.hpp (100%) rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_main_wrap.cpp (100%) rename components/eamxx/src/physics/shoc/{ => tests/infra}/shoc_main_wrap.hpp (100%) diff --git a/components/eam/src/physics/cam/shoc.F90 b/components/eam/src/physics/cam/shoc.F90 index f354ac8c71b..415cf4ca6f1 100644 --- a/components/eam/src/physics/cam/shoc.F90 +++ b/components/eam/src/physics/cam/shoc.F90 @@ -26,8 +26,6 @@ module shoc public :: shoc_init, shoc_main -logical :: use_cxx = .true. - real(rtype), parameter, public :: largeneg = -99999999.99_rtype real(rtype), parameter, public :: pi = 3.14159265358979323_rtype @@ -242,10 +240,6 @@ subroutine shoc_main ( & #endif ) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_main_f -#endif - implicit none ! INPUT VARIABLES @@ -402,28 +396,6 @@ subroutine shoc_main ( & integer :: clock_count1, clock_count_rate, clock_count_max, clock_count2, clock_count_diff #endif -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_main_f(shcol, nlev, nlevi, dtime, nadv, npbl,& ! Input - host_dx, host_dy,thv, & ! Input - zt_grid,zi_grid,pres,presi,pdel,& ! Input - wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, & ! Input - wtracer_sfc,num_qtracers,w_field, & ! Input - inv_exner,phis, & ! Input - host_dse, tke, thetal, qw, & ! Input/Output - u_wind, v_wind,qtracers,& ! Input/Output - wthv_sec,tkh,tk,& ! Input/Output - shoc_ql,shoc_cldfrac,& ! Input/Output - pblh,& ! Output - shoc_mix, isotropy,& ! Output (diagnostic) - w_sec, thl_sec, qw_sec, qwthl_sec,& ! Output (diagnostic) - wthl_sec, wqw_sec, wtke_sec,& ! Output (diagnostic) - uw_sec, vw_sec, w3,& ! Output (diagnostic) - wqls_sec, brunt, shoc_ql2) ! Output (diagnostic) - return - endif -#endif - #ifdef SCREAM_CONFIG_IS_CMAKE call system_clock(clock_count1, clock_count_rate, clock_count_max) #endif @@ -617,10 +589,6 @@ subroutine shoc_grid( & ! throughout the SHOC parameterization, also define air ! density in SHOC -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_grid_f -#endif - implicit none ! INPUT VARIABLES @@ -648,15 +616,6 @@ subroutine shoc_grid( & ! local variables integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_grid_f(shcol,nlev,nlevi,& - zt_grid,zi_grid,pdel,& - dz_zt,dz_zi,rho_zt) - return - endif -#endif - do k=1,nlev do i=1,shcol ! define thickness of the thermodynamic gridpoints @@ -693,10 +652,6 @@ subroutine compute_shoc_vapor( & ! based on SHOC's prognostic total water mixing ratio ! and diagnostic cloud water mixing ratio. -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_shoc_vapor_f -#endif - implicit none ! INPUT VARIABLES @@ -716,13 +671,6 @@ subroutine compute_shoc_vapor( & ! LOCAL VARIABLES integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_shoc_vapor_f(shcol,nlev,qw,ql,qv) - return - endif -#endif - do k = 1, nlev do i = 1, shcol qv(i,k) = qw(i,k) - ql(i,k) @@ -744,10 +692,6 @@ subroutine compute_shoc_temperature( & ! based on SHOC's prognostic liquid water potential ! temperature. -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_shoc_temperature_f -#endif - implicit none ! INPUT VARIABLES @@ -769,13 +713,6 @@ subroutine compute_shoc_temperature( & ! LOCAL VARIABLES integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_shoc_temperature_f(shcol,nlev,thetal,ql,inv_exner,tabs) - return - endif -#endif - do k = 1, nlev do i = 1, shcol tabs(i,k) = thetal(i,k)/inv_exner(i,k)+(lcond/cp)*ql(i,k) @@ -799,10 +736,6 @@ subroutine update_prognostics_implicit( & thetal,qw,tracer,tke,& ! Input/Output u_wind,v_wind) ! Input/Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: update_prognostics_implicit_f -#endif - implicit none ! INPUT VARIABLES @@ -871,20 +804,6 @@ subroutine update_prognostics_implicit( & real(rtype) :: dl(shcol,nlev) ! Factorized subdiagonal for solver real(rtype) :: d(shcol,nlev) ! Factorized diagonal for solver -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call update_prognostics_implicit_f(& - shcol,nlev,nlevi,num_tracer,& ! Input - dtime,dz_zt,dz_zi,rho_zt,& ! Input - zt_grid,zi_grid,tk,tkh,& ! Input - uw_sfc,vw_sfc,wthl_sfc,wqw_sfc,& ! Input - wtracer_sfc,& ! Input - thetal,qw,tracer,tke,& ! Input/Output - u_wind,v_wind) ! Input/Output - return - endif -#endif - ! linearly interpolate tkh, tk, and air density onto the interface grids call linear_interp(zt_grid,zi_grid,tkh,tkh_zi,nlev,nlevi,shcol,0._rtype) call linear_interp(zt_grid,zi_grid,tk,tk_zi,nlev,nlevi,shcol,0._rtype) @@ -946,10 +865,6 @@ end subroutine update_prognostics_implicit subroutine compute_tmpi(nlevi, shcol, dtime, rho_zi, dz_zi, tmpi) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_tmpi_f -#endif - !intent-ins integer, intent(in) :: nlevi, shcol !time step [s] @@ -965,13 +880,6 @@ subroutine compute_tmpi(nlevi, shcol, dtime, rho_zi, dz_zi, tmpi) !local vars integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_tmpi_f(nlevi, shcol, dtime, rho_zi, dz_zi, tmpi) - return - endif -#endif - tmpi(:,1) = 0._rtype ! eqn: tmpi = dt*(g*rho)**2/dp, where dp = g*rho*dz, therefore tmpi = dt*g*rho/dz do k = 2, nlevi @@ -984,10 +892,6 @@ end subroutine compute_tmpi subroutine dp_inverse(nlev, shcol, rho_zt, dz_zt, rdp_zt) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: dp_inverse_f -#endif - !intent-ins integer, intent(in) :: nlev, shcol ! Air density on thermo grid [kg/m3] @@ -1001,13 +905,6 @@ subroutine dp_inverse(nlev, shcol, rho_zt, dz_zt, rdp_zt) !local vars integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call dp_inverse_f(nlev, shcol, rho_zt, dz_zt, rdp_zt) - return - endif -#endif - do k = 1, nlev do i = 1, shcol rdp_zt(i,k) = 1._rtype/(ggr*rho_zt(i,k)*dz_zt(i,k)) @@ -1164,10 +1061,6 @@ subroutine diag_second_shoc_moments(& qwthl_sec, uw_sec, vw_sec, wtke_sec, & ! Output w_sec) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: diag_second_shoc_moments_f -#endif - ! This is the main routine to compute the second ! order moments in SHOC. @@ -1238,16 +1131,6 @@ subroutine diag_second_shoc_moments(& real(rtype) :: wstar(shcol) real(rtype) :: ustar2(shcol) -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call diag_second_shoc_moments_f(shcol,nlev,nlevi, & - thetal,qw,u_wind,v_wind,tke, isotropy,tkh,tk, dz_zi,zt_grid,zi_grid,shoc_mix, & - wthl_sfc, wqw_sfc, uw_sfc, vw_sfc,thl_sec,qw_sec,wthl_sec,wqw_sec,& - qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec) - return - endif -#endif - ! Calculate surface properties needed for lower ! boundary conditions call diag_second_moments_srf(& @@ -1303,10 +1186,6 @@ subroutine diag_second_moments_srf(& ! properties needed for the the lower ! boundary condition for the second order moments needed ! for the SHOC parameterization. -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_diag_second_moments_srf_f -#endif - implicit none ! INPUT VARIABLES @@ -1332,14 +1211,6 @@ subroutine diag_second_moments_srf(& ! Constants to parameterize surface variances real(rtype), parameter :: z_const = 1.0_rtype -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_diag_second_moments_srf_f(shcol,wthl_sfc, uw_sfc, vw_sfc, & ! Input - ustar2,wstar) ! Output - return - endif -#endif - ! apply the surface conditions to diagnose turbulent ! moments at the surface do i=1,shcol @@ -1367,10 +1238,6 @@ subroutine diag_second_moments_lbycond(& uw_sec, vw_sec, wtke_sec,& ! Output thl_sec, qw_sec, qwthl_sec) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: diag_second_moments_lbycond_f -#endif - ! Purpose of this subroutine is to diagnose the lower ! boundary condition for the second order moments needed ! for the SHOC parameterization. @@ -1424,19 +1291,6 @@ subroutine diag_second_moments_lbycond(& real(rtype), parameter :: a_const = 1.8_rtype real(rtype), parameter :: ufmin = 0.01_rtype -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call diag_second_moments_lbycond_f( & - shcol, & ! Input - wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, & ! Input - ustar2,wstar, & ! Input - wthl_sec,wqw_sec,& ! Output - uw_sec, vw_sec, wtke_sec,& ! Output - thl_sec,qw_sec,qwthl_sec) ! Output - return - endif -#endif - ! apply the surface conditions to diagnose turbulent ! moments at the surface do i=1,shcol @@ -1471,10 +1325,6 @@ subroutine diag_second_moments(& qwthl_sec,uw_sec,vw_sec,wtke_sec, & ! Input/Output w_sec) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: diag_second_moments_f -#endif - ! Purpose of this subroutine is to diagnose the second ! order moments needed for the SHOC parameterization. ! Namely these are variances of thetal, qw, and vertical @@ -1544,16 +1394,6 @@ subroutine diag_second_moments(& real(rtype) :: tkh_zi(shcol,nlevi) real(rtype) :: tk_zi(shcol,nlevi) -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call diag_second_moments_f(shcol,nlev,nlevi,thetal,qw,u_wind,v_wind,tke, & ! Input - isotropy,tkh,tk,dz_zi,zt_grid,zi_grid,shoc_mix, & ! Input - thl_sec,qw_sec,wthl_sec,wqw_sec,qwthl_sec,uw_sec,vw_sec,wtke_sec, & ! Input/Output - w_sec) - return - endif -#endif - ! Interpolate some variables from the midpoint grid to the interface grid call linear_interp(zt_grid,zi_grid,isotropy,isotropy_zi,nlev,nlevi,shcol,0._rtype) call linear_interp(zt_grid,zi_grid,tkh,tkh_zi,nlev,nlevi,shcol,0._rtype) @@ -1618,10 +1458,6 @@ subroutine calc_shoc_varorcovar(& ! (depending on if invar1 is the same as invar2) ! for a given set of inputs -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: calc_shoc_varorcovar_f -#endif - implicit none ! INPUT VARIABLES @@ -1652,14 +1488,6 @@ subroutine calc_shoc_varorcovar(& integer :: i, k, kt real(rtype) :: sm, grid_dz2 -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call calc_shoc_varorcovar_f(shcol,nlev,nlevi,tunefac,isotropy_zi,tkh_zi,dz_zi,invar1,invar2,& ! Input - varorcovar) ! Input/Output) - return - endif -#endif - do k=2,nlev kt=k-1 ! define upper grid point indicee @@ -1686,10 +1514,6 @@ subroutine calc_shoc_vertflux(& ! downgradient diffusion for a given set of ! input variables -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: calc_shoc_vertflux_f -#endif - implicit none ! INPUT VARIABLES @@ -1713,14 +1537,6 @@ subroutine calc_shoc_vertflux(& integer :: i, k, kt real(rtype) :: grid_dz -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call calc_shoc_vertflux_f(shcol,nlev,nlevi,tkh_zi,dz_zi,invar,& ! Input - vertflux) ! Input/Output) - return - endif -#endif - do k=2,nlev kt=k-1 ! define upper grid point indicee @@ -1749,9 +1565,6 @@ subroutine diag_second_moments_ubycond(& ! needed for the SHOC parameterization. Currently ! set all to zero. -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_diag_second_moments_ubycond_f -#endif implicit none ! INPUT VARIABLES @@ -1779,17 +1592,6 @@ subroutine diag_second_moments_ubycond(& ! LOCAL VARIABLES integer :: i -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_diag_second_moments_ubycond_f(& - shcol, & ! Input - thl_sec, qw_sec,& ! Output - wthl_sec,wqw_sec,& ! Output - qwthl_sec, uw_sec, vw_sec, wtke_sec) ! Output - return - endif -#endif - ! apply the upper boundary condition do i=1,shcol wthl_sec(i) = 0._rtype @@ -1821,10 +1623,6 @@ subroutine diag_third_shoc_moments(& ! for the skewness calculation in the PDF. ! This calculation follows that of Canuto et al. (2001) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: diag_third_shoc_moments_f -#endif - implicit none ! INPUT VARIABLES @@ -1868,19 +1666,6 @@ subroutine diag_third_shoc_moments(& real(rtype) :: brunt_zi(shcol,nlevi) real(rtype) :: thetal_zi(shcol,nlevi) -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call diag_third_shoc_moments_f(& - shcol,nlev,nlevi, & ! Input - w_sec, thl_sec, & ! Input - wthl_sec, isotropy, brunt,& ! Input - thetal,tke,& ! Input - dz_zt, dz_zi, zt_grid, zi_grid,& ! Input - w3) ! Output - return - endif -#endif - ! Interpolate variables onto the interface levels call linear_interp(zt_grid,zi_grid,isotropy,isotropy_zi,nlev,nlevi,shcol,0._rtype) call linear_interp(zt_grid,zi_grid,brunt,brunt_zi,nlev,nlevi,shcol,largeneg) @@ -1911,10 +1696,6 @@ subroutine compute_diag_third_shoc_moment(& thetal_zi,& ! Input w3) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_diag_third_shoc_moment_f -#endif - implicit none ! INPUT VARIABLES ! number of SHOC columns @@ -1952,17 +1733,6 @@ subroutine compute_diag_third_shoc_moment(& real(rtype) :: buoy_sgs2, bet2 real(rtype) :: f0, f1, f2, f3, f4, f5 -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_diag_third_shoc_moment_f(shcol,nlev,nlevi,w_sec,thl_sec, & ! Input - wthl_sec, tke, dz_zt, dz_zi, & ! Input - isotropy_zi,brunt_zi,w_sec_zi, & ! Input - thetal_zi, & ! Input - w3) ! Output - return - endif -#endif - ! set lower condition w3(:,nlevi) = 0._rtype @@ -2196,10 +1966,6 @@ subroutine clipping_diag_third_shoc_moments(& nlevi,shcol,w_sec_zi,& ! Input w3) ! Input/Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: clipping_diag_third_shoc_moments_f -#endif - ! perform clipping to prevent unrealistically large values from occuring implicit none @@ -2218,14 +1984,6 @@ subroutine clipping_diag_third_shoc_moments(& integer k, i -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call clipping_diag_third_shoc_moments_f(nlevi,shcol,w_sec_zi, & ! Input - w3) ! Input/Output - return - endif -#endif - do k=1, nlevi do i=1, shcol @@ -2260,10 +2018,6 @@ subroutine shoc_assumed_pdf(& ! TKE equation. This code follows the appendix of ! Larson et al. (2002) for Analytic Double Gaussian 1 -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_assumed_pdf_f -#endif - implicit none ! INPUT VARIABLES @@ -2342,20 +2096,6 @@ subroutine shoc_assumed_pdf(& real(rtype), parameter :: Tl_min = 100._rtype -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_assumed_pdf_f(& - shcol,nlev,nlevi, & ! Input - thetal,qw,w_field,thl_sec,qw_sec,& ! Input - wthl_sec,w_sec, & ! Input - wqw_sec,qwthl_sec,w3,pres, & ! Input - zt_grid,zi_grid,& ! Input - shoc_cldfrac,shoc_ql,& ! Output - wqls,wthv_sec,shoc_ql2) ! Output - return - endif -#endif - epsterm=rgas/rv thl_tol=1.e-2_rtype @@ -3120,10 +2860,6 @@ end subroutine shoc_tke subroutine integ_column_stability(nlev, shcol, dz_zt, pres, brunt, brunt_int) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: integ_column_stability_f -#endif - implicit none !intent-ins integer, intent(in) :: nlev, shcol @@ -3141,13 +2877,6 @@ subroutine integ_column_stability(nlev, shcol, dz_zt, pres, brunt, brunt_int) !local variables integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call integ_column_stability_f(nlev, shcol, dz_zt, pres, brunt, brunt_int) - return - endif -#endif - brunt_int(1:shcol) = 0._rtype do k = 1, nlev do i = 1, shcol @@ -3167,10 +2896,6 @@ end subroutine integ_column_stability subroutine compute_shr_prod(nlevi, nlev, shcol, dz_zi, u_wind, v_wind, sterm) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_shr_prod_f -#endif - implicit none integer, intent(in) :: nlevi, nlev, shcol @@ -3191,13 +2916,6 @@ subroutine compute_shr_prod(nlevi, nlev, shcol, dz_zi, u_wind, v_wind, sterm) ! Turbulent coefficient real(rtype), parameter :: Ck_sh = 0.1_rtype -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_shr_prod_f(nlevi, nlev, shcol, dz_zi, u_wind, v_wind, sterm) - return - endif -#endif - !compute shear production term do k = 2, nlev km1 = k - 1 @@ -3228,10 +2946,6 @@ end subroutine compute_shr_prod subroutine adv_sgs_tke(nlev, shcol, dtime, shoc_mix, wthv_sec, & sterm_zt, tk, tke, a_diss) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: adv_sgs_tke_f -#endif - implicit none !intent -ins @@ -3262,14 +2976,6 @@ subroutine adv_sgs_tke(nlev, shcol, dtime, shoc_mix, wthv_sec, & real(rtype) :: Ck, Cs, Ce, Ce1, Ce2, Cee -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call adv_sgs_tke_f(nlev, shcol, dtime, shoc_mix, wthv_sec, & - sterm_zt, tk, tke, a_diss) - return - endif -#endif - Cs=0.15_rtype Ck=0.1_rtype Ce=bfb_cube(Ck)/bfb_quad(Cs) @@ -3313,10 +3019,6 @@ subroutine isotropic_ts(nlev, shcol, brunt_int, tke, a_diss, brunt, isotropy) ! moments in SHOC !------------------------------------------------------------ -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: isotropic_ts_f -#endif - implicit none !intent-ins @@ -3342,14 +3044,6 @@ subroutine isotropic_ts(nlev, shcol, brunt_int, tke, a_diss, brunt, isotropy) !Parameters real(rtype), parameter :: maxiso = 20000.0_rtype ! Return to isotropic timescale [s] -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call isotropic_ts_f(nlev, shcol, brunt_int, tke, a_diss, brunt, isotropy) - return - endif -#endif - - do k = 1, nlev do i = 1, shcol @@ -3379,10 +3073,6 @@ subroutine eddy_diffusivities(nlev, shcol, pblh, zt_grid, tabs, & ! Compute eddy diffusivity for heat and momentum !------------------------------------------------------------ -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: eddy_diffusivities_f -#endif - implicit none !intent-ins @@ -3419,14 +3109,6 @@ subroutine eddy_diffusivities(nlev, shcol, pblh, zt_grid, tabs, & ! stability diffusivities real(rtype), parameter :: pbl_trans = 200.0_rtype -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call eddy_diffusivities_f(nlev, shcol, pblh, zt_grid, tabs, & - shoc_mix, sterm_zt, isotropy, tke, tkh, tk) - return - endif -#endif - do k = 1, nlev do i = 1, shcol @@ -3457,10 +3139,6 @@ subroutine check_tke(& shcol,nlev,& ! Input tke) ! Input/Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: check_tke_f -#endif - implicit none ! Make sure TKE falls within reasonable bounds ! If not, then clip @@ -3475,14 +3153,6 @@ subroutine check_tke(& ! LOCAL VARIABLES integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call check_tke_f(shcol,nlev, & ! Input - tke) ! Input/Output - return - endif -#endif - do k=1,nlev do i=1,shcol tke(i,k)=max(mintke,tke(i,k)) @@ -3505,10 +3175,6 @@ subroutine shoc_length(& ! mixing length scale, which is used to compute the ! turbulent dissipation in the SGS TKE equation -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_length_f -#endif - implicit none ! INPUT VARIABLES @@ -3544,16 +3210,6 @@ subroutine shoc_length(& real(rtype) :: thv_zi(shcol,nlevi) real(rtype) :: l_inf(shcol) -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_length_f(shcol,nlev,nlevi,host_dx,host_dy,& - zt_grid,zi_grid,dz_zt,tke,& - thv,brunt,shoc_mix) - - return - endif -#endif - ! Interpolate virtual potential temperature onto interface grid call linear_interp(zt_grid,zi_grid,thv,thv_zi,nlev,nlevi,shcol,0._rtype) @@ -3724,10 +3380,6 @@ subroutine shoc_energy_integrals(& rtm,rcm,u_wind,v_wind,& ! Input se_int,ke_int,wv_int,wl_int) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_energy_integrals_f -#endif - implicit none ! INPUT VARIABLES @@ -3762,15 +3414,6 @@ subroutine shoc_energy_integrals(& integer :: i, k real(rtype) :: rvm -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_energy_integrals_f(shcol,nlev,host_dse,pdel,& ! Input - rtm,rcm,u_wind,v_wind,& ! Input - se_int,ke_int,wv_int,wl_int) ! Output - return - endif -#endif - se_int(:) = 0._rtype ke_int(:) = 0._rtype wv_int(:) = 0._rtype @@ -3800,10 +3443,6 @@ subroutine update_host_dse(& shoc_ql,inv_exner,zt_grid,phis,& ! Input host_dse) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: update_host_dse_f -#endif - implicit none ! INPUT VARIABLES @@ -3832,14 +3471,6 @@ subroutine update_host_dse(& integer :: i, k -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call update_host_dse_f(shcol,nlev,thlm,shoc_ql,inv_exner,zt_grid,phis, & ! Input - host_dse) ! Input/Output) - return - endif -#endif - do k=1,nlev do i=1,shcol temp = (thlm(i,k)/inv_exner(i,k))+(lcond/cp)*shoc_ql(i,k) @@ -3863,10 +3494,6 @@ subroutine shoc_energy_fixer(& rho_zt,tke,pint,& ! Input host_dse) ! Input/Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_energy_fixer_f -#endif - implicit none ! INPUT VARIABLES @@ -3919,19 +3546,6 @@ subroutine shoc_energy_fixer(& real(rtype) :: se_dis(shcol), te_a(shcol), te_b(shcol) integer :: shoctop(shcol) -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_energy_fixer_f(shcol,nlev,nlevi,dtime,nadv,& ! Input - zt_grid,zi_grid,& ! Input - se_b,ke_b,wv_b,wl_b,& ! Input - se_a,ke_a,wv_a,wl_a,& ! Input - wthl_sfc,wqw_sfc,& ! Input - rho_zt,tke,pint,& ! Input - host_dse) ! Input/Output - return - endif -#endif - call shoc_energy_total_fixer(& shcol,nlev,nlevi,dtime,nadv,& ! Input zt_grid,zi_grid,& ! Input @@ -4137,10 +3751,6 @@ subroutine shoc_diag_obklen(& cldliq_sfc,qv_sfc,& ! Input ustar,kbfs,obklen) ! Ouput -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_diag_obklen_f -#endif - implicit none ! INPUT VARIABLES @@ -4174,16 +3784,6 @@ subroutine shoc_diag_obklen(& real(rtype) :: th_sfc ! potential temperature at surface real(rtype) :: thv_sfc ! virtual potential temperature at surface -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_diag_obklen_f(shcol,uw_sfc,vw_sfc,& ! Input - wthl_sfc,wqw_sfc,thl_sfc,& ! Input - cldliq_sfc,qv_sfc,& ! Input - ustar,kbfs,obklen) ! Ouput - return - endif -#endif - do i=1,shcol th_sfc = thl_sfc(i) + (lcond/cp)*cldliq_sfc(i) thv_sfc = th_sfc*(1._rtype+eps*qv_sfc(i)-cldliq_sfc(i)) @@ -4205,10 +3805,6 @@ subroutine pblintd(& ustar,obklen,kbfs,cldn,& ! Input pblh) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: pblintd_f -#endif - !----------------------------------------------------------------------- ! ! Purpose: @@ -4268,18 +3864,6 @@ subroutine pblintd(& logical(btype) :: check(shcol) ! True=>chk if Richardson no.>critcal -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call pblintd_f(& - shcol,nlev,nlevi,npbl,& ! Input - z,zi,thl,ql,& ! Input - q,u,v,& ! Input - ustar,obklen,kbfs,cldn,& ! Input - pblh) ! Output - return - endif -#endif - ! ! Compute Obukhov length virtual temperature flux and various arrays for use later: ! @@ -4343,9 +3927,6 @@ subroutine pblintd_init_pot(& shcol,nlev,& ! Input thl,ql,q,& ! Input thv) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_pblintd_init_pot_f -#endif !------------------------------Arguments-------------------------------- ! ! Input arguments @@ -4364,13 +3945,6 @@ subroutine pblintd_init_pot(& integer :: k ! level index real(rtype) :: th -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_pblintd_init_pot_f(shcol,nlev,thl,ql,q,& ! Input - thv) ! Output - return - endif -#endif ! Compute virtual potential temperature do k=1,nlev do i=1,shcol @@ -4418,10 +3992,6 @@ subroutine pblintd_height(& thv,thv_ref,& ! Input pblh,rino,check) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: pblintd_height_f -#endif - !------------------------------Arguments-------------------------------- ! ! Input arguments @@ -4450,14 +4020,6 @@ subroutine pblintd_height(& integer :: k ! level index real(rtype) :: vvk ! velocity magnitude squared -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call pblintd_height_f(shcol,nlev,npbl,z,u,v,ustar,thv,thv_ref,& ! Input - pblh,rino,check) ! Output - return - endif -#endif - ! ! PBL height calculation: Scan upward until the Richardson number between ! the first level and the current level exceeds the "critical" value. @@ -4485,10 +4047,6 @@ subroutine pblintd_surf_temp(& tlv,& ! Output pblh,check,rino) ! InOutput -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: pblintd_surf_temp_f -#endif - !------------------------------Arguments-------------------------------- ! Input arguments ! @@ -4519,15 +4077,6 @@ subroutine pblintd_surf_temp(& real(rtype), parameter :: sffrac= 0.1_rtype ! Surface layer fraction of boundary layer real(rtype), parameter :: binm = betam*sffrac ! betam * sffrac -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call pblintd_surf_temp_f(shcol,nlev,nlevi,& ! Input - z,ustar,obklen,kbfs,thv,& ! Input - tlv,pblh,check,rino) ! InOutput - return - endif -#endif - ! ! Estimate an effective surface temperature to account for surface ! fluctuations @@ -4550,10 +4099,6 @@ subroutine pblintd_check_pblh(& z,ustar,check,& ! Input pblh) ! Output -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: pblintd_check_pblh_f -#endif - !------------------------------Arguments-------------------------------- ! Input arguments ! @@ -4573,13 +4118,6 @@ subroutine pblintd_check_pblh(& ! integer :: i ! longitude index -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call pblintd_check_pblh_f(shcol,nlev,nlevi,npbl,z,ustar,check,pblh) - return - endif -#endif - ! ! PBL height must be greater than some minimum mechanical mixing depth ! Several investigators have proposed minimum mechanical mixing depth @@ -4606,10 +4144,6 @@ subroutine pblintd_cldcheck( & zi,cldn, & ! Input pblh) ! InOutput -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: shoc_pblintd_cldcheck_f -#endif - !------------------------------Arguments-------------------------------- ! Input arguments ! @@ -4629,13 +4163,6 @@ subroutine pblintd_cldcheck( & integer :: i ! longitude index logical(btype) :: cldcheck(shcol) ! True=>if cloud in lowest layer -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call shoc_pblintd_cldcheck_f(shcol, nlev, nlevi, zi, cldn, pblh) - return - endif -#endif - ! ! Final requirement on PBL heightis that it must be greater than the depth ! of the lowest model level if there is any cloud diagnosed in @@ -4660,10 +4187,6 @@ end subroutine pblintd_cldcheck subroutine linear_interp(x1,x2,y1,y2,km1,km2,ncol,minthresh) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: linear_interp_f -#endif - implicit none integer, intent(in) :: km1, km2 @@ -4675,13 +4198,6 @@ subroutine linear_interp(x1,x2,y1,y2,km1,km2,ncol,minthresh) integer :: k1, k2, i -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call linear_interp_f(x1,x2,y1,y2,km1,km2,ncol,minthresh) - return - endif -#endif - #if 1 !i = check_grid(x1,x2,km1,km2,ncol) if (km1 .eq. km2+1) then @@ -4749,10 +4265,6 @@ subroutine compute_brunt_shoc_length(nlev,nlevi,shcol,dz_zt,thv,thv_zi,brunt) ! ! Computes the brunt_visala frequency -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_brunt_shoc_length_f -#endif - implicit none integer, intent(in) :: nlev, nlevi, shcol ! Grid difference centereted on thermo grid [m] @@ -4765,13 +4277,6 @@ subroutine compute_brunt_shoc_length(nlev,nlevi,shcol,dz_zt,thv,thv_zi,brunt) real(rtype), intent(out) :: brunt(shcol, nlev) integer k, i -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_brunt_shoc_length_f(nlev,nlevi,shcol,dz_zt,thv,thv_zi,brunt) - return - endif -#endif - do k=1,nlev do i=1,shcol brunt(i,k) = (ggr/thv(i,k)) * (thv_zi(i,k) - thv_zi(i,k+1))/dz_zt(i,k) @@ -4785,10 +4290,6 @@ subroutine compute_l_inf_shoc_length(nlev,shcol,zt_grid,dz_zt,tke,l_inf) !========================================================= ! -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_l_inf_shoc_length_f -#endif - implicit none integer, intent(in) :: nlev, shcol real(rtype), intent(in) :: zt_grid(shcol,nlev), dz_zt(shcol,nlev), tke(shcol,nlev) @@ -4796,13 +4297,6 @@ subroutine compute_l_inf_shoc_length(nlev,shcol,zt_grid,dz_zt,tke,l_inf) real(rtype) :: tkes, numer(shcol), denom(shcol) integer k, i -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_l_inf_shoc_length_f(nlev,shcol,zt_grid,dz_zt,tke,l_inf) - return - endif -#endif - numer(:) = 0._rtype denom(:) = 0._rtype @@ -4822,10 +4316,6 @@ end subroutine compute_l_inf_shoc_length subroutine compute_shoc_mix_shoc_length(nlev,shcol,tke,brunt,zt_grid,l_inf,shoc_mix) -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: compute_shoc_mix_shoc_length_f -#endif - implicit none integer, intent(in) :: nlev, shcol @@ -4848,14 +4338,6 @@ subroutine compute_shoc_mix_shoc_length(nlev,shcol,tke,brunt,zt_grid,l_inf,shoc_ ! Turnover timescale [s] real(rtype), parameter :: tscale = 400._rtype -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call compute_shoc_mix_shoc_length_f(nlev,shcol,tke,brunt,zt_grid,l_inf,& !Input - shoc_mix) ! Ouptut - return - endif -#endif - brunt2(:,:) = 0.0 do k=1,nlev @@ -4876,10 +4358,6 @@ subroutine check_length_scale_shoc_length(nlev,shcol,host_dx,host_dy,shoc_mix) ! Do checks on the length scale. Make sure it is not ! larger than the grid mesh of the host model. -#ifdef SCREAM_CONFIG_IS_CMAKE - use shoc_iso_f, only: check_length_scale_shoc_length_f -#endif - implicit none integer, intent(in) :: nlev, shcol real(rtype), intent(in) :: host_dx(shcol), host_dy(shcol) @@ -4887,13 +4365,6 @@ subroutine check_length_scale_shoc_length(nlev,shcol,host_dx,host_dy,shoc_mix) real(rtype), intent(inout) :: shoc_mix(shcol, nlev) integer k, i -#ifdef SCREAM_CONFIG_IS_CMAKE - if (use_cxx) then - call check_length_scale_shoc_length_f(nlev,shcol,host_dx,host_dy,shoc_mix) - return - endif -#endif - do k=1,nlev do i=1,shcol shoc_mix(i,k)=min(maxlen,shoc_mix(i,k)) diff --git a/components/eamxx/src/physics/shoc/CMakeLists.txt b/components/eamxx/src/physics/shoc/CMakeLists.txt index 4796b30abef..b54fbe53968 100644 --- a/components/eamxx/src/physics/shoc/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/CMakeLists.txt @@ -2,7 +2,6 @@ set(SHOC_SRCS shoc_f90.cpp shoc_ic_cases.cpp shoc_iso_c.f90 - shoc_iso_f.f90 ${SCREAM_BASE_DIR}/../eam/src/physics/cam/shoc.F90 eamxx_shoc_process_interface.cpp ) diff --git a/components/eamxx/src/physics/shoc/shoc_iso_c.f90 b/components/eamxx/src/physics/shoc/shoc_iso_c.f90 index 438df4edadc..608974ea9cf 100644 --- a/components/eamxx/src/physics/shoc/shoc_iso_c.f90 +++ b/components/eamxx/src/physics/shoc/shoc_iso_c.f90 @@ -14,14 +14,6 @@ module shoc_iso_c ! contains - subroutine append_precision(string, prefix) - - character(kind=c_char, len=128), intent(inout) :: string - character(*), intent(in) :: prefix - real(kind=c_real) :: s - - write (string, '(a,i1,a1)') prefix, sizeof(s), C_NULL_CHAR - end subroutine append_precision subroutine shoc_init_c(nlev, gravit, rair, rh2o, cpair, & zvir, latvap, latice, karman, p0) bind(c) @@ -75,1355 +67,5 @@ subroutine shoc_init_for_main_bfb_c(nlev, gravit, rair, rh2o, cpair, & end subroutine shoc_init_for_main_bfb_c - subroutine shoc_main_c(shcol,nlev,nlevi,dtime,nadv,host_dx, host_dy, thv, & - zt_grid, zi_grid, pres, presi, pdel, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, & - wtracer_sfc, num_qtracers, w_field, inv_exner, phis, host_dse, tke, thetal, & - qw, u_wind, v_wind, qtracers, wthv_sec, tkh, tk, shoc_ql, shoc_cldfrac, & - pblh, shoc_mix, isotropy, w_sec, thl_sec, qw_sec, qwthl_sec, wthl_sec, & - wqw_sec, wtke_sec, uw_sec, vw_sec, w3, wqls_sec, brunt, shoc_ql2, elapsed_s) bind(C) - use shoc, only : shoc_main - - integer(kind=c_int), value, intent(in) :: shcol, nlev, nlevi, num_qtracers, nadv - real(kind=c_real), value, intent(in) :: dtime - real(kind=c_real), intent(in), dimension(shcol) :: host_dx, host_dy - real(kind=c_real), intent(in), dimension(shcol, nlev) :: zt_grid - real(kind=c_real), intent(in), dimension(shcol, nlevi) :: zi_grid - real(kind=c_real), intent(in), dimension(shcol, nlev) :: pres - real(kind=c_real), intent(in), dimension(shcol, nlevi) :: presi - real(kind=c_real), intent(in), dimension(shcol, nlev) :: pdel, thv, w_field - real(kind=c_real), intent(in), dimension(shcol) :: wthl_sfc, wqw_sfc, uw_sfc, vw_sfc - real(kind=c_real), intent(in), dimension(shcol, num_qtracers) :: wtracer_sfc - real(kind=c_real), intent(in), dimension(shcol, nlev) :: inv_exner - real(kind=c_real), intent(in), dimension(shcol) :: phis - - real(kind=c_real), intent(inout), dimension(shcol, nlev) :: host_dse, tke, & - thetal, qw, u_wind, v_wind, wthv_sec - real(kind=c_real), intent(inout), dimension(shcol, nlev, num_qtracers) :: qtracers - real(kind=c_real), intent(inout), dimension(shcol, nlev) :: tk, tkh - - real(kind=c_real), intent(inout), dimension(shcol, nlev) :: shoc_cldfrac, shoc_ql - real(kind=c_real), intent(out), dimension(shcol) :: pblh - real(kind=c_real), intent(out), dimension(shcol, nlev) :: shoc_mix, w_sec - real(kind=c_real), intent(out), dimension(shcol, nlevi) :: thl_sec, qw_sec, & - qwthl_sec, wthl_sec, wqw_sec, wtke_sec, uw_sec, vw_sec, w3 - real(kind=c_real), intent(out), dimension(shcol, nlev) :: wqls_sec, isotropy, & - brunt,shoc_ql2 - - real(kind=c_real), intent(out) :: elapsed_s - - call shoc_main(shcol, nlev, nlevi, dtime, nadv, host_dx, host_dy, thv, & - zt_grid, zi_grid, pres, presi, pdel, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, & - wtracer_sfc, num_qtracers, w_field, inv_exner, phis, host_dse, tke, thetal, & - qw, u_wind, v_wind, qtracers, wthv_sec, tkh, tk, shoc_ql, shoc_cldfrac, & - pblh, shoc_mix, isotropy, w_sec, thl_sec, qw_sec, qwthl_sec, wthl_sec, & - wqw_sec, wtke_sec, uw_sec, vw_sec, w3, wqls_sec, brunt,shoc_ql2,elapsed_s) - end subroutine shoc_main_c - - subroutine shoc_use_cxx_c(arg_use_cxx) bind(C) - use shoc, only: use_cxx - - logical(kind=c_bool), value, intent(in) :: arg_use_cxx - - use_cxx = arg_use_cxx - end subroutine shoc_use_cxx_c - - subroutine shoc_grid_c(shcol,nlev,nlevi,zt_grid,zi_grid,pdel,dz_zt,dz_zi,rho_zt) bind (C) - use shoc, only: shoc_grid - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - real(kind=c_real), intent(in) :: pdel(shcol,nlev) - - real(kind=c_real), intent(out) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(out) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(out) :: rho_zt(shcol,nlev) - - call shoc_grid(shcol,nlev,nlevi,zt_grid,zi_grid,pdel,dz_zt,dz_zi,rho_zt) - - end subroutine shoc_grid_c - - subroutine shoc_diag_obklen_c(shcol,uw_sfc,vw_sfc,wthl_sfc,wqw_sfc,& - thl_sfc,cldliq_sfc,qv_sfc,ustar,& - kbfs,obklen) bind(C) - - use shoc, only: shoc_diag_obklen - - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: uw_sfc(shcol) - real(kind=c_real), intent(in) :: vw_sfc(shcol) - real(kind=c_real), intent(in) :: wthl_sfc(shcol) - real(kind=c_real), intent(in) :: wqw_sfc(shcol) - real(kind=c_real), intent(in) :: thl_sfc(shcol) - real(kind=c_real), intent(in) :: cldliq_sfc(shcol) - real(kind=c_real), intent(in) :: qv_sfc(shcol) - - real(kind=c_real), intent(out) :: ustar(shcol) - real(kind=c_real), intent(out) :: kbfs(shcol) - real(kind=c_real), intent(out) :: obklen(shcol) - - call shoc_diag_obklen(shcol,uw_sfc,vw_sfc,wthl_sfc,wqw_sfc,& - thl_sfc,cldliq_sfc,qv_sfc,ustar,& - kbfs,obklen) - - end subroutine shoc_diag_obklen_c - - subroutine calc_shoc_varorcovar_c(& - shcol,nlev,nlevi,tunefac,& ! Input - isotropy_zi,tkh_zi,dz_zi,invar1,invar2,& ! Input - varorcovar)bind (C) ! Input/Output - - use shoc, only: calc_shoc_varorcovar - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in), value :: tunefac - real(kind=c_real), intent(in) :: isotropy_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: tkh_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: invar1(shcol,nlev) - real(kind=c_real), intent(in) :: invar2(shcol,nlev) - - real(kind=c_real), intent(inout) :: varorcovar(shcol,nlevi) - - call calc_shoc_varorcovar(& - shcol,nlev,nlevi,tunefac,& ! Input - isotropy_zi,tkh_zi,dz_zi,invar1,invar2,& ! Input - varorcovar) - - end subroutine calc_shoc_varorcovar_c - - subroutine compute_tmpi_c(nlevi, shcol, dtime, rho_zi, dz_zi, tmpi) bind(C) - use shoc, only: compute_tmpi - - integer(kind=c_int), intent(in), value :: nlevi - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in), value :: dtime - real(kind=c_real), intent(in) :: rho_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - - real(kind=c_real), intent(out) :: tmpi(shcol,nlevi) - - call compute_tmpi(nlevi, shcol, dtime, rho_zi, dz_zi, tmpi) - - end subroutine compute_tmpi_c - - subroutine dp_inverse_c(nlev, shcol, rho_zt, dz_zt, rdp_zt) bind(C) - use shoc, only: dp_inverse - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: rho_zt(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(out) :: rdp_zt(shcol,nlev) - - call dp_inverse(nlev, shcol, rho_zt, dz_zt, rdp_zt) - - end subroutine dp_inverse_c - - subroutine sfc_fluxes_c(shcol, num_tracer, dtime, rho_zi_sfc, rdp_zt_sfc, & - wthl_sfc, wqw_sfc, wtke_sfc, wtracer_sfc, & - thetal, qw, tke, tracer) bind(C) - use shoc, only: sfc_fluxes - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: num_tracer - real(kind=c_real), intent(in), value :: dtime - real(kind=c_real), intent(in) :: rho_zi_sfc(shcol) - real(kind=c_real), intent(in) :: rdp_zt_sfc(shcol) - real(kind=c_real), intent(in) :: wthl_sfc(shcol) - real(kind=c_real), intent(in) :: wqw_sfc(shcol) - real(kind=c_real), intent(in) :: wtke_sfc(shcol) - real(kind=c_real), intent(in) :: wtracer_sfc(shcol,num_tracer) - - real(kind=c_real), intent(inout) :: thetal(shcol) - real(kind=c_real), intent(inout) :: qw(shcol) - real(kind=c_real), intent(inout) :: tke(shcol) - real(kind=c_real), intent(inout) :: tracer(shcol,num_tracer) - - call sfc_fluxes(shcol, num_tracer, dtime, rho_zi_sfc, rdp_zt_sfc, & - wthl_sfc, wqw_sfc, wtke_sfc, wtracer_sfc, & - thetal, qw, tke, tracer) - - end subroutine sfc_fluxes_c - - subroutine impli_srf_stress_term_c(shcol, rho_zi_sfc, uw_sfc, vw_sfc, & - u_wind_sfc, v_wind_sfc, ksrf) bind(C) - use shoc, only: impli_srf_stress_term - - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: rho_zi_sfc(shcol) - real(kind=c_real), intent(in) :: uw_sfc(shcol) - real(kind=c_real), intent(in) :: vw_sfc(shcol) - real(kind=c_real), intent(in) :: u_wind_sfc(shcol) - real(kind=c_real), intent(in) :: v_wind_sfc(shcol) - - real(kind=c_real), intent(out) :: ksrf(shcol) - - ksrf(1:shcol) = impli_srf_stress_term(shcol, rho_zi_sfc, & - uw_sfc, vw_sfc, u_wind_sfc, v_wind_sfc) - - end subroutine impli_srf_stress_term_c - - subroutine tke_srf_flux_term_c(shcol, uw_sfc, vw_sfc, wtke_sfc) bind(C) - use shoc, only: tke_srf_flux_term - - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: uw_sfc(shcol) - real(kind=c_real), intent(in) :: vw_sfc(shcol) - - real(kind=c_real), intent(out) :: wtke_sfc(shcol) - - wtke_sfc(1:shcol) = tke_srf_flux_term(shcol, uw_sfc, vw_sfc) - - end subroutine tke_srf_flux_term_c - - subroutine check_tke_c(shcol, nlev, tke) bind(C) - use shoc, only: check_tke - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - - real(kind=c_real), intent(inout) :: tke(shcol,nlev) - - call check_tke(shcol,nlev,tke) - - end subroutine check_tke_c - - subroutine shoc_tke_c(shcol, nlev, nlevi, dtime, wthv_sec, shoc_mix, dz_zi, & - dz_zt, pres, tabs, u_wind, v_wind, brunt, zt_grid, & - zi_grid, pblh, tke, tk, tkh, isotropy) bind(C) - use shoc, only: shoc_tke - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in), value :: dtime - real(kind=c_real), intent(in) :: wthv_sec(shcol,nlev) - real(kind=c_real), intent(in) :: shoc_mix(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: pres(shcol,nlev) - real(kind=c_real), intent(in) :: tabs(shcol,nlev) - real(kind=c_real), intent(in) :: u_wind(shcol,nlev) - real(kind=c_real), intent(in) :: v_wind(shcol,nlev) - real(kind=c_real), intent(in) :: brunt(shcol,nlev) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - real(kind=c_real), intent(in) :: pblh(shcol) - - real(kind=c_real), intent(inout) :: tke(shcol,nlev) - real(kind=c_real), intent(inout) :: tk(shcol,nlev) - real(kind=c_real), intent(inout) :: tkh(shcol,nlev) - real(kind=c_real), intent(out) :: isotropy(shcol,nlev) - - call shoc_tke(shcol, nlev, nlevi, dtime, wthv_sec, shoc_mix, dz_zi, & - dz_zt, pres, tabs, u_wind, v_wind, brunt, zt_grid, & - zi_grid, pblh, tke, tk, tkh, isotropy) - - end subroutine shoc_tke_c - - subroutine integ_column_stability_c(nlev, shcol, dz_zt, pres, brunt, brunt_int) bind (C) - use shoc, only: integ_column_stability - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: pres(shcol,nlev) - real(kind=c_real), intent(in) :: brunt(shcol,nlev) - - real(kind=c_real), intent(out) :: brunt_int(shcol) - - call integ_column_stability(nlev, shcol, dz_zt, pres, brunt, brunt_int) - - end subroutine integ_column_stability_c - - subroutine compute_shr_prod_c(nlevi, nlev, shcol, dz_zi, u_wind, v_wind, sterm) bind (C) - use shoc, only: compute_shr_prod - - integer(kind=c_int), intent(in), value :: nlevi - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: u_wind(shcol,nlev) - real(kind=c_real), intent(in) :: v_wind(shcol,nlev) - - real(kind=c_real), intent(out) :: sterm(shcol,nlevi) - - call compute_shr_prod(nlevi, nlev, shcol, dz_zi, u_wind, v_wind, sterm) - - end subroutine compute_shr_prod_c - - subroutine isotropic_ts_c(nlev, shcol, brunt_int, tke, a_diss, brunt, isotropy) bind (C) - use shoc, only: isotropic_ts - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: brunt_int(shcol) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: a_diss(shcol,nlev) - real(kind=c_real), intent(in) :: brunt(shcol,nlev) - - real(kind=c_real), intent(out) :: isotropy(shcol,nlev) - - call isotropic_ts(nlev, shcol, brunt_int, tke, a_diss, brunt, isotropy) - - end subroutine isotropic_ts_c - - subroutine adv_sgs_tke_c(nlev, shcol, dtime, shoc_mix, wthv_sec, & - sterm_zt, tk, tke, a_diss) bind (C) - use shoc, only: adv_sgs_tke - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in), value :: dtime - real(kind=c_real), intent(in) :: shoc_mix(shcol,nlev) - real(kind=c_real), intent(in) :: wthv_sec(shcol,nlev) - real(kind=c_real), intent(in) :: sterm_zt(shcol,nlev) - real(kind=c_real), intent(in) :: tk(shcol,nlev) - - real(kind=c_real), intent(inout) :: tke(shcol,nlev) - - real(kind=c_real), intent(out) :: a_diss(shcol,nlev) - - call adv_sgs_tke(nlev, shcol, dtime, shoc_mix, wthv_sec, & - sterm_zt, tk, tke, a_diss) - - end subroutine adv_sgs_tke_c - - subroutine eddy_diffusivities_c(nlev, shcol, pblh, zt_grid, tabs, & - shoc_mix, sterm_zt, isotropy, tke, tkh, tk) bind (C) - use shoc, only: eddy_diffusivities - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: pblh(shcol) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: tabs(shcol,nlev) - real(kind=c_real), intent(in) :: shoc_mix(shcol,nlev) - real(kind=c_real), intent(in) :: sterm_zt(shcol,nlev) - real(kind=c_real), intent(in) :: isotropy(shcol,nlev) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - - real(kind=c_real), intent(out) :: tkh(shcol,nlev) - real(kind=c_real), intent(out) :: tk(shcol,nlev) - - call eddy_diffusivities(nlev, shcol, pblh, zt_grid, tabs, & - shoc_mix, sterm_zt, isotropy, tke, tkh, tk) - - end subroutine eddy_diffusivities_c - - subroutine update_host_dse_c(shcol, nlev, thlm, shoc_ql, inv_exner, zt_grid, & - phis, host_dse) bind (C) - use shoc, only: update_host_dse - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - real(kind=c_real), intent(in) :: thlm(shcol,nlev) - real(kind=c_real), intent(in) :: shoc_ql(shcol,nlev) - real(kind=c_real), intent(in) :: inv_exner(shcol,nlev) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: phis(shcol) - - real(kind=c_real), intent(out) :: host_dse(shcol,nlev) - - call update_host_dse(shcol, nlev, thlm, shoc_ql, inv_exner, zt_grid, & - phis, host_dse) - - end subroutine update_host_dse_c - - subroutine shoc_energy_fixer_c(shcol, nlev, nlevi, dtime, nadv, & - zt_grid, zi_grid, se_b, ke_b, wv_b, & - wl_b, se_a, ke_a, wv_a, wl_a, wthl_sfc, & - wqw_sfc, rho_zt, tke, pint, & - host_dse) bind (C) - use shoc, only: shoc_energy_fixer - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in), value :: dtime - integer(kind=c_int), intent(in), value :: nadv - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - real(kind=c_real), intent(in) :: se_b(shcol) - real(kind=c_real), intent(in) :: ke_b(shcol) - real(kind=c_real), intent(in) :: wv_b(shcol) - real(kind=c_real), intent(in) :: wl_b(shcol) - real(kind=c_real), intent(in) :: se_a(shcol) - real(kind=c_real), intent(in) :: ke_a(shcol) - real(kind=c_real), intent(in) :: wv_a(shcol) - real(kind=c_real), intent(in) :: wl_a(shcol) - real(kind=c_real), intent(in) :: wthl_sfc(shcol) - real(kind=c_real), intent(in) :: wqw_sfc(shcol) - real(kind=c_real), intent(in) :: rho_zt(shcol,nlev) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: pint(shcol,nlevi) - - real(kind=c_real), intent(inout) :: host_dse(shcol,nlev) - - call shoc_energy_fixer(shcol, nlev, nlevi, dtime, nadv, & - zt_grid, zi_grid, se_b, ke_b, wv_b, & - wl_b, se_a, ke_a, wv_a, wl_a, wthl_sfc, & - wqw_sfc, rho_zt, tke, pint, & - host_dse) - - end subroutine shoc_energy_fixer_c - - subroutine shoc_energy_integrals_c(shcol, nlev, host_dse, pdel,& - rtm, rcm, u_wind, v_wind,& - se_int, ke_int, wv_int, wl_int) bind (C) - use shoc, only: shoc_energy_integrals - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - real(kind=c_real), intent(in) :: host_dse(shcol,nlev) - real(kind=c_real), intent(in) :: pdel(shcol,nlev) - real(kind=c_real), intent(in) :: rtm(shcol,nlev) - real(kind=c_real), intent(in) :: rcm(shcol,nlev) - real(kind=c_real), intent(in) :: u_wind(shcol,nlev) - real(kind=c_real), intent(in) :: v_wind(shcol,nlev) - - real(kind=c_real), intent(out) :: se_int(shcol) - real(kind=c_real), intent(out) :: ke_int(shcol) - real(kind=c_real), intent(out) :: wv_int(shcol) - real(kind=c_real), intent(out) :: wl_int(shcol) - - call shoc_energy_integrals(shcol, nlev, host_dse, pdel,& - rtm, rcm, u_wind, v_wind,& - se_int, ke_int, wv_int, wl_int) - - end subroutine shoc_energy_integrals_c - - subroutine shoc_energy_total_fixer_c(& - shcol,nlev,nlevi,dtime,nadv,& - zt_grid,zi_grid,& - se_b,ke_b,wv_b,wl_b,& - se_a,ke_a,wv_a,wl_a,& - wthl_sfc,wqw_sfc,rho_zt,pint,& - te_a,te_b) bind (C) - use shoc, only: shoc_energy_total_fixer - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - integer(kind=c_int), intent(in), value :: nadv - real(kind=c_real), intent(in), value :: dtime - - real(kind=c_real), intent(in) :: se_b(shcol) - real(kind=c_real), intent(in) :: ke_b(shcol) - real(kind=c_real), intent(in) :: wv_b(shcol) - real(kind=c_real), intent(in) :: wl_b(shcol) - real(kind=c_real), intent(in) :: se_a(shcol) - real(kind=c_real), intent(in) :: ke_a(shcol) - real(kind=c_real), intent(in) :: wv_a(shcol) - real(kind=c_real), intent(in) :: wl_a(shcol) - real(kind=c_real), intent(in) :: wthl_sfc(shcol) - real(kind=c_real), intent(in) :: wqw_sfc(shcol) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - real(kind=c_real), intent(in) :: rho_zt(shcol,nlev) - real(kind=c_real), intent(in) :: pint(shcol,nlevi) - - real(kind=c_real), intent(out) :: te_a(shcol) - real(kind=c_real), intent(out) :: te_b(shcol) - - call shoc_energy_total_fixer(shcol,nlev,nlevi,dtime,nadv,& - zt_grid,zi_grid,& - se_b,ke_b,wv_b,wl_b,& - se_a,ke_a,wv_a,wl_a,& - wthl_sfc,wqw_sfc,rho_zt,pint,& - te_a,te_b) - - end subroutine shoc_energy_total_fixer_c - - subroutine shoc_energy_threshold_fixer_c(shcol,nlev,nlevi, & - pint,tke,te_a,te_b, & - se_dis,shoctop) bind (C) - use shoc, only: shoc_energy_threshold_fixer - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - - real(kind=c_real), intent(in) :: pint(shcol,nlevi) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: te_a(shcol) - real(kind=c_real), intent(in) :: te_b(shcol) - - real(kind=c_real), intent(out) :: se_dis(shcol) - integer(kind=c_int), intent(out) :: shoctop(shcol) - - call shoc_energy_threshold_fixer(shcol,nlev,nlevi, & - pint,tke,te_a,te_b, & - se_dis,shoctop) - - end subroutine shoc_energy_threshold_fixer_c - - subroutine shoc_energy_dse_fixer_c(shcol,nlev, & - se_dis,shoctop, & - host_dse) bind (C) - use shoc, only: shoc_energy_dse_fixer - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in) :: shoctop(shcol) - real(kind=c_real), intent(in) :: se_dis(shcol) - - real(kind=c_real), intent(inout) :: host_dse(shcol,nlev) - - call shoc_energy_dse_fixer(shcol,nlev, & - se_dis,shoctop, & - host_dse) - - end subroutine shoc_energy_dse_fixer_c - - subroutine calc_shoc_vertflux_c(shcol, nlev, nlevi, tkh_zi, dz_zi, invar, vertflux) bind (C) - use shoc, only: calc_shoc_vertflux - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: tkh_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: invar(shcol,nlev) - - real(kind=c_real), intent(inout) :: vertflux(shcol,nlevi) - - call calc_shoc_vertflux(shcol, nlev, nlevi, tkh_zi, dz_zi, invar, vertflux) - - end subroutine calc_shoc_vertflux_c - - subroutine shoc_length_c(shcol, nlev, nlevi, host_dx, host_dy, & - zt_grid, zi_grid, dz_zt, tke, thv, brunt, & - shoc_mix) bind (C) - use shoc, only: shoc_length - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: host_dx(shcol) - real(kind=c_real), intent(in) :: host_dy(shcol) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: thv(shcol,nlev) - - real(kind=c_real), intent(out) :: brunt(shcol,nlev) - real(kind=c_real), intent(out) :: shoc_mix(shcol,nlev) - - call shoc_length(shcol, nlev, nlevi, host_dx, host_dy, & - zt_grid, zi_grid, dz_zt, tke, thv, & - brunt, shoc_mix) - - end subroutine shoc_length_c - - subroutine compute_brunt_shoc_length_c(nlev,nlevi,shcol,dz_zt,thv,thv_zi,brunt) bind (C) - use shoc, only: compute_brunt_shoc_length - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: thv(shcol,nlev) - real(kind=c_real), intent(in) :: thv_zi(shcol,nlevi) - - real(kind=c_real), intent(out) :: brunt(shcol,nlev) - - call compute_brunt_shoc_length(nlev,nlevi,shcol,dz_zt,thv,thv_zi,brunt) - - end subroutine compute_brunt_shoc_length_c - - subroutine compute_l_inf_shoc_length_c(nlev,shcol,zt_grid,dz_zt,tke,l_inf) bind (C) - use shoc, only: compute_l_inf_shoc_length - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - - real(kind=c_real), intent(out) :: l_inf(shcol) - - call compute_l_inf_shoc_length(nlev,shcol,zt_grid,dz_zt,tke,l_inf) - - end subroutine compute_l_inf_shoc_length_c - - subroutine compute_shoc_mix_shoc_length_c(nlev,shcol,tke,brunt,& - zt_grid,l_inf,shoc_mix) bind (C) - use shoc, only: compute_shoc_mix_shoc_length - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: brunt(shcol,nlev) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: l_inf(shcol) - - real(kind=c_real), intent(out) :: shoc_mix(shcol,nlev) - - call compute_shoc_mix_shoc_length(nlev,shcol,tke,brunt,zt_grid,& - l_inf,shoc_mix) - - end subroutine compute_shoc_mix_shoc_length_c - - subroutine check_length_scale_shoc_length_c(nlev,shcol,host_dx,host_dy,shoc_mix) bind (C) - use shoc, only: check_length_scale_shoc_length - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: host_dx(shcol) - real(kind=c_real), intent(in) :: host_dy(shcol) - - real(kind=c_real), intent(inout) :: shoc_mix(shcol,nlev) - - call check_length_scale_shoc_length(nlev,shcol,host_dx,host_dy,shoc_mix) - - end subroutine check_length_scale_shoc_length_c - - subroutine clipping_diag_third_shoc_moments_c(nlevi,shcol,w_sec_zi,w3) bind (C) - use shoc, only: clipping_diag_third_shoc_moments - - integer(kind=c_int), intent(in), value :: nlevi - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: w_sec_zi(shcol,nlevi) - - real(kind=c_real), intent(inout) :: w3(shcol,nlevi) - - call clipping_diag_third_shoc_moments(nlevi,shcol,w_sec_zi,w3) - - end subroutine clipping_diag_third_shoc_moments_c - - subroutine fterms_input_for_diag_third_shoc_moment_c(& - dz_zi, dz_zt, dz_zt_kc, & - isotropy_zi, brunt_zi, thetal_zi, & - thedz, thedz2, iso, isosqrd, buoy_sgs2, bet2) bind (C) - use shoc, only: fterms_input_for_diag_third_shoc_moment - - real(kind=c_real), intent(in), value :: dz_zi - real(kind=c_real), intent(in), value :: dz_zt - real(kind=c_real), intent(in), value :: dz_zt_kc - real(kind=c_real), intent(in), value :: isotropy_zi - real(kind=c_real), intent(in), value :: brunt_zi - real(kind=c_real), intent(in), value :: thetal_zi - - real(kind=c_real), intent(out) :: thedz - real(kind=c_real), intent(out) :: thedz2 - real(kind=c_real), intent(out) :: iso - real(kind=c_real), intent(out) :: isosqrd - real(kind=c_real), intent(out) :: buoy_sgs2 - real(kind=c_real), intent(out) :: bet2 - - call fterms_input_for_diag_third_shoc_moment(dz_zi, dz_zt, dz_zt_kc, & - isotropy_zi, brunt_zi, thetal_zi, & - thedz, thedz2, iso, isosqrd, buoy_sgs2, bet2) - - end subroutine fterms_input_for_diag_third_shoc_moment_c - - subroutine f0_to_f5_diag_third_shoc_moment_c(& - thedz, thedz2, bet2, iso, isosqrd, & - wthl_sec, wthl_sec_kc, wthl_sec_kb, & - thl_sec_kc, thl_sec_kb, & - w_sec, w_sec_kc,w_sec_zi, & - tke, tke_kc, & - f0, f1, f2, f3, f4, f5) bind (C) - use shoc, only: f0_to_f5_diag_third_shoc_moment - - real(kind=c_real), intent(in), value :: thedz - real(kind=c_real), intent(in), value :: thedz2 - real(kind=c_real), intent(in), value :: bet2 - real(kind=c_real), intent(in), value :: iso - real(kind=c_real), intent(in), value :: isosqrd - real(kind=c_real), intent(in), value :: wthl_sec - real(kind=c_real), intent(in), value :: wthl_sec_kc - real(kind=c_real), intent(in), value :: wthl_sec_kb - real(kind=c_real), intent(in), value :: thl_sec_kc - real(kind=c_real), intent(in), value :: thl_sec_kb - real(kind=c_real), intent(in), value :: w_sec - real(kind=c_real), intent(in), value :: w_sec_kc - real(kind=c_real), intent(in), value :: w_sec_zi - real(kind=c_real), intent(in), value :: tke - real(kind=c_real), intent(in), value :: tke_kc - - real(kind=c_real), intent(out) :: f0 - real(kind=c_real), intent(out) :: f1 - real(kind=c_real), intent(out) :: f2 - real(kind=c_real), intent(out) :: f3 - real(kind=c_real), intent(out) :: f4 - real(kind=c_real), intent(out) :: f5 - - call f0_to_f5_diag_third_shoc_moment(& - thedz, thedz2, bet2, iso, isosqrd, & - wthl_sec, wthl_sec_kc, wthl_sec_kb, & - thl_sec_kc, thl_sec_kb, & - w_sec, w_sec_kc,w_sec_zi, & - tke, tke_kc, & - f0, f1, f2, f3, f4, f5) - - end subroutine f0_to_f5_diag_third_shoc_moment_c - - subroutine w3_diag_third_shoc_moment_c(aa0, aa1, x0, x1, f5, w3) bind (c) - use shoc, only: w3_diag_third_shoc_moment - - real(kind=c_real), intent(in), value :: aa0 - real(kind=c_real), intent(in), value :: aa1 - real(kind=c_real), intent(in), value :: x0 - real(kind=c_real), intent(in), value :: x1 - real(kind=c_real), intent(in), value :: f5 - - real(kind=c_real), intent(out) :: w3 - - w3 = w3_diag_third_shoc_moment(aa0, aa1, x0, x1, f5) - - end subroutine w3_diag_third_shoc_moment_c - - subroutine omega_terms_diag_third_shoc_moment_c(& - buoy_sgs2, f3, f4,& - omega0, omega1, omega2) bind (C) - use shoc, only: omega_terms_diag_third_shoc_moment - - real(kind=c_real), intent(in), value :: buoy_sgs2 - real(kind=c_real), intent(in), value :: f3 - real(kind=c_real), intent(in), value :: f4 - - real(kind=c_real), intent(out) :: omega0 - real(kind=c_real), intent(out) :: omega1 - real(kind=c_real), intent(out) :: omega2 - - call omega_terms_diag_third_shoc_moment(& - buoy_sgs2, f3, f4, & - omega0, omega1, omega2) - - end subroutine omega_terms_diag_third_shoc_moment_c - - subroutine x_y_terms_diag_third_shoc_moment_c(& - buoy_sgs2, f0, f1, f2,& - x0, y0, x1, y1) bind (C) - use shoc, only: x_y_terms_diag_third_shoc_moment - - real(kind=c_real), intent(in), value :: buoy_sgs2 - real(kind=c_real), intent(in), value :: f0 - real(kind=c_real), intent(in), value :: f1 - real(kind=c_real), intent(in), value :: f2 - - real(kind=c_real), intent(out) :: x0 - real(kind=c_real), intent(out) :: y0 - real(kind=c_real), intent(out) :: x1 - real(kind=c_real), intent(out) :: y1 - - call x_y_terms_diag_third_shoc_moment(& - buoy_sgs2, f0, f1, f2,& - x0, y0, x1, y1) - - end subroutine x_y_terms_diag_third_shoc_moment_c - - subroutine aa_terms_diag_third_shoc_moment_c(& - omega0, omega1, omega2,& - x0, x1, y0, y1, & - aa0, aa1) bind (C) - use shoc, only: aa_terms_diag_third_shoc_moment - - real(kind=c_real), intent(in), value :: omega0 - real(kind=c_real), intent(in), value :: omega1 - real(kind=c_real), intent(in), value :: omega2 - real(kind=c_real), intent(in), value :: x0 - real(kind=c_real), intent(in), value :: x1 - real(kind=c_real), intent(in), value :: y0 - real(kind=c_real), intent(in), value :: y1 - - real(kind=c_real), intent(out) :: aa0 - real(kind=c_real), intent(out) :: aa1 - - call aa_terms_diag_third_shoc_moment(& - omega0, omega1, omega2,& - x0, x1, y0, y1, & - aa0, aa1) - - end subroutine aa_terms_diag_third_shoc_moment_c - - subroutine shoc_diag_second_moments_srf_c(shcol, wthl_sfc, uw_sfc, vw_sfc, ustar2, wstar) bind(C) - use shoc, only: diag_second_moments_srf - - ! argmens - integer(kind=c_int), value, intent(in) :: shcol - real(kind=c_real), intent(in) :: wthl_sfc(shcol), uw_sfc(shcol), vw_sfc(shcol) - real(kind=c_real), intent(out) :: ustar2(shcol), wstar(shcol) - - call diag_second_moments_srf(shcol, wthl_sfc, uw_sfc, vw_sfc, ustar2, wstar) - - end subroutine shoc_diag_second_moments_srf_c - - subroutine diag_third_shoc_moments_c(& - shcol, nlev, nlevi, w_sec, thl_sec, & - wthl_sec, isotropy, brunt, thetal, & - tke, dz_zt, dz_zi, & - zt_grid, zi_grid, w3) bind(C) - use shoc, only: diag_third_shoc_moments - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: w_sec(shcol,nlev) - real(kind=c_real), intent(in) :: thl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: wthl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: isotropy(shcol,nlev) - real(kind=c_real), intent(in) :: brunt(shcol,nlev) - real(kind=c_real), intent(in) :: thetal(shcol,nlev) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - - real(kind=c_real), intent(out) :: w3(shcol,nlevi) - - call diag_third_shoc_moments(& - shcol, nlev, nlevi, w_sec, thl_sec, & - wthl_sec, isotropy, brunt, thetal, & - tke, dz_zt, dz_zi, zt_grid, zi_grid, w3) - - end subroutine diag_third_shoc_moments_c - - subroutine compute_diag_third_shoc_moment_c(& - shcol, nlev, nlevi, w_sec, thl_sec, & - wthl_sec, tke, dz_zt, dz_zi, isotropy_zi, & - brunt_zi, w_sec_zi, thetal_zi, w3) bind(C) - use shoc, only: compute_diag_third_shoc_moment - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: w_sec(shcol,nlev) - real(kind=c_real), intent(in) :: thl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: wthl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: isotropy_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: brunt_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: w_sec_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: thetal_zi(shcol,nlevi) - - real(kind=c_real), intent(out) :: w3(shcol,nlevi) - - call compute_diag_third_shoc_moment(& - shcol, nlev, nlevi, w_sec, thl_sec, & - wthl_sec, tke, dz_zt, & - dz_zi, isotropy_zi, & - brunt_zi, w_sec_zi, thetal_zi, & - w3) - - end subroutine compute_diag_third_shoc_moment_c - - subroutine linear_interp_c(x1, x2, y1, y2, km1, km2, ncol, minthresh) bind(C) - use shoc, only : linear_interp - - real(kind=c_real) , intent(in), dimension(ncol, km1) :: x1, y1 - real(kind=c_real) , intent(in), dimension(ncol, km2) :: x2 - real(kind=c_real) , intent(out), dimension(ncol, km2) :: y2 - integer(kind=c_int) , value, intent(in) :: km1, km2, ncol - real(kind=c_real) , value, intent(in) :: minthresh - - call linear_interp(x1, x2, y1, y2, km1, km2, ncol, minthresh) - end subroutine linear_interp_c - - subroutine shoc_assumed_pdf_c(shcol, nlev, nlevi, thetal, qw, & - w_field, thl_sec, qw_sec, wthl_sec, & - w_sec, wqw_sec, qwthl_sec, w3, pres, & - zt_grid, zi_grid, shoc_cldfrac, & - shoc_ql, wqls, wthv_sec, shoc_ql2) bind(C) - use shoc, only: shoc_assumed_pdf - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: thetal(shcol,nlev) - real(kind=c_real), intent(in) :: qw(shcol,nlev) - real(kind=c_real), intent(in) :: w_field(shcol,nlev) - real(kind=c_real), intent(in) :: thl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: qw_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: wthl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: w_sec(shcol,nlev) - real(kind=c_real), intent(in) :: wqw_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: qwthl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: w3(shcol,nlevi) - real(kind=c_real), intent(in) :: pres(shcol,nlev) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - - real(kind=c_real), intent(out) :: shoc_cldfrac(shcol,nlev) - real(kind=c_real), intent(out) :: shoc_ql(shcol,nlev) - real(kind=c_real), intent(out) :: wqls(shcol,nlev) - real(kind=c_real), intent(out) :: wthv_sec(shcol,nlev) - real(kind=c_real), intent(out) :: shoc_ql2(shcol,nlev) - - call shoc_assumed_pdf(shcol, nlev, nlevi, thetal, qw, & - w_field, thl_sec, qw_sec, wthl_sec, & - w_sec, wqw_sec, qwthl_sec, w3, pres, & - zt_grid, zi_grid, shoc_cldfrac, & - shoc_ql, wqls, wthv_sec, shoc_ql2) - - end subroutine shoc_assumed_pdf_c - - subroutine shoc_assumed_pdf_tilde_to_real_c(w_first, sqrtw2, w1) bind (C) - use shoc, only: shoc_assumed_pdf_tilde_to_real - - real(kind=c_real), intent(in), value :: w_first - real(kind=c_real), intent(in), value :: sqrtw2 - - real(kind=c_real), intent(inout) :: w1 - - call shoc_assumed_pdf_tilde_to_real(w_first, sqrtw2, w1) - - end subroutine shoc_assumed_pdf_tilde_to_real_c - - subroutine shoc_assumed_pdf_vv_parameters_c(w_first,w_sec,w3var,& - Skew_w,w1_1,w1_2,w2_1,w2_2,a) bind (C) - use shoc, only: shoc_assumed_pdf_vv_parameters - - real(kind=c_real), intent(in), value :: w_first - real(kind=c_real), intent(in), value :: w_sec - real(kind=c_real), intent(in), value :: w3var - - real(kind=c_real), intent(out) :: Skew_w - real(kind=c_real), intent(out) :: w1_1 - real(kind=c_real), intent(out) :: w1_2 - real(kind=c_real), intent(out) :: w2_1 - real(kind=c_real), intent(out) :: w2_2 - real(kind=c_real), intent(out) :: a - - call shoc_assumed_pdf_vv_parameters(w_first,w_sec,w3var,& - Skew_w,w1_1,w1_2,w2_1,w2_2,a) - - end subroutine shoc_assumed_pdf_vv_parameters_c - - subroutine shoc_assumed_pdf_thl_parameters_c(& - wthlsec,sqrtw2,sqrtthl,thlsec,thl_first,& - w1_1,w1_2,Skew_w,a,dothetal_skew,& - thl1_1,thl1_2,thl2_1,thl2_2,sqrtthl2_1,& - sqrtthl2_2) bind (C) - use shoc, only: shoc_assumed_pdf_thl_parameters - - real(kind=c_real), intent(in), value :: wthlsec - real(kind=c_real), intent(in), value :: sqrtw2 - real(kind=c_real), intent(in), value :: sqrtthl - real(kind=c_real), intent(in), value :: thlsec - real(kind=c_real), intent(in), value :: thl_first - real(kind=c_real), intent(in), value :: w1_1 - real(kind=c_real), intent(in), value :: w1_2 - real(kind=c_real), intent(in), value :: Skew_w - real(kind=c_real), intent(in), value :: a - logical(kind=c_bool), intent(in), value :: dothetal_skew - - real(kind=c_real), intent(out) :: thl1_1 - real(kind=c_real), intent(out) :: thl1_2 - real(kind=c_real), intent(out) :: thl2_1 - real(kind=c_real), intent(out) :: thl2_2 - real(kind=c_real), intent(out) :: sqrtthl2_1 - real(kind=c_real), intent(out) :: sqrtthl2_2 - - call shoc_assumed_pdf_thl_parameters(& - wthlsec,sqrtw2,sqrtthl,thlsec,thl_first,& - w1_1,w1_2,Skew_w,a,dothetal_skew,& - thl1_1,thl1_2,thl2_1,thl2_2,sqrtthl2_1,& - sqrtthl2_2) - - end subroutine shoc_assumed_pdf_thl_parameters_c - - subroutine shoc_assumed_pdf_qw_parameters_c(& - wqwsec,sqrtw2,Skew_w,sqrtqt,qwsec,& - w1_1,w1_2,qw_first,a,& - qw1_1,qw1_2,qw2_1,qw2_2,sqrtqw2_1,& - sqrtqw2_2) bind (C) - use shoc, only: shoc_assumed_pdf_qw_parameters - - real(kind=c_real), intent(in), value :: wqwsec - real(kind=c_real), intent(in), value :: sqrtw2 - real(kind=c_real), intent(in), value :: sqrtqt - real(kind=c_real), intent(in), value :: qwsec - real(kind=c_real), intent(in), value :: qw_first - real(kind=c_real), intent(in), value :: w1_1 - real(kind=c_real), intent(in), value :: w1_2 - real(kind=c_real), intent(in), value :: Skew_w - real(kind=c_real), intent(in), value :: a - - real(kind=c_real), intent(out) :: qw1_1 - real(kind=c_real), intent(out) :: qw1_2 - real(kind=c_real), intent(out) :: qw2_1 - real(kind=c_real), intent(out) :: qw2_2 - real(kind=c_real), intent(out) :: sqrtqw2_1 - real(kind=c_real), intent(out) :: sqrtqw2_2 - - call shoc_assumed_pdf_qw_parameters(& - wqwsec,sqrtw2,Skew_w,sqrtqt,qwsec,& - w1_1,w1_2,qw_first,a,& - qw1_1,qw1_2,qw2_1,qw2_2,sqrtqw2_1,& - sqrtqw2_2) - - end subroutine shoc_assumed_pdf_qw_parameters_c - - subroutine shoc_assumed_pdf_inplume_correlations_c(& - sqrtqw2_1,sqrtthl2_1,a,sqrtqw2_2,sqrtthl2_2,& - qwthlsec,qw1_1,qw_first,thl1_1,thl_first,qw1_2,thl1_2,& - r_qwthl_1) bind (C) - use shoc, only: shoc_assumed_pdf_inplume_correlations - - real(kind=c_real), intent(in), value :: sqrtqw2_1 - real(kind=c_real), intent(in), value :: sqrtthl2_1 - real(kind=c_real), intent(in), value :: a - real(kind=c_real), intent(in), value :: sqrtqw2_2 - real(kind=c_real), intent(in), value :: sqrtthl2_2 - real(kind=c_real), intent(in), value :: qwthlsec - real(kind=c_real), intent(in), value :: qw1_1 - real(kind=c_real), intent(in), value :: qw_first - real(kind=c_real), intent(in), value :: thl1_1 - real(kind=c_real), intent(in), value :: thl_first - real(kind=c_real), intent(in), value :: qw1_2 - real(kind=c_real), intent(in), value :: thl1_2 - - real(kind=c_real), intent(out) :: r_qwthl_1 - - call shoc_assumed_pdf_inplume_correlations(& - sqrtqw2_1,sqrtthl2_1,a,sqrtqw2_2,sqrtthl2_2,& - qwthlsec,qw1_1,qw_first,thl1_1,thl_first,qw1_2,thl1_2,& - r_qwthl_1) - - end subroutine shoc_assumed_pdf_inplume_correlations_c - - subroutine shoc_assumed_pdf_compute_temperature_c(& - thl1,basepres,pval,Tl1) bind (C) - use shoc, only: shoc_assumed_pdf_compute_temperature - - real(kind=c_real), intent(in), value :: thl1 - real(kind=c_real), intent(in), value :: basepres - real(kind=c_real), intent(in), value :: pval - - real(kind=c_real), intent(out) :: Tl1 - - call shoc_assumed_pdf_compute_temperature(thl1,basepres,pval,Tl1) - - end subroutine shoc_assumed_pdf_compute_temperature_c - - subroutine shoc_assumed_pdf_compute_qs_c(& - Tl1_1,Tl1_2,pval,& - qs1,beta1,qs2,beta2) bind (C) - use shoc, only: shoc_assumed_pdf_compute_qs - - real(kind=c_real), intent(in), value :: Tl1_1 - real(kind=c_real), intent(in), value :: Tl1_2 - real(kind=c_real), intent(in), value :: pval - - real(kind=c_real), intent(out) :: qs1 - real(kind=c_real), intent(out) :: beta1 - real(kind=c_real), intent(out) :: qs2 - real(kind=c_real), intent(out) :: beta2 - - call shoc_assumed_pdf_compute_qs(& - Tl1_1,Tl1_2,pval,& - qs1,beta1,qs2,beta2) - - end subroutine shoc_assumed_pdf_compute_qs_c - - subroutine shoc_assumed_pdf_compute_s_c(& - qw1,qs1,beta,pval,thl2,& - qw2,sqrtthl2,sqrtqw2,r_qwthl,& - s,std_s,qn,C) bind (C) - use shoc, only: shoc_assumed_pdf_compute_s - - real(kind=c_real), intent(in), value :: qw1 - real(kind=c_real), intent(in), value :: qs1 - real(kind=c_real), intent(in), value :: beta - real(kind=c_real), intent(in), value :: pval - real(kind=c_real), intent(in), value :: thl2 - real(kind=c_real), intent(in), value :: qw2 - real(kind=c_real), intent(in), value :: sqrtthl2 - real(kind=c_real), intent(in), value :: sqrtqw2 - real(kind=c_real), intent(in), value :: r_qwthl - - real(kind=c_real), intent(out) :: s - real(kind=c_real), intent(out) :: std_s - real(kind=c_real), intent(out) :: qn - real(kind=c_real), intent(out) :: C - - call shoc_assumed_pdf_compute_s(& - qw1,qs1,beta,pval,thl2,& - qw2,sqrtthl2,sqrtqw2,r_qwthl,& - s,std_s,qn,C) - - end subroutine shoc_assumed_pdf_compute_s_c - - subroutine shoc_assumed_pdf_compute_sgs_liquid_c(& - a,ql1,ql2,shoc_ql) bind (C) - use shoc, only: shoc_assumed_pdf_compute_sgs_liquid - - real(kind=c_real), intent(in), value :: a - real(kind=c_real), intent(in), value :: ql1 - real(kind=c_real), intent(in), value :: ql2 - - real(kind=c_real), intent(out) :: shoc_ql - - call shoc_assumed_pdf_compute_sgs_liquid(& - a,ql1,ql2,shoc_ql) - - end subroutine shoc_assumed_pdf_compute_sgs_liquid_c - - subroutine shoc_assumed_pdf_compute_cloud_liquid_variance_c(& - a,s1,ql1,C1,std_s1,& - s2,ql2,C2,std_s2,shoc_ql,& - shoc_ql2) bind (C) - use shoc, only: shoc_assumed_pdf_compute_cloud_liquid_variance - - real(kind=c_real), intent(in), value :: a - real(kind=c_real), intent(in), value :: s1 - real(kind=c_real), intent(in), value :: ql1 - real(kind=c_real), intent(in), value :: C1 - real(kind=c_real), intent(in), value :: std_s1 - real(kind=c_real), intent(in), value :: s2 - real(kind=c_real), intent(in), value :: ql2 - real(kind=c_real), intent(in), value :: C2 - real(kind=c_real), intent(in), value :: std_s2 - real(kind=c_real), intent(in), value :: shoc_ql - - real(kind=c_real), intent(out) :: shoc_ql2 - - call shoc_assumed_pdf_compute_cloud_liquid_variance(& - a,s1,ql1,C1,std_s1,& - s2,ql2,C2,std_s2,shoc_ql,& - shoc_ql2) - - end subroutine shoc_assumed_pdf_compute_cloud_liquid_variance_c - - subroutine shoc_assumed_pdf_compute_liquid_water_flux_c(& - a,w1_1,w_first,ql1,w1_2,ql2,& - wqls) bind (C) - use shoc, only: shoc_assumed_pdf_compute_liquid_water_flux - - real(kind=c_real), intent(in), value :: a - real(kind=c_real), intent(in), value :: w1_1 - real(kind=c_real), intent(in), value :: w_first - real(kind=c_real), intent(in), value :: ql1 - real(kind=c_real), intent(in), value :: w1_2 - real(kind=c_real), intent(in), value :: ql2 - - real(kind=c_real), intent(out) :: wqls - - call shoc_assumed_pdf_compute_liquid_water_flux(& - a,w1_1,w_first,ql1,w1_2,ql2,& - wqls) - - end subroutine shoc_assumed_pdf_compute_liquid_water_flux_c - - subroutine shoc_assumed_pdf_compute_buoyancy_flux_c(& - wthlsec,epsterm,wqwsec,pval,wqls,& - wthv_sec) bind (C) - use shoc, only: shoc_assumed_pdf_compute_buoyancy_flux - - real(kind=c_real), intent(in), value :: wthlsec - real(kind=c_real), intent(in), value :: epsterm - real(kind=c_real), intent(in), value :: wqwsec - real(kind=c_real), intent(in), value :: pval - real(kind=c_real), intent(in), value :: wqls - - real(kind=c_real), intent(out) :: wthv_sec - - call shoc_assumed_pdf_compute_buoyancy_flux(& - wthlsec,epsterm,wqwsec,pval,wqls,& - wthv_sec) - - end subroutine shoc_assumed_pdf_compute_buoyancy_flux_c - - subroutine shoc_diag_second_moments_ubycond_c(shcol, thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec) bind(C) - use shoc, only: diag_second_moments_ubycond - - ! argmens - integer(kind=c_int), value, intent(in) :: shcol - real(kind=c_real), intent(out) :: thl_sec(shcol), qw_sec(shcol), qwthl_sec(shcol),wthl_sec(shcol),wqw_sec(shcol), uw_sec(shcol), vw_sec(shcol), wtke_sec(shcol) - - call diag_second_moments_ubycond(shcol, thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec) - end subroutine shoc_diag_second_moments_ubycond_c - - subroutine shoc_pblintd_init_pot_c(shcol, nlev, thl, ql, q, thv) bind(C) - use shoc, only: pblintd_init_pot - - integer(kind=c_int), value, intent(in) :: shcol, nlev - real(kind=c_real), intent(in) :: thl(shcol, nlev), ql(shcol, nlev), q(shcol, nlev) - real(kind=c_real), intent(out) :: thv(shcol, nlev) - - call pblintd_init_pot(shcol, nlev, thl, ql, q, thv) - - end subroutine shoc_pblintd_init_pot_c - - subroutine diag_second_moments_lbycond_c(shcol, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, ustar2, wstar, wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec, thl_sec, qw_sec, qwthl_sec) bind(C) - use shoc, only : diag_second_moments_lbycond - - integer(kind=c_int) , value, intent(in) :: shcol - real(kind=c_real) , intent(in), dimension(shcol) :: wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, ustar2, wstar - real(kind=c_real) , intent(out), dimension(shcol) :: wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec, thl_sec, qw_sec, qwthl_sec - - call diag_second_moments_lbycond(shcol, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, ustar2, wstar, wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec, thl_sec, qw_sec, qwthl_sec) - end subroutine diag_second_moments_lbycond_c - - subroutine diag_second_moments_c(shcol, nlev, nlevi, thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, dz_zi, zt_grid, zi_grid, shoc_mix, thl_sec, qw_sec, & - wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec) bind(C) - use shoc, only : diag_second_moments - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, zt_grid, shoc_mix - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi, zi_grid - real(kind=c_real) , intent(inout), dimension(shcol, nlevi) :: thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: w_sec - - call diag_second_moments(shcol, nlev, nlevi, thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, dz_zi, zt_grid, zi_grid, shoc_mix, thl_sec, & - qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec) - - end subroutine diag_second_moments_c - - subroutine diag_second_shoc_moments_c(shcol, nlev, nlevi, thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, dz_zi, zt_grid, & - zi_grid, shoc_mix, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, thl_sec, qw_sec, wthl_sec, wqw_sec, & - qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec) bind(C) - use shoc, only : diag_second_shoc_moments - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, zt_grid, shoc_mix - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi, zi_grid - real(kind=c_real) , intent(in), dimension(shcol) :: wthl_sfc, wqw_sfc, uw_sfc, vw_sfc - real(kind=c_real) , intent(out), dimension(shcol, nlevi) :: thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: w_sec - - call diag_second_shoc_moments(shcol, nlev, nlevi, thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, dz_zi, zt_grid, & - zi_grid, shoc_mix, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, thl_sec, qw_sec, wthl_sec, wqw_sec, & - qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec) - end subroutine diag_second_shoc_moments_c - - subroutine shoc_pblintd_cldcheck_c(shcol, nlev, nlevi, zi, cldn, pblh) bind(C) - use shoc, only: pblintd_cldcheck - - integer(kind=c_int), value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real), intent(in) :: zi(shcol, nlevi), cldn(shcol, nlev) - real(kind=c_real), intent(inout) :: pblh(shcol) - - call pblintd_cldcheck(shcol, nlev, nlevi, zi, cldn, pblh) - end subroutine shoc_pblintd_cldcheck_c - - subroutine compute_shoc_vapor_c(shcol, nlev, qw, ql, qv) bind(C) - use shoc, only : compute_shoc_vapor - - integer(kind=c_int) , value, intent(in) :: shcol, nlev - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: qw, ql - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: qv - - call compute_shoc_vapor(shcol, nlev, qw, ql, qv) - end subroutine compute_shoc_vapor_c - - subroutine update_prognostics_implicit_c(shcol, nlev, nlevi, num_tracer, dtime, dz_zt, dz_zi, rho_zt, zt_grid, zi_grid, tk, tkh, uw_sfc, vw_sfc, wthl_sfc, wqw_sfc, wtracer_sfc, thetal, qw, tracer, tke, u_wind, v_wind) bind(C) - use shoc, only : update_prognostics_implicit - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, num_tracer - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: dz_zt, rho_zt, zt_grid, tk, tkh - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi, zi_grid - real(kind=c_real) , intent(in), dimension(shcol) :: uw_sfc, vw_sfc, wthl_sfc, wqw_sfc - real(kind=c_real) , intent(in), dimension(shcol, num_tracer) :: wtracer_sfc - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: thetal, qw, tke, u_wind, v_wind - real(kind=c_real) , intent(inout), dimension(shcol, nlev, num_tracer) :: tracer - - call update_prognostics_implicit(shcol, nlev, nlevi, num_tracer, dtime, dz_zt, dz_zi, rho_zt, zt_grid, zi_grid, tk, tkh, uw_sfc, vw_sfc, wthl_sfc, wqw_sfc, wtracer_sfc, thetal, qw, tracer, tke, u_wind, v_wind) - end subroutine update_prognostics_implicit_c - - subroutine pblintd_height_c(shcol, nlev, npbl_in, z, u, v, ustar, thv, thv_ref, pblh, rino, check) bind(C) - use shoc, only : npbl, pblintd_height - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, npbl_in - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z, u, v, thv - real(kind=c_real) , intent(in), dimension(shcol) :: ustar, thv_ref - real(kind=c_real) , intent(out), dimension(shcol) :: pblh - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: rino - logical(kind=c_bool) , intent(inout), dimension(shcol) :: check - - ! setup npbl - npbl = npbl_in - call pblintd_height(shcol, nlev, z, u, v, ustar, thv, thv_ref, pblh, rino, check) - end subroutine pblintd_height_c - - subroutine vd_shoc_decomp_c(shcol, nlev, nlevi, kv_term, tmpi, rdp_zt, dtime, flux, du, dl, d) bind(C) - use shoc, only : vd_shoc_decomp - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: kv_term, tmpi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: rdp_zt - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol) :: flux - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: du, dl, d - - call vd_shoc_decomp(shcol, nlev, nlevi, kv_term, tmpi, rdp_zt, dtime, flux, du, dl, d) - end subroutine vd_shoc_decomp_c - - subroutine vd_shoc_solve_c(shcol, nlev, du, dl, d, var) bind(C) - use shoc, only : vd_shoc_solve - - integer(kind=c_int) , value, intent(in) :: shcol, nlev - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: du, dl, d - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: var - - call vd_shoc_solve(shcol, nlev, du, dl, d, var) - end subroutine vd_shoc_solve_c - - subroutine pblintd_surf_temp_c(shcol, nlev, nlevi, z, ustar, obklen, kbfs, thv, tlv, pblh, check, rino) bind(C) - use shoc, only : npbl, pblintd_surf_temp - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z, thv - real(kind=c_real) , intent(in), dimension(shcol) :: ustar, obklen, kbfs - real(kind=c_real) , intent(out), dimension(shcol) :: tlv - real(kind=c_real) , intent(inout), dimension(shcol) :: pblh - logical(kind=c_bool) , intent(inout), dimension(shcol) :: check - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: rino - - ! setup npbl - npbl = nlev - call pblintd_surf_temp(shcol, nlev, nlevi, z, ustar, obklen, kbfs, thv, tlv, pblh, check, rino) - end subroutine pblintd_surf_temp_c - - subroutine pblintd_check_pblh_c(shcol, nlev, nlevi, z, ustar, check, pblh) bind(C) - use shoc, only : npbl,pblintd_check_pblh - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z - real(kind=c_real) , intent(in), dimension(shcol) :: ustar - logical(kind=c_bool) , intent(in), dimension(shcol) :: check - real(kind=c_real) , intent(out), dimension(shcol) :: pblh - - ! setup npbl - npbl = nlev - call pblintd_check_pblh(shcol, nlev, nlevi, z, ustar, check, pblh) - end subroutine pblintd_check_pblh_c - - subroutine pblintd_c(shcol, nlev, nlevi, npbl_in, z, zi, thl, ql, q, u, v, ustar, obklen, kbfs, cldn, pblh) bind(C) - use shoc, only : npbl, pblintd - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, npbl_in - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z, thl, ql, q, u, v, cldn - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: zi - real(kind=c_real) , intent(in), dimension(shcol) :: ustar, obklen, kbfs - real(kind=c_real) , intent(out), dimension(shcol) :: pblh - - ! setup npbl - npbl = npbl_in - call pblintd(shcol, nlev, nlevi, z, zi, thl, ql, q, u, v, ustar, obklen, kbfs, cldn, pblh) - end subroutine pblintd_c - - subroutine compute_shoc_temperature_c(shcol, nlev, thetal, ql, inv_exner, tabs) bind(C) - use shoc, only : compute_shoc_temperature - - integer(kind=c_int) , value, intent(in) :: shcol, nlev - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thetal, ql, inv_exner - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: tabs - - call compute_shoc_temperature(shcol, nlev, thetal, ql, inv_exner, tabs) - end subroutine compute_shoc_temperature_c end module shoc_iso_c diff --git a/components/eamxx/src/physics/shoc/shoc_iso_f.f90 b/components/eamxx/src/physics/shoc/shoc_iso_f.f90 deleted file mode 100644 index 6cf55a9b453..00000000000 --- a/components/eamxx/src/physics/shoc/shoc_iso_f.f90 +++ /dev/null @@ -1,532 +0,0 @@ -module shoc_iso_f - use iso_c_binding - implicit none - -#include "scream_config.f" -#ifdef SCREAM_DOUBLE_PRECISION -# define c_real c_double -#else -# define c_real c_float -#endif - -! -! This file contains bridges from shoc fortran to scream c++. -! - -interface - - subroutine calc_shoc_varorcovar_f(shcol, nlev, nlevi, tunefac, isotropy_zi, tkh_zi, dz_zi, invar1, invar2, varorcovar) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in), value :: tunefac - real(kind=c_real), intent(in) :: isotropy_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: tkh_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: invar1(shcol,nlev) - real(kind=c_real), intent(in) :: invar2(shcol,nlev) - - real(kind=c_real), intent(inout) :: varorcovar(shcol,nlevi) - - end subroutine calc_shoc_varorcovar_f - - subroutine calc_shoc_vertflux_f(shcol, nlev, nlevi, tkh_zi, dz_zi, invar, vertflux) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: tkh_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: invar(shcol,nlev) - - real(kind=c_real), intent(inout) :: vertflux(shcol,nlevi) - - end subroutine calc_shoc_vertflux_f - - subroutine shoc_diag_second_moments_srf_f(shcol, wthl_sfc, uw_sfc, vw_sfc, ustar2, wstar) bind(C) - use iso_c_binding - - integer(kind=c_int), value, intent(in) :: shcol - - ! arguments - real(kind=c_real), intent(in) :: wthl_sfc(shcol) - real(kind=c_real), intent(in) :: uw_sfc(shcol) - real(kind=c_real), intent(in) :: vw_sfc(shcol) - real(kind=c_real), intent(out) :: ustar2(shcol) - real(kind=c_real), intent(out) :: wstar(shcol) - - end subroutine shoc_diag_second_moments_srf_f - - subroutine shoc_diag_second_moments_ubycond_f(shcol, thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec) bind(C) - use iso_c_binding - - ! argmens - integer(kind=c_int), value, intent(in) :: shcol - real(kind=c_real), intent(out) :: thl_sec(shcol), qw_sec(shcol), qwthl_sec(shcol),wthl_sec(shcol),wqw_sec(shcol), & - uw_sec(shcol), vw_sec(shcol), wtke_sec(shcol) - - end subroutine shoc_diag_second_moments_ubycond_f - - subroutine update_host_dse_f(shcol, nlev, thlm, shoc_ql, inv_exner, zt_grid, & - phis, host_dse) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - real(kind=c_real), intent(in) :: thlm(shcol,nlev) - real(kind=c_real), intent(in) :: shoc_ql(shcol,nlev) - real(kind=c_real), intent(in) :: inv_exner(shcol,nlev) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: phis(shcol) - - real(kind=c_real), intent(out) :: host_dse(shcol,nlev) - - end subroutine update_host_dse_f - - subroutine compute_diag_third_shoc_moment_f(shcol, nlev, nlevi, w_sec, thl_sec, & - wthl_sec, tke, dz_zt, & - dz_zi, isotropy_zi, & - brunt_zi, w_sec_zi, thetal_zi, & - w3) bind(C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - real(kind=c_real), intent(in) :: w_sec(shcol,nlev) - real(kind=c_real), intent(in) :: thl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: wthl_sec(shcol,nlevi) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: isotropy_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: brunt_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: w_sec_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: thetal_zi(shcol,nlevi) - - real(kind=c_real), intent(out) :: w3(shcol,nlevi) - - end subroutine compute_diag_third_shoc_moment_f - - subroutine check_tke_f(shcol, nlev, tke) bind(C) - - use iso_c_binding - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - - real(kind=c_real), intent(inout) :: tke(shcol,nlev) - - end subroutine check_tke_f - - subroutine shoc_pblintd_init_pot_f(shcol, nlev, thl, ql, q, thv) bind(C) - use iso_c_binding - - integer(kind=c_int), value, intent(in) :: shcol, nlev - real(kind=c_real), intent(in) :: thl(shcol, nlev), ql(shcol, nlev), q(shcol,nlev) - real(kind=c_real), intent(out) :: thv(shcol, nlev) - - end subroutine shoc_pblintd_init_pot_f - - subroutine compute_shoc_mix_shoc_length_f(nlev,shcol,tke,brunt,& - zt_grid,l_inf,shoc_mix) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: brunt(shcol,nlev) - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: l_inf(shcol) - - real(kind=c_real), intent(out) :: shoc_mix(shcol,nlev) - - end subroutine compute_shoc_mix_shoc_length_f - - subroutine linear_interp_f(x1, x2, y1, y2, km1, km2, ncol, minthresh) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: km1, km2, ncol - real(kind=c_real) , intent(in), dimension(ncol, km1) :: x1, y1 - real(kind=c_real) , intent(in), dimension(ncol, km2) :: x2 - real(kind=c_real) , intent(out), dimension(ncol, km2) :: y2 - real(kind=c_real) , value, intent(in) :: minthresh - end subroutine linear_interp_f - -subroutine clipping_diag_third_shoc_moments_f(nlevi,shcol,w_sec_zi,w3) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: nlevi - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: w_sec_zi(shcol,nlevi) - - real(kind=c_real), intent(inout) :: w3(shcol,nlevi) - -end subroutine clipping_diag_third_shoc_moments_f - -subroutine shoc_energy_integrals_f(shcol, nlev, host_dse, pdel,& - rtm, rcm, u_wind, v_wind,& - se_int, ke_int, wv_int, wl_int) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - real(kind=c_real), intent(in) :: host_dse(shcol,nlev) - real(kind=c_real), intent(in) :: pdel(shcol,nlev) - real(kind=c_real), intent(in) :: rtm(shcol,nlev) - real(kind=c_real), intent(in) :: rcm(shcol,nlev) - real(kind=c_real), intent(in) :: u_wind(shcol,nlev) - real(kind=c_real), intent(in) :: v_wind(shcol,nlev) - - real(kind=c_real), intent(out) :: se_int(shcol) - real(kind=c_real), intent(out) :: ke_int(shcol) - real(kind=c_real), intent(out) :: wv_int(shcol) - real(kind=c_real), intent(out) :: wl_int(shcol) - -end subroutine shoc_energy_integrals_f - -subroutine diag_second_moments_lbycond_f(shcol, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, ustar2, wstar, & - wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec, thl_sec, qw_sec, qwthl_sec) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol - real(kind=c_real) , intent(in), dimension(shcol) :: wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, ustar2, wstar - real(kind=c_real) , intent(out), dimension(shcol) :: wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec, thl_sec, qw_sec, qwthl_sec -end subroutine diag_second_moments_lbycond_f - -subroutine diag_second_moments_f(shcol, nlev, nlevi, thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, dz_zi, zt_grid, zi_grid, & - shoc_mix, thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, zt_grid, shoc_mix - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi, zi_grid - real(kind=c_real) , intent(inout), dimension(shcol, nlevi) :: thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: w_sec -end subroutine diag_second_moments_f - - subroutine diag_second_shoc_moments_f(shcol, nlev, nlevi, thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, dz_zi, zt_grid, & - zi_grid, shoc_mix, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, thl_sec, qw_sec, wthl_sec, wqw_sec, & - qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, zt_grid, shoc_mix - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi, zi_grid - real(kind=c_real) , intent(in), dimension(shcol) :: wthl_sfc, wqw_sfc, uw_sfc, vw_sfc - real(kind=c_real) , intent(out), dimension(shcol, nlevi) :: thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: w_sec - end subroutine diag_second_shoc_moments_f - -subroutine compute_brunt_shoc_length_f(nlev, nlevi, shcol, dz_zt, thv, thv_zi, brunt) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: nlev, nlevi, shcol - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: dz_zt, thv - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: thv_zi - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: brunt - -end subroutine compute_brunt_shoc_length_f - -subroutine compute_l_inf_shoc_length_f(nlev,shcol,zt_grid,dz_zt,tke,l_inf) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - - real(kind=c_real), intent(out) :: l_inf(shcol) - -end subroutine compute_l_inf_shoc_length_f - -subroutine check_length_scale_shoc_length_f(nlev, shcol, host_dx, host_dy, shoc_mix) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: nlev, shcol - real(kind=c_real) , intent(in), dimension(shcol) :: host_dx, host_dy - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: shoc_mix - -end subroutine check_length_scale_shoc_length_f - -subroutine shoc_diag_obklen_f(shcol, uw_sfc, vw_sfc, wthl_sfc, wqw_sfc, thl_sfc, cldliq_sfc, qv_sfc, ustar, kbfs, obklen) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol - real(kind=c_real) , intent(in), dimension(shcol) :: uw_sfc, vw_sfc, wthl_sfc, wqw_sfc, thl_sfc, cldliq_sfc, qv_sfc - real(kind=c_real) , intent(out), dimension(shcol) :: ustar, kbfs, obklen - -end subroutine shoc_diag_obklen_f - -subroutine shoc_pblintd_cldcheck_f(shcol, nlev, nlevi, zi, cldn, pblh) bind(C) - use iso_c_binding - - integer(kind=c_int), value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real), intent(in) :: zi(shcol, nlevi), cldn(shcol, nlev) - real(kind=c_real), intent(inout) :: pblh(shcol) -end subroutine shoc_pblintd_cldcheck_f - -subroutine shoc_length_f(shcol, nlev, nlevi, host_dx, host_dy, & - zt_grid, zi_grid, dz_zt, tke, & - thv, brunt, shoc_mix) bind (C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: shcol - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: nlevi - - real(kind=c_real), intent(in) :: host_dx(shcol) - real(kind=c_real), intent(in) :: host_dy(shcol) - - real(kind=c_real), intent(in) :: zt_grid(shcol,nlev) - real(kind=c_real), intent(in) :: zi_grid(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: tke(shcol,nlev) - real(kind=c_real), intent(in) :: thv(shcol,nlev) - - real(kind=c_real), intent(out) :: brunt(shcol,nlev) - real(kind=c_real), intent(out) :: shoc_mix(shcol,nlev) - -end subroutine shoc_length_f - -subroutine shoc_energy_fixer_f(shcol, nlev, nlevi, dtime, nadv, zt_grid, zi_grid,& - se_b, ke_b, wv_b, wl_b, se_a, ke_a, wv_a, wl_a,& - wthl_sfc, wqw_sfc, rho_zt, tke, pint, host_dse) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, nadv - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: zt_grid, rho_zt, tke - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: zi_grid, pint - real(kind=c_real) , intent(in), dimension(shcol) :: se_b, ke_b, wv_b, wl_b, se_a, ke_a, wv_a, wl_a, wthl_sfc, wqw_sfc - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: host_dse - -end subroutine shoc_energy_fixer_f - - subroutine compute_shoc_vapor_f(shcol, nlev, qw, ql, qv) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: qw, ql - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: qv - end subroutine compute_shoc_vapor_f - - subroutine update_prognostics_implicit_f(shcol, nlev, nlevi, num_tracer, dtime, dz_zt, dz_zi, rho_zt, zt_grid, zi_grid, tk, tkh, uw_sfc, vw_sfc, wthl_sfc, wqw_sfc, wtracer_sfc, thetal, qw, tracer, tke, u_wind, v_wind) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, num_tracer - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: dz_zt, rho_zt, zt_grid, tk, tkh - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi, zi_grid - real(kind=c_real) , intent(in), dimension(shcol) :: uw_sfc, vw_sfc, wthl_sfc, wqw_sfc - real(kind=c_real) , intent(in), dimension(shcol, num_tracer) :: wtracer_sfc - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: thetal, qw, tke, u_wind, v_wind - real(kind=c_real) , intent(inout), dimension(shcol, nlev, num_tracer) :: tracer - end subroutine update_prognostics_implicit_f - -subroutine diag_third_shoc_moments_f(shcol, nlev, nlevi, w_sec, thl_sec, wthl_sec, isotropy, brunt,& - thetal, tke, dz_zt, dz_zi, zt_grid, zi_grid, w3) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: w_sec, isotropy, brunt, thetal, tke, dz_zt, zt_grid - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: thl_sec, wthl_sec, dz_zi, zi_grid - real(kind=c_real) , intent(out), dimension(shcol, nlevi) :: w3 -end subroutine diag_third_shoc_moments_f - - subroutine adv_sgs_tke_f(nlev, shcol, dtime, shoc_mix, wthv_sec, sterm_zt, tk, tke, a_diss) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: nlev, shcol - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: shoc_mix, wthv_sec, sterm_zt, tk - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: tke - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: a_diss - end subroutine adv_sgs_tke_f - -subroutine shoc_assumed_pdf_f(shcol, nlev, nlevi, thetal, qw, w_field, thl_sec, qw_sec,& - wthl_sec, w_sec, wqw_sec, qwthl_sec, w3, pres, zt_grid,& - zi_grid, shoc_cldfrac, shoc_ql, wqls, wthv_sec, shoc_ql2) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thetal, qw, w_field, w_sec, pres, zt_grid - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, w3, zi_grid - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: shoc_cldfrac, shoc_ql, wqls, wthv_sec, shoc_ql2 -end subroutine shoc_assumed_pdf_f - -subroutine compute_shr_prod_f(nlevi, nlev, shcol, dz_zi, u_wind, v_wind, sterm) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: nlevi, nlev, shcol - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: u_wind, v_wind - real(kind=c_real) , intent(out), dimension(shcol, nlevi) :: sterm -end subroutine compute_shr_prod_f - -subroutine compute_tmpi_f(nlevi, shcol, dtime, rho_zi, dz_zi, tmpi) bind(C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: nlevi - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in), value :: dtime - real(kind=c_real), intent(in) :: rho_zi(shcol,nlevi) - real(kind=c_real), intent(in) :: dz_zi(shcol,nlevi) - - real(kind=c_real), intent(out) :: tmpi(shcol,nlevi) -end subroutine compute_tmpi_f - -subroutine integ_column_stability_f(nlev, shcol, dz_zt, pres, brunt, brunt_int) bind(C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(in) :: pres(shcol,nlev) - real(kind=c_real), intent(in) :: brunt(shcol,nlev) - real(kind=c_real), intent(out) :: brunt_int(shcol) - -end subroutine integ_column_stability_f - -subroutine dp_inverse_f(nlev, shcol, rho_zt, dz_zt, rdp_zt) bind(C) - use iso_c_binding - - integer(kind=c_int), intent(in), value :: nlev - integer(kind=c_int), intent(in), value :: shcol - real(kind=c_real), intent(in) :: rho_zt(shcol,nlev) - real(kind=c_real), intent(in) :: dz_zt(shcol,nlev) - real(kind=c_real), intent(out) :: rdp_zt(shcol,nlev) -end subroutine dp_inverse_f - - subroutine shoc_main_f(shcol, nlev, nlevi, dtime, nadv, npbl, host_dx, host_dy, & - thv, zt_grid, zi_grid, pres, presi, pdel, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, & - wtracer_sfc, num_qtracers, w_field, inv_exner, phis, host_dse, tke, thetal, qw, & - u_wind, v_wind, qtracers, wthv_sec, tkh, tk, shoc_ql, shoc_cldfrac, pblh, & - shoc_mix, isotropy, w_sec, thl_sec, qw_sec, qwthl_sec, wthl_sec, wqw_sec, & - wtke_sec, uw_sec, vw_sec, w3, wqls_sec, brunt, shoc_ql2) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, nadv, num_qtracers, npbl - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol) :: host_dx, host_dy, wthl_sfc, wqw_sfc, uw_sfc, vw_sfc, phis - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thv, zt_grid, pres, pdel, w_field, inv_exner - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: zi_grid, presi - real(kind=c_real) , intent(in), dimension(shcol, num_qtracers) :: wtracer_sfc - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: host_dse, tke, thetal, qw, u_wind, v_wind, wthv_sec, tkh, tk, shoc_ql, shoc_cldfrac - real(kind=c_real) , intent(inout), dimension(shcol, nlev, num_qtracers) :: qtracers - real(kind=c_real) , intent(out), dimension(shcol) :: pblh - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: shoc_mix, isotropy, w_sec, wqls_sec, brunt, shoc_ql2 - real(kind=c_real) , intent(out), dimension(shcol, nlevi) :: thl_sec, qw_sec, qwthl_sec, wthl_sec, wqw_sec, wtke_sec, uw_sec, vw_sec, w3 - end subroutine shoc_main_f - - subroutine isotropic_ts_f(nlev, shcol, brunt_int, tke, a_diss, brunt, isotropy) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: nlev, shcol - real(kind=c_real) , intent(in), dimension(shcol) :: brunt_int - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: tke, a_diss, brunt - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: isotropy - end subroutine isotropic_ts_f - - subroutine pblintd_height_f(shcol, nlev, npbl, z, u, v, ustar, thv, thv_ref, pblh, rino, check) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, npbl - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z, u, v, thv - real(kind=c_real) , intent(in), dimension(shcol) :: ustar, thv_ref - real(kind=c_real) , intent(out), dimension(shcol) :: pblh - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: rino - logical(kind=c_bool) , intent(inout), dimension(shcol) :: check - end subroutine pblintd_height_f - - subroutine vd_shoc_decomp_and_solve_f(shcol, nlev, nlevi, num_rhs, kv_term, tmpi, rdp_zt, dtime, flux, var) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, num_rhs - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: kv_term, tmpi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: rdp_zt - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol) :: flux - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: var - end subroutine vd_shoc_decomp_and_solve_f - - subroutine pblintd_surf_temp_f(shcol, nlev, nlevi, z, ustar, obklen, kbfs, thv, tlv, pblh, check, rino) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z, thv - real(kind=c_real) , intent(in), dimension(shcol) :: ustar, obklen, kbfs - real(kind=c_real) , intent(out), dimension(shcol) :: tlv - real(kind=c_real) , intent(inout), dimension(shcol) :: pblh - logical(kind=c_bool) , intent(inout), dimension(shcol) :: check - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: rino - end subroutine pblintd_surf_temp_f - - subroutine pblintd_check_pblh_f(shcol, nlev, nlevi, npbl, z, ustar, check, pblh) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, npbl - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z - real(kind=c_real) , intent(in), dimension(shcol) :: ustar - logical(kind=c_bool) , intent(in), dimension(shcol) :: check - real(kind=c_real) , intent(inout), dimension(shcol) :: pblh - end subroutine pblintd_check_pblh_f - - subroutine pblintd_f(shcol, nlev, nlevi, npbl, z, zi, thl, ql, q, u, v, ustar, obklen, kbfs, cldn, pblh) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi, npbl - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: z, thl, ql, q, u, v, cldn - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: zi - real(kind=c_real) , intent(in), dimension(shcol) :: ustar, obklen, kbfs - real(kind=c_real) , intent(out), dimension(shcol) :: pblh - end subroutine pblintd_f - - subroutine shoc_grid_f(shcol, nlev, nlevi, zt_grid, zi_grid, pdel, dz_zt, dz_zi, rho_zt) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: zt_grid, pdel - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: zi_grid - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: dz_zt, rho_zt - real(kind=c_real) , intent(out), dimension(shcol, nlevi) :: dz_zi - end subroutine shoc_grid_f - - subroutine eddy_diffusivities_f(nlev, shcol, pblh, zt_grid, tabs, shoc_mix, sterm_zt, isotropy, tke, tkh, tk) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: nlev, shcol - real(kind=c_real) , intent(in), dimension(shcol) :: pblh - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: zt_grid, tabs, shoc_mix, sterm_zt, isotropy, tke - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: tkh, tk - end subroutine eddy_diffusivities_f - - subroutine shoc_tke_f(shcol, nlev, nlevi, dtime, wthv_sec, shoc_mix, dz_zi, dz_zt, pres, tabs, & - u_wind, v_wind, brunt, zt_grid, zi_grid, pblh, tke, tk, tkh, isotropy) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev, nlevi - real(kind=c_real) , value, intent(in) :: dtime - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: wthv_sec, shoc_mix, dz_zt, pres, tabs, u_wind, v_wind, brunt, zt_grid - real(kind=c_real) , intent(in), dimension(shcol, nlevi) :: dz_zi, zi_grid - real(kind=c_real) , intent(in), dimension(shcol) :: pblh - real(kind=c_real) , intent(inout), dimension(shcol, nlev) :: tke, tk, tkh - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: isotropy - end subroutine shoc_tke_f - - subroutine compute_shoc_temperature_f(shcol, nlev, thetal, ql, inv_exner, tabs) bind(C) - use iso_c_binding - - integer(kind=c_int) , value, intent(in) :: shcol, nlev - real(kind=c_real) , intent(in), dimension(shcol, nlev) :: thetal, ql, inv_exner - real(kind=c_real) , intent(out), dimension(shcol, nlev) :: tabs - end subroutine compute_shoc_temperature_f - -end interface - -end module shoc_iso_f diff --git a/components/eamxx/src/physics/shoc/shoc_f90.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_f90.cpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_f90.cpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_f90.cpp diff --git a/components/eamxx/src/physics/shoc/shoc_f90.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_f90.hpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_f90.hpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_f90.hpp diff --git a/components/eamxx/src/physics/shoc/shoc_functions_f90.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.cpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_functions_f90.cpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.cpp diff --git a/components/eamxx/src/physics/shoc/shoc_functions_f90.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.hpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_functions_f90.hpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.hpp diff --git a/components/eamxx/src/physics/shoc/shoc_ic_cases.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.cpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_ic_cases.cpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.cpp diff --git a/components/eamxx/src/physics/shoc/shoc_ic_cases.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.hpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_ic_cases.hpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.hpp diff --git a/components/eamxx/src/physics/shoc/shoc_main_wrap.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_main_wrap.cpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp diff --git a/components/eamxx/src/physics/shoc/shoc_main_wrap.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.hpp similarity index 100% rename from components/eamxx/src/physics/shoc/shoc_main_wrap.hpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.hpp diff --git a/components/eamxx/src/physics/shoc/tests/shoc_unit_tests_common.hpp b/components/eamxx/src/physics/shoc/tests/shoc_unit_tests_common.hpp index 0d74ebaa5fe..97b728d9a10 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_unit_tests_common.hpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_unit_tests_common.hpp @@ -48,9 +48,6 @@ struct UnitWrap { using Smask = typename Functions::Smask; using C = typename Functions::C; - static constexpr Int max_pack_size = 16; - static constexpr Int num_test_itrs = max_pack_size / Spack::n; - // Put struct decls here struct TestCalcShocVertflux; struct TestShocDiagObklen; From 982003326549db1ed901758cb9f79da4581a813d Mon Sep 17 00:00:00 2001 From: James Foucar Date: Fri, 8 Nov 2024 13:13:16 -0700 Subject: [PATCH 249/529] Add sentinel for parsing --- .../eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp | 2 +- .../physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp | 2 +- .../physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp | 2 +- .../shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp | 2 +- .../physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_energy_integral_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp | 2 +- components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp | 2 +- components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp | 2 +- components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp | 3 ++- .../eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp | 3 ++- .../src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp | 2 +- components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp | 2 +- .../src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp | 2 +- components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp | 2 +- .../shoc/tests/shoc_update_prognostics_implicit_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp | 2 +- .../physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp | 2 +- .../eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp | 2 +- 42 files changed, 44 insertions(+), 42 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp index e947946fa20..0a5139c4cbc 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp @@ -477,7 +477,7 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf { REQUIRE(d_f90.shoc_ql2[k] == d_cxx.shoc_ql2[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp index 3018d0e5aa6..b07ea8ee968 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp @@ -176,7 +176,7 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength { REQUIRE(d_f90.brunt[k] == d_cxx.brunt[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp index bd023e2ed79..5f822fb83c1 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp @@ -146,7 +146,7 @@ struct UnitWrap::UnitTest::TestCheckShocLength { REQUIRE(d_f90.shoc_mix[k] == d_cxx.shoc_mix[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp index 75581e2283c..8dc28e59423 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp @@ -128,7 +128,7 @@ struct UnitWrap::UnitTest::TestShocCheckTke { REQUIRE(d_f90.tke[k] == d_cxx.tke[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp index 28bef1aae25..0498d0d9602 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp @@ -155,7 +155,7 @@ struct UnitWrap::UnitTest::TestClipThirdMoms { REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp index d63bf34bb50..efcbbf4f2bc 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp @@ -249,7 +249,7 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird { REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp index 27452cdcf70..86b8f796d38 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp @@ -253,7 +253,7 @@ struct UnitWrap::UnitTest::TestComputeShocTemp { REQUIRE(d_f90.tabs[k] == d_cxx.tabs[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp index afd184e1823..38e13fcbf8d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp @@ -139,7 +139,7 @@ struct UnitWrap::UnitTest::TestComputeShocVapor { REQUIRE(d_f90.qv[k] == d_cxx.qv[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp index 930faf31d6b..da07b632434 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp @@ -228,7 +228,7 @@ struct UnitWrap::UnitTest::TestShocDiagObklen { REQUIRE(d_f90.obklen[s] == d_cxx.obklen[s]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp index 25f56139d77..c1770c45855 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp @@ -124,7 +124,7 @@ struct UnitWrap::UnitTest::TestSecondMomSrf { REQUIRE(mom_srf_data_f90[i].wstar[k] == mom_srf_data_cxx[i].wstar[k]); } } - } + } // SCREAM_BFB_TESTING #endif } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp index d4dbd3e7b71..1bae79c852d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp @@ -111,7 +111,7 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond { REQUIRE(uby_fortran[i].wtke_sec[k] == uby_cxx[i].wtke_sec[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp index 1f1f3df8e5c..36309052b47 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp @@ -174,7 +174,7 @@ struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond { REQUIRE(d_f90.qwthl_sec[k] == d_cxx.qwthl_sec[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp index f83bfa313f9..3dba867917b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp @@ -317,7 +317,7 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments { REQUIRE(d_f90.wtke_sec[k] == d_cxx.wtke_sec[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp index 0385335c808..eab0fbead12 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp @@ -329,7 +329,7 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments { REQUIRE(d_f90.wtke_sec[k] == d_cxx.wtke_sec[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp index 82b4d88c0f7..5ddd261d0d9 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp @@ -269,7 +269,7 @@ struct UnitWrap::UnitTest::TestShocDiagThird { REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp index 0a96e5adc62..acffb965df1 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp @@ -315,7 +315,7 @@ struct UnitWrap::UnitTest::TestShocEddyDiff { REQUIRE(d_f90.tk[k] == d_cxx.tk[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp index dfb37104f01..253fb959723 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp @@ -331,7 +331,7 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer { REQUIRE(d_f90.host_dse[k] == d_cxx.host_dse[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp index 8142da9371d..a782329d500 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp @@ -189,7 +189,7 @@ struct UnitWrap::UnitTest::TestShocEnergyInt { REQUIRE(d_f90.wl_int[c] == d_cxx.wl_int[c]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp index a4e01eadb85..8c56d72ce2a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp @@ -193,7 +193,7 @@ struct UnitWrap::UnitTest::TestShocUpdateDse { REQUIRE(d_f90.host_dse[k] == d_cxx.host_dse[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp index 6a79eeca02e..81f2aa5ac9d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp @@ -184,7 +184,7 @@ struct UnitWrap::UnitTest::TestShocGrid { REQUIRE(d_f90.dz_zi[k] == d_cxx.dz_zi[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp index 53280dab17a..5c55f4947a8 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp @@ -169,7 +169,7 @@ struct UnitWrap::UnitTest::TestImpCompTmpi { REQUIRE(d_f90.tmpi[k] == d_cxx.tmpi[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp index aad9c026686..c11ce4c8a9e 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp @@ -149,7 +149,7 @@ struct UnitWrap::UnitTest::TestImpDpInverse { REQUIRE(d_f90.rdp_zt[k] == d_cxx.rdp_zt[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp index 84faaebe4b9..48a25d86e2b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp @@ -160,7 +160,7 @@ struct UnitWrap::UnitTest::TestLInfShocLength { REQUIRE(d_f90.l_inf[c] == d_cxx.l_inf[c]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp index 0f890db9ce1..8fb7ff66281 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp @@ -251,7 +251,7 @@ struct UnitWrap::UnitTest::TestShocLength { REQUIRE(d_f90.shoc_mix[k] == d_cxx.shoc_mix[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp index 0a9c666688b..427e5f6d622 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp @@ -395,7 +395,7 @@ struct UnitWrap::UnitTest::TestShocLinearInt { REQUIRE(d_f90.y2[k] == d_cxx.y2[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp index 5c3eb8f9860..65d328744b7 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp @@ -481,7 +481,7 @@ struct UnitWrap::UnitTest::TestShocMain { REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp index 4d6b5dfdce1..1bcba869a51 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp @@ -175,7 +175,7 @@ struct UnitWrap::UnitTest::TestCompShocMixLength { REQUIRE(d_f90.shoc_mix[k] == d_cxx.shoc_mix[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp index 2d5f01c8ff2..0b848633464 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp @@ -132,7 +132,7 @@ struct UnitWrap::UnitTest::TestPblintdCheckPblh { REQUIRE(d_f90.pblh[k] == d_cxx.pblh[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp index df65050acac..de1c377d185 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp @@ -117,6 +117,7 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck { PblintdCldcheckData(cldcheck_data_f90[3]), }; + // Get data from fortran for (auto& d : cldcheck_data_f90) { // expects data in C layout pblintd_cldcheck(d); @@ -135,7 +136,7 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck { REQUIRE(cldcheck_data_f90[i].pblh[k] == cldcheck_data_cxx[i].pblh[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp index 9c33c7de68b..c1fc82fd405 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp @@ -236,7 +236,7 @@ struct UnitWrap::UnitTest::TestPblintdHeight { REQUIRE(d_f90.check[k] == d_cxx.check[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp index b01c39eed95..dc1a97b3130 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp @@ -172,6 +172,7 @@ struct UnitWrap::UnitTest::TestPblintdInitPot { PblintdInitPotData(pblintd_init_pot_data_f90[3]), }; + // Get data from fortran for (auto& d : pblintd_init_pot_data_f90) { // expects data in C layout pblintd_init_pot(d); @@ -192,7 +193,7 @@ struct UnitWrap::UnitTest::TestPblintdInitPot { } } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp index ccf3d110fc8..072bcc5d1d9 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp @@ -172,7 +172,7 @@ struct UnitWrap::UnitTest::TestPblintdSurfTemp { REQUIRE(d_f90.rino[k] == d_cxx.rino[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp index b5cd117228b..8878b7b10bc 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp @@ -197,7 +197,7 @@ struct UnitWrap::UnitTest::TestPblintd { REQUIRE(d_f90.pblh[k] == d_cxx.pblh[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp index ea2c95470d8..e8f0321a837 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp @@ -246,7 +246,7 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke { REQUIRE(d_f90.a_diss[k] == d_cxx.a_diss[k]); } } - } + } // SCREAM_BFB_TESTING }//run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp index eb68bbc11df..d576de1174c 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp @@ -172,7 +172,7 @@ struct UnitWrap::UnitTest::TestShocIntColStab { REQUIRE(d_f90.brunt_int[c] == d_cxx.brunt_int[c]); } } - } + } // SCREAM_BFB_TESTING } //run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp index c90128857cb..558f40481f4 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp @@ -229,7 +229,7 @@ struct UnitWrap::UnitTest::TestShocIsotropicTs { REQUIRE(d_f90.isotropy[k] == d_cxx.isotropy[k]); } } - } + } // SCREAM_BFB_TESTING }//run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp index 0672ce3b3ae..a19c2233e9d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp @@ -210,7 +210,7 @@ struct UnitWrap::UnitTest::TestShocShearProd { REQUIRE(d_f90.sterm[k] == d_cxx.sterm[k]); } } - } + } // SCREAM_BFB_TESTING } //run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp index f09ecc79c7d..41c2ebc50bf 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp @@ -314,7 +314,7 @@ struct UnitWrap::UnitTest::TestShocTke { REQUIRE(d_f90.isotropy[k] == d_cxx.isotropy[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp index 83cfb8d5707..82313e22ca7 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp @@ -409,7 +409,7 @@ struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit { REQUIRE(d_f90.tracer[k] == d_cxx.tracer[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp index 4a743009f24..cbf66bc4a58 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp @@ -339,7 +339,7 @@ static void run_bfb() REQUIRE(d_f90.varorcovar[k] == d_cxx.varorcovar[k]); } } - } + } // SCREAM_BFB_TESTING } }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp index 3bd213cf784..5f373f870b6 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp @@ -76,7 +76,7 @@ struct UnitWrap::UnitTest::TestVdShocDecompandSolve { REQUIRE(d_f90.var[k] == d_cxx.var[k]); } } - } + } // SCREAM_BFB_TESTING } // run_bfb }; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp index 7ac7c7c5316..2b83169420b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp @@ -185,7 +185,7 @@ struct UnitWrap::UnitTest::TestCalcShocVertflux { REQUIRE(d_f90.vertflux[k] == d_cxx.vertflux[k]); } } - } + } // SCREAM_BFB_TESTING } }; From bea3c66996666423516d4ba6bd11b9b520434229 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Fri, 8 Nov 2024 13:14:43 -0700 Subject: [PATCH 250/529] This file had windows carraige returns --- .../shoc/tests/shoc_assumed_pdf_tests.cpp | 1008 ++++++++--------- 1 file changed, 504 insertions(+), 504 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp index 0a5139c4cbc..ed5d50199e6 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp @@ -1,504 +1,504 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" -#include "share/util/scream_setup_random_test.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestShocAssumedPdf { - - static void run_property() - { - static constexpr Int shcol = 2; - static constexpr Int nlev = 5; - static constexpr auto nlevi = nlev + 1; - - // Tests for the top level subroutine - // shoc_assumed_pdf - - // Tests will start simple, and gradually add complexity to test - // the physics. - // NOTE: for this test we want exactly two columns. - - // TEST ONE - // No SGS variability test. Given inputs where there is a saturated - // profile but NO SGS variability in the scalar fluxes or variances - // (i.e. all second and third moment terms are zero), then verify that - // that cloud fraction is either 1 or 0 and that the SGS variability - // outputs are also zero everywhere. - - // Define input data - - // Note that the moisture and height profiles below represent that - // of the BOMEX case, but the temperatures are much colder, to encourage - // there to be points with ample cloud produced for this test. - - // Liquid water potential temperature [K] - static constexpr Real thetal[nlev] = {303, 300, 298, 298, 300}; - // Total water mixing ratio [kg/kg] - static constexpr Real qw[nlev] = {0.003, 0.004, 0.011, 0.016, 0.017}; - // Pressure [Pa] - static constexpr Real pres[nlev] = {70000, 80000, 85000, 90000, 100000}; - // Define the heights on the zt grid [m] - static constexpr Real zi_grid[nlevi] = {3000, 2000, 1500, 1000, 500, 0}; - - // All variances will be given zero or minimum threshold inputs - - // Define some reasonable bounds for output - static constexpr Real wqls_bound = 0.1; - static constexpr Real wthv_sec_bound = 10; - static constexpr Real shoc_ql2_bound = 0.1; - static constexpr Real shoc_ql_bound = 0.1; - - Real zt_grid[nlev]; - // Compute heights on midpoint grid - for(Int n = 0; n < nlev; ++n) { - zt_grid[n] = 0.5*(zi_grid[n]+zi_grid[n+1]); - } - - // Initialize data structure for bridging to F90 - ShocAssumedPdfData SDS(shcol, nlev, nlevi); - - // Load input data - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - SDS.thetal[offset] = thetal[n]; - SDS.qw[offset] = qw[n]; - SDS.pres[offset] = pres[n]; - SDS.zt_grid[offset] = zt_grid[n]; - SDS.w_field[offset] = 0; - SDS.w_sec[offset] = 0.004; - } - - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - - SDS.thl_sec[offset] = 0; - SDS.qw_sec[offset] = 0; - SDS.wthl_sec[offset] = 0; - SDS.wqw_sec[offset] = 0; - SDS.qwthl_sec[offset] = 0; - SDS.w3[offset] = 0; - SDS.zi_grid[offset] = zi_grid[n]; - } - } - - // Check that the inputs make sense - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - REQUIRE(SDS.qw[offset] > 0); - REQUIRE(SDS.thetal[offset] > 0); - REQUIRE(SDS.pres[offset] > 0); - REQUIRE(SDS.zt_grid[offset] > 0); - } - - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlev; - - REQUIRE(SDS.zi_grid[offset] >= 0); - } - } - - // Check that zt increase updward and pres decrease upward - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlev - 1; ++n) { - const auto offset = n + s * nlev; - REQUIRE(SDS.zt_grid[offset + 1] - SDS.zt_grid[offset] < 0); - REQUIRE(SDS.pres[offset + 1] - SDS.pres[offset] > 0); - } - - // Check that zi increase upward - for(Int n = 0; n < nlevi - 1; ++n) { - const auto offset = n + s * nlevi; - REQUIRE(SDS.zi_grid[offset + 1] - SDS.zi_grid[offset] < 0); - } - - } - - // Test that the inputs are reasonable. - REQUIRE(SDS.nlevi - SDS.nlev == 1); - // For this test we want exactly two columns - REQUIRE(SDS.shcol == 2); - - // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); - - // Verify the result - // Make sure cloud fraction is either 1 or 0 and all - // SGS terms are zero. - - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - REQUIRE( (SDS.shoc_cldfrac[offset] == 0 || SDS.shoc_cldfrac[offset] == 1) ); - REQUIRE(SDS.wqls[offset] == 0); - REQUIRE(SDS.wthv_sec[offset] == 0); - REQUIRE(std::abs(SDS.shoc_ql2[offset]) < std::numeric_limits::epsilon()); // Computation is not exactly BFB with 0 - REQUIRE(SDS.shoc_ql[offset] >= 0); - } - } - - // TEST TWO - // Add in Scalar fluxes. This should give us a nonzero - // buoyancy flux everywhere but other SGS terms should remain zero - - // We will assume turbulence with a uniform profile - - // Flux of liquid water [K m/s] - static constexpr Real wthl_sec = -0.03; - // Flux of total water [m/s kg/kg] - static constexpr Real wqw_sec = 0.0002; - - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - - SDS.wthl_sec[offset] = wthl_sec; - SDS.wqw_sec[offset] = wqw_sec; - } - } - - // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); - - // Verify the result - // Make sure cloud fraction is either 1 or 0 and all - // SGS terms are zero, EXCEPT wthv_sec. - - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - REQUIRE( (SDS.shoc_cldfrac[offset] == 0 || SDS.shoc_cldfrac[offset] == 1) ); - REQUIRE(SDS.wqls[offset] == 0); - REQUIRE(SDS.wthv_sec[offset] != 0); - REQUIRE(std::abs(SDS.wthv_sec[offset] < wthv_sec_bound)); - REQUIRE(std::abs(SDS.shoc_ql2[offset]) < std::numeric_limits::epsilon()); // Computation is not exactly BFB with 0 - REQUIRE(SDS.shoc_ql[offset] >= 0); - REQUIRE(SDS.shoc_ql[offset] < shoc_ql_bound); - } - } - - // TEST THREE and FOUR - // Add in Scalar variances, and POSITIVE vertical velocity skewness test. - - // Add strong scalar variances as such that will produce cloud at every level. - - // For the first column feed in zero vertical velocity skewness. - // For the second column feed in large veriticle velocity skewss. - // Verify that for points where cloud fraction was < 0.5 in the first column, - // that cloud fraction then vice versa for points with cloud fraction > 0.5. - - // Thetal variance [K^2] - static constexpr Real thl_sec = 2; - // total water variance [kg^2/kg^2] - static constexpr Real qw_sec = 0.0002; - // Temperature and total water covariance [K kg/kg] - static constexpr Real qwthl_sec = 1e-5; - // Vertical velocity variance [m2/s2] - static constexpr Real w_sec = 0.2; - - // Load input data - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - SDS.w_sec[offset] = w_sec; - } - - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - - SDS.thl_sec[offset] = thl_sec; - SDS.qw_sec[offset] = qw_sec; - SDS.qwthl_sec[offset] = qwthl_sec; - SDS.w3[offset] = s*1.0; - } - } - - // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); - - // Check the result - - // With such a turbulence and scalar profile, this should have - // encouraged cloud everywhere. Verify that this is true. - - // Also verify that output lies within some reasonable bounds. - - // Then verify vertical velocity skewness info - - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - const auto offsets = n + (s+1) * nlevi; - if (s < shcol-1){ - // Verify input w3 is greater in subsequent columns - REQUIRE(SDS.w3[offsets] > SDS.w3[offset]); - } - } - - // Verify output falls within reasonable bounds. For this positive - // vertical velocity skewness test and with the give inputs there - // should be cloud everywhere and all flux terms should be positive. - - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - const auto offsets = n + (s+1) * nlev; - - REQUIRE( (SDS.shoc_cldfrac[offset] > 0 || SDS.shoc_cldfrac[offset] < 1) ); - REQUIRE(SDS.wqls[offset] > 0); - REQUIRE(SDS.wthv_sec[offset] > 0); - REQUIRE(SDS.shoc_ql2[offset] > 0); - REQUIRE(SDS.shoc_ql[offset] > 0); - - REQUIRE(SDS.wqls[offset] < 0.1); - REQUIRE(SDS.wthv_sec[offset] < wthv_sec_bound); - REQUIRE(SDS.shoc_ql2[offset] < shoc_ql2_bound); - REQUIRE(SDS.shoc_ql[offset] < shoc_ql_bound); - - // Now verify that the relationships in a strongly positive vertical - // velocity flux regime hold true, relative to a symmetric vertical - // velocity regime. - if (s < shcol-1){ - - if (SDS.shoc_cldfrac[offset] < 0.5){ - REQUIRE(SDS.shoc_cldfrac[offsets] < SDS.shoc_cldfrac[offset]); - } - else if (SDS.shoc_cldfrac[offset] > 0.5){ - REQUIRE(SDS.shoc_cldfrac[offsets] > SDS.shoc_cldfrac[offset]); - } - - // In addition, in a positive skewness environment, the following - // should also be true - - // Grid mean liquid water decreased - REQUIRE(SDS.shoc_ql[offsets] < SDS.shoc_ql[offset]); - // liquid water flux increased - REQUIRE(SDS.wqls[offsets] > SDS.wqls[offset]); - // buoyancy flux increased - REQUIRE(SDS.wthv_sec[offsets] > SDS.wthv_sec[offset]); - // liquid water variance increased - REQUIRE(SDS.shoc_ql2[offsets] > SDS.shoc_ql2[offset]); - } - } - } - - // TEST FIVE - // Negative vertical velocity skewness. - - // Using same input as the above test, feed one column with zero skeweness - // and another test with negative vertical velocity skewness and verify - // result is physical. - - // Load input data - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - - SDS.w3[offset] = s*-1.0; - } - } - - // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); - - // Check the result - - // Verify that output lies within some reasonable bounds. - - // Then verify vertical velocity skewness info - - for(Int s = 0; s < shcol; ++s) { - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - const auto offsets = n + (s+1) * nlevi; - if (s < shcol-1){ - // Verify input w3 is greater in subsequent columns - REQUIRE(SDS.w3[offsets] < SDS.w3[offset]); - } - } - - // Verify output falls within reasonable bounds - // For this negative vertical velocity test some variables - // will be expected to be less than zero. - - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - const auto offsets = n + (s+1) * nlev; - - REQUIRE( (SDS.shoc_cldfrac[offset] >= 0 || SDS.shoc_cldfrac[offset] < 1) ); - REQUIRE(SDS.shoc_ql2[offset] > 0); - REQUIRE(SDS.shoc_ql[offset] >= 0); - - REQUIRE(std::abs(SDS.wqls[offset] ) < wqls_bound); - REQUIRE(std::abs(SDS.wthv_sec[offset]) < wthv_sec_bound); - REQUIRE(SDS.shoc_ql2[offset] < shoc_ql2_bound); - REQUIRE(SDS.shoc_ql[offset] < shoc_ql_bound); - - // Now verify that the relationships in a strongly negative vertical - // velocity flux regime hold true, relative to a symmetric vertical - // velocity regime. - if (s < shcol-1){ - - if (SDS.shoc_cldfrac[offset] < 0.5){ - REQUIRE(SDS.shoc_cldfrac[offsets] < SDS.shoc_cldfrac[offset]); - } - else if (SDS.shoc_cldfrac[offset] > 0.5){ - REQUIRE(SDS.shoc_cldfrac[offsets] > SDS.shoc_cldfrac[offset]); - } - - // In addition, in a positive skewness environment, the following - // should also be true - - // Grid mean liquid water decreased - REQUIRE(SDS.shoc_ql[offsets] < SDS.shoc_ql[offset]); - // if cloud present, verify liquid water and buoyancy flux is negative - if (SDS.shoc_ql[offsets] > 0){ - REQUIRE(SDS.wqls[offsets] < SDS.wqls[offset]); - REQUIRE(SDS.wqls[offsets] < 0); - - REQUIRE(SDS.wthv_sec[offsets] < SDS.wthv_sec[offset]); - REQUIRE(SDS.wthv_sec[offsets] < 0); - } - - // liquid water variance increased - REQUIRE(SDS.shoc_ql2[offsets] > SDS.shoc_ql2[offset]); - } - } - } - - } - - static void run_bfb() - { - auto engine = setup_random_test(); - - ShocAssumedPdfData SDS_f90[] = { - // shcol, nlev, nlevi - ShocAssumedPdfData(10, 71, 72), - ShocAssumedPdfData(10, 12, 13), - ShocAssumedPdfData(7, 16, 17), - ShocAssumedPdfData(2, 7, 8), - }; - - // Generate random input data - for (auto& d : SDS_f90) { - d.randomize(engine, { - {d.thetal, {500, 700}}, - {d.zi_grid, {0, 100}}, - }); - } - - // Create copies of data for use by cxx. Needs to happen before fortran calls so that - // inout data is in original state - ShocAssumedPdfData SDS_cxx[] = { - ShocAssumedPdfData(SDS_f90[0]), - ShocAssumedPdfData(SDS_f90[1]), - ShocAssumedPdfData(SDS_f90[2]), - ShocAssumedPdfData(SDS_f90[3]), - }; - - // Assume all data is in C layout - - // Get data from fortran - for (auto& d : SDS_f90) { - // expects data in C layout - shoc_assumed_pdf(d); - } - - // Get data from cxx - for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, - d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, - d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, - d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); - d.transpose(); - } - - // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ShocAssumedPdfData); - for (Int i = 0; i < num_runs; ++i) { - ShocAssumedPdfData& d_f90 = SDS_f90[i]; - ShocAssumedPdfData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.wqls); ++k) { - REQUIRE(d_f90.shoc_cldfrac[k] == d_cxx.shoc_cldfrac[k]); - REQUIRE(d_f90.shoc_ql[k] == d_cxx.shoc_ql[k]); - REQUIRE(d_f90.wqls[k] == d_cxx.wqls[k]); - REQUIRE(d_f90.wthv_sec[k] == d_cxx.wthv_sec[k]); - REQUIRE(d_f90.shoc_ql2[k] == d_cxx.shoc_ql2[k]); - } - } - } // SCREAM_BFB_TESTING - } -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace { - -TEST_CASE("shoc_assumed_pdf_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAssumedPdf; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_assumed_pdf_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAssumedPdf; - - TestStruct::run_bfb(); -} - -} // namespace +#include "catch2/catch.hpp" + +#include "shoc_unit_tests_common.hpp" +#include "shoc_functions.hpp" +#include "shoc_functions_f90.hpp" +#include "physics/share/physics_constants.hpp" +#include "share/scream_types.hpp" +#include "share/util/scream_setup_random_test.hpp" + +#include "ekat/ekat_pack.hpp" +#include "ekat/util/ekat_arch.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" + +#include +#include +#include +#include + +namespace scream { +namespace shoc { +namespace unit_test { + +template +struct UnitWrap::UnitTest::TestShocAssumedPdf { + + static void run_property() + { + static constexpr Int shcol = 2; + static constexpr Int nlev = 5; + static constexpr auto nlevi = nlev + 1; + + // Tests for the top level subroutine + // shoc_assumed_pdf + + // Tests will start simple, and gradually add complexity to test + // the physics. + // NOTE: for this test we want exactly two columns. + + // TEST ONE + // No SGS variability test. Given inputs where there is a saturated + // profile but NO SGS variability in the scalar fluxes or variances + // (i.e. all second and third moment terms are zero), then verify that + // that cloud fraction is either 1 or 0 and that the SGS variability + // outputs are also zero everywhere. + + // Define input data + + // Note that the moisture and height profiles below represent that + // of the BOMEX case, but the temperatures are much colder, to encourage + // there to be points with ample cloud produced for this test. + + // Liquid water potential temperature [K] + static constexpr Real thetal[nlev] = {303, 300, 298, 298, 300}; + // Total water mixing ratio [kg/kg] + static constexpr Real qw[nlev] = {0.003, 0.004, 0.011, 0.016, 0.017}; + // Pressure [Pa] + static constexpr Real pres[nlev] = {70000, 80000, 85000, 90000, 100000}; + // Define the heights on the zt grid [m] + static constexpr Real zi_grid[nlevi] = {3000, 2000, 1500, 1000, 500, 0}; + + // All variances will be given zero or minimum threshold inputs + + // Define some reasonable bounds for output + static constexpr Real wqls_bound = 0.1; + static constexpr Real wthv_sec_bound = 10; + static constexpr Real shoc_ql2_bound = 0.1; + static constexpr Real shoc_ql_bound = 0.1; + + Real zt_grid[nlev]; + // Compute heights on midpoint grid + for(Int n = 0; n < nlev; ++n) { + zt_grid[n] = 0.5*(zi_grid[n]+zi_grid[n+1]); + } + + // Initialize data structure for bridging to F90 + ShocAssumedPdfData SDS(shcol, nlev, nlevi); + + // Load input data + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.thetal[offset] = thetal[n]; + SDS.qw[offset] = qw[n]; + SDS.pres[offset] = pres[n]; + SDS.zt_grid[offset] = zt_grid[n]; + SDS.w_field[offset] = 0; + SDS.w_sec[offset] = 0.004; + } + + for(Int n = 0; n < nlevi; ++n) { + const auto offset = n + s * nlevi; + + SDS.thl_sec[offset] = 0; + SDS.qw_sec[offset] = 0; + SDS.wthl_sec[offset] = 0; + SDS.wqw_sec[offset] = 0; + SDS.qwthl_sec[offset] = 0; + SDS.w3[offset] = 0; + SDS.zi_grid[offset] = zi_grid[n]; + } + } + + // Check that the inputs make sense + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + REQUIRE(SDS.qw[offset] > 0); + REQUIRE(SDS.thetal[offset] > 0); + REQUIRE(SDS.pres[offset] > 0); + REQUIRE(SDS.zt_grid[offset] > 0); + } + + for(Int n = 0; n < nlevi; ++n) { + const auto offset = n + s * nlev; + + REQUIRE(SDS.zi_grid[offset] >= 0); + } + } + + // Check that zt increase updward and pres decrease upward + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev - 1; ++n) { + const auto offset = n + s * nlev; + REQUIRE(SDS.zt_grid[offset + 1] - SDS.zt_grid[offset] < 0); + REQUIRE(SDS.pres[offset + 1] - SDS.pres[offset] > 0); + } + + // Check that zi increase upward + for(Int n = 0; n < nlevi - 1; ++n) { + const auto offset = n + s * nlevi; + REQUIRE(SDS.zi_grid[offset + 1] - SDS.zi_grid[offset] < 0); + } + + } + + // Test that the inputs are reasonable. + REQUIRE(SDS.nlevi - SDS.nlev == 1); + // For this test we want exactly two columns + REQUIRE(SDS.shcol == 2); + + // Call the C++ implementation. + SDS.transpose(); + // expects data in fortran layout + shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, + SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, + SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, + SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); + SDS.transpose(); + + // Verify the result + // Make sure cloud fraction is either 1 or 0 and all + // SGS terms are zero. + + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + REQUIRE( (SDS.shoc_cldfrac[offset] == 0 || SDS.shoc_cldfrac[offset] == 1) ); + REQUIRE(SDS.wqls[offset] == 0); + REQUIRE(SDS.wthv_sec[offset] == 0); + REQUIRE(std::abs(SDS.shoc_ql2[offset]) < std::numeric_limits::epsilon()); // Computation is not exactly BFB with 0 + REQUIRE(SDS.shoc_ql[offset] >= 0); + } + } + + // TEST TWO + // Add in Scalar fluxes. This should give us a nonzero + // buoyancy flux everywhere but other SGS terms should remain zero + + // We will assume turbulence with a uniform profile + + // Flux of liquid water [K m/s] + static constexpr Real wthl_sec = -0.03; + // Flux of total water [m/s kg/kg] + static constexpr Real wqw_sec = 0.0002; + + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlevi; ++n) { + const auto offset = n + s * nlevi; + + SDS.wthl_sec[offset] = wthl_sec; + SDS.wqw_sec[offset] = wqw_sec; + } + } + + // Call the C++ implementation. + SDS.transpose(); + // expects data in fortran layout + shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, + SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, + SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, + SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); + SDS.transpose(); + + // Verify the result + // Make sure cloud fraction is either 1 or 0 and all + // SGS terms are zero, EXCEPT wthv_sec. + + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + REQUIRE( (SDS.shoc_cldfrac[offset] == 0 || SDS.shoc_cldfrac[offset] == 1) ); + REQUIRE(SDS.wqls[offset] == 0); + REQUIRE(SDS.wthv_sec[offset] != 0); + REQUIRE(std::abs(SDS.wthv_sec[offset] < wthv_sec_bound)); + REQUIRE(std::abs(SDS.shoc_ql2[offset]) < std::numeric_limits::epsilon()); // Computation is not exactly BFB with 0 + REQUIRE(SDS.shoc_ql[offset] >= 0); + REQUIRE(SDS.shoc_ql[offset] < shoc_ql_bound); + } + } + + // TEST THREE and FOUR + // Add in Scalar variances, and POSITIVE vertical velocity skewness test. + + // Add strong scalar variances as such that will produce cloud at every level. + + // For the first column feed in zero vertical velocity skewness. + // For the second column feed in large veriticle velocity skewss. + // Verify that for points where cloud fraction was < 0.5 in the first column, + // that cloud fraction then vice versa for points with cloud fraction > 0.5. + + // Thetal variance [K^2] + static constexpr Real thl_sec = 2; + // total water variance [kg^2/kg^2] + static constexpr Real qw_sec = 0.0002; + // Temperature and total water covariance [K kg/kg] + static constexpr Real qwthl_sec = 1e-5; + // Vertical velocity variance [m2/s2] + static constexpr Real w_sec = 0.2; + + // Load input data + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + + SDS.w_sec[offset] = w_sec; + } + + for(Int n = 0; n < nlevi; ++n) { + const auto offset = n + s * nlevi; + + SDS.thl_sec[offset] = thl_sec; + SDS.qw_sec[offset] = qw_sec; + SDS.qwthl_sec[offset] = qwthl_sec; + SDS.w3[offset] = s*1.0; + } + } + + // Call the C++ implementation. + SDS.transpose(); + // expects data in fortran layout + shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, + SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, + SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, + SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); + SDS.transpose(); + + // Check the result + + // With such a turbulence and scalar profile, this should have + // encouraged cloud everywhere. Verify that this is true. + + // Also verify that output lies within some reasonable bounds. + + // Then verify vertical velocity skewness info + + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlevi; ++n) { + const auto offset = n + s * nlevi; + const auto offsets = n + (s+1) * nlevi; + if (s < shcol-1){ + // Verify input w3 is greater in subsequent columns + REQUIRE(SDS.w3[offsets] > SDS.w3[offset]); + } + } + + // Verify output falls within reasonable bounds. For this positive + // vertical velocity skewness test and with the give inputs there + // should be cloud everywhere and all flux terms should be positive. + + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + const auto offsets = n + (s+1) * nlev; + + REQUIRE( (SDS.shoc_cldfrac[offset] > 0 || SDS.shoc_cldfrac[offset] < 1) ); + REQUIRE(SDS.wqls[offset] > 0); + REQUIRE(SDS.wthv_sec[offset] > 0); + REQUIRE(SDS.shoc_ql2[offset] > 0); + REQUIRE(SDS.shoc_ql[offset] > 0); + + REQUIRE(SDS.wqls[offset] < 0.1); + REQUIRE(SDS.wthv_sec[offset] < wthv_sec_bound); + REQUIRE(SDS.shoc_ql2[offset] < shoc_ql2_bound); + REQUIRE(SDS.shoc_ql[offset] < shoc_ql_bound); + + // Now verify that the relationships in a strongly positive vertical + // velocity flux regime hold true, relative to a symmetric vertical + // velocity regime. + if (s < shcol-1){ + + if (SDS.shoc_cldfrac[offset] < 0.5){ + REQUIRE(SDS.shoc_cldfrac[offsets] < SDS.shoc_cldfrac[offset]); + } + else if (SDS.shoc_cldfrac[offset] > 0.5){ + REQUIRE(SDS.shoc_cldfrac[offsets] > SDS.shoc_cldfrac[offset]); + } + + // In addition, in a positive skewness environment, the following + // should also be true + + // Grid mean liquid water decreased + REQUIRE(SDS.shoc_ql[offsets] < SDS.shoc_ql[offset]); + // liquid water flux increased + REQUIRE(SDS.wqls[offsets] > SDS.wqls[offset]); + // buoyancy flux increased + REQUIRE(SDS.wthv_sec[offsets] > SDS.wthv_sec[offset]); + // liquid water variance increased + REQUIRE(SDS.shoc_ql2[offsets] > SDS.shoc_ql2[offset]); + } + } + } + + // TEST FIVE + // Negative vertical velocity skewness. + + // Using same input as the above test, feed one column with zero skeweness + // and another test with negative vertical velocity skewness and verify + // result is physical. + + // Load input data + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlevi; ++n) { + const auto offset = n + s * nlevi; + + SDS.w3[offset] = s*-1.0; + } + } + + // Call the C++ implementation. + SDS.transpose(); + // expects data in fortran layout + shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, + SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, + SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, + SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); + SDS.transpose(); + + // Check the result + + // Verify that output lies within some reasonable bounds. + + // Then verify vertical velocity skewness info + + for(Int s = 0; s < shcol; ++s) { + for(Int n = 0; n < nlevi; ++n) { + const auto offset = n + s * nlevi; + const auto offsets = n + (s+1) * nlevi; + if (s < shcol-1){ + // Verify input w3 is greater in subsequent columns + REQUIRE(SDS.w3[offsets] < SDS.w3[offset]); + } + } + + // Verify output falls within reasonable bounds + // For this negative vertical velocity test some variables + // will be expected to be less than zero. + + for(Int n = 0; n < nlev; ++n) { + const auto offset = n + s * nlev; + const auto offsets = n + (s+1) * nlev; + + REQUIRE( (SDS.shoc_cldfrac[offset] >= 0 || SDS.shoc_cldfrac[offset] < 1) ); + REQUIRE(SDS.shoc_ql2[offset] > 0); + REQUIRE(SDS.shoc_ql[offset] >= 0); + + REQUIRE(std::abs(SDS.wqls[offset] ) < wqls_bound); + REQUIRE(std::abs(SDS.wthv_sec[offset]) < wthv_sec_bound); + REQUIRE(SDS.shoc_ql2[offset] < shoc_ql2_bound); + REQUIRE(SDS.shoc_ql[offset] < shoc_ql_bound); + + // Now verify that the relationships in a strongly negative vertical + // velocity flux regime hold true, relative to a symmetric vertical + // velocity regime. + if (s < shcol-1){ + + if (SDS.shoc_cldfrac[offset] < 0.5){ + REQUIRE(SDS.shoc_cldfrac[offsets] < SDS.shoc_cldfrac[offset]); + } + else if (SDS.shoc_cldfrac[offset] > 0.5){ + REQUIRE(SDS.shoc_cldfrac[offsets] > SDS.shoc_cldfrac[offset]); + } + + // In addition, in a positive skewness environment, the following + // should also be true + + // Grid mean liquid water decreased + REQUIRE(SDS.shoc_ql[offsets] < SDS.shoc_ql[offset]); + // if cloud present, verify liquid water and buoyancy flux is negative + if (SDS.shoc_ql[offsets] > 0){ + REQUIRE(SDS.wqls[offsets] < SDS.wqls[offset]); + REQUIRE(SDS.wqls[offsets] < 0); + + REQUIRE(SDS.wthv_sec[offsets] < SDS.wthv_sec[offset]); + REQUIRE(SDS.wthv_sec[offsets] < 0); + } + + // liquid water variance increased + REQUIRE(SDS.shoc_ql2[offsets] > SDS.shoc_ql2[offset]); + } + } + } + + } + + static void run_bfb() + { + auto engine = setup_random_test(); + + ShocAssumedPdfData SDS_f90[] = { + // shcol, nlev, nlevi + ShocAssumedPdfData(10, 71, 72), + ShocAssumedPdfData(10, 12, 13), + ShocAssumedPdfData(7, 16, 17), + ShocAssumedPdfData(2, 7, 8), + }; + + // Generate random input data + for (auto& d : SDS_f90) { + d.randomize(engine, { + {d.thetal, {500, 700}}, + {d.zi_grid, {0, 100}}, + }); + } + + // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // inout data is in original state + ShocAssumedPdfData SDS_cxx[] = { + ShocAssumedPdfData(SDS_f90[0]), + ShocAssumedPdfData(SDS_f90[1]), + ShocAssumedPdfData(SDS_f90[2]), + ShocAssumedPdfData(SDS_f90[3]), + }; + + // Assume all data is in C layout + + // Get data from fortran + for (auto& d : SDS_f90) { + // expects data in C layout + shoc_assumed_pdf(d); + } + + // Get data from cxx + for (auto& d : SDS_cxx) { + d.transpose(); + // expects data in fortran layout + shoc_assumed_pdf_f(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, + d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, + d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, + d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); + d.transpose(); + } + + // Verify BFB results, all data should be in C layout + if (SCREAM_BFB_TESTING) { + static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ShocAssumedPdfData); + for (Int i = 0; i < num_runs; ++i) { + ShocAssumedPdfData& d_f90 = SDS_f90[i]; + ShocAssumedPdfData& d_cxx = SDS_cxx[i]; + for (Int k = 0; k < d_f90.total(d_f90.wqls); ++k) { + REQUIRE(d_f90.shoc_cldfrac[k] == d_cxx.shoc_cldfrac[k]); + REQUIRE(d_f90.shoc_ql[k] == d_cxx.shoc_ql[k]); + REQUIRE(d_f90.wqls[k] == d_cxx.wqls[k]); + REQUIRE(d_f90.wthv_sec[k] == d_cxx.wthv_sec[k]); + REQUIRE(d_f90.shoc_ql2[k] == d_cxx.shoc_ql2[k]); + } + } + } // SCREAM_BFB_TESTING + } +}; + +} // namespace unit_test +} // namespace shoc +} // namespace scream + +namespace { + +TEST_CASE("shoc_assumed_pdf_property", "shoc") +{ + using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAssumedPdf; + + TestStruct::run_property(); +} + +TEST_CASE("shoc_assumed_pdf_bfb", "shoc") +{ + using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAssumedPdf; + + TestStruct::run_bfb(); +} + +} // namespace From 33d6d3fc419cf308bbfb76f3e694ef9049977538 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Fri, 8 Nov 2024 13:40:46 -0700 Subject: [PATCH 251/529] prog --- .../eamxx/src/physics/shoc/CMakeLists.txt | 9 --- .../src/physics/shoc/tests/CMakeLists.txt | 69 +++++++++---------- .../infra/{shoc_f90.cpp => shoc_data.cpp} | 0 .../infra/{shoc_f90.hpp => shoc_data.hpp} | 0 ...c_functions_f90.cpp => shoc_test_data.cpp} | 0 ...c_functions_f90.hpp => shoc_test_data.hpp} | 0 .../{ => infra}/shoc_unit_tests_common.hpp | 0 7 files changed, 31 insertions(+), 47 deletions(-) rename components/eamxx/src/physics/shoc/tests/infra/{shoc_f90.cpp => shoc_data.cpp} (100%) rename components/eamxx/src/physics/shoc/tests/infra/{shoc_f90.hpp => shoc_data.hpp} (100%) rename components/eamxx/src/physics/shoc/tests/infra/{shoc_functions_f90.cpp => shoc_test_data.cpp} (100%) rename components/eamxx/src/physics/shoc/tests/infra/{shoc_functions_f90.hpp => shoc_test_data.hpp} (100%) rename components/eamxx/src/physics/shoc/tests/{ => infra}/shoc_unit_tests_common.hpp (100%) diff --git a/components/eamxx/src/physics/shoc/CMakeLists.txt b/components/eamxx/src/physics/shoc/CMakeLists.txt index b54fbe53968..92041141589 100644 --- a/components/eamxx/src/physics/shoc/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/CMakeLists.txt @@ -1,18 +1,9 @@ set(SHOC_SRCS - shoc_f90.cpp - shoc_ic_cases.cpp shoc_iso_c.f90 ${SCREAM_BASE_DIR}/../eam/src/physics/cam/shoc.F90 eamxx_shoc_process_interface.cpp ) -if (NOT SCREAM_LIB_ONLY) - list(APPEND SHOC_SRCS - shoc_functions_f90.cpp - shoc_main_wrap.cpp - ) # Add f90 bridges needed for testing -endif() - set(SHOC_HEADERS shoc.hpp eamxx_shoc_process_interface.hpp diff --git a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt index f61de7d76a4..aeae4ad4039 100644 --- a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt @@ -1,5 +1,7 @@ include (ScreamUtils) +add_subdirectory(infra) + set(SHOC_TESTS_SRCS shoc_tests.cpp shoc_grid_tests.cpp @@ -71,50 +73,41 @@ set(SHOC_TESTS_SRCS shoc_compute_shoc_temperature_tests.cpp ) # SHOC_TESTS_SRCS -# NOTE: tests inside this if statement won't be built in a baselines-only build -if (NOT SCREAM_ONLY_GENERATE_BASELINES) - CreateUnitTest(shoc_tests "${SHOC_TESTS_SRCS}" - LIBS shoc - THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} - ) - - if (NOT SCREAM_SHOC_SMALL_KERNELS) - CreateUnitTest(shoc_sk_tests "${SHOC_TESTS_SRCS}" - LIBS shoc_sk - THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} - EXE_ARGS shoc_main_bfb - ) - endif() -endif() - +# All tests should understand the same baseline args if (SCREAM_ENABLE_BASELINE_TESTS) if (SCREAM_ONLY_GENERATE_BASELINES) - set(BASELINE_FILE_ARG "-g -b ${SCREAM_BASELINES_DIR}/data/shoc_run_and_cmp.baseline") + set(BASELINE_FILE_ARG "-g -b ${SCREAM_BASELINES_DIR}/data") else() - set(BASELINE_FILE_ARG "-b ${SCREAM_BASELINES_DIR}/data/shoc_run_and_cmp.baseline") + set(BASELINE_FILE_ARG "-c -b ${SCREAM_BASELINES_DIR}/data") endif() +else() + set(BASELINE_FILE_ARG "-n") # no baselines +endif() - CreateUnitTestExec(shoc_run_and_cmp "shoc_run_and_cmp.cpp" - LIBS shoc - EXCLUDE_MAIN_CPP) +CreateUnitTest(shoc_tests "${SHOC_TESTS_SRCS}" + LIBS shoc shoc_test_infra + THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} + EXE_ARGS "--flags=\\'${BASELINE_FILE_ARG}\\'" + ) - CreateUnitTestFromExec(shoc_run_and_cmp_cxx shoc_run_and_cmp - THREADS ${SCREAM_TEST_MAX_THREADS} - EXE_ARGS "${BASELINE_FILE_ARG}" - LABELS "shoc;physics") +if (NOT SCREAM_SHOC_SMALL_KERNELS) + CreateUnitTest(shoc_sk_tests "${SHOC_TESTS_SRCS}" + LIBS shoc_sk shoc_test_infra + THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} + EXE_ARGS shoc_main_bfb "--flags=\\'${BASELINE_FILE_ARG}\\'" + ) +endif() - CreateUnitTestFromExec(shoc_run_and_cmp_f90 shoc_run_and_cmp - THREADS ${SCREAM_TEST_MAX_THREADS} - EXE_ARGS "-f ${BASELINE_FILE_ARG}" - LABELS "shoc;physics") +CreateUnitTest(shoc_run_and_cmp "shoc_run_and_cmp.cpp" + LIBS shoc shoc_test_infra + EXCLUDE_MAIN_CPP + THREADS ${SCREAM_TEST_MAX_THREADS} + EXE_ARGS "${BASELINE_FILE_ARG}" + LABELS "shoc;physics") - # By default, baselines should be created using all fortran (ctest -L baseline_gen). If the user wants - # to use CXX to generate their baselines, they should use "ctest -L baseline_gen_cxx". - # Note: the baseline_gen label is really only used if SCREAM_ONLY_GENERATE_BASELINES=ON, but no harm adding it - if (SCREAM_TEST_MAX_THREADS GREATER 1) - # ECUT only adds _ompX if we have more than one value of X, or if X>1 - set (TEST_SUFFIX _omp${SCREAM_TEST_MAX_THREADS}) - endif() - set_tests_properties (shoc_run_and_cmp_f90${TEST_SUFFIX} PROPERTIES LABELS "baseline_gen;baseline_cmp") - set_tests_properties (shoc_run_and_cmp_cxx${TEST_SUFFIX} PROPERTIES LABELS "baseline_gen;cxx baseline_cmp") +if (SCREAM_TEST_MAX_THREADS GREATER 1) + # ECUT only adds _ompX if we have more than one value of X, or if X>1 + set (TEST_SUFFIX _omp${SCREAM_TEST_MAX_THREADS}) endif() + +set_tests_properties (shoc_run_and_cmp${TEST_SUFFIX} PROPERTIES LABELS "baseline_gen;baseline_cmp") diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_f90.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp similarity index 100% rename from components/eamxx/src/physics/shoc/tests/infra/shoc_f90.cpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_f90.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp similarity index 100% rename from components/eamxx/src/physics/shoc/tests/infra/shoc_f90.hpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp similarity index 100% rename from components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.cpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp similarity index 100% rename from components/eamxx/src/physics/shoc/tests/infra/shoc_functions_f90.hpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp diff --git a/components/eamxx/src/physics/shoc/tests/shoc_unit_tests_common.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp similarity index 100% rename from components/eamxx/src/physics/shoc/tests/shoc_unit_tests_common.hpp rename to components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp From 6a9208434ccffb82afb6081f70f96737b681ef29 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Fri, 8 Nov 2024 13:40:57 -0700 Subject: [PATCH 252/529] prog --- .../eamxx/src/physics/shoc/tests/infra/CMakeLists.txt | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 components/eamxx/src/physics/shoc/tests/infra/CMakeLists.txt diff --git a/components/eamxx/src/physics/shoc/tests/infra/CMakeLists.txt b/components/eamxx/src/physics/shoc/tests/infra/CMakeLists.txt new file mode 100644 index 00000000000..0c0c75ca6aa --- /dev/null +++ b/components/eamxx/src/physics/shoc/tests/infra/CMakeLists.txt @@ -0,0 +1,10 @@ +set(INFRA_SRCS + shoc_data.cpp + shoc_ic_cases.cpp + shoc_main_wrap.cpp + shoc_test_data.cpp +) + +add_library(shoc_test_infra ${INFRA_SRCS}) +target_link_libraries(shoc_test_infra shoc) +target_include_directories(shoc_test_infra PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) From 940af13e59923ee155ada2ee9cdf51a552e91414 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Mon, 11 Nov 2024 10:54:44 -0700 Subject: [PATCH 253/529] prog --- .../physics/shoc/tests/infra/shoc_data.cpp | 2 +- .../shoc/tests/infra/shoc_ic_cases.hpp | 2 +- .../shoc/tests/infra/shoc_main_wrap.cpp | 4 +- .../shoc/tests/infra/shoc_test_data.cpp | 4 +- .../tests/infra/shoc_unit_tests_common.hpp | 82 +++++++++++++++++++ .../physics/shoc/tests/shoc_grid_tests.cpp | 2 +- 6 files changed, 89 insertions(+), 7 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp index bc14a9110d5..4da3ba46678 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp @@ -1,4 +1,4 @@ -#include "shoc_f90.hpp" +#include "shoc_data.hpp" #include "physics_constants.hpp" #include "shoc_ic_cases.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.hpp index 42c71c2536e..26c06a3cf12 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.hpp @@ -1,7 +1,7 @@ #ifndef INCLUDE_SCREAM_SHOC_IC_CASES_HPP #define INCLUDE_SCREAM_SHOC_IC_CASES_HPP -#include "shoc_f90.hpp" +#include "shoc_data.hpp" namespace scream { namespace shoc { diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp index 5edfdcd6d28..cdf9df3cad5 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp @@ -1,6 +1,6 @@ #include "shoc_main_wrap.hpp" -#include "shoc_f90.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_data.hpp" +#include "shoc_test_data.hpp" #include "physics_constants.hpp" #include "shoc_ic_cases.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index e7468062d3c..0c671623d97 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -1,6 +1,6 @@ -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" -#include "shoc_f90.hpp" +#include "shoc_data.hpp" #include "ekat/ekat_assert.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp index 97b728d9a10..a640952fad3 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp @@ -4,6 +4,8 @@ #include "shoc_functions.hpp" #include "share/scream_types.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "share/util/scream_setup_random_test.hpp" +#include "ekat/util/ekat_file_utils.hpp" namespace scream { namespace shoc { @@ -21,6 +23,12 @@ namespace unit_test { struct UnitWrap { + enum BASELINE_ACTION { + NONE, + COMPARE, + GENERATE + }; + template struct UnitTest : public KokkosTypes { @@ -48,6 +56,80 @@ struct UnitWrap { using Smask = typename Functions::Smask; using C = typename Functions::C; + struct Base { + std::string m_baseline_path; + std::string m_test_name; + BASELINE_ACTION m_baseline_action; + ekat::FILEPtr m_fid; + + Base() : + m_baseline_path(""), + m_test_name(Catch::getResultCapture().getCurrentTestName()), + m_baseline_action(NONE), + m_fid() + { + Functions::shoc_init(); // many tests will need fortran table data + auto& ts = ekat::TestSession::get(); + auto raw_flags = ts.flags.begin()->first; + std::stringstream ss(raw_flags); + std::string flag; + bool next_token_is_path = false; + while (ss >> flag) { + if (flag == "-c") { + m_baseline_action = COMPARE; + } + else if (flag == "-g") { + m_baseline_action = GENERATE; + } + else if (flag == "-n") { + m_baseline_action = NONE; + } + else if (flag == "-b") { + next_token_is_path = true; + } + else if (next_token_is_path) { + m_baseline_path = flag; + next_token_is_path = false; + } + } + EKAT_REQUIRE_MSG( !(m_baseline_action != NONE && m_baseline_path == ""), + "SHOC unit test flags problem: baseline actions were requested but no baseline path was provided"); + + std::string baseline_name = m_baseline_path + "/" + m_test_name; + if (m_baseline_action == COMPARE) { + m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "r")); + } + else if (m_baseline_action == GENERATE) { + m_fid = ekat::FILEPtr(fopen(baseline_name.c_str(), "w")); + } + } + + ~Base() + { + scream::shoc::SHOCGlobalForFortran::deinit(); + } + + std::mt19937_64 get_engine() + { + if (m_baseline_action != COMPARE) { + // We can use any seed + int seed; + auto engine = setup_random_test(nullptr, &seed); + if (m_baseline_action == GENERATE) { + // Write the seed + ekat::write(&seed, 1, m_fid); + } + return engine; + } + else { + // Read the seed + int seed; + ekat::read(&seed, 1, m_fid); + return setup_random_test(seed); + } + } + }; + // Put struct decls here struct TestCalcShocVertflux; struct TestShocDiagObklen; diff --git a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp index 81f2aa5ac9d..34625760ecc 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp @@ -4,7 +4,7 @@ #include "physics/share/physics_constants.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" From 937850eae3b93216bc95f6b41ba04c215fd2c5b6 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 12 Nov 2024 14:17:26 -0700 Subject: [PATCH 254/529] Use data funcs for CXX now --- .../physics/p3/tests/p3_main_unit_tests.cpp | 2 - .../shoc/tests/infra/shoc_main_wrap.cpp | 70 +- .../shoc/tests/infra/shoc_test_data.cpp | 733 +++++------------- .../shoc/tests/infra/shoc_test_data.hpp | 92 +-- .../tests/infra/shoc_unit_tests_common.hpp | 4 +- .../tests/shoc_aa_diag_third_moms_tests.cpp | 2 +- .../shoc/tests/shoc_assumed_pdf_tests.cpp | 96 +-- .../shoc/tests/shoc_brunt_length_tests.cpp | 58 +- .../shoc/tests/shoc_check_length_tests.cpp | 58 +- .../shoc/tests/shoc_check_tke_tests.cpp | 58 +- .../shoc/tests/shoc_clip_third_moms_tests.cpp | 58 +- .../tests/shoc_compute_diag_third_tests.cpp | 66 +- .../shoc_compute_shoc_temperature_tests.cpp | 66 +- .../tests/shoc_compute_shoc_vapor_tests.cpp | 58 +- .../shoc/tests/shoc_diag_obklen_tests.cpp | 76 +- .../tests/shoc_diag_second_mom_srf_test.cpp | 45 +- .../shoc_diag_second_mom_ubycond_test.cpp | 32 +- ...shoc_diag_second_moments_lbycond_tests.cpp | 72 +- .../tests/shoc_diag_second_moments_tests.cpp | 82 +- .../shoc_diag_second_shoc_moments_tests.cpp | 81 +- .../shoc/tests/shoc_diag_third_tests.cpp | 72 +- .../tests/shoc_eddy_diffusivities_tests.cpp | 73 +- .../tests/shoc_energy_dse_fixer_tests.cpp | 2 +- .../shoc/tests/shoc_energy_fixer_tests.cpp | 75 +- .../shoc/tests/shoc_energy_integral_tests.cpp | 68 +- .../shoc_energy_threshold_fixer_tests.cpp | 2 +- .../tests/shoc_energy_total_fixer_tests.cpp | 2 +- .../tests/shoc_energy_update_dse_tests.cpp | 60 +- .../shoc_fterm_diag_third_moms_tests.cpp | 2 +- .../shoc_fterm_input_third_moms_tests.cpp | 2 +- .../physics/shoc/tests/shoc_grid_tests.cpp | 65 +- .../shoc/tests/shoc_impli_comp_tmpi_tests.cpp | 59 +- .../tests/shoc_impli_dp_inverse_tests.cpp | 59 +- .../tests/shoc_impli_sfc_fluxes_tests.cpp | 2 +- .../tests/shoc_impli_srf_stress_tests.cpp | 2 +- .../shoc/tests/shoc_impli_srf_tke_tests.cpp | 2 +- .../shoc/tests/shoc_l_inf_length_tests.cpp | 58 +- .../physics/shoc/tests/shoc_length_tests.cpp | 71 +- .../shoc/tests/shoc_linear_interp_tests.cpp | 74 +- .../physics/shoc/tests/shoc_main_tests.cpp | 193 +++-- .../shoc/tests/shoc_mix_length_tests.cpp | 64 +- .../shoc_omega_diag_third_moms_tests.cpp | 2 +- .../tests/shoc_pblintd_check_pblh_tests.cpp | 62 +- .../tests/shoc_pblintd_cldcheck_tests.cpp | 48 +- .../shoc/tests/shoc_pblintd_height_tests.cpp | 79 +- .../shoc/tests/shoc_pblintd_init_pot_test.cpp | 48 +- .../tests/shoc_pblintd_surf_temp_tests.cpp | 77 +- .../physics/shoc/tests/shoc_pblintd_tests.cpp | 66 +- .../tests/shoc_pdf_compute_buoyflux_tests.cpp | 2 +- .../tests/shoc_pdf_compute_cloudvar_tests.cpp | 2 +- .../tests/shoc_pdf_compute_liqflux_tests.cpp | 2 +- .../shoc/tests/shoc_pdf_compute_qs_tests.cpp | 2 +- .../shoc/tests/shoc_pdf_compute_s_tests.cpp | 2 +- .../tests/shoc_pdf_compute_sgsliq_tests.cpp | 2 +- .../shoc/tests/shoc_pdf_computetemp_tests.cpp | 2 +- .../tests/shoc_pdf_inplume_corr_tests.cpp | 2 +- .../tests/shoc_pdf_qw_parameters_tests.cpp | 2 +- .../tests/shoc_pdf_thl_parameters_tests.cpp | 2 +- .../shoc/tests/shoc_pdf_tildetoreal_tests.cpp | 2 +- .../tests/shoc_pdf_vv_parameters_tests.cpp | 2 +- .../physics/shoc/tests/shoc_run_and_cmp.cpp | 2 +- .../shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp | 64 +- .../shoc/tests/shoc_tke_column_stab_tests.cpp | 64 +- .../tests/shoc_tke_isotropic_ts_tests.cpp | 62 +- .../shoc/tests/shoc_tke_shr_prod_tests.cpp | 62 +- .../src/physics/shoc/tests/shoc_tke_tests.cpp | 84 +- .../physics/shoc/tests/shoc_unit_tests.cpp | 2 +- ...shoc_update_prognostics_implicit_tests.cpp | 92 +-- .../shoc/tests/shoc_varorcovar_tests.cpp | 80 +- .../shoc_vd_shoc_decomp_and_solve_tests.cpp | 55 +- .../shoc/tests/shoc_vertflux_tests.cpp | 58 +- .../tests/shoc_w3_diag_third_moms_tests.cpp | 2 +- .../tests/shoc_xy_diag_third_moms_tests.cpp | 2 +- 73 files changed, 1624 insertions(+), 2227 deletions(-) diff --git a/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp index 4fb471c3cf5..c60efd2b882 100644 --- a/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_main_unit_tests.cpp @@ -445,7 +445,6 @@ void run_bfb_p3_main() // Get data from cxx for (auto& d : isds_cxx) { - d.template transpose(); p3_main_host( d.qc, d.nc, d.qr, d.nr, d.th_atm, d.qv, d.dt, d.qi, d.qm, d.ni, d.bm, d.pres, d.dz, d.nc_nuceat_tend, d.nccn_prescribed, d.ni_activated, d.inv_qc_relvar, d.it, d.precip_liq_surf, @@ -453,7 +452,6 @@ void run_bfb_p3_main() d.rho_qi, d.do_predict_nc, d.do_prescribed_CCN, d.dpres, d.inv_exner, d.qv2qi_depos_tend, d.precip_liq_flux, d.precip_ice_flux, d.cld_frac_r, d.cld_frac_l, d.cld_frac_i, d.liq_ice_exchange, d.vap_liq_exchange, d.vap_ice_exchange, d.qv_prev, d.t_prev); - d.template transpose(); } if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp index cdf9df3cad5..957a67593f7 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp @@ -8,64 +8,30 @@ using scream::Real; using scream::Int; -extern "C" { - Int shoc_main_c(int shcol, int nlev, int nlevi, Real dtime, int nadv, - Real* host_dx, Real* host_dy, Real* thv, Real* zt_grid, - Real* zi_grid, Real* pres, Real* presi, Real* pdel, - Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, - Real* wtracer_sfc, int num_qtracers, Real* w_field, - Real* inv_exner, Real* phis, Real* host_dse, Real* tke, - Real* thetal, Real* qw, Real* u_wind, Real* v_wind, - Real* qtracers, Real* wthv_sec, Real* tkh, Real* tk, - Real* shoc_ql, Real* shoc_cldfrac, Real* pblh, - Real* shoc_mix, Real* isotropy, Real* w_sec, Real* thl_sec, - Real* qw_sec, Real* qwthl_sec, Real* wthl_sec, Real* wqw_sec, - Real* wtke_sec, Real* uw_sec, Real* vw_sec, Real* w3, - Real* wqls_sec, Real* brunt, Real* shoc_ql2, Real* elapsed_s); -} namespace scream { namespace shoc { -Int shoc_main(FortranData& d, bool use_fortran) { +Int shoc_main(FortranData& d) { EKAT_REQUIRE_MSG(d.dtime > 0, "Invalid dtime"); EKAT_REQUIRE_MSG(d.nadv > 0, "Invalid nadv"); - if (use_fortran) { - Real elapsed_s; - shoc_main_c((int)d.shcol, (int)d.nlev, (int)d.nlevi, d.dtime, (int)d.nadv, - d.host_dx.data(), d.host_dy.data(), d.thv.data(), - d.zt_grid.data(), d.zi_grid.data(), d.pres.data(), d.presi.data(), - d.pdel.data(), d.wthl_sfc.data(), d.wqw_sfc.data(), d.uw_sfc.data(), - d.vw_sfc.data(), d.wtracer_sfc.data(), (int)d.num_qtracers, - d.w_field.data(), d.inv_exner.data(), d.phis.data(), d.host_dse.data(), - d.tke.data(), d.thetal.data(), d.qw.data(), d.u_wind.data(), - d.v_wind.data(), d.qtracers.data(), d.wthv_sec.data(), d.tkh.data(), - d.tk.data(), d.shoc_ql.data(), d.shoc_cldfrac.data(), d.pblh.data(), - d.shoc_mix.data(), d.isotropy.data(), d.w_sec.data(), - d.thl_sec.data(), d.qw_sec.data(), d.qwthl_sec.data(), - d.wthl_sec.data(), d.wqw_sec.data(), d.wtke_sec.data(), - d.uw_sec.data(), d.vw_sec.data(), d.w3.data(), d.wqls_sec.data(), - d.brunt.data(), d.shoc_ql2.data(), &elapsed_s); - return static_cast(elapsed_s * 1000000); - } else { - const int npbl = d.nlev; - return shoc_main_f((int)d.shcol, (int)d.nlev, (int)d.nlevi, d.dtime, (int)d.nadv, - npbl, d.host_dx.data(), d.host_dy.data(), - d.thv.data(), d.zt_grid.data(), d.zi_grid.data(), d.pres.data(), - d.presi.data(), d.pdel.data(), d.wthl_sfc.data(), - d.wqw_sfc.data(), d.uw_sfc.data(), d.vw_sfc.data(), - d.wtracer_sfc.data(), (int)d.num_qtracers, - d.w_field.data(), d.inv_exner.data(), d.phis.data(), d.host_dse.data(), - d.tke.data(), d.thetal.data(), d.qw.data(), - d.u_wind.data(), d.v_wind.data(), d.qtracers.data(), d.wthv_sec.data(), - d.tkh.data(), d.tk.data(), d.shoc_ql.data(), - d.shoc_cldfrac.data(), d.pblh.data(), d.shoc_mix.data(), d.isotropy.data(), - d.w_sec.data(), d.thl_sec.data(), - d.qw_sec.data(), d.qwthl_sec.data(), d.wthl_sec.data(), d.wqw_sec.data(), - d.wtke_sec.data(), d.uw_sec.data(), - d.vw_sec.data(), d.w3.data(), d.wqls_sec.data(), d.brunt.data(), - d.shoc_ql2.data()); - } + const int npbl = d.nlev; + return shoc_main_host((int)d.shcol, (int)d.nlev, (int)d.nlevi, d.dtime, (int)d.nadv, + npbl, d.host_dx.data(), d.host_dy.data(), + d.thv.data(), d.zt_grid.data(), d.zi_grid.data(), d.pres.data(), + d.presi.data(), d.pdel.data(), d.wthl_sfc.data(), + d.wqw_sfc.data(), d.uw_sfc.data(), d.vw_sfc.data(), + d.wtracer_sfc.data(), (int)d.num_qtracers, + d.w_field.data(), d.inv_exner.data(), d.phis.data(), d.host_dse.data(), + d.tke.data(), d.thetal.data(), d.qw.data(), + d.u_wind.data(), d.v_wind.data(), d.qtracers.data(), d.wthv_sec.data(), + d.tkh.data(), d.tk.data(), d.shoc_ql.data(), + d.shoc_cldfrac.data(), d.pblh.data(), d.shoc_mix.data(), d.isotropy.data(), + d.w_sec.data(), d.thl_sec.data(), + d.qw_sec.data(), d.qwthl_sec.data(), d.wthl_sec.data(), d.wqw_sec.data(), + d.wtke_sec.data(), d.uw_sec.data(), + d.vw_sec.data(), d.w3.data(), d.wqls_sec.data(), d.brunt.data(), + d.shoc_ql2.data()); } namespace { diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 0c671623d97..0be4b8fc04f 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -14,777 +14,417 @@ using scream::Real; using scream::Int; -// -// A C interface to SHOC fortran calls. The stubs below will link to fortran definitions in shoc_iso_c.f90 -// - -extern "C" { - -// Special shoc_init function for shoc_main_bfb test -void shoc_init_for_main_bfb_c(int nlev, Real gravit, Real rair, Real rh2o, Real cpair, - Real zvir, Real latvap, Real latice, Real karman, Real p0, - Real* pref_mid, int nbot_shoc, int ntop_shoc); -void shoc_use_cxx_c(bool use_cxx); - - -void shoc_grid_c(int shcol, int nlev, int nlevi, Real *zt_grid, Real *zi_grid, - Real *pdel, Real *dz_zt, Real *dzi_zi, Real *rho_zt); - -void shoc_diag_obklen_c(Int shcol, Real *uw_sfc, Real *vw_sfc, Real *wthl_sfc, - Real *wqw_sfc, Real *thl_sfc, Real *cldliq_sfc, - Real *qv_sfc, Real *ustar, Real *kbfs, Real *obklen); - -void update_host_dse_c(Int shcol, Int nlev, Real *thlm, Real *shoc_ql, - Real *inv_exner, Real *zt_grid, Real *phis, Real *host_dse); - -void shoc_energy_fixer_c(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, - Real *zt_grid, Real *zi_grid, Real *se_b, Real *ke_b, - Real *wv_b, Real *wl_b, Real *se_a, Real *ke_a, - Real *wv_a, Real *wl_a, Real *wthl_sfc, Real *wqw_sfc, - Real *rho_zt, Real *tke, Real *pint, - Real *host_dse); - -void shoc_energy_integrals_c(Int shcol, Int nlev, Real *host_dse, Real *pdel, - Real *rtm, Real *rcm, Real *u_wind, Real *v_wind, - Real *se_int, Real *ke_int, Real *wv_int, Real *wl_int); - -void shoc_energy_total_fixer_c(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, - Real *zt_grid, Real *zi_grid, - Real *se_b, Real *ke_b, Real *wv_b, Real *wl_b, - Real *se_a, Real *ke_a, Real *wv_a, Real *wl_a, - Real *wthl_sfc, Real *wqw_sfc, Real *rho_zt, Real *pint, - Real *te_a, Real *te_b); - -void shoc_energy_threshold_fixer_c(Int shcol, Int nlev, Int nlevi, - Real *pint, Real *tke, Real *te_a, Real *te_b, - Real *se_dis, Int *shoctop); - -void shoc_energy_dse_fixer_c(Int shcol, Int nlev, - Real *se_dis, Int *shoctop, - Real *host_dse); - -void calc_shoc_varorcovar_c(Int shcol, Int nlev, Int nlevi, Real tunefac, - Real *isotropy_zi, Real *tkh_zi, Real *dz_zi, - Real *invar1, Real *invar2, Real *varorcovar); - -void compute_tmpi_c(Int nlevi, Int shcol, Real dtime, Real *rho_zi, - Real *dz_zi, Real *tmpi); - -void dp_inverse_c(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_zt); - -void sfc_fluxes_c(Int shcol, Int num_tracer, Real dtime, Real *rho_zi_sfc, - Real *rdp_zt_sfc, Real *wthl_sfc, Real *wqw_sfc, Real *wtracer_sfc, - Real *wtke_sfc, Real *thetal, Real *qw, Real *tke, Real *tracer); - -void impli_srf_stress_term_c(Int shcol, Real *rho_zi_sfc, Real *uw_sfc, - Real *vw_sfc, Real *u_wind_sfc, Real *v_wind_sfc, - Real *ksrf); - -void tke_srf_flux_term_c(Int shcol, Real *uw_sfc, Real *vw_sfc, - Real *wtke_sfc); - -void check_tke_c(Int shcol, Int nlev, Real *tke); - -void shoc_tke_c(Int shcol, Int nlev, Int nlevi, Real dtime, Real *wthv_sec, - Real *shoc_mix, Real *dz_zi, Real *dz_zt, Real *pres, - Real* tabs, Real *u_wind, Real *v_wind, Real *brunt, - Real *zt_grid, Real *zi_grid, Real *pblh, Real *tke, - Real *tk, Real *tkh, Real *isotropy); - -void integ_column_stability_c(Int nlev, Int shcol, Real *dz_zt, Real *pres, - Real *brunt, Real *brunt_int); - -void compute_shr_prod_c(Int nlevi, Int nlev, Int shcol, Real *dz_zi, - Real *u_wind, Real *v_wind, Real *sterm); - -void isotropic_ts_c(Int nlev, Int shcol, Real *brunt_int, Real *tke, - Real *a_diss, Real *brunt, Real *isotropy); - -void adv_sgs_tke_c(Int nlev, Int shcol, Real dtime, Real *shoc_mix, - Real *wthv_sec, Real *sterm_zt, Real *tk, - Real *tke, Real *a_diss); - -void eddy_diffusivities_c(Int nlev, Int shcol, Real *pblh, - Real *zt_grid, Real *tabs, Real *shoc_mix, Real *sterm_zt, - Real *isotropy, Real *tke, Real *tkh, Real *tk); - -void calc_shoc_vertflux_c(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, - Real *dz_zi, Real *invar, Real *vertflux); - -void shoc_length_c(Int shcol, Int nlev, Int nlevi, Real *host_dx, - Real *host_dy, Real *zt_grid, - Real *zi_grid, Real *dz_zt, Real *tke, - Real *thv, Real *brunt, Real *shoc_mix); - -void compute_brunt_shoc_length_c(Int nlev, Int nlevi, Int shcol ,Real *dz_zt, - Real *thv, Real *thv_zi, Real *brunt); - -void compute_l_inf_shoc_length_c(Int nlev, Int shcol, Real *zt_grid, Real *dz_zt, - Real *tke, Real *l_inf); - -void compute_shoc_mix_shoc_length_c(Int nlev, Int shcol, Real *tke, Real* brunt, - Real *zt_grid, Real *l_inf, Real *shoc_mix); - -void check_length_scale_shoc_length_c(Int nlev, Int shcol, Real *host_dx, - Real *host_dy, Real *shoc_mix); - -void clipping_diag_third_shoc_moments_c(Int nlevi, Int shcol, Real *w_sec_zi, - Real *w3); - -void fterms_input_for_diag_third_shoc_moment_c(Real dz_zi, Real dz_zt, Real dz_zt_kc, - Real isotropy_zi, Real brunt_zi, Real thetal_zi, - Real *thedz, Real *thedz2, Real *iso, - Real *isosqrd, Real *buoy_sgs2, Real *bet2); -void f0_to_f5_diag_third_shoc_moment_c(Real thedz, Real thedz2, Real bet2, Real iso, - Real isosqrd, Real wthl_sec, Real wthl_sec_kc, - Real wthl_sec_kb, Real thl_sec_kc, - Real thl_sec_kb, Real w_sec, Real w_sec_kc, Real w_sec_zi, - Real tke, Real tke_kc, Real *f0, Real *f1, - Real *f2, Real *f3, Real *f4, Real *f5); - -void omega_terms_diag_third_shoc_moment_c(Real buoy_sgs2, Real f3, Real f4, - Real *omega0, Real *omega1, Real *omega2); - -void x_y_terms_diag_third_shoc_moment_c(Real buoy_sgs2, Real f0, Real f1, Real f2, - Real *x0, Real *y0, Real *x1, Real *y1); - -void aa_terms_diag_third_shoc_moment_c(Real omega0, Real omega1, Real omega2, - Real x0, Real x1, Real y0, Real y1, - Real *aa0, Real *aa1); - -void w3_diag_third_shoc_moment_c(Real aa0, Real aa1, Real x0, - Real x1, Real f5, Real *w3); -void shoc_diag_second_moments_srf_c(Int shcol, Real* wthl_sfc, Real* uw_sfc, Real* vw_sfc, - Real* ustar2, Real* wstar); - -void diag_third_shoc_moments_c(Int shoc, Int nlev, Int nlevi, Real *w_sec, - Real *thl_sec, - Real *wthl_sec, Real *isotropy, Real *brunt, - Real *thetal, Real *tke, - Real *dz_zt, Real *dz_zi, Real *zt_grid, - Real *zi_grid, Real *w3); - -void compute_diag_third_shoc_moment_c(Int shcol, Int nlev, Int nlevi, Real *w_sec, - Real *thl_sec, Real *wthl_sec, Real *tke, - Real *dz_zt, Real *dz_zi, Real *isotropy_zi, - Real *brunt_zi, Real *w_sec_zi, Real *thetal_zi, - Real *w3); - -void linear_interp_c(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, Int ncol, Real minthresh); - -void shoc_assumed_pdf_c(Int shcol, Int nlev, Int nlevi, Real *thetal, Real *qw, - Real *w_first, Real *thl_sec, Real *qw_sec, Real *wthl_sec, - Real *w_sec, Real *wqw_sec, Real *qwthl_sec, Real *w3, - Real *pres, Real *zt_grid, Real *zi_grid, - Real *shoc_cldfrac, Real *shoc_ql, Real *wqls, - Real *wthv_sec, Real *shoc_ql2); - -void shoc_assumed_pdf_tilde_to_real_c(Real w_first, Real sqrtw2, Real* w1); - -void shoc_assumed_pdf_vv_parameters_c(Real w_first, Real w_sec, Real w3var, - Real *Skew_w, Real *w1_1, Real *w1_2, - Real *w2_1, Real *w2_2, Real *a); - -void shoc_assumed_pdf_thl_parameters_c(Real wthlsec, Real sqrtw2, Real sqrtthl, - Real thlsec, Real thl_first, Real w1_1, - Real w1_2, Real Skew_w, Real a, bool dothetal_skew, - Real *thl1_1, Real *thl1_2, Real *thl2_1, - Real *thl2_2, Real *sqrtthl2_1, - Real *sqrtthl2_2); - -void shoc_assumed_pdf_qw_parameters_c(Real wqwsec, Real sqrtw2, Real Skew_w, - Real sqrtqt, Real qw_sec, Real w1_1, - Real w1_2, Real qw_first, Real a, - Real *qw1_1, Real *qw1_2, Real *qw2_1, - Real *qw2_2, Real *sqrtqw2_1, - Real *sqrtqw2_2); - -void shoc_assumed_pdf_inplume_correlations_c(Real sqrtqw2_1, Real sqrtthl2_1, - Real a, Real sqrtqw2_2, Real sqrtthl2_2, - Real qwthlsec, Real qw1_1, Real qw_first, - Real thl1_1, Real thl_first, Real qw1_2, - Real thl1_2, Real *r_qwthl_1); - -void shoc_assumed_pdf_compute_temperature_c(Real thl1, Real basepres, - Real pval, Real *Tl1); - -void shoc_assumed_pdf_compute_qs_c(Real Tl1_1, Real Tl1_2, Real pval, - Real *qs1, Real *beta1, Real *qs2, Real *beta2); - -void shoc_assumed_pdf_compute_s_c(Real qw1, Real qs1, Real beta, Real pval, Real thl2, - Real qw2,Real sqrtthl2, Real sqrtqw2, Real r_qwthl, - Real *s, Real *std_s, Real *qn, Real *C); - -void shoc_assumed_pdf_compute_sgs_liquid_c(Real a, Real ql1, Real ql2, Real *shoc_ql); - -void shoc_assumed_pdf_compute_cloud_liquid_variance_c(Real a, Real s1, Real ql1, - Real C1, Real std_s1, Real s2, Real ql2, Real C2, - Real std_s2, Real shoc_ql, Real *shoc_ql2); - -void shoc_assumed_pdf_compute_liquid_water_flux_c(Real a, Real w1_1, Real w_first, - Real ql1, Real w1_2, Real ql2, Real *wqls); - -void shoc_assumed_pdf_compute_buoyancy_flux_c(Real wthlsec, Real epsterm, Real wqwsec, - Real pval, Real wqls, Real *wthv_sec); - -void shoc_diag_second_moments_ubycond_c(Int shcol, Real* thl_sec, Real* qw_sec, - Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, - Real* uw_sec, Real* vw_sec, Real* wtke_sec); - -void shoc_pblintd_init_pot_c(Int shcol, Int nlev, Real* thl, Real* ql, Real* q, Real* thv); - -void diag_second_moments_lbycond_c(Int shcol, Real *wthl_sfc, Real *wqw_sfc, Real *uw_sfc, - Real *vw_sfc, Real *ustar2, Real *wstar, Real *wthl_sec, - Real *wqw_sec, Real *uw_sec, Real *vw_sec, Real *wtke_sec, - Real *thl_sec, Real *qw_sec, Real *qwthl_sec); - -void diag_second_moments_c(Int shcol, Int nlev, Int nlevi, Real *thetal, Real *qw, - Real *u_wind, Real *v_wind, Real *tke, Real *isotropy, - Real *tkh, Real *tk, Real *dz_zi, Real *zt_grid, Real *zi_grid, - Real *shoc_mix, Real *thl_sec, Real *qw_sec, Real *wthl_sec, - Real *wqw_sec, Real *qwthl_sec, Real *uw_sec, Real *vw_sec, - Real *wtke_sec, Real *w_sec); - -void diag_second_shoc_moments_c(Int shcol, Int nlev, Int nlevi, Real *thetal, - Real *qw, Real *u_wind, Real *v_wind, Real *tke, - Real *isotropy, Real *tkh, Real *tk, Real *dz_zi, - Real *zt_grid, Real *zi_grid, Real *shoc_mix, - Real *wthl_sfc, Real *wqw_sfc, Real *uw_sfc, - Real *vw_sfc, Real *thl_sec, Real *qw_sec, - Real *wthl_sec, Real *wqw_sec, Real *qwthl_sec, - Real *uw_sec, Real *vw_sec, Real *wtke_sec, Real *w_sec); - -void shoc_pblintd_cldcheck_c(Int shcol, Int nlev, Int nlevi, Real* zi, Real* cldn, Real* pblh); - -void compute_shoc_vapor_c(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv); - -void update_prognostics_implicit_c(Int shcol, Int nlev, Int nlevi, Int num_tracer, Real dtime, - Real* dz_zt, Real* dz_zi, Real* rho_zt, Real* zt_grid, Real* zi_grid, - Real* tk, Real* tkh, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, - Real* wqw_sfc, Real* wtracer_sfc, Real* thetal, Real* qw, Real* tracer, - Real* tke, Real* u_wind, Real* v_wind); - -void shoc_main_c(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* host_dx, Real* host_dy, - Real* thv, Real* zt_grid, Real* zi_grid, Real* pres, Real* presi, Real* pdel, - Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* wtracer_sfc, - Int num_qtracers, Real* w_field, Real* inv_exner, Real* phis, Real* host_dse, Real* tke, - Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* qtracers, Real* wthv_sec, - Real* tkh, Real* tk, Real* shoc_ql, Real* shoc_cldfrac, Real* pblh, Real* shoc_mix, - Real* isotropy, Real* w_sec, Real* thl_sec, Real* qw_sec, Real* qwthl_sec, Real* wthl_sec, - Real* wqw_sec, Real* wtke_sec, Real* uw_sec, Real* vw_sec, Real* w3, Real* wqls_sec, - Real* brunt, Real* shoc_ql2, Real* elapsed_s); - -void pblintd_height_c(Int shcol, Int nlev, Int npbl_in, Real* z, Real* u, Real* v, Real* ustar, Real* thv, Real* thv_ref, Real* pblh, Real* rino, bool* check); - -void vd_shoc_decomp_c(Int shcol, Int nlev, Int nlevi, Real* kv_term, Real* tmpi, Real* rdp_zt, Real dtime, - Real* flux, Real* du, Real* dl, Real* d); - -void vd_shoc_solve_c(Int shcol, Int nlev, Real* du, Real* dl, Real* d, Real* var); -void pblintd_surf_temp_c(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, Real* obklen, Real* kbfs, Real* thv, Real* tlv, Real* pblh, bool* check, Real* rino); -void pblintd_check_pblh_c(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, bool* check, Real* pblh); -void pblintd_c(Int shcol, Int nlev, Int nlevi, Int npbl_in, Real* z, Real* zi, Real* thl, Real* ql, Real* q, Real* u, Real* v, Real* ustar, Real* obklen, Real* kbfs, Real* cldn, Real* pblh); - -void compute_shoc_temperature_c(Int shcol, Int nlev, Real* thetal, Real*ql, Real* inv_exner, Real* tabs); - -} // extern "C" : end _c decls - namespace scream { namespace shoc { // -// Glue functions to call fortran from from C++ with the Data struct +// Glue functions to call from host with the Data struct // -// In all C++ -> Fortran bridge functions you should see shoc_init(nlev, true). -// We are provisionally following P3 here in case SHOC uses global data. The -// 'true' argument is to set shoc to use its fortran implementations instead of -// calling back to C++. We want this behavior since it doesn't make much sense -// for C++ to bridge over to fortran only to have fortran bridge back to C++. -// Anyone who wants the C++ implementation should call it directly. We need -// need to be aware of data layout since f90 is different from cxx. All these -// functions will expect incoming data to be C layout. They will transpose to f90 -// before calling fortran and then back to C before returning. +// In all of these functions you should see shoc_init(nlev, true). +// We are provisionally following P3 here in case SHOC uses global data. // void shoc_grid(ShocGridData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_grid_c(d.shcol, d.nlev, d.nlevi, d.zt_grid, d.zi_grid, d.pdel, d.dz_zt, d.dz_zi, d.rho_zt); - d.transpose(); + shoc_init(d.nlev); + shoc_grid_host(d.shcol, d.nlev, d.nlevi, d.zt_grid, d.zi_grid, d.pdel, d.dz_zt, d.dz_zi, d.rho_zt); } void shoc_diag_obklen(ShocDiagObklenData& d) { - shoc_init(1, true); // single level function - shoc_diag_obklen_c(d.shcol, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, d.thl_sfc, d.cldliq_sfc, d.qv_sfc, d.ustar, d.kbfs, d.obklen); + shoc_init(1); // single level function + shoc_diag_obklen_host(d.shcol, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, d.thl_sfc, d.cldliq_sfc, d.qv_sfc, d.ustar, d.kbfs, d.obklen); } void update_host_dse(UpdateHostDseData& d) { - shoc_init(d.nlev, true); - d.transpose(); - update_host_dse_c(d.shcol, d.nlev, d.thlm, d.shoc_ql, d.inv_exner, d.zt_grid, d.phis, d.host_dse); - d.transpose(); + shoc_init(d.nlev); + update_host_dse_host(d.shcol, d.nlev, d.thlm, d.shoc_ql, d.inv_exner, d.zt_grid, d.phis, d.host_dse); } void shoc_energy_fixer(ShocEnergyFixerData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_energy_fixer_c(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.zt_grid, d.zi_grid, d.se_b, d.ke_b, d.wv_b, d.wl_b, d.se_a, d.ke_a, d.wv_a, d.wl_a, d.wthl_sfc, d.wqw_sfc, d.rho_zt, d.tke, d.pint, d.host_dse); - d.transpose(); + shoc_init(d.nlev); + shoc_energy_fixer_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.zt_grid, d.zi_grid, d.se_b, d.ke_b, d.wv_b, d.wl_b, d.se_a, d.ke_a, d.wv_a, d.wl_a, d.wthl_sfc, d.wqw_sfc, d.rho_zt, d.tke, d.pint, d.host_dse); } void shoc_energy_integrals(ShocEnergyIntegralsData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_energy_integrals_c(d.shcol, d.nlev, d.host_dse, d.pdel, d.rtm, d.rcm, d.u_wind, d.v_wind, d.se_int, d.ke_int, d.wv_int, d.wl_int); - d.transpose(); + shoc_init(d.nlev); + shoc_energy_integrals_host(d.shcol, d.nlev, d.host_dse, d.pdel, d.rtm, d.rcm, d.u_wind, d.v_wind, d.se_int, d.ke_int, d.wv_int, d.wl_int); } void shoc_energy_total_fixer(ShocEnergyTotalFixerData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_energy_total_fixer_c(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, + shoc_init(d.nlev); + shoc_energy_total_fixer_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.zt_grid, d.zi_grid, d.se_b, d.ke_b, d.wv_b, d.wl_b, d.se_a, d.ke_a, d.wv_a, d.wl_a, d.wthl_sfc, d.wqw_sfc, d.rho_zt, d.pint, d.te_a, d.te_b); - d.transpose(); } void shoc_energy_threshold_fixer(ShocEnergyThresholdFixerData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_energy_threshold_fixer_c(d.shcol, d.nlev, d.nlevi, d.pint, d.tke, d.te_a, d.te_b, d.se_dis, d.shoctop); - d.transpose(); + shoc_init(d.nlev); + shoc_energy_threshold_fixer_host(d.shcol, d.nlev, d.nlevi, d.pint, d.tke, d.te_a, d.te_b, d.se_dis, d.shoctop); } void shoc_energy_dse_fixer(ShocEnergyDseFixerData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_energy_dse_fixer_c(d.shcol, d.nlev, d.se_dis, d.shoctop, d.host_dse); - d.transpose(); + shoc_init(d.nlev); + shoc_energy_dse_fixer_host(d.shcol, d.nlev, d.se_dis, d.shoctop, d.host_dse); } void calc_shoc_vertflux(CalcShocVertfluxData& d) { - shoc_init(d.nlev, true); - d.transpose(); - calc_shoc_vertflux_c(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); - d.transpose(); + shoc_init(d.nlev); + calc_shoc_vertflux_host(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); } void calc_shoc_varorcovar(CalcShocVarorcovarData& d) { - shoc_init(d.nlev, true); - d.transpose(); - calc_shoc_varorcovar_c(d.shcol, d.nlev, d.nlevi, d.tunefac, d.isotropy_zi, d.tkh_zi, d.dz_zi, d.invar1, d.invar2, d.varorcovar); - d.transpose(); + shoc_init(d.nlev); + calc_shoc_varorcovar_host(d.shcol, d.nlev, d.nlevi, d.tunefac, d.isotropy_zi, d.tkh_zi, d.dz_zi, d.invar1, d.invar2, d.varorcovar); } void compute_tmpi(ComputeTmpiData& d) { - shoc_init(d.nlevi - 1, true); // nlev = nlevi - 1 - d.transpose(); - compute_tmpi_c(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); - d.transpose(); + shoc_init(d.nlevi - 1); // nlev = nlevi - 1 + compute_tmpi_host(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); } void dp_inverse(DpInverseData& d) { - shoc_init(d.nlev, true); - d.transpose(); - dp_inverse_c(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); - d.transpose(); + shoc_init(d.nlev); + dp_inverse_host(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); } void sfc_fluxes(SfcFluxesData& d) { - shoc_init(1, true); // single layer function - d.transpose(); - sfc_fluxes_c(d.shcol, d.num_tracer, d.dtime, d.rho_zi_sfc, d.rdp_zt_sfc, d.wthl_sfc, d.wqw_sfc, d.wtke_sfc, d.wtracer_sfc, d.thetal, d.qw, d.tke, d.wtracer); - d.transpose(); + shoc_init(1); // single layer function + sfc_fluxes_host(d.shcol, d.num_tracer, d.dtime, d.rho_zi_sfc, d.rdp_zt_sfc, d.wthl_sfc, d.wqw_sfc, d.wtke_sfc, d.wtracer_sfc, d.thetal, d.qw, d.tke, d.wtracer); } void impli_srf_stress_term(ImpliSrfStressTermData& d) { - shoc_init(1, true); // single layer function - impli_srf_stress_term_c(d.shcol, d.rho_zi_sfc, d.uw_sfc, d.vw_sfc, d.u_wind_sfc, d.v_wind_sfc, d.ksrf); + shoc_init(1); // single layer function + impli_srf_stress_term_host(d.shcol, d.rho_zi_sfc, d.uw_sfc, d.vw_sfc, d.u_wind_sfc, d.v_wind_sfc, d.ksrf); } void tke_srf_flux_term(TkeSrfFluxTermData& d) { - shoc_init(1, true); // single layer function - tke_srf_flux_term_c(d.shcol, d.uw_sfc, d.vw_sfc, d.wtke_sfc); + shoc_init(1); // single layer function + tke_srf_flux_term_host(d.shcol, d.uw_sfc, d.vw_sfc, d.wtke_sfc); } void integ_column_stability(IntegColumnStabilityData& d) { - shoc_init(d.nlev, true); - d.transpose(); - integ_column_stability_c(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); - d.transpose(); + shoc_init(d.nlev); + integ_column_stability_host(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); } void check_tke(CheckTkeData& d) { - shoc_init(d.nlev, true); - d.transpose(); - check_tke_c(d.shcol, d.nlev, d.tke); - d.transpose(); + shoc_init(d.nlev); + check_tke_host(d.shcol, d.nlev, d.tke); } void shoc_tke(ShocTkeData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_tke_c(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); - d.transpose(); + shoc_init(d.nlev); + shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); } void compute_shr_prod(ComputeShrProdData& d) { - shoc_init(d.nlev, true); - d.transpose(); - compute_shr_prod_c(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); - d.transpose(); + shoc_init(d.nlev); + compute_shr_prod_host(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); } void isotropic_ts(IsotropicTsData& d) { - shoc_init(d.nlev, true); - d.transpose(); - isotropic_ts_c(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); - d.transpose(); + shoc_init(d.nlev); + isotropic_ts_host(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); } void adv_sgs_tke(AdvSgsTkeData& d) { - shoc_init(d.nlev, true); - d.transpose(); - adv_sgs_tke_c(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); - d.transpose(); + shoc_init(d.nlev); + adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); } void eddy_diffusivities(EddyDiffusivitiesData& d) { - shoc_init(d.nlev, true); - d.transpose(); - eddy_diffusivities_c(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); - d.transpose(); + shoc_init(d.nlev); + eddy_diffusivities_host(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); } void shoc_length(ShocLengthData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_length_c(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); - d.transpose(); + shoc_init(d.nlev); + shoc_length_host(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); } void compute_brunt_shoc_length(ComputeBruntShocLengthData& d) { - shoc_init(d.nlev, true); - d.transpose(); - compute_brunt_shoc_length_c(d.nlev, d.nlevi, d.shcol, d.dz_zt, d.thv, d.thv_zi, d.brunt); - d.transpose(); + shoc_init(d.nlev); + compute_brunt_shoc_length_host(d.nlev, d.nlevi, d.shcol, d.dz_zt, d.thv, d.thv_zi, d.brunt); } void compute_l_inf_shoc_length(ComputeLInfShocLengthData& d) { - shoc_init(d.nlev, true); - d.transpose(); - compute_l_inf_shoc_length_c(d.nlev, d.shcol, d.zt_grid, d.dz_zt, d.tke, d.l_inf); - d.transpose(); + shoc_init(d.nlev); + compute_l_inf_shoc_length_host(d.nlev, d.shcol, d.zt_grid, d.dz_zt, d.tke, d.l_inf); } void compute_shoc_mix_shoc_length(ComputeShocMixShocLengthData& d) { - shoc_init(d.nlev, true); - d.transpose(); - compute_shoc_mix_shoc_length_c(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); - d.transpose(); + shoc_init(d.nlev); + compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); } void check_length_scale_shoc_length(CheckLengthScaleShocLengthData& d) { - shoc_init(d.nlev, true); - d.transpose(); - check_length_scale_shoc_length_c(d.nlev, d.shcol, d.host_dx, d.host_dy, d.shoc_mix); - d.transpose(); + shoc_init(d.nlev); + check_length_scale_shoc_length_host(d.nlev, d.shcol, d.host_dx, d.host_dy, d.shoc_mix); } void fterms_input_for_diag_third_shoc_moment(FtermsInputForDiagThirdShocMomentData& d) { - shoc_init(1, true); // single level function - fterms_input_for_diag_third_shoc_moment_c(d.dz_zi, d.dz_zt, d.dz_zt_kc, d.isotropy_zi, d.brunt_zi, d.thetal_zi, &d.thedz, &d.thedz2, &d.iso, &d.isosqrd, &d.buoy_sgs2, &d.bet2); + shoc_init(1); // single level function + fterms_input_for_diag_third_shoc_moment_host(d.dz_zi, d.dz_zt, d.dz_zt_kc, d.isotropy_zi, d.brunt_zi, d.thetal_zi, &d.thedz, &d.thedz2, &d.iso, &d.isosqrd, &d.buoy_sgs2, &d.bet2); } void aa_terms_diag_third_shoc_moment(AaTermsDiagThirdShocMomentData& d) { - shoc_init(1, true); // single level function - aa_terms_diag_third_shoc_moment_c(d.omega0, d.omega1, d.omega2, d.x0, d.x1, d.y0, d.y1, &d.aa0, &d.aa1); + shoc_init(1); // single level function + aa_terms_diag_third_shoc_moment_host(d.omega0, d.omega1, d.omega2, d.x0, d.x1, d.y0, d.y1, &d.aa0, &d.aa1); } void f0_to_f5_diag_third_shoc_moment(F0ToF5DiagThirdShocMomentData& d) { - shoc_init(1, true); // single level function - f0_to_f5_diag_third_shoc_moment_c(d.thedz, d.thedz2, d.bet2, d.iso, d.isosqrd, d.wthl_sec, d.wthl_sec_kc, d.wthl_sec_kb, d.thl_sec_kc, d.thl_sec_kb, d.w_sec, d.w_sec_kc, d.w_sec_zi, d.tke, d.tke_kc, &d.f0, &d.f1, &d.f2, &d.f3, &d.f4, &d.f5); + shoc_init(1); // single level function + f0_to_f5_diag_third_shoc_moment_host(d.thedz, d.thedz2, d.bet2, d.iso, d.isosqrd, d.wthl_sec, d.wthl_sec_kc, d.wthl_sec_kb, d.thl_sec_kc, d.thl_sec_kb, d.w_sec, d.w_sec_kc, d.w_sec_zi, d.tke, d.tke_kc, &d.f0, &d.f1, &d.f2, &d.f3, &d.f4, &d.f5); } void omega_terms_diag_third_shoc_moment(OmegaTermsDiagThirdShocMomentData& d) { - shoc_init(1, true); // single level function - omega_terms_diag_third_shoc_moment_c(d.buoy_sgs2, d.f3, d.f4, &d.omega0, &d.omega1, &d.omega2); + shoc_init(1); // single level function + omega_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f3, d.f4, &d.omega0, &d.omega1, &d.omega2); } void x_y_terms_diag_third_shoc_moment(XYTermsDiagThirdShocMomentData& d) { - shoc_init(1, true); // single level function - x_y_terms_diag_third_shoc_moment_c(d.buoy_sgs2, d.f0, d.f1, d.f2, &d.x0, &d.y0, &d.x1, &d.y1); + shoc_init(1); // single level function + x_y_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f0, d.f1, d.f2, &d.x0, &d.y0, &d.x1, &d.y1); } void w3_diag_third_shoc_moment(W3DiagThirdShocMomentData& d) { - shoc_init(1, true); // single level function - w3_diag_third_shoc_moment_c(d.aa0, d.aa1, d.x0, d.x1, d.f5, &d.w3); + shoc_init(1); // single level function + w3_diag_third_shoc_moment_host(d.aa0, d.aa1, d.x0, d.x1, d.f5, &d.w3); } void clipping_diag_third_shoc_moments(ClippingDiagThirdShocMomentsData& d) { - shoc_init(d.nlevi - 1, true); // nlev = nlevi - 1 - d.transpose(); - clipping_diag_third_shoc_moments_c(d.nlevi, d.shcol, d.w_sec_zi, d.w3); - d.transpose(); + shoc_init(d.nlevi - 1); // nlev = nlevi - 1 + clipping_diag_third_shoc_moments_host(d.nlevi, d.shcol, d.w_sec_zi, d.w3); } void diag_second_moments_srf(DiagSecondMomentsSrfData& d) { - shoc_init(1, true); // single level function - shoc_diag_second_moments_srf_c(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); + shoc_init(1); // single level function + shoc_diag_second_moments_srf_host(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); } void linear_interp(LinearInterpData& d) { - shoc_init(d.km1, true); - d.transpose(); - linear_interp_c(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); - d.transpose(); + shoc_init(d.km1); + linear_interp_host(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); } void diag_third_shoc_moments(DiagThirdShocMomentsData& d) { - shoc_init(d.nlev, true); - d.transpose(); - diag_third_shoc_moments_c(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); - d.transpose(); + shoc_init(d.nlev); + diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); } void compute_diag_third_shoc_moment(ComputeDiagThirdShocMomentData& d) { - shoc_init(d.nlev, true); - d.transpose(); - compute_diag_third_shoc_moment_c(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); - d.transpose(); + shoc_init(d.nlev); + compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); } void shoc_assumed_pdf(ShocAssumedPdfData& d) { - shoc_init(d.nlev, true); - d.transpose(); - shoc_assumed_pdf_c(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); - d.transpose(); + shoc_init(d.nlev); + shoc_assumed_pdf_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); } void shoc_assumed_pdf_tilde_to_real(ShocAssumedPdfTildeToRealData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_tilde_to_real_c(d.w_first, d.sqrtw2, &d.w1); + shoc_init(1); // single level function + shoc_assumed_pdf_tilde_to_real_host(d.w_first, d.sqrtw2, &d.w1); } void shoc_assumed_pdf_vv_parameters(ShocAssumedPdfVvParametersData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_vv_parameters_c(d.w_first, d.w_sec, d.w3var, &d.skew_w, &d.w1_1, &d.w1_2, &d.w2_1, &d.w2_2, &d.a); + shoc_init(1); // single level function + shoc_assumed_pdf_vv_parameters_host(d.w_first, d.w_sec, d.w3var, &d.skew_w, &d.w1_1, &d.w1_2, &d.w2_1, &d.w2_2, &d.a); } void shoc_assumed_pdf_thl_parameters(ShocAssumedPdfThlParametersData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_thl_parameters_c(d.wthlsec, d.sqrtw2, d.sqrtthl, d.thlsec, d.thl_first, d.w1_1, d.w1_2, d.skew_w, d.a, d.dothetal_skew, &d.thl1_1, &d.thl1_2, &d.thl2_1, &d.thl2_2, &d.sqrtthl2_1, &d.sqrtthl2_2); + shoc_init(1); // single level function + shoc_assumed_pdf_thl_parameters_host(d.wthlsec, d.sqrtw2, d.sqrtthl, d.thlsec, d.thl_first, d.w1_1, d.w1_2, d.skew_w, d.a, d.dothetal_skew, &d.thl1_1, &d.thl1_2, &d.thl2_1, &d.thl2_2, &d.sqrtthl2_1, &d.sqrtthl2_2); } void shoc_assumed_pdf_qw_parameters(ShocAssumedPdfQwParametersData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_qw_parameters_c(d.wqwsec, d.sqrtw2, d.skew_w, d.sqrtqt, d.qwsec, d.w1_2, d.w1_1, d.qw_first, d.a, &d.qw1_1, &d.qw1_2, &d.qw2_1, &d.qw2_2, &d.sqrtqw2_1, &d.sqrtqw2_2); + shoc_init(1); // single level function + shoc_assumed_pdf_qw_parameters_host(d.wqwsec, d.sqrtw2, d.skew_w, d.sqrtqt, d.qwsec, d.w1_2, d.w1_1, d.qw_first, d.a, &d.qw1_1, &d.qw1_2, &d.qw2_1, &d.qw2_2, &d.sqrtqw2_1, &d.sqrtqw2_2); } void shoc_assumed_pdf_inplume_correlations(ShocAssumedPdfInplumeCorrelationsData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_inplume_correlations_c(d.sqrtqw2_1, d.sqrtthl2_1, d.a, d.sqrtqw2_2, d.sqrtthl2_2, d.qwthlsec, d.qw1_1, d.qw_first, d.thl1_1, d.thl_first, d.qw1_2, d.thl1_2, &d.r_qwthl_1); + shoc_init(1); // single level function + shoc_assumed_pdf_inplume_correlations_host(d.sqrtqw2_1, d.sqrtthl2_1, d.a, d.sqrtqw2_2, d.sqrtthl2_2, d.qwthlsec, d.qw1_1, d.qw_first, d.thl1_1, d.thl_first, d.qw1_2, d.thl1_2, &d.r_qwthl_1); } void shoc_assumed_pdf_compute_temperature(ShocAssumedPdfComputeTemperatureData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_compute_temperature_c(d.thl1, d.basepres, d.pval, &d.tl1); + shoc_init(1); // single level function + shoc_assumed_pdf_compute_temperature_host(d.thl1, d.basepres, d.pval, &d.tl1); } void shoc_assumed_pdf_compute_qs(ShocAssumedPdfComputeQsData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_compute_qs_c(d.tl1_1, d.tl1_2, d.pval, &d.qs1, &d.beta1, &d.qs2, &d.beta2); + shoc_init(1); // single level function + shoc_assumed_pdf_compute_qs_host(d.tl1_1, d.tl1_2, d.pval, &d.qs1, &d.beta1, &d.qs2, &d.beta2); } void shoc_assumed_pdf_compute_s(ShocAssumedPdfComputeSData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_compute_s_c(d.qw1, d.qs1, d.beta, d.pval, d.thl2, d.qw2, d.sqrtthl2, d.sqrtqw2, d.r_qwthl, &d.s, &d.std_s, &d.qn, &d.c); + shoc_init(1); // single level function + shoc_assumed_pdf_compute_s_host(d.qw1, d.qs1, d.beta, d.pval, d.thl2, d.qw2, d.sqrtthl2, d.sqrtqw2, d.r_qwthl, &d.s, &d.std_s, &d.qn, &d.c); } void shoc_assumed_pdf_compute_sgs_liquid(ShocAssumedPdfComputeSgsLiquidData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_compute_sgs_liquid_c(d.a, d.ql1, d.ql2, &d.shoc_ql); + shoc_init(1); // single level function + shoc_assumed_pdf_compute_sgs_liquid_host(d.a, d.ql1, d.ql2, &d.shoc_ql); } void shoc_assumed_pdf_compute_cloud_liquid_variance(ShocAssumedPdfComputeCloudLiquidVarianceData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_compute_cloud_liquid_variance_c(d.a, d.s1, d.ql1, d.c1, d.std_s1, d.s2, d.ql2, d.c2, d.std_s2, d.shoc_ql, &d.shoc_ql2); + shoc_init(1); // single level function + shoc_assumed_pdf_compute_cloud_liquid_variance_host(d.a, d.s1, d.ql1, d.c1, d.std_s1, d.s2, d.ql2, d.c2, d.std_s2, d.shoc_ql, &d.shoc_ql2); } void shoc_assumed_pdf_compute_liquid_water_flux(ShocAssumedPdfComputeLiquidWaterFluxData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_compute_liquid_water_flux_c(d.a, d.w1_1, d.w_first, d.ql1, d.w1_2, d.ql2, &d.wqls); + shoc_init(1); // single level function + shoc_assumed_pdf_compute_liquid_water_flux_host(d.a, d.w1_1, d.w_first, d.ql1, d.w1_2, d.ql2, &d.wqls); } void shoc_assumed_pdf_compute_buoyancy_flux(ShocAssumedPdfComputeBuoyancyFluxData& d) { - shoc_init(1, true); // single level function - shoc_assumed_pdf_compute_buoyancy_flux_c(d.wthlsec, d.epsterm, d.wqwsec, d.pval, d.wqls, &d.wthv_sec); + shoc_init(1); // single level function + shoc_assumed_pdf_compute_buoyancy_flux_host(d.wthlsec, d.epsterm, d.wqwsec, d.pval, d.wqls, &d.wthv_sec); } void diag_second_moments_ubycond(DiagSecondMomentsUbycondData& d) { - shoc_init(1, true); // single level function - shoc_diag_second_moments_ubycond_c(d.shcol, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec); + shoc_init(1); // single level function + shoc_diag_second_moments_ubycond_host(d.shcol, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec); } void pblintd_init_pot(PblintdInitPotData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - shoc_pblintd_init_pot_c(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); - d.transpose(); + shoc_init(d.nlev, true); + shoc_pblintd_init_pot_host(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); } void pblintd_cldcheck(PblintdCldcheckData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - shoc_pblintd_cldcheck_c(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); - d.transpose(); + shoc_init(d.nlev, true); + shoc_pblintd_cldcheck_host(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); } void diag_second_moments_lbycond(DiagSecondMomentsLbycondData& d) { - shoc_init(1, true); // single level function - diag_second_moments_lbycond_c(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); + shoc_init(1); // single level function + diag_second_moments_lbycond_host(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); } void diag_second_moments(DiagSecondMomentsData& d) { - shoc_init(d.nlev, true); - d.transpose(); - diag_second_moments_c(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, + shoc_init(d.nlev); + diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); - d.transpose(); } void diag_second_shoc_moments(DiagSecondShocMomentsData& d) { - shoc_init(d.nlev, true); - d.transpose(); - diag_second_shoc_moments_c(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, + shoc_init(d.nlev); + diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); - d.transpose(); } void compute_shoc_vapor(ComputeShocVaporData& d) { - shoc_init(d.nlev, true); - d.transpose(); - compute_shoc_vapor_c(d.shcol, d.nlev, d.qw, d.ql, d.qv); - d.transpose(); + shoc_init(d.nlev); + compute_shoc_vapor_host(d.shcol, d.nlev, d.qw, d.ql, d.qv); } void update_prognostics_implicit(UpdatePrognosticsImplicitData& d) { - shoc_init(d.nlev, true); - d.transpose(); - update_prognostics_implicit_c(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, + shoc_init(d.nlev); + update_prognostics_implicit_host(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, d.dz_zt, d.dz_zi, d.rho_zt, d.zt_grid, d.zi_grid, d.tk, d.tkh, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, d.wtracer_sfc, d.thetal, d.qw, d.tracer, d.tke, d.u_wind, d.v_wind); - d.transpose(); } void shoc_main(ShocMainData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - shoc_main_c(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, + shoc_init(d.nlev, true); + shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, d.pres, d.presi, d.pdel, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.wtracer_sfc, d.num_qtracers, d.w_field, d.inv_exner, d.phis, d.host_dse, d.tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.qtracers, d.wthv_sec, d.tkh, d.tk, d.shoc_ql, d.shoc_cldfrac, d.pblh, d.shoc_mix, d.isotropy, d.w_sec, d.thl_sec, d.qw_sec, d.qwthl_sec, d.wthl_sec, d.wqw_sec, d.wtke_sec, d.uw_sec, d.vw_sec, d.w3, d.wqls_sec, d.brunt, d.shoc_ql2, &d.elapsed_s); - d.transpose(); } void shoc_main_with_init(ShocMainData& d) { using C = scream::physics::Constants; - d.transpose(); - shoc_init_for_main_bfb_c(d.nlev, C::gravit, C::Rair, C::RH2O, C::Cpair, C::ZVIR, C::LatVap, C::LatIce, C::Karman, C::P0, + shoc_init_for_main_bfb_host(d.nlev, C::gravit, C::Rair, C::RH2O, C::Cpair, C::ZVIR, C::LatVap, C::LatIce, C::Karman, C::P0, d.pref_mid, d.nbot_shoc, d.ntop_shoc+1); - shoc_use_cxx_c(false); - - shoc_main_c(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, + shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, d.pres, d.presi, d.pdel, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.wtracer_sfc, d.num_qtracers, d.w_field, d.inv_exner, d.phis, d.host_dse, d.tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.qtracers, d.wthv_sec, d.tkh, d.tk, d.shoc_ql, d.shoc_cldfrac, d.pblh, d.shoc_mix, d.isotropy, d.w_sec, d.thl_sec, d.qw_sec, d.qwthl_sec, d.wthl_sec, d.wqw_sec, d.wtke_sec, d.uw_sec, d.vw_sec, d.w3, d.wqls_sec, d.brunt, d.shoc_ql2, &d.elapsed_s); - d.transpose(); } void pblintd_height(PblintdHeightData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - pblintd_height_c(d.shcol, d.nlev, d.npbl, d.z, d.u, d.v, d.ustar, d.thv, d.thv_ref, d.pblh, d.rino, d.check); - d.transpose(); + shoc_init(d.nlev, true); + pblintd_height_host(d.shcol, d.nlev, d.npbl, d.z, d.u, d.v, d.ustar, d.thv, d.thv_ref, d.pblh, d.rino, d.check); } void vd_shoc_decomp_and_solve(VdShocDecompandSolveData& d) { - shoc_init(d.nlev, true); - d.transpose(); + shoc_init(d.nlev); // Call decomp subroutine - vd_shoc_decomp_c(d.shcol, d.nlev, d.nlevi, d.kv_term, d.tmpi, d.rdp_zt, d.dtime, d.flux, d.du, d.dl, d.d); + vd_shoc_decomp_host(d.shcol, d.nlev, d.nlevi, d.kv_term, d.tmpi, d.rdp_zt, d.dtime, d.flux, d.du, d.dl, d.d); // Call solver for each problem. The `var` array represents 3d // data with an entry per (shcol, nlev, n_rhs). Fortran requires // 2d data (shcol, nlev) for each rhs. @@ -794,54 +434,45 @@ void vd_shoc_decomp_and_solve(VdShocDecompandSolveData& d) for(Int s=0; s(); } void pblintd_surf_temp(PblintdSurfTempData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - pblintd_surf_temp_c(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.obklen, d.kbfs, d.thv, d.tlv, d.pblh, d.check, d.rino); - d.transpose(); + shoc_init(d.nlev, true); + pblintd_surf_temp_host(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.obklen, d.kbfs, d.thv, d.tlv, d.pblh, d.check, d.rino); } void pblintd_check_pblh(PblintdCheckPblhData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - pblintd_check_pblh_c(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.check, d.pblh); - d.transpose(); + shoc_init(d.nlev, true); + pblintd_check_pblh_host(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.check, d.pblh); } void pblintd(PblintdData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - pblintd_c(d.shcol, d.nlev, d.nlevi, d.npbl, d.z, d.zi, d.thl, d.ql, d.q, d.u, d.v, d.ustar, d.obklen, d.kbfs, d.cldn, d.pblh); - d.transpose(); + shoc_init(d.nlev, true); + pblintd_host(d.shcol, d.nlev, d.nlevi, d.npbl, d.z, d.zi, d.thl, d.ql, d.q, d.u, d.v, d.ustar, d.obklen, d.kbfs, d.cldn, d.pblh); } void compute_shoc_temperature(ComputeShocTempData& d) { - shoc_init(d.nlev, true, true); - d.transpose(); - compute_shoc_temperature_c(d.shcol, d.nlev, d.thetal, d.ql, d.inv_exner, d.tabs); - d.transpose(); + shoc_init(d.nlev, true); + compute_shoc_temperature_host(d.shcol, d.nlev, d.thetal, d.ql, d.inv_exner, d.tabs); } // end _c impls // -// _f function definitions. These expect data in C layout +// _host function definitions. These expect data in C layout // -void calc_shoc_varorcovar_f(Int shcol, Int nlev, Int nlevi, Real tunefac, +void calc_shoc_varorcovar_host(Int shcol, Int nlev, Int nlevi, Real tunefac, Real *isotropy_zi, Real *tkh_zi, Real *dz_zi, Real *invar1, Real *invar2, Real *varorcovar) { @@ -892,7 +523,7 @@ void calc_shoc_varorcovar_f(Int shcol, Int nlev, Int nlevi, Real tunefac, ekat::device_to_host({varorcovar}, shcol, nlevi, inout_views, true); } -void calc_shoc_vertflux_f(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, +void calc_shoc_vertflux_host(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, Real *dz_zi, Real *invar, Real *vertflux) { using SHF = Functions; @@ -937,7 +568,7 @@ void calc_shoc_vertflux_f(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, ekat::device_to_host({vertflux}, shcol, nlevi, inout_views, true); } -void shoc_diag_second_moments_srf_f(Int shcol, Real* wthl_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar) +void shoc_diag_second_moments_srf_host(Int shcol, Real* wthl_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar) { using SHOC = Functions; using Scalar = typename SHOC::Scalar; @@ -975,7 +606,7 @@ void shoc_diag_second_moments_srf_f(Int shcol, Real* wthl_sfc, Real* uw_sfc, Rea ScreamDeepCopy::copy_to_host({ustar2, wstar}, shcol, inout_views); } -void shoc_diag_second_moments_ubycond_f(Int shcol, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, +void shoc_diag_second_moments_ubycond_host(Int shcol, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec) { using SHOC = Functions; @@ -1020,7 +651,7 @@ void shoc_diag_second_moments_ubycond_f(Int shcol, Real* thl_sec, Real* qw_sec, ScreamDeepCopy::copy_to_host({thl_sec, qw_sec, qwthl_sec, wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec}, shcol, host_views); } -void update_host_dse_f(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* inv_exner, Real* zt_grid, +void update_host_dse_host(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* inv_exner, Real* zt_grid, Real* phis, Real* host_dse) { using SHF = Functions; @@ -1070,7 +701,7 @@ void update_host_dse_f(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* inv ekat::device_to_host({host_dse}, shcol, nlev, inout_views, true); } -void compute_diag_third_shoc_moment_f(Int shcol, Int nlev, Int nlevi, Real* w_sec, +void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* tke, Real* dz_zt, Real* dz_zi, Real* isotropy_zi, Real* brunt_zi, Real* w_sec_zi, Real* thetal_zi, @@ -1144,7 +775,7 @@ void compute_diag_third_shoc_moment_f(Int shcol, Int nlev, Int nlevi, Real* w_se ekat::device_to_host({w3}, shcol, nlevi, inout_views, true); } -void shoc_pblintd_init_pot_f(Int shcol, Int nlev, Real *thl, Real* ql, Real* q, +void shoc_pblintd_init_pot_host(Int shcol, Int nlev, Real *thl, Real* ql, Real* q, Real *thv) { using SHOC = Functions; @@ -1182,7 +813,7 @@ void shoc_pblintd_init_pot_f(Int shcol, Int nlev, Real *thl, Real* ql, Real* q, ekat::device_to_host({thv}, shcol, nlev, inout_views, true); } -void compute_shoc_mix_shoc_length_f(Int nlev, Int shcol, Real* tke, Real* brunt, +void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* brunt, Real* zt_grid, Real* l_inf, Real* shoc_mix) { using SHF = Functions; @@ -1234,7 +865,7 @@ void compute_shoc_mix_shoc_length_f(Int nlev, Int shcol, Real* tke, Real* brunt, ekat::device_to_host({shoc_mix}, shcol, nlev, inout_views, true); } -void check_tke_f(Int shcol, Int nlev, Real* tke) +void check_tke_host(Int shcol, Int nlev, Real* tke) { using SHOC = Functions; using Spack = typename SHOC::Spack; @@ -1266,7 +897,7 @@ void check_tke_f(Int shcol, Int nlev, Real* tke) ekat::device_to_host({tke}, shcol, nlev, inout_views, true); } -void linear_interp_f(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, Int ncol, Real minthresh) +void linear_interp_host(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, Int ncol, Real minthresh) { using SHF = Functions; @@ -1308,7 +939,7 @@ void linear_interp_f(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, I ekat::device_to_host({y2}, ncol, km2, inout_views, true); } -void clipping_diag_third_shoc_moments_f(Int nlevi, Int shcol, Real *w_sec_zi, +void clipping_diag_third_shoc_moments_host(Int nlevi, Int shcol, Real *w_sec_zi, Real *w3) { using SHF = Functions; @@ -1343,7 +974,7 @@ void clipping_diag_third_shoc_moments_f(Int nlevi, Int shcol, Real *w_sec_zi, ekat::device_to_host({w3}, shcol, nlevi, inout_views, true); } -void shoc_energy_integrals_f(Int shcol, Int nlev, Real *host_dse, Real *pdel, +void shoc_energy_integrals_host(Int shcol, Int nlev, Real *host_dse, Real *pdel, Real *rtm, Real *rcm, Real *u_wind, Real *v_wind, Real *se_int, Real *ke_int, Real *wv_int, Real *wl_int) { @@ -1410,7 +1041,7 @@ void shoc_energy_integrals_f(Int shcol, Int nlev, Real *host_dse, Real *pdel, ScreamDeepCopy::copy_to_host({se_int,ke_int,wv_int,wl_int}, shcol, inout_views); } -void diag_second_moments_lbycond_f(Int shcol, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar, +void diag_second_moments_lbycond_host(Int shcol, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar, Real* wthl_sec, Real* wqw_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* thl_sec, Real* qw_sec, Real* qwthl_sec) { using SHOC = Functions; @@ -1473,7 +1104,7 @@ void diag_second_moments_lbycond_f(Int shcol, Real* wthl_sfc, Real* wqw_sfc, Rea ScreamDeepCopy::copy_to_host({wthl_sec, wqw_sec, uw_sec, vw_sec, wtke_sec, thl_sec, qw_sec, qwthl_sec}, shcol, host_views); } -void diag_second_moments_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, +void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec) @@ -1574,7 +1205,7 @@ void diag_second_moments_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* q ekat::device_to_host({thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec}, dim1, dim2, host_views, true); } -void diag_second_shoc_moments_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, +void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec) @@ -1692,7 +1323,7 @@ void diag_second_shoc_moments_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Re ekat::device_to_host({thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec}, dim1, dim2, host_2d_views, true); } -void compute_brunt_shoc_length_f(Int nlev, Int nlevi, Int shcol, Real* dz_zt, Real* thv, Real* thv_zi, Real* brunt) +void compute_brunt_shoc_length_host(Int nlev, Int nlevi, Int shcol, Real* dz_zt, Real* thv, Real* thv_zi, Real* brunt) { using SHF = Functions; @@ -1734,7 +1365,7 @@ void compute_brunt_shoc_length_f(Int nlev, Int nlevi, Int shcol, Real* dz_zt, Re ekat::device_to_host({brunt}, shcol, nlev, inout_views, true); } -void compute_l_inf_shoc_length_f(Int nlev, Int shcol, Real *zt_grid, Real *dz_zt, +void compute_l_inf_shoc_length_host(Int nlev, Int shcol, Real *zt_grid, Real *dz_zt, Real *tke, Real *l_inf) { using SHF = Functions; @@ -1782,7 +1413,7 @@ void compute_l_inf_shoc_length_f(Int nlev, Int shcol, Real *zt_grid, Real *dz_zt ScreamDeepCopy::copy_to_host({l_inf}, shcol, inout_views); } -void check_length_scale_shoc_length_f(Int nlev, Int shcol, Real* host_dx, Real* host_dy, Real* shoc_mix) +void check_length_scale_shoc_length_host(Int nlev, Int shcol, Real* host_dx, Real* host_dy, Real* shoc_mix) { using SHF = Functions; @@ -1824,7 +1455,7 @@ void check_length_scale_shoc_length_f(Int nlev, Int shcol, Real* host_dx, Real* ekat::device_to_host({shoc_mix}, shcol, nlev, inout_views, true); } -void shoc_diag_obklen_f(Int shcol, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, Real* thl_sfc, +void shoc_diag_obklen_host(Int shcol, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, Real* thl_sfc, Real* cldliq_sfc, Real* qv_sfc, Real* ustar, Real* kbfs, Real* obklen) { using SHF = Functions; @@ -1880,7 +1511,7 @@ void shoc_diag_obklen_f(Int shcol, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, R ScreamDeepCopy::copy_to_host({ustar, kbfs, obklen}, shcol, inout_views); } -void shoc_pblintd_cldcheck_f(Int shcol, Int nlev, Int nlevi, Real* zi, Real* cldn, Real* pblh) { +void shoc_pblintd_cldcheck_host(Int shcol, Int nlev, Int nlevi, Real* zi, Real* cldn, Real* pblh) { using SHOC = Functions; using Spack = typename SHOC::Spack; using Scalar = typename SHOC::Scalar; @@ -1919,7 +1550,7 @@ void shoc_pblintd_cldcheck_f(Int shcol, Int nlev, Int nlevi, Real* zi, Real* cld ScreamDeepCopy::copy_to_host({pblh}, shcol, inout_views); } -void shoc_length_f(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_dy, +void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_dy, Real* zt_grid, Real* zi_grid, Real*dz_zt, Real* tke, Real* thv, Real*brunt, Real* shoc_mix) { @@ -1994,7 +1625,7 @@ void shoc_length_f(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_dy, ekat::device_to_host({brunt,shoc_mix}, shcol, nlev, inout_views, true); } -void shoc_energy_fixer_f(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, +void shoc_energy_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, Real* zi_grid, Real* se_b, Real* ke_b, Real* wv_b, Real* wl_b, Real* se_a, Real* ke_a, Real* wv_a, Real* wl_a, Real* wthl_sfc, Real* wqw_sfc, Real* rho_zt, Real* tke, Real* pint, @@ -2085,7 +1716,7 @@ void shoc_energy_fixer_f(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, R ekat::device_to_host({host_dse}, shcol, nlev, inout_views, true); } -void compute_shoc_vapor_f(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv) +void compute_shoc_vapor_host(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv) { using SHF = Functions; @@ -2124,7 +1755,7 @@ void compute_shoc_vapor_f(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv) ekat::device_to_host({qv}, shcol, nlev, inout_views, true); } -void update_prognostics_implicit_f(Int shcol, Int nlev, Int nlevi, Int num_tracer, Real dtime, +void update_prognostics_implicit_host(Int shcol, Int nlev, Int nlevi, Int num_tracer, Real dtime, Real* dz_zt, Real* dz_zi, Real* rho_zt, Real* zt_grid, Real* zi_grid, Real* tk, Real* tkh, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, Real* wtracer_sfc, Real* thetal, Real* qw, Real* tracer, @@ -2262,7 +1893,7 @@ void update_prognostics_implicit_f(Int shcol, Int nlev, Int nlevi, Int num_trace ekat::device_to_host({tracer}, shcol, nlev, num_tracer, inout_views, true); } -void diag_third_shoc_moments_f(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, +void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* isotropy, Real* brunt, Real* thetal, Real* tke, Real* dz_zt, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* w3) @@ -2341,7 +1972,7 @@ void diag_third_shoc_moments_f(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real ekat::device_to_host({w3}, shcol, nlevi, inout_views, true); } -void adv_sgs_tke_f(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_sec, +void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_sec, Real* sterm_zt, Real* tk, Real* tke, Real* a_diss) { using SHF = Functions; @@ -2392,7 +2023,7 @@ void adv_sgs_tke_f(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_s ekat::device_to_host({tke, a_diss}, shcol, nlev, inout_views, true); } -void shoc_assumed_pdf_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* w_field, +void shoc_assumed_pdf_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* w_field, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* w_sec, Real* wqw_sec, Real* qwthl_sec, Real* w3, Real* pres, Real* zt_grid, Real* zi_grid, Real* shoc_cldfrac, Real* shoc_ql, Real* wqls, Real* wthv_sec, Real* shoc_ql2) @@ -2479,7 +2110,7 @@ void shoc_assumed_pdf_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, std::vector out_views = {shoc_cldfrac_d, shoc_ql_d, wqls_d, wthv_sec_d, shoc_ql2_d}; ekat::device_to_host({shoc_cldfrac, shoc_ql, wqls, wthv_sec, shoc_ql2}, shcol, nlev, out_views, true); } -void compute_shr_prod_f(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_wind, Real* v_wind, Real* sterm) +void compute_shr_prod_host(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_wind, Real* v_wind, Real* sterm) { using SHF = Functions; @@ -2528,7 +2159,7 @@ void compute_shr_prod_f(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_win ekat::device_to_host({sterm}, shcol, nlevi, inout_views, true); } -void compute_tmpi_f(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_zi, Real *tmpi) +void compute_tmpi_host(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_zi, Real *tmpi) { using SHF = Functions; @@ -2567,7 +2198,7 @@ void compute_tmpi_f(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_zi, ekat::device_to_host({tmpi}, shcol, nlevi, inout_views, true); } -void integ_column_stability_f(Int nlev, Int shcol, Real *dz_zt, +void integ_column_stability_host(Int nlev, Int shcol, Real *dz_zt, Real *pres, Real* brunt, Real *brunt_int) { using SHF = Functions; @@ -2619,7 +2250,7 @@ void integ_column_stability_f(Int nlev, Int shcol, Real *dz_zt, ScreamDeepCopy::copy_to_host({brunt_int}, shcol, inout_views); } -void isotropic_ts_f(Int nlev, Int shcol, Real* brunt_int, Real* tke, +void isotropic_ts_host(Int nlev, Int shcol, Real* brunt_int, Real* tke, Real* a_diss, Real* brunt, Real* isotropy) { using SHF = Functions; @@ -2682,7 +2313,7 @@ void isotropic_ts_f(Int nlev, Int shcol, Real* brunt_int, Real* tke, } -void dp_inverse_f(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_zt) +void dp_inverse_host(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_zt) { using SHF = Functions; @@ -2721,7 +2352,7 @@ void dp_inverse_f(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_zt) ekat::device_to_host({rdp_zt}, shcol, nlev, inout_views, true); } -int shoc_init_f(Int nlev, Real *pref_mid, Int nbot_shoc, Int ntop_shoc) +int shoc_init_host(Int nlev, Real *pref_mid, Int nbot_shoc, Int ntop_shoc) { using SHF = Functions; using Spack = typename SHF::Spack; @@ -2735,7 +2366,7 @@ int shoc_init_f(Int nlev, Real *pref_mid, Int nbot_shoc, Int ntop_shoc) return SHF::shoc_init(nbot_shoc,ntop_shoc,pref_mid_d); } -Int shoc_main_f(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npbl, Real* host_dx, Real* host_dy, Real* thv, Real* zt_grid, +Int shoc_main_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npbl, Real* host_dx, Real* host_dy, Real* thv, Real* zt_grid, Real* zi_grid, Real* pres, Real* presi, Real* pdel, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* wtracer_sfc, Int num_qtracers, Real* w_field, Real* inv_exner, Real* phis, Real* host_dse, Real* tke, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* qtracers, Real* wthv_sec, Real* tkh, Real* tk, @@ -2981,7 +2612,7 @@ Int shoc_main_f(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npbl, return elapsed_microsec; } -void pblintd_height_f(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* v, Real* ustar, Real* thv, Real* thv_ref, Real* pblh, Real* rino, bool* check) +void pblintd_height_host(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* v, Real* ustar, Real* thv, Real* thv_ref, Real* pblh, Real* rino, bool* check) { using SHOC = Functions; using Spack = typename SHOC::Spack; @@ -3040,7 +2671,7 @@ void pblintd_height_f(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* v, ScreamDeepCopy::copy_to_host({check}, shcol, out_bool_1d_views); } -void vd_shoc_decomp_and_solve_f(Int shcol, Int nlev, Int nlevi, Int num_rhs, Real* kv_term, Real* tmpi, Real* rdp_zt, Real dtime, +void vd_shoc_decomp_and_solve_host(Int shcol, Int nlev, Int nlevi, Int num_rhs, Real* kv_term, Real* tmpi, Real* rdp_zt, Real dtime, Real* flux, Real* var) { using SHF = Functions; @@ -3112,7 +2743,7 @@ void vd_shoc_decomp_and_solve_f(Int shcol, Int nlev, Int nlevi, Int num_rhs, Rea ekat::device_to_host({var}, shcol, nlev, num_rhs, inout_views, true); } -void shoc_grid_f(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid, Real* pdel, Real* dz_zt, Real* dz_zi, Real* rho_zt) +void shoc_grid_host(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid, Real* pdel, Real* dz_zt, Real* dz_zi, Real* rho_zt) { using SHF = Functions; @@ -3161,7 +2792,7 @@ void shoc_grid_f(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid, R ekat::device_to_host({dz_zt, dz_zi, rho_zt}, {shcol, shcol, shcol}, {nlev, nlevi, nlev}, inout_views, true); } -void eddy_diffusivities_f(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, +void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, Real* isotropy, Real* tke, Real* tkh, Real* tk) { using SHF = Functions; @@ -3226,7 +2857,7 @@ void eddy_diffusivities_f(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* ekat::device_to_host({tkh, tk}, shcol, nlev, inout_views, true); } -void pblintd_surf_temp_f(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, Real* obklen, Real* kbfs, Real* thv, Real* tlv, Real* pblh, bool* check, Real* rino) +void pblintd_surf_temp_host(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, Real* obklen, Real* kbfs, Real* thv, Real* tlv, Real* pblh, bool* check, Real* rino) { using SHOC = Functions; using Spack = typename SHOC::Spack; @@ -3283,7 +2914,7 @@ void pblintd_surf_temp_f(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, R ScreamDeepCopy::copy_to_host({check}, shcol, out_bool_1d_views); } -void pblintd_check_pblh_f(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* ustar, bool* check, Real* pblh) +void pblintd_check_pblh_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* ustar, bool* check, Real* pblh) { using SHOC = Functions; using Spack = typename SHOC::Spack; @@ -3319,7 +2950,7 @@ void pblintd_check_pblh_f(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Rea ScreamDeepCopy::copy_to_host({pblh}, shcol, out_1d_views); } -void pblintd_f(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, Real* thl, Real* ql, Real* q, Real* u, Real* v, Real* ustar, Real* obklen, Real* kbfs, Real* cldn, Real* pblh) +void pblintd_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, Real* thl, Real* ql, Real* q, Real* u, Real* v, Real* ustar, Real* obklen, Real* kbfs, Real* cldn, Real* pblh) { using SHF = Functions; @@ -3399,7 +3030,7 @@ void pblintd_f(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, Real ScreamDeepCopy::copy_to_host({pblh}, shcol, out_views); } -void shoc_tke_f(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, +void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, Real* tabs, Real* u_wind, Real* v_wind, Real* brunt, Real* zt_grid, Real* zi_grid, Real* pblh, Real* tke, Real* tk, Real* tkh, Real* isotropy) { @@ -3499,7 +3130,7 @@ void shoc_tke_f(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, Real ekat::device_to_host({tke, tk, tkh, isotropy}, shcol, nlev, inout_views, true); } -void compute_shoc_temperature_f(Int shcol, Int nlev, Real *thetal, Real *ql, Real *inv_exner, Real* tabs) +void compute_shoc_temperature_host(Int shcol, Int nlev, Real *thetal, Real *ql, Real *inv_exner, Real* tabs) { using SHF = Functions; diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index bc61efb168e..87497784c57 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1069,7 +1069,7 @@ struct ComputeShocTempData : public PhysicsTestData { PTD_STD_DEF(ComputeShocTempData, 2, shcol, nlev); }; -// Glue functions to call fortran from from C++ with the Data struct +// Glue functions to call from host with the Data struct void shoc_grid (ShocGridData& d); void shoc_diag_obklen (ShocDiagObklenData& d); @@ -1138,87 +1138,88 @@ void pblintd_surf_temp(PblintdSurfTempData& d); void pblintd_check_pblh(PblintdCheckPblhData& d); void pblintd(PblintdData& d); void compute_shoc_temperature(ComputeShocTempData& d); -extern "C" { // _f function decls -void calc_shoc_varorcovar_f(Int shcol, Int nlev, Int nlevi, Real tunefac, +// Call from host + +void calc_shoc_varorcovar_host(Int shcol, Int nlev, Int nlevi, Real tunefac, Real *isotropy_zi, Real *tkh_zi, Real *dz_zi, Real *invar1, Real *invar2, Real *varorcovar); -void calc_shoc_vertflux_f(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, +void calc_shoc_vertflux_host(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, Real *dz_zi, Real *invar, Real *vertflux); -void shoc_diag_second_moments_srf_f(Int shcol, Real* wthl, Real* uw, Real* vw, +void shoc_diag_second_moments_srf_host(Int shcol, Real* wthl, Real* uw, Real* vw, Real* ustar2, Real* wstar); -void shoc_diag_second_moments_ubycond_f(Int shcol, Real* thl, Real* qw, Real* wthl, +void shoc_diag_second_moments_ubycond_host(Int shcol, Real* thl, Real* qw, Real* wthl, Real* wqw, Real* qwthl, Real* uw, Real* vw, Real* wtke); -void update_host_dse_f(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* inv_exner, Real* zt_grid, +void update_host_dse_host(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* inv_exner, Real* zt_grid, Real* phis, Real* host_dse); -void compute_diag_third_shoc_moment_f(Int shcol, Int nlev, Int nlevi, Real* w_sec, +void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* tke, Real* dz_zt, Real* dz_zi, Real* isotropy_zi, Real* brunt_zi, Real* w_sec_zi, Real* thetal_zi, Real* w3); -void shoc_pblintd_init_pot_f(Int shcol, Int nlev, Real* thl, Real* ql, Real* q, Real* thv); -void compute_shoc_mix_shoc_length_f(Int nlev, Int shcol, Real* tke, Real* brunt, +void shoc_pblintd_init_pot_host(Int shcol, Int nlev, Real* thl, Real* ql, Real* q, Real* thv); +void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* brunt, Real* zt_grid, Real* l_inf, Real* shoc_mix); -void check_tke_f(Int shcol, Int nlev, Real* tke); -void linear_interp_f(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, Int ncol, Real minthresh); -void clipping_diag_third_shoc_moments_f(Int nlevi, Int shcol, Real *w_sec_zi, +void check_tke_host(Int shcol, Int nlev, Real* tke); +void linear_interp_host(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, Int ncol, Real minthresh); +void clipping_diag_third_shoc_moments_host(Int nlevi, Int shcol, Real *w_sec_zi, Real *w3); -void shoc_energy_integrals_f(Int shcol, Int nlev, Real *host_dse, Real *pdel, +void shoc_energy_integrals_host(Int shcol, Int nlev, Real *host_dse, Real *pdel, Real *rtm, Real *rcm, Real *u_wind, Real *v_wind, Real *se_int, Real *ke_int, Real *wv_int, Real *wl_int); -void compute_brunt_shoc_length_f(Int nlev, Int nlevi, Int shcol, Real* dz_zt, Real* thv, +void compute_brunt_shoc_length_host(Int nlev, Int nlevi, Int shcol, Real* dz_zt, Real* thv, Real* thv_zi, Real* brunt); -void compute_l_inf_shoc_length_f(Int nlev, Int shcol, Real *zt_grid, Real *dz_zt, +void compute_l_inf_shoc_length_host(Int nlev, Int shcol, Real *zt_grid, Real *dz_zt, Real *tke, Real *l_inf); -void check_length_scale_shoc_length_f(Int nlev, Int shcol, Real* host_dx, Real* host_dy, +void check_length_scale_shoc_length_host(Int nlev, Int shcol, Real* host_dx, Real* host_dy, Real* shoc_mix); -void diag_second_moments_lbycond_f(Int shcol, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar, +void diag_second_moments_lbycond_host(Int shcol, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar, Real* wthl_sec, Real* wqw_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* thl_sec, Real* qw_sec, Real* qwthl_sec); -void diag_second_moments_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, +void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec); -void diag_second_shoc_moments_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, +void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, Real* isotropy, Real* tkh, Real* tk, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* shoc_mix, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* wqw_sec, Real* qwthl_sec, Real* uw_sec, Real* vw_sec, Real* wtke_sec, Real* w_sec); -void shoc_diag_obklen_f(Int shcol, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, +void shoc_diag_obklen_host(Int shcol, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, Real* thl_sfc, Real* cldliq_sfc, Real* qv_sfc, Real* ustar, Real* kbfs, Real* obklen); -void shoc_pblintd_cldcheck_f(Int shcol, Int nlev, Int nlevi, Real* zi, Real* cldn, Real* pblh); -void compute_shr_prod_f(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_wind, Real* v_wind, Real* sterm); -void shoc_length_f(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_dy, +void shoc_pblintd_cldcheck_host(Int shcol, Int nlev, Int nlevi, Real* zi, Real* cldn, Real* pblh); +void compute_shr_prod_host(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_wind, Real* v_wind, Real* sterm); +void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_dy, Real* zt_grid, Real* zi_grid, Real*dz_zt, Real* tke, Real* thv, Real*brunt, Real* shoc_mix); -void shoc_energy_fixer_f(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, +void shoc_energy_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, Real* zi_grid, Real* se_b, Real* ke_b, Real* wv_b, Real* wl_b, Real* se_a, Real* ke_a, Real* wv_a, Real* wl_a, Real* wthl_sfc, Real* wqw_sfc, Real* rho_zt, Real* tke, Real* pint, Real* host_dse); -void compute_shoc_vapor_f(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv); -void update_prognostics_implicit_f(Int shcol, Int nlev, Int nlevi, Int num_tracer, Real dtime, +void compute_shoc_vapor_host(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv); +void update_prognostics_implicit_host(Int shcol, Int nlev, Int nlevi, Int num_tracer, Real dtime, Real* dz_zt, Real* dz_zi, Real* rho_zt, Real* zt_grid, Real* zi_grid, Real* tk, Real* tkh, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, Real* wtracer_sfc, Real* thetal, Real* qw, Real* tracer, Real* tke, Real* u_wind, Real* v_wind); -void diag_third_shoc_moments_f(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, +void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, Real* wthl_sec, Real* isotropy, Real* brunt, Real* thetal, Real* tke, Real* dz_zt, Real* dz_zi, Real* zt_grid, Real* zi_grid, Real* w3); -void adv_sgs_tke_f(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_sec, Real* sterm_zt, +void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_sec, Real* sterm_zt, Real* tk, Real* tke, Real* a_diss); -void shoc_assumed_pdf_f(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* w_field, +void shoc_assumed_pdf_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* w_field, Real* thl_sec, Real* qw_sec, Real* wthl_sec, Real* w_sec, Real* wqw_sec, Real* qwthl_sec, Real* w3, Real* pres, Real* zt_grid, Real* zi_grid, Real* shoc_cldfrac, Real* shoc_ql, Real* wqls, Real* wthv_sec, Real* shoc_ql2); -void compute_tmpi_f(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_zi, Real *tmpi); -void integ_column_stability_f(Int nlev, Int shcol, Real *dz_zt, +void compute_tmpi_host(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_zi, Real *tmpi); +void integ_column_stability_host(Int nlev, Int shcol, Real *dz_zt, Real *pres, Real *brunt, Real *brunt_int); -void isotropic_ts_f(Int nlev, Int shcol, Real* brunt_int, Real* tke, +void isotropic_ts_host(Int nlev, Int shcol, Real* brunt_int, Real* tke, Real* a_diss, Real* brunt, Real* isotropy); -void dp_inverse_f(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_zt); +void dp_inverse_host(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_zt); -int shoc_init_f(Int nlev, Real* pref_mid, Int nbot_shoc, Int ntop_shoc); -Int shoc_main_f(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npbl, Real* host_dx, Real* host_dy, Real* thv, +int shoc_init_host(Int nlev, Real* pref_mid, Int nbot_shoc, Int ntop_shoc); +Int shoc_main_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npbl, Real* host_dx, Real* host_dy, Real* thv, Real* zt_grid, Real* zi_grid, Real* pres, Real* presi, Real* pdel, Real* wthl_sfc, Real* wqw_sfc, Real* uw_sfc, Real* vw_sfc, Real* wtracer_sfc, Int num_qtracers, Real* w_field, Real* inv_exner, Real* phis, Real* host_dse, Real* tke, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, @@ -1227,24 +1228,23 @@ Int shoc_main_f(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npbl, Real* wthl_sec, Real* wqw_sec, Real* wtke_sec, Real* uw_sec, Real* vw_sec, Real* w3, Real* wqls_sec, Real* brunt, Real* shoc_ql2); -void pblintd_height_f(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* v, Real* ustar, Real* thv, Real* thv_ref, Real* pblh, Real* rino, bool* check); +void pblintd_height_host(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* v, Real* ustar, Real* thv, Real* thv_ref, Real* pblh, Real* rino, bool* check); -void vd_shoc_decomp_and_solve_f(Int shcol, Int nlev, Int nlevi, Int num_rhs, Real* kv_term, Real* tmpi, Real* rdp_zt, Real dtime, +void vd_shoc_decomp_and_solve_host(Int shcol, Int nlev, Int nlevi, Int num_rhs, Real* kv_term, Real* tmpi, Real* rdp_zt, Real dtime, Real* flux, Real* var); -void pblintd_surf_temp_f(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, Real* obklen, Real* kbfs, Real* thv, Real* tlv, Real* pblh, bool* check, Real* rino); +void pblintd_surf_temp_host(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, Real* obklen, Real* kbfs, Real* thv, Real* tlv, Real* pblh, bool* check, Real* rino); -void pblintd_check_pblh_f(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* ustar, bool* check, Real* pblh); +void pblintd_check_pblh_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* ustar, bool* check, Real* pblh); -void pblintd_f(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, Real* thl, Real* ql, Real* q, Real* u, Real* v, Real* ustar, Real* obklen, Real* kbfs, Real* cldn, Real* pblh); -void shoc_grid_f(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid, Real* pdel, Real* dz_zt, Real* dz_zi, Real* rho_zt); -void eddy_diffusivities_f(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, Real* isotropy, +void pblintd_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, Real* thl, Real* ql, Real* q, Real* u, Real* v, Real* ustar, Real* obklen, Real* kbfs, Real* cldn, Real* pblh); +void shoc_grid_host(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid, Real* pdel, Real* dz_zt, Real* dz_zi, Real* rho_zt); +void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, Real* isotropy, Real* tke, Real* tkh, Real* tk); -void shoc_tke_f(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, +void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, Real* shoc_mix, Real* dz_zi, Real* dz_zt, Real* pres, Real* u_wind, Real* v_wind, Real* brunt, Real* obklen, Real* zt_grid, Real* zi_grid, Real* pblh, Real* tke, Real* tk, Real* tkh, Real* isotropy); -void compute_shoc_temperature_f(Int shcol, Int nlev, Real* thetal, Real* ql, Real* inv_exner, Real* tabs); -} // end _f function decls +void compute_shoc_temperature_host(Int shcol, Int nlev, Real* thetal, Real* ql, Real* inv_exner, Real* tabs); } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp index a640952fad3..d392c9e905e 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp @@ -6,6 +6,7 @@ #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "share/util/scream_setup_random_test.hpp" #include "ekat/util/ekat_file_utils.hpp" +#include "ekat/util/ekat_test_utils.hpp" namespace scream { namespace shoc { @@ -68,7 +69,7 @@ struct UnitWrap { m_baseline_action(NONE), m_fid() { - Functions::shoc_init(); // many tests will need fortran table data + //Functions::shoc_init(); // many tests will need fortran table data auto& ts = ekat::TestSession::get(); auto raw_flags = ts.flags.begin()->first; std::stringstream ss(raw_flags); @@ -106,7 +107,6 @@ struct UnitWrap { ~Base() { - scream::shoc::SHOCGlobalForFortran::deinit(); } std::mt19937_64 get_engine() diff --git a/components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp index d6d7d522d66..7c8223f3530 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp index ed5d50199e6..feea510aa49 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocAssumedPdf { +struct UnitWrap::UnitTest::TestShocAssumedPdf : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -141,13 +141,7 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf { REQUIRE(SDS.shcol == 2); // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); + shoc_assumed_pdf(SDS); // Verify the result // Make sure cloud fraction is either 1 or 0 and all @@ -186,13 +180,7 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf { } // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); + shoc_assumed_pdf(SDS); // Verify the result // Make sure cloud fraction is either 1 or 0 and all @@ -250,13 +238,7 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf { } // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); + shoc_assumed_pdf(SDS); // Check the result @@ -340,13 +322,7 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf { } // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.w_field, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.w_sec, SDS.wqw_sec, - SDS.qwthl_sec, SDS.w3, SDS.pres, SDS.zt_grid, SDS.zi_grid, - SDS.shoc_cldfrac, SDS.shoc_ql, SDS.wqls, SDS.wthv_sec, SDS.shoc_ql2); - SDS.transpose(); + shoc_assumed_pdf(SDS); // Check the result @@ -415,11 +391,11 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocAssumedPdfData SDS_f90[] = { + ShocAssumedPdfData SDS_baseline[] = { // shcol, nlev, nlevi ShocAssumedPdfData(10, 71, 72), ShocAssumedPdfData(10, 12, 13), @@ -428,56 +404,54 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine, { {d.thetal, {500, 700}}, {d.zi_grid, {0, 100}}, }); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocAssumedPdfData SDS_cxx[] = { - ShocAssumedPdfData(SDS_f90[0]), - ShocAssumedPdfData(SDS_f90[1]), - ShocAssumedPdfData(SDS_f90[2]), - ShocAssumedPdfData(SDS_f90[3]), + ShocAssumedPdfData(SDS_baseline[0]), + ShocAssumedPdfData(SDS_baseline[1]), + ShocAssumedPdfData(SDS_baseline[2]), + ShocAssumedPdfData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - shoc_assumed_pdf(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - shoc_assumed_pdf_f(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, - d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, - d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, - d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); - d.transpose(); + shoc_assumed_pdf(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ShocAssumedPdfData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocAssumedPdfData); for (Int i = 0; i < num_runs; ++i) { - ShocAssumedPdfData& d_f90 = SDS_f90[i]; + ShocAssumedPdfData& d_baseline = SDS_baseline[i]; ShocAssumedPdfData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.wqls); ++k) { - REQUIRE(d_f90.shoc_cldfrac[k] == d_cxx.shoc_cldfrac[k]); - REQUIRE(d_f90.shoc_ql[k] == d_cxx.shoc_ql[k]); - REQUIRE(d_f90.wqls[k] == d_cxx.wqls[k]); - REQUIRE(d_f90.wthv_sec[k] == d_cxx.wthv_sec[k]); - REQUIRE(d_f90.shoc_ql2[k] == d_cxx.shoc_ql2[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.wqls); ++k) { + REQUIRE(d_baseline.shoc_cldfrac[k] == d_cxx.shoc_cldfrac[k]); + REQUIRE(d_baseline.shoc_ql[k] == d_cxx.shoc_ql[k]); + REQUIRE(d_baseline.wqls[k] == d_cxx.wqls[k]); + REQUIRE(d_baseline.wthv_sec[k] == d_cxx.wthv_sec[k]); + REQUIRE(d_baseline.shoc_ql2[k] == d_cxx.shoc_ql2[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -491,14 +465,14 @@ TEST_CASE("shoc_assumed_pdf_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAssumedPdf; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_assumed_pdf_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAssumedPdf; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp index b07ea8ee968..3b679b609c8 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestCompBruntShocLength { +struct UnitWrap::UnitTest::TestCompBruntShocLength : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -91,10 +91,7 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength { } // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - compute_brunt_shoc_length_f(SDS.nlev,SDS.nlevi,SDS.shcol,SDS.dz_zt,SDS.thv,SDS.thv_zi,SDS.brunt); - SDS.transpose(); + compute_brunt_shoc_length(SDS); // Check the results for(Int s = 0; s < shcol; ++s) { @@ -124,11 +121,11 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeBruntShocLengthData SDS_f90[] = { + ComputeBruntShocLengthData SDS_baseline[] = { // shcol, nlev, nlevi ComputeBruntShocLengthData(10, 71, 72), ComputeBruntShocLengthData(10, 12, 13), @@ -137,46 +134,47 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeBruntShocLengthData SDS_cxx[] = { - ComputeBruntShocLengthData(SDS_f90[0]), - ComputeBruntShocLengthData(SDS_f90[1]), - ComputeBruntShocLengthData(SDS_f90[2]), - ComputeBruntShocLengthData(SDS_f90[3]), + ComputeBruntShocLengthData(SDS_baseline[0]), + ComputeBruntShocLengthData(SDS_baseline[1]), + ComputeBruntShocLengthData(SDS_baseline[2]), + ComputeBruntShocLengthData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - compute_brunt_shoc_length(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - compute_brunt_shoc_length_f(d.nlev,d.nlevi,d.shcol,d.dz_zt,d.thv,d.thv_zi,d.brunt); - d.transpose(); + compute_brunt_shoc_length(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ComputeBruntShocLengthData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeBruntShocLengthData); for (Int i = 0; i < num_runs; ++i) { - ComputeBruntShocLengthData& d_f90 = SDS_f90[i]; + ComputeBruntShocLengthData& d_baseline = SDS_baseline[i]; ComputeBruntShocLengthData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.brunt); ++k) { - REQUIRE(d_f90.brunt[k] == d_cxx.brunt[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.brunt); ++k) { + REQUIRE(d_baseline.brunt[k] == d_cxx.brunt[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -190,14 +188,14 @@ TEST_CASE("shoc_brunt_length_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCompBruntShocLength; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_brunt_length_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCompBruntShocLength; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp index 5f822fb83c1..973cbc5c068 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestCheckShocLength { +struct UnitWrap::UnitTest::TestCheckShocLength : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real maxlen = scream::shoc::Constants::maxlen; static constexpr Real minlen = scream::shoc::Constants::minlen; @@ -76,10 +76,7 @@ struct UnitWrap::UnitTest::TestCheckShocLength { } // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - check_length_scale_shoc_length_f(SDS.nlev,SDS.shcol,SDS.host_dx,SDS.host_dy,SDS.shoc_mix); - SDS.transpose(); + check_length_scale_shoc_length(SDS); // Check the results for(Int s = 0; s < shcol; ++s) { @@ -94,11 +91,11 @@ struct UnitWrap::UnitTest::TestCheckShocLength { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - CheckLengthScaleShocLengthData SDS_f90[] = { + CheckLengthScaleShocLengthData SDS_baseline[] = { // shcol, nlev CheckLengthScaleShocLengthData(10, 71), CheckLengthScaleShocLengthData(10, 12), @@ -107,46 +104,47 @@ struct UnitWrap::UnitTest::TestCheckShocLength { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state CheckLengthScaleShocLengthData SDS_cxx[] = { - CheckLengthScaleShocLengthData(SDS_f90[0]), - CheckLengthScaleShocLengthData(SDS_f90[1]), - CheckLengthScaleShocLengthData(SDS_f90[2]), - CheckLengthScaleShocLengthData(SDS_f90[3]), + CheckLengthScaleShocLengthData(SDS_baseline[0]), + CheckLengthScaleShocLengthData(SDS_baseline[1]), + CheckLengthScaleShocLengthData(SDS_baseline[2]), + CheckLengthScaleShocLengthData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - check_length_scale_shoc_length(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - check_length_scale_shoc_length_f(d.nlev,d.shcol,d.host_dx,d.host_dy,d.shoc_mix); - d.transpose(); + check_length_scale_shoc_length(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(CheckLengthScaleShocLengthData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CheckLengthScaleShocLengthData); for (Int i = 0; i < num_runs; ++i) { - CheckLengthScaleShocLengthData& d_f90 = SDS_f90[i]; + CheckLengthScaleShocLengthData& d_baseline = SDS_baseline[i]; CheckLengthScaleShocLengthData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.shoc_mix); ++k) { - REQUIRE(d_f90.shoc_mix[k] == d_cxx.shoc_mix[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.shoc_mix); ++k) { + REQUIRE(d_baseline.shoc_mix[k] == d_cxx.shoc_mix[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -160,14 +158,14 @@ TEST_CASE("shoc_check_length_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCheckShocLength; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_check_length_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCheckShocLength; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp index 8dc28e59423..a4d6886530c 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocCheckTke { +struct UnitWrap::UnitTest::TestShocCheckTke : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real mintke = scream::shoc::Constants::mintke; static constexpr Int shcol = 2; @@ -53,10 +53,7 @@ struct UnitWrap::UnitTest::TestShocCheckTke { REQUIRE((SDS.shcol > 0 && SDS.nlev > 0)); // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - check_tke_f(SDS.nlev, SDS.shcol, SDS.tke); - SDS.transpose(); + check_tke(SDS); // Check the result against the input values for(Int s = 0; s < shcol; ++s) { @@ -76,11 +73,11 @@ struct UnitWrap::UnitTest::TestShocCheckTke { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - CheckTkeData SDS_f90[] = { + CheckTkeData SDS_baseline[] = { // shcol, nlev CheckTkeData(10, 71), CheckTkeData(10, 12), @@ -89,46 +86,47 @@ struct UnitWrap::UnitTest::TestShocCheckTke { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state CheckTkeData SDS_cxx[] = { - CheckTkeData(SDS_f90[0]), - CheckTkeData(SDS_f90[1]), - CheckTkeData(SDS_f90[2]), - CheckTkeData(SDS_f90[3]), + CheckTkeData(SDS_baseline[0]), + CheckTkeData(SDS_baseline[1]), + CheckTkeData(SDS_baseline[2]), + CheckTkeData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - check_tke(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - check_tke_f(d.nlev, d.shcol, d.tke); - d.transpose(); + check_tke_host(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(CheckTkeData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CheckTkeData); for (Int i = 0; i < num_runs; ++i) { - CheckTkeData& d_f90 = SDS_f90[i]; + CheckTkeData& d_baseline = SDS_baseline[i]; CheckTkeData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.tke); ++k) { - REQUIRE(d_f90.tke[k] == d_cxx.tke[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.tke); ++k) { + REQUIRE(d_baseline.tke[k] == d_cxx.tke[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -143,14 +141,14 @@ TEST_CASE("shoc_check_tke_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocCheckTke; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_check_tke_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocCheckTke; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp index 0498d0d9602..a76cf0a5b71 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestClipThirdMoms { +struct UnitWrap::UnitTest::TestClipThirdMoms : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlevi = 5; @@ -83,10 +83,7 @@ struct UnitWrap::UnitTest::TestClipThirdMoms { } // Call the C++ implementation. - SDS.transpose(); - // expects data in fortran layout - clipping_diag_third_shoc_moments_f(SDS.nlevi,SDS.shcol,SDS.w_sec_zi,SDS.w3); - SDS.transpose(); + clipping_diag_third_shoc_moments(SDS); // Check the result // For large values of w3, verify that the result has been reduced @@ -103,11 +100,11 @@ struct UnitWrap::UnitTest::TestClipThirdMoms { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ClippingDiagThirdShocMomentsData SDS_f90[] = { + ClippingDiagThirdShocMomentsData SDS_baseline[] = { // shcol, nlevi ClippingDiagThirdShocMomentsData(10, 72), ClippingDiagThirdShocMomentsData(10, 13), @@ -116,46 +113,47 @@ struct UnitWrap::UnitTest::TestClipThirdMoms { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ClippingDiagThirdShocMomentsData SDS_cxx[] = { - ClippingDiagThirdShocMomentsData(SDS_f90[0]), - ClippingDiagThirdShocMomentsData(SDS_f90[1]), - ClippingDiagThirdShocMomentsData(SDS_f90[2]), - ClippingDiagThirdShocMomentsData(SDS_f90[3]), + ClippingDiagThirdShocMomentsData(SDS_baseline[0]), + ClippingDiagThirdShocMomentsData(SDS_baseline[1]), + ClippingDiagThirdShocMomentsData(SDS_baseline[2]), + ClippingDiagThirdShocMomentsData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - clipping_diag_third_shoc_moments(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - clipping_diag_third_shoc_moments_f(d.nlevi,d.shcol,d.w_sec_zi,d.w3); - d.transpose(); + clipping_diag_third_shoc_moments(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ClippingDiagThirdShocMomentsData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ClippingDiagThirdShocMomentsData); for (Int i = 0; i < num_runs; ++i) { - ClippingDiagThirdShocMomentsData& d_f90 = SDS_f90[i]; + ClippingDiagThirdShocMomentsData& d_baseline = SDS_baseline[i]; ClippingDiagThirdShocMomentsData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.w3); ++k) { - REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.w3); ++k) { + REQUIRE(d_baseline.w3[k] == d_cxx.w3[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -169,14 +167,14 @@ TEST_CASE("shoc_clip_third_moms_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestClipThirdMoms; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_clip_third_moms_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestClipThirdMoms; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp index efcbbf4f2bc..ba27d5ed945 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocCompDiagThird { +struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -146,14 +146,7 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - compute_diag_third_shoc_moment_f(SDS.shcol,SDS.nlev,SDS.nlevi,SDS.w_sec,SDS.thl_sec, - SDS.wthl_sec,SDS.tke,SDS.dz_zt, - SDS.dz_zi,SDS.isotropy_zi, - SDS.brunt_zi,SDS.w_sec_zi,SDS.thetal_zi, - SDS.w3); - SDS.transpose(); + compute_diag_third_shoc_moment(SDS); // Check the result @@ -193,11 +186,11 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeDiagThirdShocMomentData SDS_f90[] = { + ComputeDiagThirdShocMomentData SDS_baseline[] = { // shcol, nlev, nlevi ComputeDiagThirdShocMomentData(10, 71, 72), ComputeDiagThirdShocMomentData(10, 12, 13), @@ -206,50 +199,47 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeDiagThirdShocMomentData SDS_cxx[] = { - ComputeDiagThirdShocMomentData(SDS_f90[0]), - ComputeDiagThirdShocMomentData(SDS_f90[1]), - ComputeDiagThirdShocMomentData(SDS_f90[2]), - ComputeDiagThirdShocMomentData(SDS_f90[3]), + ComputeDiagThirdShocMomentData(SDS_baseline[0]), + ComputeDiagThirdShocMomentData(SDS_baseline[1]), + ComputeDiagThirdShocMomentData(SDS_baseline[2]), + ComputeDiagThirdShocMomentData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - compute_diag_third_shoc_moment(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - compute_diag_third_shoc_moment_f(d.shcol,d.nlev,d.nlevi,d.w_sec,d.thl_sec, - d.wthl_sec,d.tke,d.dz_zt, - d.dz_zi,d.isotropy_zi, - d.brunt_zi,d.w_sec_zi,d.thetal_zi, - d.w3); - d.transpose(); + compute_diag_third_shoc_moment(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ComputeDiagThirdShocMomentData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeDiagThirdShocMomentData); for (Int i = 0; i < num_runs; ++i) { - ComputeDiagThirdShocMomentData& d_f90 = SDS_f90[i]; + ComputeDiagThirdShocMomentData& d_baseline = SDS_baseline[i]; ComputeDiagThirdShocMomentData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.w3); ++k) { - REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.w3); ++k) { + REQUIRE(d_baseline.w3[k] == d_cxx.w3[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -263,14 +253,14 @@ TEST_CASE("shoc_comp_diag_third_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocCompDiagThird; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_comp_diag_third_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocCompDiagThird; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp index 86b8f796d38..21dfbf69cf8 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestComputeShocTemp { +struct UnitWrap::UnitTest::TestComputeShocTemp : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 1; static constexpr Int nlev = 3; @@ -68,9 +68,7 @@ struct UnitWrap::UnitTest::TestComputeShocTemp { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - compute_shoc_temperature_f(SDS.shcol, SDS.nlev, SDS.thetal, SDS.ql, SDS.inv_exner, SDS.tabs); - SDS.transpose(); // go back to C layout + compute_shoc_temperature(SDS); // Require that absolute temperature is equal to thetal for(Int s = 0; s < shcol; ++s) { @@ -116,9 +114,7 @@ struct UnitWrap::UnitTest::TestComputeShocTemp { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - compute_shoc_temperature_f(SDS.shcol, SDS.nlev, SDS.thetal, SDS.ql, SDS.inv_exner, SDS.tabs); - SDS.transpose(); // go back to C layout + compute_shoc_temperature(SDS); // Require that absolute temperature is greather than thetal for(Int s = 0; s < shcol; ++s) { @@ -177,9 +173,7 @@ struct UnitWrap::UnitTest::TestComputeShocTemp { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - compute_shoc_temperature_f(SDS.shcol, SDS.nlev, SDS.thetal, SDS.ql, SDS.inv_exner, SDS.tabs); - SDS.transpose(); // go back to C layout + compute_shoc_temperature(SDS); // Require that absolute temperature be less than thetal for(Int s = 0; s < shcol; ++s) { @@ -202,11 +196,11 @@ struct UnitWrap::UnitTest::TestComputeShocTemp { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeShocTempData f90_data[] = { + ComputeShocTempData baseline_data[] = { // shcol, nlev ComputeShocTempData(10, 71), ComputeShocTempData(10, 12), @@ -215,45 +209,47 @@ struct UnitWrap::UnitTest::TestComputeShocTemp { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeShocTempData cxx_data[] = { - ComputeShocTempData(f90_data[0]), - ComputeShocTempData(f90_data[1]), - ComputeShocTempData(f90_data[2]), - ComputeShocTempData(f90_data[3]), + ComputeShocTempData(baseline_data[0]), + ComputeShocTempData(baseline_data[1]), + ComputeShocTempData(baseline_data[2]), + ComputeShocTempData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - compute_shoc_temperature(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - compute_shoc_temperature_f(d.shcol, d.nlev, d.thetal, d.ql, d.inv_exner, d.tabs); - d.transpose(); // go back to C layout + compute_shoc_temperature(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ComputeShocTempData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ComputeShocTempData); for (Int i = 0; i < num_runs; ++i) { - ComputeShocTempData& d_f90 = f90_data[i]; + ComputeShocTempData& d_baseline = baseline_data[i]; ComputeShocTempData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.tabs); ++k) { - REQUIRE(d_f90.tabs[k] == d_cxx.tabs[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.tabs); ++k) { + REQUIRE(d_baseline.tabs[k] == d_cxx.tabs[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -267,14 +263,14 @@ TEST_CASE("shoc_compute_shoc_temperature_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestComputeShocTemp; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_compute_shoc_temperature_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestComputeShocTemp; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp index 38e13fcbf8d..6aedf7a0adf 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestComputeShocVapor { +struct UnitWrap::UnitTest::TestComputeShocVapor : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -63,9 +63,7 @@ struct UnitWrap::UnitTest::TestComputeShocVapor { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - compute_shoc_vapor_f(SDS.shcol, SDS.nlev, SDS.qw, SDS.ql, SDS.qv); - SDS.transpose(); // go back to C layout + compute_shoc_vapor(SDS); // Verify the result for(Int s = 0; s < shcol; ++s) { @@ -88,11 +86,11 @@ struct UnitWrap::UnitTest::TestComputeShocVapor { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeShocVaporData f90_data[] = { + ComputeShocVaporData baseline_data[] = { // shcol, nlev ComputeShocVaporData(10, 71), ComputeShocVaporData(10, 12), @@ -101,45 +99,47 @@ struct UnitWrap::UnitTest::TestComputeShocVapor { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeShocVaporData cxx_data[] = { - ComputeShocVaporData(f90_data[0]), - ComputeShocVaporData(f90_data[1]), - ComputeShocVaporData(f90_data[2]), - ComputeShocVaporData(f90_data[3]), + ComputeShocVaporData(baseline_data[0]), + ComputeShocVaporData(baseline_data[1]), + ComputeShocVaporData(baseline_data[2]), + ComputeShocVaporData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - compute_shoc_vapor(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - compute_shoc_vapor_f(d.shcol, d.nlev, d.qw, d.ql, d.qv); - d.transpose(); // go back to C layout + compute_shoc_vapor(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ComputeShocVaporData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ComputeShocVaporData); for (Int i = 0; i < num_runs; ++i) { - ComputeShocVaporData& d_f90 = f90_data[i]; + ComputeShocVaporData& d_baseline = baseline_data[i]; ComputeShocVaporData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.qv); ++k) { - REQUIRE(d_f90.qv[k] == d_cxx.qv[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.qv); ++k) { + REQUIRE(d_baseline.qv[k] == d_cxx.qv[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -153,14 +153,14 @@ TEST_CASE("compute_shoc_vapor_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestComputeShocVapor; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("compute_shoc_vapor_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestComputeShocVapor; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp index da07b632434..cd48afea56f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "physics/share/physics_constants.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocDiagObklen { +struct UnitWrap::UnitTest::TestShocDiagObklen : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 5; @@ -84,12 +84,7 @@ struct UnitWrap::UnitTest::TestShocDiagObklen { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - shoc_diag_obklen_f(SDS.shcol, SDS.uw_sfc, SDS.vw_sfc, SDS.wthl_sfc, SDS.wqw_sfc, - SDS.thl_sfc, SDS.cldliq_sfc, SDS.qv_sfc, SDS.ustar, SDS.kbfs, - SDS.obklen); - SDS.transpose(); + shoc_diag_obklen(SDS); // Check the result @@ -154,12 +149,7 @@ struct UnitWrap::UnitTest::TestShocDiagObklen { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - shoc_diag_obklen_f(SDS.shcol, SDS.uw_sfc, SDS.vw_sfc, SDS.wthl_sfc, SDS.wqw_sfc, - SDS.thl_sfc, SDS.cldliq_sfc, SDS.qv_sfc, SDS.ustar, SDS.kbfs, - SDS.obklen); - SDS.transpose(); + shoc_diag_obklen(SDS); // Verify that DIMENSIONLESS obukhov length decreases as columns // increases due to the increasing surface fluxes @@ -172,11 +162,11 @@ struct UnitWrap::UnitTest::TestShocDiagObklen { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocDiagObklenData SDS_f90[] = { + ShocDiagObklenData SDS_baseline[] = { // shcol ShocDiagObklenData(12), ShocDiagObklenData(10), @@ -185,50 +175,50 @@ struct UnitWrap::UnitTest::TestShocDiagObklen { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocDiagObklenData SDS_cxx[] = { - ShocDiagObklenData(SDS_f90[0]), - ShocDiagObklenData(SDS_f90[1]), - ShocDiagObklenData(SDS_f90[2]), - ShocDiagObklenData(SDS_f90[3]) + ShocDiagObklenData(SDS_baseline[0]), + ShocDiagObklenData(SDS_baseline[1]), + ShocDiagObklenData(SDS_baseline[2]), + ShocDiagObklenData(SDS_baseline[3]) }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocDiagObklenData); + // Assume all data is in C layout - // Get data from fortran - for (auto& d : SDS_f90) { - // expects data in C layout - shoc_diag_obklen(d); + // Read baseline data + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - shoc_diag_obklen_f(d.shcol, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, - d.thl_sfc, d.cldliq_sfc, d.qv_sfc, d.ustar, d.kbfs, - d.obklen); - d.transpose(); + shoc_diag_obklen(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ShocDiagObklenData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { for (Int i = 0; i < num_runs; ++i) { - ShocDiagObklenData& d_f90 = SDS_f90[i]; + ShocDiagObklenData& d_baseline = SDS_baseline[i]; ShocDiagObklenData& d_cxx = SDS_cxx[i]; - for (Int s = 0; s < d_f90.shcol; ++s) { - REQUIRE(d_f90.ustar[s] == d_cxx.ustar[s]); - REQUIRE(d_f90.kbfs[s] == d_cxx.kbfs[s]); - REQUIRE(d_f90.obklen[s] == d_cxx.obklen[s]); + for (Int s = 0; s < d_baseline.shcol; ++s) { + REQUIRE(d_baseline.ustar[s] == d_cxx.ustar[s]); + REQUIRE(d_baseline.kbfs[s] == d_cxx.kbfs[s]); + REQUIRE(d_baseline.obklen[s] == d_cxx.obklen[s]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + SDS_cxx[i].write(Base::m_fid); + } + } } }; @@ -242,14 +232,14 @@ TEST_CASE("shoc_diag_obklen_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocDiagObklen; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_diag_obklen_length_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocDiagObklen; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp index c1770c45855..5ec4ac51e56 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestSecondMomSrf { +struct UnitWrap::UnitTest::TestSecondMomSrf : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { // Property test for the SHOC subroutine: // diag_second_moments_srf @@ -52,7 +52,7 @@ struct UnitWrap::UnitTest::TestSecondMomSrf { } // Call the C++ implementation - shoc_diag_second_moments_srf_f(SDS.shcol, SDS.wthl_sfc, SDS.uw_sfc, SDS.vw_sfc, SDS.ustar2, SDS.wstar); + shoc_diag_second_moments_srf(SDS); // Verify the output for (Int s = 0; s < shcol; ++s){ @@ -82,12 +82,12 @@ struct UnitWrap::UnitTest::TestSecondMomSrf { } - static void run_bfb() + void run_bfb() { #if 0 - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - SHOCSecondMomentSrfData mom_srf_data_f90[] = { + SHOCSecondMomentSrfData mom_srf_data_baseline[] = { // shcol SHOCSecondMomentSrfData(36), SHOCSecondMomentSrfData(72), @@ -95,36 +95,41 @@ struct UnitWrap::UnitTest::TestSecondMomSrf { SHOCSecondMomentSrfData(256), }; - for (auto& d : mom_srf_data_f90) { + for (auto& d : mom_srf_data_baseline) { d.randomize(engine, { {d.wthl, {-1, 1}} }); } SHOCSecondMomentSrfData mom_srf_data_cxx[] = { - SHOCSecondMomentSrfData(mom_srf_data_f90[0]), - SHOCSecondMomentSrfData(mom_srf_data_f90[1]), - SHOCSecondMomentSrfData(mom_srf_data_f90[2]), - SHOCSecondMomentSrfData(mom_srf_data_f90[3]), + SHOCSecondMomentSrfData(mom_srf_data_baseline[0]), + SHOCSecondMomentSrfData(mom_srf_data_baseline[1]), + SHOCSecondMomentSrfData(mom_srf_data_baseline[2]), + SHOCSecondMomentSrfData(mom_srf_data_baseline[3]), }; - for (auto& d : mom_srf_data_f90) { + for (auto& d : mom_srf_data_baseline) { // expects data in C layout shoc_diag_second_moments_srf(d); } for (auto& d : mom_srf_data_cxx) { - shoc_diag_second_moments_srf_f(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); + shoc_diag_second_moments_srf(d); } - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(mom_srf_data_f90) / sizeof(SHOCSecondMomentSrfData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(mom_srf_data_baseline) / sizeof(SHOCSecondMomentSrfData); for (Int i = 0; i < num_runs; ++i) { Int shcol = mom_srf_data_cxx[i].shcol; for (Int k = 0; k < shcol; ++k) { - REQUIRE(mom_srf_data_f90[i].ustar2[k] == mom_srf_data_cxx[i].ustar2[k]); - REQUIRE(mom_srf_data_f90[i].wstar[k] == mom_srf_data_cxx[i].wstar[k]); + REQUIRE(mom_srf_data_baseline[i].ustar2[k] == mom_srf_data_cxx[i].ustar2[k]); + REQUIRE(mom_srf_data_baseline[i].wstar[k] == mom_srf_data_cxx[i].wstar[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } #endif } @@ -139,13 +144,13 @@ namespace { TEST_CASE("shoc_second_moments_srf_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestSecondMomSrf; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_second_moments_srf_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestSecondMomSrf; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp index 1bae79c852d..c1c526a8cad 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -23,9 +23,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestSecondMomUbycond { +struct UnitWrap::UnitTest::TestSecondMomUbycond : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { // Property test for SHOC subroutine: // diag_second_moments_ubycond @@ -43,8 +43,7 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond { REQUIRE(shcol > 0); // Call the C++ implementation - shoc_diag_second_moments_ubycond_f(SDS.shcol, SDS.thl_sec, SDS.qw_sec, SDS.qwthl_sec, SDS.wthl_sec, - SDS.wqw_sec, SDS.uw_sec, SDS.vw_sec, SDS.wtke_sec); + shoc_diag_second_moments_ubycond(SDS); // Verify the result // all output should be zero. @@ -61,9 +60,9 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); DiagSecondMomentsUbycondData uby_fortran[] = { // shcol @@ -79,7 +78,7 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state DiagSecondMomentsUbycondData uby_cxx[num_runs] = { DiagSecondMomentsUbycondData(uby_fortran[0]), @@ -88,16 +87,16 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond { DiagSecondMomentsUbycondData(uby_fortran[3]), }; - // Get data from fortran + // Read baseline data for (auto& d : uby_fortran) { - diag_second_moments_ubycond(d); + d.read(Base::m_fid); } for (auto& d : uby_cxx) { - shoc_diag_second_moments_ubycond_f(d.shcol, d.thl_sec, d.qw_sec, d.qwthl_sec, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec); + shoc_diag_second_moments_ubycond(d); } - if (SCREAM_BFB_TESTING) { + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { for (Int i = 0; i < num_runs; ++i) { const Int shcol = uby_cxx[i].shcol; for (Int k = 0; k < shcol; ++k) { @@ -112,6 +111,11 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond { } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -126,14 +130,14 @@ TEST_CASE("second_mom_uby_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestSecondMomUbycond; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("second_mom_uby_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestSecondMomUbycond; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp index 36309052b47..7966ca13595 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond { +struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { // Property tests for the SHOC function // diag_second_moments_lbycond @@ -76,10 +76,7 @@ struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond { } // Call the C++ implementation - diag_second_moments_lbycond_f(SDS.shcol, SDS.wthl_sfc, SDS.wqw_sfc, SDS.uw_sfc, - SDS.vw_sfc, SDS.ustar2, SDS.wstar, SDS.wthl_sec, - SDS.wqw_sec, SDS.uw_sec, SDS.vw_sec, SDS.wtke_sec, - SDS.thl_sec, SDS.qw_sec, SDS.qwthl_sec); + diag_second_moments_lbycond(SDS); // Verify output is as expected for (Int s = 0; s < shcol; ++s){ @@ -118,11 +115,11 @@ struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - DiagSecondMomentsLbycondData f90_data[] = { + DiagSecondMomentsLbycondData baseline_data[] = { DiagSecondMomentsLbycondData(120), DiagSecondMomentsLbycondData(120), DiagSecondMomentsLbycondData(120), @@ -130,51 +127,54 @@ struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state DiagSecondMomentsLbycondData cxx_data[] = { - DiagSecondMomentsLbycondData(f90_data[0]), - DiagSecondMomentsLbycondData(f90_data[1]), - DiagSecondMomentsLbycondData(f90_data[2]), - DiagSecondMomentsLbycondData(f90_data[3]), + DiagSecondMomentsLbycondData(baseline_data[0]), + DiagSecondMomentsLbycondData(baseline_data[1]), + DiagSecondMomentsLbycondData(baseline_data[2]), + DiagSecondMomentsLbycondData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - diag_second_moments_lbycond(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - diag_second_moments_lbycond_f(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, - d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); + diag_second_moments_lbycond(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(DiagSecondMomentsLbycondData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(DiagSecondMomentsLbycondData); for (Int i = 0; i < num_runs; ++i) { - DiagSecondMomentsLbycondData& d_f90 = f90_data[i]; + DiagSecondMomentsLbycondData& d_baseline = baseline_data[i]; DiagSecondMomentsLbycondData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.shcol; ++k) { - REQUIRE(d_f90.wthl_sec[k] == d_cxx.wthl_sec[k]); - REQUIRE(d_f90.wqw_sec[k] == d_cxx.wqw_sec[k]); - REQUIRE(d_f90.uw_sec[k] == d_cxx.uw_sec[k]); - REQUIRE(d_f90.vw_sec[k] == d_cxx.vw_sec[k]); - REQUIRE(d_f90.wtke_sec[k] == d_cxx.wtke_sec[k]); - REQUIRE(d_f90.thl_sec[k] == d_cxx.thl_sec[k]); - REQUIRE(d_f90.qw_sec[k] == d_cxx.qw_sec[k]); - REQUIRE(d_f90.qwthl_sec[k] == d_cxx.qwthl_sec[k]); + for (Int k = 0; k < d_baseline.shcol; ++k) { + REQUIRE(d_baseline.wthl_sec[k] == d_cxx.wthl_sec[k]); + REQUIRE(d_baseline.wqw_sec[k] == d_cxx.wqw_sec[k]); + REQUIRE(d_baseline.uw_sec[k] == d_cxx.uw_sec[k]); + REQUIRE(d_baseline.vw_sec[k] == d_cxx.vw_sec[k]); + REQUIRE(d_baseline.wtke_sec[k] == d_cxx.wtke_sec[k]); + REQUIRE(d_baseline.thl_sec[k] == d_cxx.thl_sec[k]); + REQUIRE(d_baseline.qw_sec[k] == d_cxx.qw_sec[k]); + REQUIRE(d_baseline.qwthl_sec[k] == d_cxx.qwthl_sec[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -189,14 +189,14 @@ TEST_CASE("diag_second_moments_lbycond_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestDiagSecondMomentsLbycond; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("diag_second_moments_lbycond_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestDiagSecondMomentsLbycond; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp index 3dba867917b..f06e0097023 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestDiagSecondMoments { +struct UnitWrap::UnitTest::TestDiagSecondMoments : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -163,12 +163,7 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - diag_second_moments_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.u_wind, SDS.v_wind, - SDS.tke, SDS.isotropy, SDS.tkh, SDS.tk, SDS.dz_zi, SDS.zt_grid, SDS.zi_grid, SDS.shoc_mix, - SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.wqw_sec, SDS.qwthl_sec, SDS.uw_sec, - SDS.vw_sec, SDS.wtke_sec, SDS.w_sec); - SDS.transpose(); // go back to C layout + diag_second_moments(SDS); // Verify output makes sense for(Int s = 0; s < shcol; ++s) { @@ -254,11 +249,11 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - DiagSecondMomentsData f90_data[] = { + DiagSecondMomentsData baseline_data[] = { DiagSecondMomentsData(36, 72, 73), DiagSecondMomentsData(72, 72, 73), DiagSecondMomentsData(128, 72, 73), @@ -266,58 +261,57 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state DiagSecondMomentsData cxx_data[] = { - DiagSecondMomentsData(f90_data[0]), - DiagSecondMomentsData(f90_data[1]), - DiagSecondMomentsData(f90_data[2]), - DiagSecondMomentsData(f90_data[3]), + DiagSecondMomentsData(baseline_data[0]), + DiagSecondMomentsData(baseline_data[1]), + DiagSecondMomentsData(baseline_data[2]), + DiagSecondMomentsData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - diag_second_moments(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - diag_second_moments_f(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, - d.tke, d.isotropy, d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, - d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, - d.vw_sec, d.wtke_sec, d.w_sec); - d.transpose(); // go back to C layout + diag_second_moments(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(DiagSecondMomentsData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(DiagSecondMomentsData); for (Int i = 0; i < num_runs; ++i) { - DiagSecondMomentsData& d_f90 = f90_data[i]; + DiagSecondMomentsData& d_baseline = baseline_data[i]; DiagSecondMomentsData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.w_sec); ++k) { - REQUIRE(d_f90.w_sec[k] == d_cxx.w_sec[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.w_sec); ++k) { + REQUIRE(d_baseline.w_sec[k] == d_cxx.w_sec[k]); } - for (Int k = 0; k < d_f90.total(d_f90.thl_sec); ++k) { - REQUIRE(d_f90.thl_sec[k] == d_cxx.thl_sec[k]); - REQUIRE(d_f90.qw_sec[k] == d_cxx.qw_sec[k]); - REQUIRE(d_f90.wthl_sec[k] == d_cxx.wthl_sec[k]); - REQUIRE(d_f90.wqw_sec[k] == d_cxx.wqw_sec[k]); - REQUIRE(d_f90.qwthl_sec[k] == d_cxx.qwthl_sec[k]); - REQUIRE(d_f90.uw_sec[k] == d_cxx.uw_sec[k]); - REQUIRE(d_f90.vw_sec[k] == d_cxx.vw_sec[k]); - REQUIRE(d_f90.wtke_sec[k] == d_cxx.wtke_sec[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.thl_sec); ++k) { + REQUIRE(d_baseline.thl_sec[k] == d_cxx.thl_sec[k]); + REQUIRE(d_baseline.qw_sec[k] == d_cxx.qw_sec[k]); + REQUIRE(d_baseline.wthl_sec[k] == d_cxx.wthl_sec[k]); + REQUIRE(d_baseline.wqw_sec[k] == d_cxx.wqw_sec[k]); + REQUIRE(d_baseline.qwthl_sec[k] == d_cxx.qwthl_sec[k]); + REQUIRE(d_baseline.uw_sec[k] == d_cxx.uw_sec[k]); + REQUIRE(d_baseline.vw_sec[k] == d_cxx.vw_sec[k]); + REQUIRE(d_baseline.wtke_sec[k] == d_cxx.wtke_sec[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -332,14 +326,14 @@ TEST_CASE("diag_second_moments_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestDiagSecondMoments; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("diag_second_moments_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestDiagSecondMoments; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp index eab0fbead12..2585e1aa07f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestDiagSecondShocMoments { +struct UnitWrap::UnitTest::TestDiagSecondShocMoments : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; @@ -161,12 +161,7 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - diag_second_shoc_moments_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.thetal, SDS.qw, SDS.u_wind, SDS.v_wind, SDS.tke, SDS.isotropy, - SDS.tkh, SDS.tk, SDS.dz_zi, SDS.zt_grid, SDS.zi_grid, SDS.shoc_mix, SDS.wthl_sfc, SDS.wqw_sfc, - SDS.uw_sfc, SDS.vw_sfc, SDS.thl_sec, SDS.qw_sec, SDS.wthl_sec, SDS.wqw_sec, SDS.qwthl_sec, - SDS.uw_sec, SDS.vw_sec, SDS.wtke_sec, SDS.w_sec); - SDS.transpose(); // go back to C layout + diag_second_shoc_moments(SDS); // Verify output makes sense for(Int s = 0; s < shcol; ++s) { @@ -267,11 +262,11 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - DiagSecondShocMomentsData f90_data[] = { + DiagSecondShocMomentsData baseline_data[] = { DiagSecondShocMomentsData(36, 72, 73), DiagSecondShocMomentsData(72, 72, 73), DiagSecondShocMomentsData(128, 72, 73), @@ -279,57 +274,57 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state DiagSecondShocMomentsData cxx_data[] = { - DiagSecondShocMomentsData(f90_data[0]), - DiagSecondShocMomentsData(f90_data[1]), - DiagSecondShocMomentsData(f90_data[2]), - DiagSecondShocMomentsData(f90_data[3]), + DiagSecondShocMomentsData(baseline_data[0]), + DiagSecondShocMomentsData(baseline_data[1]), + DiagSecondShocMomentsData(baseline_data[2]), + DiagSecondShocMomentsData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - diag_second_shoc_moments(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - diag_second_shoc_moments_f(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, - d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, - d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); - d.transpose(); // go back to C layout + diag_second_shoc_moments(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(DiagSecondShocMomentsData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(DiagSecondShocMomentsData); for (Int i = 0; i < num_runs; ++i) { - DiagSecondShocMomentsData& d_f90 = f90_data[i]; + DiagSecondShocMomentsData& d_baseline = baseline_data[i]; DiagSecondShocMomentsData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.w_sec); ++k) { - REQUIRE(d_f90.w_sec[k] == d_cxx.w_sec[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.w_sec); ++k) { + REQUIRE(d_baseline.w_sec[k] == d_cxx.w_sec[k]); } - for (Int k = 0; k < d_f90.total(d_f90.thl_sec); ++k) { - REQUIRE(d_f90.thl_sec[k] == d_cxx.thl_sec[k]); - REQUIRE(d_f90.qw_sec[k] == d_cxx.qw_sec[k]); - REQUIRE(d_f90.wthl_sec[k] == d_cxx.wthl_sec[k]); - REQUIRE(d_f90.wqw_sec[k] == d_cxx.wqw_sec[k]); - REQUIRE(d_f90.qwthl_sec[k] == d_cxx.qwthl_sec[k]); - REQUIRE(d_f90.uw_sec[k] == d_cxx.uw_sec[k]); - REQUIRE(d_f90.vw_sec[k] == d_cxx.vw_sec[k]); - REQUIRE(d_f90.wtke_sec[k] == d_cxx.wtke_sec[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.thl_sec); ++k) { + REQUIRE(d_baseline.thl_sec[k] == d_cxx.thl_sec[k]); + REQUIRE(d_baseline.qw_sec[k] == d_cxx.qw_sec[k]); + REQUIRE(d_baseline.wthl_sec[k] == d_cxx.wthl_sec[k]); + REQUIRE(d_baseline.wqw_sec[k] == d_cxx.wqw_sec[k]); + REQUIRE(d_baseline.qwthl_sec[k] == d_cxx.qwthl_sec[k]); + REQUIRE(d_baseline.uw_sec[k] == d_cxx.uw_sec[k]); + REQUIRE(d_baseline.vw_sec[k] == d_cxx.vw_sec[k]); + REQUIRE(d_baseline.wtke_sec[k] == d_cxx.wtke_sec[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -344,14 +339,14 @@ TEST_CASE("diag_second_shoc_moments_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestDiagSecondShocMoments; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("diag_second_shoc_moments_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestDiagSecondShocMoments; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp index 5ddd261d0d9..0c60db01536 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocDiagThird { +struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -143,13 +143,7 @@ struct UnitWrap::UnitTest::TestShocDiagThird { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - diag_third_shoc_moments_f(SDS.shcol,SDS.nlev,SDS.nlevi,SDS.w_sec,SDS.thl_sec, - SDS.wthl_sec,SDS.isotropy,SDS.brunt,SDS.thetal, - SDS.tke,SDS.dz_zt,SDS.dz_zi,SDS.zt_grid,SDS.zi_grid, - SDS.w3); - SDS.transpose(); + diag_third_shoc_moments(SDS); // Check to make sure there is at least one // positive w3 value for convective boundary layer @@ -193,13 +187,7 @@ struct UnitWrap::UnitTest::TestShocDiagThird { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - diag_third_shoc_moments_f(SDS.shcol,SDS.nlev,SDS.nlevi,SDS.w_sec,SDS.thl_sec, - SDS.wthl_sec,SDS.isotropy,SDS.brunt,SDS.thetal, - SDS.tke,SDS.dz_zt,SDS.dz_zi,SDS.zt_grid,SDS.zi_grid, - SDS.w3); - SDS.transpose(); + diag_third_shoc_moments(SDS); // Verify that new result is greater or equal in magnitude // that the result from test one @@ -214,11 +202,11 @@ struct UnitWrap::UnitTest::TestShocDiagThird { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - DiagThirdShocMomentsData SDS_f90[] = { + DiagThirdShocMomentsData SDS_baseline[] = { // shcol, nlev, nlevi DiagThirdShocMomentsData(10, 71, 72), DiagThirdShocMomentsData(10, 12, 13), @@ -227,49 +215,47 @@ struct UnitWrap::UnitTest::TestShocDiagThird { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine, {{d.thetal, {300, 301}}}); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state DiagThirdShocMomentsData SDS_cxx[] = { - DiagThirdShocMomentsData(SDS_f90[0]), - DiagThirdShocMomentsData(SDS_f90[1]), - DiagThirdShocMomentsData(SDS_f90[2]), - DiagThirdShocMomentsData(SDS_f90[3]), + DiagThirdShocMomentsData(SDS_baseline[0]), + DiagThirdShocMomentsData(SDS_baseline[1]), + DiagThirdShocMomentsData(SDS_baseline[2]), + DiagThirdShocMomentsData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - diag_third_shoc_moments(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - diag_third_shoc_moments_f(d.shcol,d.nlev,d.nlevi,d.w_sec,d.thl_sec, - d.wthl_sec,d.isotropy,d.brunt,d.thetal, - d.tke,d.dz_zt,d.dz_zi,d.zt_grid,d.zi_grid, - d.w3); - d.transpose(); + diag_third_shoc_moments(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(DiagThirdShocMomentsData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(DiagThirdShocMomentsData); for (Int i = 0; i < num_runs; ++i) { - DiagThirdShocMomentsData& d_f90 = SDS_f90[i]; + DiagThirdShocMomentsData& d_baseline = SDS_baseline[i]; DiagThirdShocMomentsData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.w3); ++k) { - REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.w3); ++k) { + REQUIRE(d_baseline.w3[k] == d_cxx.w3[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -283,14 +269,14 @@ TEST_CASE("shoc_diag_third_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocDiagThird; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_diag_third_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocDiagThird; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp index acffb965df1..566dd2762bd 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocEddyDiff { +struct UnitWrap::UnitTest::TestShocEddyDiff : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 1; @@ -98,10 +98,7 @@ struct UnitWrap::UnitTest::TestShocEddyDiff { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - eddy_diffusivities_f(SDS.nlev, SDS.shcol, SDS.pblh, SDS.zt_grid, SDS.tabs, SDS.shoc_mix, - SDS.sterm_zt, SDS.isotropy, SDS.tke, SDS.tkh, SDS.tk); - SDS.transpose(); // go back to C layout + eddy_diffusivities(SDS); // Check to make sure the answers in the columns are different for(Int s = 0; s < shcol-1; ++s) { @@ -168,10 +165,7 @@ struct UnitWrap::UnitTest::TestShocEddyDiff { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - eddy_diffusivities_f(SDS.nlev, SDS.shcol, SDS.pblh, SDS.zt_grid, SDS.tabs, SDS.shoc_mix, - SDS.sterm_zt, SDS.isotropy, SDS.tke, SDS.tkh, SDS.tk); - SDS.transpose(); // go back to C layout + eddy_diffusivities(SDS); // Check to make sure the answers in the columns are larger // when the length scale and shear term are larger @@ -241,10 +235,7 @@ struct UnitWrap::UnitTest::TestShocEddyDiff { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - eddy_diffusivities_f(SDS.nlev, SDS.shcol, SDS.pblh, SDS.zt_grid, SDS.tabs, SDS.shoc_mix, - SDS.sterm_zt, SDS.isotropy, SDS.tke, SDS.tkh, SDS.tk); - SDS.transpose(); // go back to C layout + eddy_diffusivities(SDS); // Check to make sure the diffusivities are smaller // in the columns where isotropy and tke are smaller @@ -263,11 +254,11 @@ struct UnitWrap::UnitTest::TestShocEddyDiff { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - EddyDiffusivitiesData f90_data[] = { + EddyDiffusivitiesData baseline_data[] = { EddyDiffusivitiesData(10, 71), EddyDiffusivitiesData(10, 12), EddyDiffusivitiesData(7, 16), @@ -275,47 +266,49 @@ struct UnitWrap::UnitTest::TestShocEddyDiff { }; // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state EddyDiffusivitiesData cxx_data[] = { - EddyDiffusivitiesData(f90_data[0]), - EddyDiffusivitiesData(f90_data[1]), - EddyDiffusivitiesData(f90_data[2]), - EddyDiffusivitiesData(f90_data[3]), + EddyDiffusivitiesData(baseline_data[0]), + EddyDiffusivitiesData(baseline_data[1]), + EddyDiffusivitiesData(baseline_data[2]), + EddyDiffusivitiesData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - eddy_diffusivities(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - eddy_diffusivities_f(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); - d.transpose(); // go back to C layout + eddy_diffusivities(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(EddyDiffusivitiesData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(EddyDiffusivitiesData); for (Int i = 0; i < num_runs; ++i) { - EddyDiffusivitiesData& d_f90 = f90_data[i]; + EddyDiffusivitiesData& d_baseline = baseline_data[i]; EddyDiffusivitiesData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.tkh); ++k) { - REQUIRE(d_f90.tkh[k] == d_cxx.tkh[k]); - REQUIRE(d_f90.tk[k] == d_cxx.tk[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.tkh); ++k) { + REQUIRE(d_baseline.tkh[k] == d_cxx.tkh[k]); + REQUIRE(d_baseline.tk[k] == d_cxx.tk[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -329,14 +322,14 @@ TEST_CASE("shoc_tke_eddy_diffusivities_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEddyDiff; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_tke_eddy_diffusivities_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEddyDiff; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp index 9b91a7ef0b2..c2c4b2e167d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp index 253fb959723..dd1daf4a2c7 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "shoc_constants.hpp" #include "share/scream_types.hpp" @@ -23,9 +23,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocEnergyFixer { +struct UnitWrap::UnitTest::TestShocEnergyFixer : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real gravit = scream::physics::Constants::gravit; static constexpr Real Cpair = scream::physics::Constants::Cpair; @@ -158,14 +158,7 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - shoc_energy_fixer_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.dtime, SDS.nadv, - SDS.zt_grid, SDS.zi_grid, SDS.se_b, SDS.ke_b, SDS.wv_b, - SDS.wl_b, SDS.se_a, SDS.ke_a, SDS.wv_a, SDS.wl_a, SDS.wthl_sfc, - SDS.wqw_sfc, SDS.rho_zt, SDS.tke, SDS.pint, - SDS.host_dse); - SDS.transpose(); + shoc_energy_fixer(SDS); // Check test // Verify that the dry static energy has not changed if surface @@ -239,14 +232,7 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - shoc_energy_fixer_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.dtime, SDS.nadv, - SDS.zt_grid, SDS.zi_grid, SDS.se_b, SDS.ke_b, SDS.wv_b, - SDS.wl_b, SDS.se_a, SDS.ke_a, SDS.wv_a, SDS.wl_a, SDS.wthl_sfc, - SDS.wqw_sfc, SDS.rho_zt, SDS.tke, SDS.pint, - SDS.host_dse); - SDS.transpose(); + shoc_energy_fixer(SDS); // Verify the result for(Int s = 0; s < shcol; ++s) { @@ -275,11 +261,11 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocEnergyFixerData SDS_f90[] = { + ShocEnergyFixerData SDS_baseline[] = { // shcol, nlev, nlevi, dtime, nadv ShocEnergyFixerData(10, 71, 72, 300, 2), ShocEnergyFixerData(10, 12, 13, 100, 10), @@ -288,50 +274,47 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocEnergyFixerData SDS_cxx[] = { - ShocEnergyFixerData(SDS_f90[0]), - ShocEnergyFixerData(SDS_f90[1]), - ShocEnergyFixerData(SDS_f90[2]), - ShocEnergyFixerData(SDS_f90[3]), + ShocEnergyFixerData(SDS_baseline[0]), + ShocEnergyFixerData(SDS_baseline[1]), + ShocEnergyFixerData(SDS_baseline[2]), + ShocEnergyFixerData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - shoc_energy_fixer(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - shoc_energy_fixer_f(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, - d.zt_grid, d.zi_grid, d.se_b, d.ke_b, d.wv_b, - d.wl_b, d.se_a, d.ke_a, d.wv_a, d.wl_a, d.wthl_sfc, - d.wqw_sfc, d.rho_zt, d.tke, d.pint, - d.host_dse); - d.transpose(); + shoc_energy_fixer(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ShocEnergyFixerData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocEnergyFixerData); for (Int i = 0; i < num_runs; ++i) { - ShocEnergyFixerData& d_f90 = SDS_f90[i]; + ShocEnergyFixerData& d_baseline = SDS_baseline[i]; ShocEnergyFixerData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.host_dse); ++k) { - REQUIRE(d_f90.host_dse[k] == d_cxx.host_dse[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.host_dse); ++k) { + REQUIRE(d_baseline.host_dse[k] == d_cxx.host_dse[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -345,14 +328,14 @@ TEST_CASE("shoc_energy_fixer_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyFixer; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_energy_fixer_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyFixer; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp index a782329d500..7bc0e4d1aac 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocEnergyInt { +struct UnitWrap::UnitTest::TestShocEnergyInt : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -108,12 +108,7 @@ struct UnitWrap::UnitTest::TestShocEnergyInt { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - shoc_energy_integrals_f(SDS.shcol, SDS.nlev, SDS.host_dse, SDS.pdel, - SDS.rtm, SDS.rcm, SDS.u_wind, SDS.v_wind, - SDS.se_int, SDS.ke_int, SDS.wv_int, SDS.wl_int); - SDS.transpose(); + shoc_energy_integrals(SDS); // Check test for(Int s = 0; s < shcol; ++s) { @@ -132,11 +127,11 @@ struct UnitWrap::UnitTest::TestShocEnergyInt { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocEnergyIntegralsData SDS_f90[] = { + ShocEnergyIntegralsData SDS_baseline[] = { // shcol, nlev ShocEnergyIntegralsData(10, 71), ShocEnergyIntegralsData(10, 12), @@ -145,51 +140,50 @@ struct UnitWrap::UnitTest::TestShocEnergyInt { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocEnergyIntegralsData SDS_cxx[] = { - ShocEnergyIntegralsData(SDS_f90[0]), - ShocEnergyIntegralsData(SDS_f90[1]), - ShocEnergyIntegralsData(SDS_f90[2]), - ShocEnergyIntegralsData(SDS_f90[3]), + ShocEnergyIntegralsData(SDS_baseline[0]), + ShocEnergyIntegralsData(SDS_baseline[1]), + ShocEnergyIntegralsData(SDS_baseline[2]), + ShocEnergyIntegralsData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - shoc_energy_integrals(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - shoc_energy_integrals_f(d.shcol, d.nlev, d.host_dse, d.pdel, - d.rtm, d.rcm, d.u_wind, d.v_wind, - d.se_int, d.ke_int, d.wv_int, d.wl_int); - d.transpose(); + shoc_energy_integrals(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ShocEnergyIntegralsData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocEnergyIntegralsData); for (Int i = 0; i < num_runs; ++i) { - ShocEnergyIntegralsData& d_f90 = SDS_f90[i]; + ShocEnergyIntegralsData& d_baseline = SDS_baseline[i]; ShocEnergyIntegralsData& d_cxx = SDS_cxx[i]; - for (Int c = 0; c < d_f90.shcol; ++c) { - REQUIRE(d_f90.se_int[c] == d_cxx.se_int[c]); - REQUIRE(d_f90.ke_int[c] == d_cxx.ke_int[c]); - REQUIRE(d_f90.wv_int[c] == d_cxx.wv_int[c]); - REQUIRE(d_f90.wl_int[c] == d_cxx.wl_int[c]); + for (Int c = 0; c < d_baseline.shcol; ++c) { + REQUIRE(d_baseline.se_int[c] == d_cxx.se_int[c]); + REQUIRE(d_baseline.ke_int[c] == d_cxx.ke_int[c]); + REQUIRE(d_baseline.wv_int[c] == d_cxx.wv_int[c]); + REQUIRE(d_baseline.wl_int[c] == d_cxx.wl_int[c]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -203,14 +197,14 @@ TEST_CASE("shoc_energy_integrals_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyInt; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_energy_integrals_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyInt; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp index 19743c39189..47da76a4fa2 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp index ea59b217f77..302b7607b30 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp index 8c56d72ce2a..3aec754a542 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocUpdateDse { +struct UnitWrap::UnitTest::TestShocUpdateDse : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -109,11 +109,7 @@ struct UnitWrap::UnitTest::TestShocUpdateDse { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - update_host_dse_f(SDS.shcol,SDS.nlev,SDS.thlm,SDS.shoc_ql,SDS.inv_exner,SDS.zt_grid, - SDS.phis,SDS.host_dse); - SDS.transpose(); + update_host_dse(SDS); // Check test for(Int s = 0; s < shcol; ++s) { @@ -140,11 +136,11 @@ struct UnitWrap::UnitTest::TestShocUpdateDse { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - UpdateHostDseData SDS_f90[] = { + UpdateHostDseData SDS_baseline[] = { // shcol, nlev UpdateHostDseData(10, 71), UpdateHostDseData(10, 12), @@ -153,47 +149,47 @@ struct UnitWrap::UnitTest::TestShocUpdateDse { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state UpdateHostDseData SDS_cxx[] = { - UpdateHostDseData(SDS_f90[0]), - UpdateHostDseData(SDS_f90[1]), - UpdateHostDseData(SDS_f90[2]), - UpdateHostDseData(SDS_f90[3]), + UpdateHostDseData(SDS_baseline[0]), + UpdateHostDseData(SDS_baseline[1]), + UpdateHostDseData(SDS_baseline[2]), + UpdateHostDseData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - update_host_dse(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - update_host_dse_f(d.shcol,d.nlev,d.thlm,d.shoc_ql,d.inv_exner,d.zt_grid, - d.phis,d.host_dse); - d.transpose(); + update_host_dse(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(UpdateHostDseData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(UpdateHostDseData); for (Int i = 0; i < num_runs; ++i) { - UpdateHostDseData& d_f90 = SDS_f90[i]; + UpdateHostDseData& d_baseline = SDS_baseline[i]; UpdateHostDseData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.host_dse); ++k) { - REQUIRE(d_f90.host_dse[k] == d_cxx.host_dse[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.host_dse); ++k) { + REQUIRE(d_baseline.host_dse[k] == d_cxx.host_dse[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -207,14 +203,14 @@ TEST_CASE("shoc_energy_host_dse_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocUpdateDse; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_energy_host_dse_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocUpdateDse; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp index 4fd800ca4ad..df99a555382 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp index 8d7774f1aba..e724cfe07d8 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp index 34625760ecc..f89d3eabea0 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp @@ -23,9 +23,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocGrid { +struct UnitWrap::UnitTest::TestShocGrid : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real gravit = scream::physics::Constants::gravit; static constexpr Int shcol = 2; @@ -80,9 +80,7 @@ struct UnitWrap::UnitTest::TestShocGrid { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - shoc_grid_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.zt_grid, SDS.zi_grid, SDS.pdel, SDS.dz_zt, SDS.dz_zi, SDS.rho_zt); - SDS.transpose(); // go back to C layout + shoc_grid(SDS); // First check that dz is correct for(Int s = 0; s < shcol; ++s) { @@ -129,62 +127,65 @@ struct UnitWrap::UnitTest::TestShocGrid { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocGridData f90_data[] = { + ShocGridData baseline_data[] = { ShocGridData(10, 71, 72), ShocGridData(10, 12, 13), ShocGridData(7, 16, 17), ShocGridData(2, 7, 8), }; + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ShocGridData); + // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocGridData cxx_data[] = { - ShocGridData(f90_data[0]), - ShocGridData(f90_data[1]), - ShocGridData(f90_data[2]), - ShocGridData(f90_data[3]), + ShocGridData(baseline_data[0]), + ShocGridData(baseline_data[1]), + ShocGridData(baseline_data[2]), + ShocGridData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - shoc_grid(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - shoc_grid_f(d.shcol, d.nlev, d.nlevi, d.zt_grid, d.zi_grid, d.pdel, d.dz_zt, d.dz_zi, d.rho_zt); - d.transpose(); // go back to C layout + shoc_grid(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ShocGridData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { for (Int i = 0; i < num_runs; ++i) { - ShocGridData& d_f90 = f90_data[i]; + ShocGridData& d_baseline = baseline_data[i]; ShocGridData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.dz_zt); ++k) { - REQUIRE(d_f90.dz_zt[k] == d_cxx.dz_zt[k]); - REQUIRE(d_f90.rho_zt[k] == d_cxx.rho_zt[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.dz_zt); ++k) { + REQUIRE(d_baseline.dz_zt[k] == d_cxx.dz_zt[k]); + REQUIRE(d_baseline.rho_zt[k] == d_cxx.rho_zt[k]); } - for (Int k = 0; k < d_f90.total(d_f90.dz_zi); ++k) { - REQUIRE(d_f90.dz_zi[k] == d_cxx.dz_zi[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.dz_zi); ++k) { + REQUIRE(d_baseline.dz_zi[k] == d_cxx.dz_zi[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -198,14 +199,14 @@ TEST_CASE("shoc_grid_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocGrid; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_grid_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocGrid; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp index 5c55f4947a8..2ee4cd44fd7 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestImpCompTmpi { +struct UnitWrap::UnitTest::TestImpCompTmpi : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlevi = 6; @@ -87,9 +87,7 @@ struct UnitWrap::UnitTest::TestImpCompTmpi { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - compute_tmpi_f(SDS.nlevi, SDS.shcol, SDS.dtime, SDS.rho_zi, SDS.dz_zi, SDS.tmpi); - SDS.transpose(); // go back to C layout + compute_tmpi(SDS); // Verify result for(Int s = 0; s < shcol; ++s) { @@ -118,11 +116,11 @@ struct UnitWrap::UnitTest::TestImpCompTmpi { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeTmpiData f90_data[] = { + ComputeTmpiData baseline_data[] = { // shcol, nlevi, dtime ComputeTmpiData(10, 72, 1), ComputeTmpiData(10, 13, 10), @@ -131,45 +129,48 @@ struct UnitWrap::UnitTest::TestImpCompTmpi { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeTmpiData cxx_data[] = { - ComputeTmpiData(f90_data[0]), - ComputeTmpiData(f90_data[1]), - ComputeTmpiData(f90_data[2]), - ComputeTmpiData(f90_data[3]), + ComputeTmpiData(baseline_data[0]), + ComputeTmpiData(baseline_data[1]), + ComputeTmpiData(baseline_data[2]), + ComputeTmpiData(baseline_data[3]), }; + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ComputeTmpiData); + // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - compute_tmpi(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - compute_tmpi_f(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); - d.transpose(); // go back to C layout + compute_tmpi(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ComputeTmpiData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { for (Int i = 0; i < num_runs; ++i) { - ComputeTmpiData& d_f90 = f90_data[i]; + ComputeTmpiData& d_baseline = baseline_data[i]; ComputeTmpiData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.tmpi); ++k) { - REQUIRE(d_f90.tmpi[k] == d_cxx.tmpi[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.tmpi); ++k) { + REQUIRE(d_baseline.tmpi[k] == d_cxx.tmpi[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -183,14 +184,14 @@ TEST_CASE("shoc_imp_comp_tmpi_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpCompTmpi; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_imp_comp_tmpi_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpCompTmpi; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp index c11ce4c8a9e..22acf6d6860 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestImpDpInverse { +struct UnitWrap::UnitTest::TestImpDpInverse : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -74,9 +74,7 @@ struct UnitWrap::UnitTest::TestImpDpInverse { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - dp_inverse_f(SDS.nlev, SDS.shcol, SDS.rho_zt, SDS.dz_zt, SDS.rdp_zt); - SDS.transpose(); // go back to C layout + dp_inverse(SDS); // Verify result for(Int s = 0; s < shcol; ++s) { @@ -98,11 +96,11 @@ struct UnitWrap::UnitTest::TestImpDpInverse { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - DpInverseData f90_data[] = { + DpInverseData baseline_data[] = { // shcol, nlev DpInverseData(10, 71), DpInverseData(10, 12), @@ -111,45 +109,48 @@ struct UnitWrap::UnitTest::TestImpDpInverse { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state DpInverseData cxx_data[] = { - DpInverseData(f90_data[0]), - DpInverseData(f90_data[1]), - DpInverseData(f90_data[2]), - DpInverseData(f90_data[3]), + DpInverseData(baseline_data[0]), + DpInverseData(baseline_data[1]), + DpInverseData(baseline_data[2]), + DpInverseData(baseline_data[3]), }; + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(DpInverseData); + // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - dp_inverse(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - dp_inverse_f(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); - d.transpose(); // go back to C layout + dp_inverse(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(DpInverseData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { for (Int i = 0; i < num_runs; ++i) { - DpInverseData& d_f90 = f90_data[i]; + DpInverseData& d_baseline = baseline_data[i]; DpInverseData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.rdp_zt); ++k) { - REQUIRE(d_f90.rdp_zt[k] == d_cxx.rdp_zt[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.rdp_zt); ++k) { + REQUIRE(d_baseline.rdp_zt[k] == d_cxx.rdp_zt[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -163,14 +164,14 @@ TEST_CASE("shoc_imp_dp_inverse_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpDpInverse; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_imp_dp_inverse_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpDpInverse; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp index 8f8f25cdd4a..2b2942e7a3d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp index 97f6d2a0be3..786d4ade1f8 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp index bb19e21e30c..4dd4b89e86b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp index 48a25d86e2b..2d12db2e050 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestLInfShocLength { +struct UnitWrap::UnitTest::TestLInfShocLength : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 3; static constexpr Int nlev = 5; @@ -89,10 +89,7 @@ struct UnitWrap::UnitTest::TestLInfShocLength { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - compute_l_inf_shoc_length_f(SDS.nlev,SDS.shcol,SDS.zt_grid,SDS.dz_zt,SDS.tke,SDS.l_inf); - SDS.transpose(); + compute_l_inf_shoc_length(SDS); // Check the results // Make sure result is bounded correctly @@ -108,11 +105,11 @@ struct UnitWrap::UnitTest::TestLInfShocLength { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeLInfShocLengthData SDS_f90[] = { + ComputeLInfShocLengthData SDS_baseline[] = { // shcol, nlev ComputeLInfShocLengthData(10, 71), ComputeLInfShocLengthData(10, 12), @@ -121,46 +118,47 @@ struct UnitWrap::UnitTest::TestLInfShocLength { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeLInfShocLengthData SDS_cxx[] = { - ComputeLInfShocLengthData(SDS_f90[0]), - ComputeLInfShocLengthData(SDS_f90[1]), - ComputeLInfShocLengthData(SDS_f90[2]), - ComputeLInfShocLengthData(SDS_f90[3]), + ComputeLInfShocLengthData(SDS_baseline[0]), + ComputeLInfShocLengthData(SDS_baseline[1]), + ComputeLInfShocLengthData(SDS_baseline[2]), + ComputeLInfShocLengthData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - compute_l_inf_shoc_length(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - compute_l_inf_shoc_length_f(d.nlev,d.shcol,d.zt_grid,d.dz_zt,d.tke,d.l_inf); - d.transpose(); + compute_l_inf_shoc_length(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ComputeLInfShocLengthData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeLInfShocLengthData); for (Int i = 0; i < num_runs; ++i) { - ComputeLInfShocLengthData& d_f90 = SDS_f90[i]; + ComputeLInfShocLengthData& d_baseline = SDS_baseline[i]; ComputeLInfShocLengthData& d_cxx = SDS_cxx[i]; - for (Int c = 0; c < d_f90.shcol; ++c) { - REQUIRE(d_f90.l_inf[c] == d_cxx.l_inf[c]); + for (Int c = 0; c < d_baseline.shcol; ++c) { + REQUIRE(d_baseline.l_inf[c] == d_cxx.l_inf[c]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -174,14 +172,14 @@ TEST_CASE("shoc_l_inf_length_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestLInfShocLength; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_l_inf_length_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestLInfShocLength; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp index 8fb7ff66281..f35eed0e45c 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocLength { +struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real minlen = scream::shoc::Constants::minlen; static constexpr Real maxlen = scream::shoc::Constants::maxlen; @@ -121,12 +121,7 @@ struct UnitWrap::UnitTest::TestShocLength { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - shoc_length_f(SDS.shcol,SDS.nlev,SDS.nlevi,SDS.host_dx,SDS.host_dy, - SDS.zt_grid,SDS.zi_grid,SDS.dz_zt,SDS.tke, - SDS.thv,SDS.brunt,SDS.shoc_mix); - SDS.transpose(); + shoc_length(SDS); // Verify output for(Int s = 0; s < shcol; ++s) { @@ -175,12 +170,7 @@ struct UnitWrap::UnitTest::TestShocLength { } // call C++ implentation - SDS.transpose(); - // expects data in fortran layout - shoc_length_f(SDS.shcol,SDS.nlev,SDS.nlevi,SDS.host_dx,SDS.host_dy, - SDS.zt_grid,SDS.zi_grid,SDS.dz_zt,SDS.tke, - SDS.thv,SDS.brunt,SDS.shoc_mix); - SDS.transpose(); + shoc_length(SDS); // Verify output for(Int s = 0; s < shcol; ++s) { @@ -196,11 +186,11 @@ struct UnitWrap::UnitTest::TestShocLength { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocLengthData SDS_f90[] = { + ShocLengthData SDS_baseline[] = { // shcol, nlev, nlevi ShocLengthData(12, 71, 72), ShocLengthData(10, 12, 13), @@ -209,49 +199,48 @@ struct UnitWrap::UnitTest::TestShocLength { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocLengthData SDS_cxx[] = { - ShocLengthData(SDS_f90[0]), - ShocLengthData(SDS_f90[1]), - ShocLengthData(SDS_f90[2]), - ShocLengthData(SDS_f90[3]), + ShocLengthData(SDS_baseline[0]), + ShocLengthData(SDS_baseline[1]), + ShocLengthData(SDS_baseline[2]), + ShocLengthData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - shoc_length(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - shoc_length_f(d.shcol,d.nlev,d.nlevi,d.host_dx,d.host_dy, - d.zt_grid,d.zi_grid,d.dz_zt,d.tke, - d.thv,d.brunt,d.shoc_mix); - d.transpose(); + shoc_length(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ShocLengthData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocLengthData); for (Int i = 0; i < num_runs; ++i) { - ShocLengthData& d_f90 = SDS_f90[i]; + ShocLengthData& d_baseline = SDS_baseline[i]; ShocLengthData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.brunt); ++k) { - REQUIRE(d_f90.brunt[k] == d_cxx.brunt[k]); - REQUIRE(d_f90.shoc_mix[k] == d_cxx.shoc_mix[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.brunt); ++k) { + REQUIRE(d_baseline.brunt[k] == d_cxx.brunt[k]); + REQUIRE(d_baseline.shoc_mix[k] == d_cxx.shoc_mix[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -265,14 +254,14 @@ TEST_CASE("shoc_length_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocLength; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_length_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocLength; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp index 427e5f6d622..263e09e22b9 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocLinearInt { +struct UnitWrap::UnitTest::TestShocLinearInt : public UnitWrap::UnitTest::Base { - static void run_property_fixed() + void run_property_fixed() { static constexpr Int shcol = 2; static constexpr Int km1 = 5; @@ -100,9 +100,7 @@ struct UnitWrap::UnitTest::TestShocLinearInt { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - linear_interp_f(SDS.x1, SDS.x2, SDS.y1, SDS.y2, SDS.km1, SDS.km2, SDS.ncol, SDS.minthresh); - SDS.transpose(); // go back to C layout + linear_interp(SDS); // First check that all output temperatures are greater than zero @@ -194,9 +192,7 @@ struct UnitWrap::UnitTest::TestShocLinearInt { } // Call the C++ implementation - SDS2.transpose(); // _f expects data in fortran layout - linear_interp_f(SDS2.x1, SDS2.x2, SDS2.y1, SDS2.y2, SDS2.km1, SDS2.km2, SDS2.ncol, SDS2.minthresh); - SDS2.transpose(); // go back to C layout + linear_interp(SDS2); // Check the result, make sure output is bounded correctly @@ -223,7 +219,7 @@ struct UnitWrap::UnitTest::TestShocLinearInt { } } - static void run_property_random(bool km1_bigger) + void run_property_random(bool km1_bigger) { std::default_random_engine generator; std::pair km1_range = {13, 25}; @@ -281,9 +277,7 @@ struct UnitWrap::UnitTest::TestShocLinearInt { } // Call the C++ implementation - d.transpose(); // _f expects data in fortran layout - linear_interp_f(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); - d.transpose(); // go back to C layout + linear_interp(d); // The combination of single-precision and randomness generating points // close together can result in larger error margins. @@ -333,18 +327,18 @@ struct UnitWrap::UnitTest::TestShocLinearInt { } } - static void run_property() + void run_property() { run_property_fixed(); run_property_random(true); run_property_random(false); } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - LinearInterpData f90_data[] = { + LinearInterpData baseline_data[] = { // shcol, nlev(km1), nlevi(km2), minthresh LinearInterpData(10, 72, 71, 1e-15), LinearInterpData(10, 71, 72, 1e-15), @@ -355,47 +349,49 @@ struct UnitWrap::UnitTest::TestShocLinearInt { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state LinearInterpData cxx_data[] = { - LinearInterpData(f90_data[0]), - LinearInterpData(f90_data[1]), - LinearInterpData(f90_data[2]), - LinearInterpData(f90_data[3]), - LinearInterpData(f90_data[4]), - LinearInterpData(f90_data[5]), + LinearInterpData(baseline_data[0]), + LinearInterpData(baseline_data[1]), + LinearInterpData(baseline_data[2]), + LinearInterpData(baseline_data[3]), + LinearInterpData(baseline_data[4]), + LinearInterpData(baseline_data[5]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - linear_interp(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - linear_interp_f(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); - d.transpose(); // go back to C layout + linear_interp(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(LinearInterpData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(LinearInterpData); for (Int i = 0; i < num_runs; ++i) { - LinearInterpData& d_f90 = f90_data[i]; + LinearInterpData& d_baseline = baseline_data[i]; LinearInterpData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.y2); ++k) { - REQUIRE(d_f90.y2[k] == d_cxx.y2[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.y2); ++k) { + REQUIRE(d_baseline.y2[k] == d_cxx.y2[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -410,14 +406,14 @@ TEST_CASE("shoc_linear_interp_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocLinearInt; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_linear_interp_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocLinearInt; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp index 65d328744b7..5dcd30068c0 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocMain { +struct UnitWrap::UnitTest::TestShocMain : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real mintke = scream::shoc::Constants::mintke; static constexpr Real minlen = scream::shoc::Constants::minlen; @@ -259,18 +259,8 @@ struct UnitWrap::UnitTest::TestShocMain { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - const int npbl = shoc_init_f(SDS.nlev, SDS.pref_mid, SDS.nbot_shoc, SDS.ntop_shoc); - - shoc_main_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.dtime, SDS.nadv, npbl, SDS.host_dx, SDS.host_dy, - SDS.thv, SDS.zt_grid, SDS.zi_grid, SDS.pres, SDS.presi, SDS.pdel, SDS.wthl_sfc, - SDS.wqw_sfc, SDS.uw_sfc, SDS.vw_sfc, SDS.wtracer_sfc, SDS.num_qtracers, - SDS.w_field, SDS.inv_exner, SDS.phis, SDS.host_dse, SDS.tke, SDS.thetal, SDS.qw, - SDS.u_wind, SDS.v_wind, SDS.qtracers, SDS.wthv_sec, SDS.tkh, SDS.tk, SDS.shoc_ql, - SDS.shoc_cldfrac, SDS.pblh, SDS.shoc_mix, SDS.isotropy, SDS.w_sec, SDS.thl_sec, - SDS.qw_sec, SDS.qwthl_sec, SDS.wthl_sec, SDS.wqw_sec, SDS.wtke_sec, SDS.uw_sec, - SDS.vw_sec, SDS.w3, SDS.wqls_sec, SDS.brunt, SDS.shoc_ql2); - SDS.transpose(); // go back to C layout + const int npbl = shoc_init_host(SDS.nlev, SDS.pref_mid, SDS.nbot_shoc, SDS.ntop_shoc); + shoc_main(SDS); // Make sure output falls within reasonable bounds for(Int s = 0; s < shcol; ++s) { @@ -339,11 +329,11 @@ struct UnitWrap::UnitTest::TestShocMain { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocMainData f90_data[] = { + ShocMainData baseline_data[] = { // shcol, nlev, nlevi, num_qtracers, dtime, nadv, nbot_shoc, ntop_shoc(C++ indexing) ShocMainData(12, 72, 73, 5, 300, 15, 72, 0), ShocMainData(8, 12, 13, 3, 300, 10, 8, 3), @@ -352,7 +342,7 @@ struct UnitWrap::UnitTest::TestShocMain { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine, { {d.presi, {700e2,1000e2}}, @@ -374,114 +364,109 @@ struct UnitWrap::UnitTest::TestShocMain { }); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocMainData cxx_data[] = { - ShocMainData(f90_data[0]), - ShocMainData(f90_data[1]), - ShocMainData(f90_data[2]), - ShocMainData(f90_data[3]) + ShocMainData(baseline_data[0]), + ShocMainData(baseline_data[1]), + ShocMainData(baseline_data[2]), + ShocMainData(baseline_data[3]) }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - shoc_main_with_init(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - const int npbl = shoc_init_f(d.nlev, d.pref_mid, d.nbot_shoc, d.ntop_shoc); - - shoc_main_f(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, npbl, d.host_dx, d.host_dy, - d.thv, d.zt_grid, d.zi_grid, d.pres, d.presi, d.pdel, d.wthl_sfc, - d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.wtracer_sfc, d.num_qtracers, - d.w_field, d.inv_exner, d.phis, d.host_dse, d.tke, d.thetal, d.qw, - d.u_wind, d.v_wind, d.qtracers, d.wthv_sec, d.tkh, d.tk, d.shoc_ql, - d.shoc_cldfrac, d.pblh, d.shoc_mix, d.isotropy, d.w_sec, d.thl_sec, - d.qw_sec, d.qwthl_sec, d.wthl_sec, d.wqw_sec, d.wtke_sec, d.uw_sec, - d.vw_sec, d.w3, d.wqls_sec, d.brunt, d.shoc_ql2); - d.transpose(); // go back to C layout + const int npbl = shoc_init_host(d.nlev, d.pref_mid, d.nbot_shoc, d.ntop_shoc); + + shoc_main(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ShocMainData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ShocMainData); for (Int i = 0; i < num_runs; ++i) { - ShocMainData& d_f90 = f90_data[i]; + ShocMainData& d_baseline = baseline_data[i]; ShocMainData& d_cxx = cxx_data[i]; - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.host_dse)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.tke)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.thetal)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.qw)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.u_wind)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.v_wind)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.wthv_sec)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.tkh)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.tk)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.shoc_ql)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.shoc_cldfrac)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.shoc_mix)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.isotropy)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.w_sec)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.wqls_sec)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.brunt)); - REQUIRE(d_f90.total(d_f90.host_dse) == d_cxx.total(d_cxx.shoc_ql2)); - for (Int k = 0; k < d_f90.total(d_f90.host_dse); ++k) { - REQUIRE(d_f90.host_dse[k] == d_cxx.host_dse[k]); - REQUIRE(d_f90.tke[k] == d_cxx.tke[k]); - REQUIRE(d_f90.thetal[k] == d_cxx.thetal[k]); - REQUIRE(d_f90.qw[k] == d_cxx.qw[k]); - REQUIRE(d_f90.u_wind[k] == d_cxx.u_wind[k]); - REQUIRE(d_f90.v_wind[k] == d_cxx.v_wind[k]); - REQUIRE(d_f90.wthv_sec[k] == d_cxx.wthv_sec[k]); - REQUIRE(d_f90.tk[k] == d_cxx.tk[k]); - REQUIRE(d_f90.shoc_ql[k] == d_cxx.shoc_ql[k]); - REQUIRE(d_f90.shoc_cldfrac[k] == d_cxx.shoc_cldfrac[k]); - REQUIRE(d_f90.shoc_mix[k] == d_cxx.shoc_mix[k]); - REQUIRE(d_f90.isotropy[k] == d_cxx.isotropy[k]); - REQUIRE(d_f90.w_sec[k] == d_cxx.w_sec[k]); - REQUIRE(d_f90.wqls_sec[k] == d_cxx.wqls_sec[k]); - REQUIRE(d_f90.brunt[k] == d_cxx.brunt[k]); - REQUIRE(d_f90.shoc_ql2[k] == d_cxx.shoc_ql2[k]); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.host_dse)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.tke)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.thetal)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.qw)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.u_wind)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.v_wind)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.wthv_sec)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.tkh)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.tk)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.shoc_ql)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.shoc_cldfrac)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.shoc_mix)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.isotropy)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.w_sec)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.wqls_sec)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.brunt)); + REQUIRE(d_baseline.total(d_baseline.host_dse) == d_cxx.total(d_cxx.shoc_ql2)); + for (Int k = 0; k < d_baseline.total(d_baseline.host_dse); ++k) { + REQUIRE(d_baseline.host_dse[k] == d_cxx.host_dse[k]); + REQUIRE(d_baseline.tke[k] == d_cxx.tke[k]); + REQUIRE(d_baseline.thetal[k] == d_cxx.thetal[k]); + REQUIRE(d_baseline.qw[k] == d_cxx.qw[k]); + REQUIRE(d_baseline.u_wind[k] == d_cxx.u_wind[k]); + REQUIRE(d_baseline.v_wind[k] == d_cxx.v_wind[k]); + REQUIRE(d_baseline.wthv_sec[k] == d_cxx.wthv_sec[k]); + REQUIRE(d_baseline.tk[k] == d_cxx.tk[k]); + REQUIRE(d_baseline.shoc_ql[k] == d_cxx.shoc_ql[k]); + REQUIRE(d_baseline.shoc_cldfrac[k] == d_cxx.shoc_cldfrac[k]); + REQUIRE(d_baseline.shoc_mix[k] == d_cxx.shoc_mix[k]); + REQUIRE(d_baseline.isotropy[k] == d_cxx.isotropy[k]); + REQUIRE(d_baseline.w_sec[k] == d_cxx.w_sec[k]); + REQUIRE(d_baseline.wqls_sec[k] == d_cxx.wqls_sec[k]); + REQUIRE(d_baseline.brunt[k] == d_cxx.brunt[k]); + REQUIRE(d_baseline.shoc_ql2[k] == d_cxx.shoc_ql2[k]); } - REQUIRE(d_f90.total(d_f90.qtracers) == d_cxx.total(d_cxx.qtracers)); - for (Int k = 0; k < d_f90.total(d_f90.qtracers); ++k) { - REQUIRE(d_f90.qtracers[k] == d_cxx.qtracers[k]); + REQUIRE(d_baseline.total(d_baseline.qtracers) == d_cxx.total(d_cxx.qtracers)); + for (Int k = 0; k < d_baseline.total(d_baseline.qtracers); ++k) { + REQUIRE(d_baseline.qtracers[k] == d_cxx.qtracers[k]); } - REQUIRE(d_f90.total(d_f90.pblh) == d_cxx.total(d_cxx.pblh)); - for (Int k = 0; k < d_f90.total(d_f90.pblh); ++k) { - REQUIRE(d_f90.pblh[k] == d_cxx.pblh[k]); + REQUIRE(d_baseline.total(d_baseline.pblh) == d_cxx.total(d_cxx.pblh)); + for (Int k = 0; k < d_baseline.total(d_baseline.pblh); ++k) { + REQUIRE(d_baseline.pblh[k] == d_cxx.pblh[k]); } - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.thl_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.qw_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.qwthl_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.wthl_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.wqw_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.wtke_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.uw_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.vw_sec)); - REQUIRE(d_f90.total(d_f90.thl_sec) == d_cxx.total(d_cxx.w3)); - for (Int k = 0; k < d_f90.total(d_f90.thl_sec); ++k) { - REQUIRE(d_f90.thl_sec[k] == d_cxx.thl_sec[k]); - REQUIRE(d_f90.qw_sec[k] == d_cxx.qw_sec[k]); - REQUIRE(d_f90.qwthl_sec[k] == d_cxx.qwthl_sec[k]); - REQUIRE(d_f90.wthl_sec[k] == d_cxx.wthl_sec[k]); - REQUIRE(d_f90.wqw_sec[k] == d_cxx.wqw_sec[k]); - REQUIRE(d_f90.wtke_sec[k] == d_cxx.wtke_sec[k]); - REQUIRE(d_f90.uw_sec[k] == d_cxx.uw_sec[k]); - REQUIRE(d_f90.vw_sec[k] == d_cxx.vw_sec[k]); - REQUIRE(d_f90.w3[k] == d_cxx.w3[k]); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.thl_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.qw_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.qwthl_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.wthl_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.wqw_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.wtke_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.uw_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.vw_sec)); + REQUIRE(d_baseline.total(d_baseline.thl_sec) == d_cxx.total(d_cxx.w3)); + for (Int k = 0; k < d_baseline.total(d_baseline.thl_sec); ++k) { + REQUIRE(d_baseline.thl_sec[k] == d_cxx.thl_sec[k]); + REQUIRE(d_baseline.qw_sec[k] == d_cxx.qw_sec[k]); + REQUIRE(d_baseline.qwthl_sec[k] == d_cxx.qwthl_sec[k]); + REQUIRE(d_baseline.wthl_sec[k] == d_cxx.wthl_sec[k]); + REQUIRE(d_baseline.wqw_sec[k] == d_cxx.wqw_sec[k]); + REQUIRE(d_baseline.wtke_sec[k] == d_cxx.wtke_sec[k]); + REQUIRE(d_baseline.uw_sec[k] == d_cxx.uw_sec[k]); + REQUIRE(d_baseline.vw_sec[k] == d_cxx.vw_sec[k]); + REQUIRE(d_baseline.w3[k] == d_cxx.w3[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -495,14 +480,14 @@ TEST_CASE("shoc_main_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocMain; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_main_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocMain; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp index 1bcba869a51..bdf5bd607f3 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestCompShocMixLength { +struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 3; static constexpr Int nlev = 5; @@ -91,13 +91,7 @@ struct UnitWrap::UnitTest::TestCompShocMixLength { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - compute_shoc_mix_shoc_length_f(SDS.nlev, SDS.shcol, - SDS.tke, SDS.brunt, - SDS.zt_grid, - SDS.l_inf, SDS.shoc_mix); - SDS.transpose(); + compute_shoc_mix_shoc_length(SDS); // Check the results for(Int s = 0; s < shcol; ++s) { @@ -120,11 +114,11 @@ struct UnitWrap::UnitTest::TestCompShocMixLength { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeShocMixShocLengthData SDS_f90[] = { + ComputeShocMixShocLengthData SDS_baseline[] = { // shcol, nlev ComputeShocMixShocLengthData(10, 71), ComputeShocMixShocLengthData(10, 12), @@ -133,49 +127,47 @@ struct UnitWrap::UnitTest::TestCompShocMixLength { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeShocMixShocLengthData SDS_cxx[] = { - ComputeShocMixShocLengthData(SDS_f90[0]), - ComputeShocMixShocLengthData(SDS_f90[1]), - ComputeShocMixShocLengthData(SDS_f90[2]), - ComputeShocMixShocLengthData(SDS_f90[3]), + ComputeShocMixShocLengthData(SDS_baseline[0]), + ComputeShocMixShocLengthData(SDS_baseline[1]), + ComputeShocMixShocLengthData(SDS_baseline[2]), + ComputeShocMixShocLengthData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - compute_shoc_mix_shoc_length(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - compute_shoc_mix_shoc_length_f(d.nlev, d.shcol, - d.tke, d.brunt, - d.zt_grid, - d.l_inf, d.shoc_mix); - d.transpose(); + compute_shoc_mix_shoc_length(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(ComputeShocMixShocLengthData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeShocMixShocLengthData); for (Int i = 0; i < num_runs; ++i) { - ComputeShocMixShocLengthData& d_f90 = SDS_f90[i]; + ComputeShocMixShocLengthData& d_baseline = SDS_baseline[i]; ComputeShocMixShocLengthData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.shoc_mix); ++k) { - REQUIRE(d_f90.shoc_mix[k] == d_cxx.shoc_mix[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.shoc_mix); ++k) { + REQUIRE(d_baseline.shoc_mix[k] == d_cxx.shoc_mix[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -189,14 +181,14 @@ TEST_CASE("shoc_mix_length_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCompShocMixLength; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_mix_length_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCompShocMixLength; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp index e7fd4a507ae..45828793358 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp index 0b848633464..f254b4e077d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestPblintdCheckPblh { +struct UnitWrap::UnitTest::TestPblintdCheckPblh : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr auto ustar_min = scream::shoc::Constants::ustar_min; static constexpr Int shcol = 5; @@ -68,9 +68,7 @@ struct UnitWrap::UnitTest::TestPblintdCheckPblh { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - pblintd_check_pblh_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.nlev, SDS.z, SDS.ustar, SDS.check, SDS.pblh); - SDS.transpose(); // go back to C layout + pblintd_check_pblh(SDS); // Check the result // Check that PBL height is greater than zero. This is an @@ -80,11 +78,11 @@ struct UnitWrap::UnitTest::TestPblintdCheckPblh { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - PblintdCheckPblhData f90_data[] = { + PblintdCheckPblhData baseline_data[] = { PblintdCheckPblhData(36, 72, 73), PblintdCheckPblhData(72, 72, 73), PblintdCheckPblhData(128, 72, 73), @@ -92,47 +90,49 @@ struct UnitWrap::UnitTest::TestPblintdCheckPblh { }; // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine, { {d.check, {1, 1}} }); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state PblintdCheckPblhData cxx_data[] = { - PblintdCheckPblhData(f90_data[0]), - PblintdCheckPblhData(f90_data[1]), - PblintdCheckPblhData(f90_data[2]), - PblintdCheckPblhData(f90_data[3]), + PblintdCheckPblhData(baseline_data[0]), + PblintdCheckPblhData(baseline_data[1]), + PblintdCheckPblhData(baseline_data[2]), + PblintdCheckPblhData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - pblintd_check_pblh(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - pblintd_check_pblh_f(d.shcol, d.nlev, d.nlevi, d.nlev, d.z, d.ustar, d.check, d.pblh); - d.transpose(); // go back to C layout + pblintd_check_pblh(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(PblintdCheckPblhData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(PblintdCheckPblhData); for (Int i = 0; i < num_runs; ++i) { - PblintdCheckPblhData& d_f90 = f90_data[i]; + PblintdCheckPblhData& d_baseline = baseline_data[i]; PblintdCheckPblhData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.pblh); ++k) { - REQUIRE(d_f90.total(d_f90.pblh) == d_cxx.total(d_cxx.pblh)); - REQUIRE(d_f90.pblh[k] == d_cxx.pblh[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.pblh); ++k) { + REQUIRE(d_baseline.total(d_baseline.pblh) == d_cxx.total(d_cxx.pblh)); + REQUIRE(d_baseline.pblh[k] == d_cxx.pblh[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -147,14 +147,14 @@ TEST_CASE("pblintd_check_pblh_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdCheckPblh; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("pblintd_check_pblh_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdCheckPblh; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp index de1c377d185..a239d8f8eb9 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestPblintdCldCheck { +struct UnitWrap::UnitTest::TestPblintdCldCheck : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 5; static constexpr Int nlev = 3; @@ -80,8 +80,7 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck { } // Call the C++ implementation - SDS.transpose(); - shoc_pblintd_cldcheck_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.zi, SDS.cldn, SDS.pblh); + shoc_pblintd_cldcheck(SDS); // Check the result for(Int s = 0; s < shcol; ++s) { @@ -94,11 +93,11 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - PblintdCldcheckData cldcheck_data_f90[] = { + PblintdCldcheckData cldcheck_data_baseline[] = { // shcol, nlev, nlevi PblintdCldcheckData(36, 128, 129), PblintdCldcheckData(72, 128, 129), @@ -106,37 +105,40 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck { PblintdCldcheckData(256, 128, 129), }; - for (auto& d : cldcheck_data_f90) { + for (auto& d : cldcheck_data_baseline) { d.randomize(engine); } PblintdCldcheckData cldcheck_data_cxx[] = { - PblintdCldcheckData(cldcheck_data_f90[0]), - PblintdCldcheckData(cldcheck_data_f90[1]), - PblintdCldcheckData(cldcheck_data_f90[2]), - PblintdCldcheckData(cldcheck_data_f90[3]), + PblintdCldcheckData(cldcheck_data_baseline[0]), + PblintdCldcheckData(cldcheck_data_baseline[1]), + PblintdCldcheckData(cldcheck_data_baseline[2]), + PblintdCldcheckData(cldcheck_data_baseline[3]), }; - // Get data from fortran + // Read baseline data for (auto& d : cldcheck_data_f90) { - // expects data in C layout - pblintd_cldcheck(d); + d.read(Base::m_fid); } for (auto& d : cldcheck_data_cxx) { - d.transpose(); - shoc_pblintd_cldcheck_f(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); + shoc_pblintd_cldcheck(d); } - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(cldcheck_data_f90) / sizeof(PblintdCldcheckData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(cldcheck_data_baseline) / sizeof(PblintdCldcheckData); for (Int i = 0; i < num_runs; ++i) { const Int shcol = cldcheck_data_cxx[i].shcol; for (Int k = 0; k < shcol; ++k) { - REQUIRE(cldcheck_data_f90[i].pblh[k] == cldcheck_data_cxx[i].pblh[k]); + REQUIRE(cldcheck_data_baseline[i].pblh[k] == cldcheck_data_cxx[i].pblh[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -150,14 +152,14 @@ namespace { TEST_CASE("shoc_pblintd_cldcheck_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdCldCheck; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_pblintd_cldcheck_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdCldCheck; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp index c1fc82fd405..ec8337bab5a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestPblintdHeight { +struct UnitWrap::UnitTest::TestPblintdHeight : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr auto ustar_min = scream::shoc::Constants::ustar_min; static const auto approx_zero = Approx(0.0).margin(1e-16); @@ -86,10 +86,7 @@ struct UnitWrap::UnitTest::TestPblintdHeight { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - pblintd_height_f(SDS.shcol, SDS.nlev, SDS.npbl, SDS.z, SDS.u, SDS.v, SDS.ustar, - SDS.thv, SDS.thv_ref, SDS.pblh, SDS.rino, SDS.check); - SDS.transpose(); // go back to C layout + pblintd_height(SDS); // Check the result for(Int s = 0; s < shcol; ++s) { @@ -123,10 +120,7 @@ struct UnitWrap::UnitTest::TestPblintdHeight { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - pblintd_height_f(SDS.shcol, SDS.nlev, SDS.npbl, SDS.z, SDS.u, SDS.v, SDS.ustar, - SDS.thv, SDS.thv_ref, SDS.pblh, SDS.rino, SDS.check); - SDS.transpose(); // go back to C layout + pblintd_height(SDS); // Check the result for(Int s = 0; s < shcol; ++s) { @@ -165,10 +159,7 @@ struct UnitWrap::UnitTest::TestPblintdHeight { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - pblintd_height_f(SDS.shcol, SDS.nlev, SDS.npbl, SDS.z, SDS.u, SDS.v, SDS.ustar, - SDS.thv, SDS.thv_ref, SDS.pblh, SDS.rino, SDS.check); - SDS.transpose(); // go back to C layout + pblintd_height(SDS); // Check that PBLH is zero (not modified) everywhere for(Int s = 0; s < shcol; ++s) { @@ -177,13 +168,13 @@ struct UnitWrap::UnitTest::TestPblintdHeight { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); Int npbl_rand = rand()%72 + 1; - PblintdHeightData f90_data[] = { + PblintdHeightData baseline_data[] = { PblintdHeightData(10, 72, 1), PblintdHeightData(10, 72, 72), PblintdHeightData(10, 72, npbl_rand), @@ -193,50 +184,52 @@ struct UnitWrap::UnitTest::TestPblintdHeight { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state PblintdHeightData cxx_data[] = { - PblintdHeightData(f90_data[0]), - PblintdHeightData(f90_data[1]), - PblintdHeightData(f90_data[2]), - PblintdHeightData(f90_data[3]), - PblintdHeightData(f90_data[4]), - PblintdHeightData(f90_data[5]), + PblintdHeightData(baseline_data[0]), + PblintdHeightData(baseline_data[1]), + PblintdHeightData(baseline_data[2]), + PblintdHeightData(baseline_data[3]), + PblintdHeightData(baseline_data[4]), + PblintdHeightData(baseline_data[5]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - pblintd_height(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - pblintd_height_f(d.shcol, d.nlev, d.npbl, d.z, d.u, d.v, d.ustar, d.thv, d.thv_ref, d.pblh, d.rino, d.check); - d.transpose(); // go back to C layout + pblintd_height(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(PblintdHeightData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(PblintdHeightData); for (Int i = 0; i < num_runs; ++i) { - PblintdHeightData& d_f90 = f90_data[i]; + PblintdHeightData& d_baseline = baseline_data[i]; PblintdHeightData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.pblh); ++k) { - REQUIRE(d_f90.total(d_f90.pblh) == d_cxx.total(d_cxx.pblh)); - REQUIRE(d_f90.pblh[k] == d_cxx.pblh[k]); - REQUIRE(d_f90.total(d_f90.pblh) == d_cxx.total(d_cxx.check)); - REQUIRE(d_f90.check[k] == d_cxx.check[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.pblh); ++k) { + REQUIRE(d_baseline.total(d_baseline.pblh) == d_cxx.total(d_cxx.pblh)); + REQUIRE(d_baseline.pblh[k] == d_cxx.pblh[k]); + REQUIRE(d_baseline.total(d_baseline.pblh) == d_cxx.total(d_cxx.check)); + REQUIRE(d_baseline.check[k] == d_cxx.check[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -251,14 +244,14 @@ TEST_CASE("pblintd_height_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdHeight; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("pblintd_height_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdHeight; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp index dc1a97b3130..888f5814ed2 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestPblintdInitPot { +struct UnitWrap::UnitTest::TestPblintdInitPot : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 1; @@ -77,7 +77,7 @@ struct UnitWrap::UnitTest::TestPblintdInitPot { } // call the C++ implementation - shoc_pblintd_init_pot_f(SDS.shcol, SDS.nlev, SDS.thl, SDS.ql, SDS.q, SDS.thv); + shoc_pblintd_init_pot(SDS); // Check the result. // Verify that virtual potential temperature is idential @@ -126,7 +126,7 @@ struct UnitWrap::UnitTest::TestPblintdInitPot { } // Call the C++ implementation - shoc_pblintd_init_pot_f(SDS.shcol, SDS.nlev, SDS.thl, SDS.ql, SDS.q, SDS.thv); + shoc_pblintd_init_pot(SDS); // Check test // Verify that column with condensate loading @@ -149,11 +149,11 @@ struct UnitWrap::UnitTest::TestPblintdInitPot { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - PblintdInitPotData pblintd_init_pot_data_f90[] = { + PblintdInitPotData pblintd_init_pot_data_baseline[] = { // shcol, nlev PblintdInitPotData(36, 72), PblintdInitPotData(72, 72), @@ -161,39 +161,43 @@ struct UnitWrap::UnitTest::TestPblintdInitPot { PblintdInitPotData(256, 72), }; - for (auto& d : pblintd_init_pot_data_f90) { + for (auto& d : pblintd_init_pot_data_baseline) { d.randomize(engine); } PblintdInitPotData pblintd_init_pot_data_cxx[] = { - PblintdInitPotData(pblintd_init_pot_data_f90[0]), - PblintdInitPotData(pblintd_init_pot_data_f90[1]), - PblintdInitPotData(pblintd_init_pot_data_f90[2]), - PblintdInitPotData(pblintd_init_pot_data_f90[3]), + PblintdInitPotData(pblintd_init_pot_data_baseline[0]), + PblintdInitPotData(pblintd_init_pot_data_baseline[1]), + PblintdInitPotData(pblintd_init_pot_data_baseline[2]), + PblintdInitPotData(pblintd_init_pot_data_baseline[3]), }; - // Get data from fortran + // Read baseline data for (auto& d : pblintd_init_pot_data_f90) { - // expects data in C layout - pblintd_init_pot(d); + d.read(Base::m_fid); } for (auto& d : pblintd_init_pot_data_cxx) { - shoc_pblintd_init_pot_f(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); + shoc_pblintd_init_pot(d); } - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(pblintd_init_pot_data_f90) / sizeof(PblintdInitPotData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(pblintd_init_pot_data_baseline) / sizeof(PblintdInitPotData); for (Int i = 0; i < num_runs; ++i) { Int shcol = pblintd_init_pot_data_cxx[i].shcol; Int nlev = pblintd_init_pot_data_cxx[i].nlev; for (Int j = 0; j < shcol; ++j ) { for (Int k = 0; k < nlev; ++k) { - REQUIRE(pblintd_init_pot_data_f90[i].thv[j*k] == pblintd_init_pot_data_cxx[i].thv[j*k]); + REQUIRE(pblintd_init_pot_data_baseline[i].thv[j*k] == pblintd_init_pot_data_cxx[i].thv[j*k]); } } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -208,14 +212,14 @@ TEST_CASE("shoc_pblintd_init_pot_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdInitPot; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_pblintd_init_pot_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdInitPot; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp index 072bcc5d1d9..0efdfc5ba03 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestPblintdSurfTemp { +struct UnitWrap::UnitTest::TestPblintdSurfTemp : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr auto ustar_min = scream::shoc::Constants::ustar_min; static constexpr Int shcol = 4; @@ -84,10 +84,7 @@ struct UnitWrap::UnitTest::TestPblintdSurfTemp { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - pblintd_surf_temp_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.z, SDS.ustar, SDS.obklen, - SDS.kbfs, SDS.thv, SDS.tlv, SDS.pblh, SDS.check, SDS.rino); - SDS.transpose(); // go back to C layout + pblintd_surf_temp(SDS); // Check the result for(Int s = 0; s < shcol; ++s) { @@ -112,11 +109,11 @@ struct UnitWrap::UnitTest::TestPblintdSurfTemp { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - PblintdSurfTempData f90_data[] = { + PblintdSurfTempData baseline_data[] = { PblintdSurfTempData(6, 7, 8), PblintdSurfTempData(64, 72, 73), PblintdSurfTempData(128, 72, 73), @@ -124,55 +121,57 @@ struct UnitWrap::UnitTest::TestPblintdSurfTemp { }; // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine, { {d.obklen, {100., 200.}} }); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state PblintdSurfTempData cxx_data[] = { - PblintdSurfTempData(f90_data[0]), - PblintdSurfTempData(f90_data[1]), - PblintdSurfTempData(f90_data[2]), - PblintdSurfTempData(f90_data[3]), + PblintdSurfTempData(baseline_data[0]), + PblintdSurfTempData(baseline_data[1]), + PblintdSurfTempData(baseline_data[2]), + PblintdSurfTempData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - pblintd_surf_temp(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - pblintd_surf_temp_f(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.obklen, d.kbfs, d.thv, d.tlv, d.pblh, d.check, d.rino); - d.transpose(); // go back to C layout + pblintd_surf_temp(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(PblintdSurfTempData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(PblintdSurfTempData); for (Int i = 0; i < num_runs; ++i) { - PblintdSurfTempData& d_f90 = f90_data[i]; + PblintdSurfTempData& d_baseline = baseline_data[i]; PblintdSurfTempData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.tlv); ++k) { - REQUIRE(d_f90.total(d_f90.tlv) == d_cxx.total(d_cxx.tlv)); - REQUIRE(d_f90.tlv[k] == d_cxx.tlv[k]); - REQUIRE(d_f90.total(d_f90.tlv) == d_cxx.total(d_cxx.pblh)); - REQUIRE(d_f90.pblh[k] == d_cxx.pblh[k]); - REQUIRE(d_f90.total(d_f90.tlv) == d_cxx.total(d_cxx.check)); - REQUIRE(d_f90.check[k] == d_cxx.check[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.tlv); ++k) { + REQUIRE(d_baseline.total(d_baseline.tlv) == d_cxx.total(d_cxx.tlv)); + REQUIRE(d_baseline.tlv[k] == d_cxx.tlv[k]); + REQUIRE(d_baseline.total(d_baseline.tlv) == d_cxx.total(d_cxx.pblh)); + REQUIRE(d_baseline.pblh[k] == d_cxx.pblh[k]); + REQUIRE(d_baseline.total(d_baseline.tlv) == d_cxx.total(d_cxx.check)); + REQUIRE(d_baseline.check[k] == d_cxx.check[k]); } - for (Int k = 0; k < d_f90.total(d_f90.rino); ++k) { - REQUIRE(d_f90.total(d_f90.rino) == d_cxx.total(d_cxx.rino)); - REQUIRE(d_f90.rino[k] == d_cxx.rino[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.rino); ++k) { + REQUIRE(d_baseline.total(d_baseline.rino) == d_cxx.total(d_cxx.rino)); + REQUIRE(d_baseline.rino[k] == d_cxx.rino[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -187,14 +186,14 @@ TEST_CASE("pblintd_surf_temp_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdSurfTemp; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("pblintd_surf_temp_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintdSurfTemp; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp index 8878b7b10bc..a201e60ce76 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestPblintd { +struct UnitWrap::UnitTest::TestPblintd : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr auto ustar_min = scream::shoc::Constants::ustar_min; static constexpr Int shcol = 5; @@ -122,11 +122,7 @@ struct UnitWrap::UnitTest::TestPblintd { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - pblintd_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.npbl, SDS.z, SDS.zi, - SDS.thl, SDS.ql, SDS.q, SDS.u, SDS.v, SDS.ustar, SDS.obklen, - SDS.kbfs, SDS.cldn, SDS.pblh); - SDS.transpose(); // go back to C layout + pblintd(SDS); // Make sure PBL height is reasonable // Should be larger than second lowest zi level and lower @@ -140,13 +136,13 @@ struct UnitWrap::UnitTest::TestPblintd { } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); Int npbl_rand = rand()%71 + 1; - PblintdData f90_data[] = { + PblintdData baseline_data[] = { PblintdData(10, 71, 72, 71), PblintdData(10, 71, 72, 1), PblintdData(10, 71, 72, npbl_rand), @@ -156,48 +152,50 @@ struct UnitWrap::UnitTest::TestPblintd { }; // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state PblintdData cxx_data[] = { - PblintdData(f90_data[0]), - PblintdData(f90_data[1]), - PblintdData(f90_data[2]), - PblintdData(f90_data[3]), - PblintdData(f90_data[4]), - PblintdData(f90_data[5]), + PblintdData(baseline_data[0]), + PblintdData(baseline_data[1]), + PblintdData(baseline_data[2]), + PblintdData(baseline_data[3]), + PblintdData(baseline_data[4]), + PblintdData(baseline_data[5]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - pblintd(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - pblintd_f(d.shcol, d.nlev, d.nlevi, d.npbl, d.z, d.zi, d.thl, d.ql, d.q, d.u, d.v, d.ustar, d.obklen, d.kbfs, d.cldn, d.pblh); - d.transpose(); // go back to C layout + pblintd(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(PblintdData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(PblintdData); for (Int i = 0; i < num_runs; ++i) { - PblintdData& d_f90 = f90_data[i]; + PblintdData& d_baseline = baseline_data[i]; PblintdData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.pblh); ++k) { - REQUIRE(d_f90.pblh[k] == d_cxx.pblh[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.pblh); ++k) { + REQUIRE(d_baseline.pblh[k] == d_cxx.pblh[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -212,14 +210,14 @@ TEST_CASE("pblintd_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintd; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("pblintd_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestPblintd; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp index 261cc24dc29..5eb8488a070 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_cloudvar_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_cloudvar_tests.cpp index 79594e068a1..7fdd57ff005 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_cloudvar_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_cloudvar_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_liqflux_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_liqflux_tests.cpp index f1dd2e9bc0e..bee4f5db740 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_liqflux_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_liqflux_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_qs_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_qs_tests.cpp index 6e430a02f06..4a3e0cf8a6f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_qs_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_qs_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_s_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_s_tests.cpp index 0f40ccb63a0..ffdddaa1928 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_s_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_s_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_sgsliq_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_sgsliq_tests.cpp index 3964cf6e7ed..af5e87dc418 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_sgsliq_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_sgsliq_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp index ce4d27dc15a..f850607ee45 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_inplume_corr_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_inplume_corr_tests.cpp index d1d17fcebef..a9ffdf242f3 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_inplume_corr_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_inplume_corr_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp index 5e7b0b8d72a..645abf9fef9 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp index f00c7b2c292..727f3951a2a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_tildetoreal_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_tildetoreal_tests.cpp index 3c0f84a6222..a0728f2e358 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_tildetoreal_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_tildetoreal_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp index 2f0abe43e76..c1a9cab2673 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp index 94a58b4de9c..b98027ba5c8 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp @@ -1,5 +1,5 @@ #include "shoc_main_wrap.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "shoc_ic_cases.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp index e8f0321a837..07a5fd4ecbd 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp @@ -1,7 +1,7 @@ #include "catch2/catch.hpp" #include "shoc_unit_tests_common.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "shoc_functions.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" @@ -22,9 +22,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocAdvSgsTke { +struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real mintke = scream::shoc::Constants::mintke; static constexpr Real maxtke = scream::shoc::Constants::maxtke; @@ -95,9 +95,7 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - adv_sgs_tke_f(SDS.nlev, SDS.shcol, SDS.dtime, SDS.shoc_mix, SDS.wthv_sec, SDS.sterm_zt, SDS.tk, SDS.tke, SDS.a_diss); - SDS.transpose(); // go back to C layout + adv_sgs_tke(SDS); // Check to make sure that there has been // TKE growth @@ -162,9 +160,7 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - adv_sgs_tke_f(SDS.nlev, SDS.shcol, SDS.dtime, SDS.shoc_mix, SDS.wthv_sec, SDS.sterm_zt, SDS.tk, SDS.tke, SDS.a_diss); - SDS.transpose(); // go back to C layout + adv_sgs_tke(SDS); // Check to make sure that the column with // the smallest length scale has larger @@ -194,11 +190,11 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - AdvSgsTkeData f90_data[] = { + AdvSgsTkeData baseline_data[] = { // shcol, nlev AdvSgsTkeData(10, 71, 72), AdvSgsTkeData(10, 12, 13), @@ -207,46 +203,48 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state AdvSgsTkeData cxx_data[] = { - AdvSgsTkeData(f90_data[0]), - AdvSgsTkeData(f90_data[1]), - AdvSgsTkeData(f90_data[2]), - AdvSgsTkeData(f90_data[3]), + AdvSgsTkeData(baseline_data[0]), + AdvSgsTkeData(baseline_data[1]), + AdvSgsTkeData(baseline_data[2]), + AdvSgsTkeData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - adv_sgs_tke(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - adv_sgs_tke_f(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); - d.transpose(); // go back to C layout + adv_sgs_tke(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(AdvSgsTkeData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(AdvSgsTkeData); for (Int i = 0; i < num_runs; ++i) { - AdvSgsTkeData& d_f90 = f90_data[i]; + AdvSgsTkeData& d_baseline = baseline_data[i]; AdvSgsTkeData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.tke); ++k) { - REQUIRE(d_f90.tke[k] == d_cxx.tke[k]); - REQUIRE(d_f90.a_diss[k] == d_cxx.a_diss[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.tke); ++k) { + REQUIRE(d_baseline.tke[k] == d_cxx.tke[k]); + REQUIRE(d_baseline.a_diss[k] == d_cxx.a_diss[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } }//run_bfb }; @@ -260,14 +258,14 @@ TEST_CASE("shoc_tke_adv_sgs_tke_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAdvSgsTke; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_tke_adv_sgs_tke_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocAdvSgsTke; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp index d576de1174c..ff01ef1dcf8 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocIntColStab { +struct UnitWrap::UnitTest::TestShocIntColStab : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -76,9 +76,7 @@ struct UnitWrap::UnitTest::TestShocIntColStab { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - integ_column_stability_f(SDS.nlev, SDS.shcol, SDS.dz_zt, SDS.pres, SDS.brunt, SDS.brunt_int); - SDS.transpose(); // go back to C layout + integ_column_stability(SDS); // Check test // Verify that output is zero @@ -110,9 +108,7 @@ struct UnitWrap::UnitTest::TestShocIntColStab { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - integ_column_stability_f(SDS.nlev, SDS.shcol, SDS.dz_zt, SDS.pres, SDS.brunt, SDS.brunt_int); - SDS.transpose(); // go back to C layout + integ_column_stability(SDS); // Check test // Verify that output is negative @@ -121,12 +117,12 @@ struct UnitWrap::UnitTest::TestShocIntColStab { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - //declare data for the f90 function call - IntegColumnStabilityData f90_data[] = { + //declare data for the baseline function call + IntegColumnStabilityData baseline_data[] = { IntegColumnStabilityData(10, 71), IntegColumnStabilityData(10, 12), IntegColumnStabilityData(7, 16), @@ -134,45 +130,47 @@ struct UnitWrap::UnitTest::TestShocIntColStab { }; //Generate random data - for (auto &d : f90_data) { + for (auto &d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data (if any) is in original state IntegColumnStabilityData cxx_data[] = { - IntegColumnStabilityData(f90_data[0]), - IntegColumnStabilityData(f90_data[1]), - IntegColumnStabilityData(f90_data[2]), - IntegColumnStabilityData(f90_data[3]), + IntegColumnStabilityData(baseline_data[0]), + IntegColumnStabilityData(baseline_data[1]), + IntegColumnStabilityData(baseline_data[2]), + IntegColumnStabilityData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto &d : f90_data) { - // expects data in C layout - integ_column_stability(d); + // Read baseline data + for (auto &d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto &d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - integ_column_stability_f(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); - d.transpose(); // go back to C layout + integ_column_stability(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(IntegColumnStabilityData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(IntegColumnStabilityData); for (Int i = 0; i < num_runs; ++i) { - IntegColumnStabilityData& d_f90 = f90_data[i]; + IntegColumnStabilityData& d_baseline = baseline_data[i]; IntegColumnStabilityData& d_cxx = cxx_data[i]; - for (Int c = 0; c < d_f90.shcol; ++c) { - REQUIRE(d_f90.brunt_int[c] == d_cxx.brunt_int[c]); + for (Int c = 0; c < d_baseline.shcol; ++c) { + REQUIRE(d_baseline.brunt_int[c] == d_cxx.brunt_int[c]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } //run_bfb }; @@ -186,14 +184,14 @@ TEST_CASE("shoc_tke_column_stab_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocIntColStab; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_tke_column_stab_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocIntColStab; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp index 558f40481f4..5c1a73ff9df 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocIsotropicTs { +struct UnitWrap::UnitTest::TestShocIsotropicTs : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real maxiso = scream::shoc::Constants::maxiso; static constexpr Int shcol = 2; @@ -82,9 +82,7 @@ struct UnitWrap::UnitTest::TestShocIsotropicTs { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - isotropic_ts_f(SDS.nlev, SDS.shcol, SDS.brunt_int, SDS.tke, SDS.a_diss, SDS.brunt, SDS.isotropy); - SDS.transpose(); // go back to C layout + isotropic_ts(SDS); // Check that output falls within reasonable bounds for(Int s = 0; s < shcol; ++s) { @@ -148,9 +146,7 @@ struct UnitWrap::UnitTest::TestShocIsotropicTs { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - isotropic_ts_f(SDS.nlev, SDS.shcol, SDS.brunt_int, SDS.tke, SDS.a_diss, SDS.brunt, SDS.isotropy); - SDS.transpose(); // go back to C layout + isotropic_ts(SDS); // Check that output falls within reasonable bounds for(Int s = 0; s < shcol; ++s) { @@ -178,11 +174,11 @@ struct UnitWrap::UnitTest::TestShocIsotropicTs { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - IsotropicTsData f90_data[] = { + IsotropicTsData baseline_data[] = { // shcol, nlev IsotropicTsData(10, 71), IsotropicTsData(10, 12), @@ -191,45 +187,47 @@ struct UnitWrap::UnitTest::TestShocIsotropicTs { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state IsotropicTsData cxx_data[] = { - IsotropicTsData(f90_data[0]), - IsotropicTsData(f90_data[1]), - IsotropicTsData(f90_data[2]), - IsotropicTsData(f90_data[3]), + IsotropicTsData(baseline_data[0]), + IsotropicTsData(baseline_data[1]), + IsotropicTsData(baseline_data[2]), + IsotropicTsData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - isotropic_ts(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - isotropic_ts_f(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); - d.transpose(); // go back to C layout + isotropic_ts(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(IsotropicTsData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(IsotropicTsData); for (Int i = 0; i < num_runs; ++i) { - IsotropicTsData& d_f90 = f90_data[i]; + IsotropicTsData& d_baseline = baseline_data[i]; IsotropicTsData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.isotropy); ++k) { - REQUIRE(d_f90.isotropy[k] == d_cxx.isotropy[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.isotropy); ++k) { + REQUIRE(d_baseline.isotropy[k] == d_cxx.isotropy[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } }//run_bfb }; @@ -244,14 +242,14 @@ TEST_CASE("shoc_tke_isotropic_ts_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocIsotropicTs; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_tke_isotropic_ts_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocIsotropicTs; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp index a19c2233e9d..a3349d8b55f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocShearProd { +struct UnitWrap::UnitTest::TestShocShearProd : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 5; @@ -94,9 +94,7 @@ struct UnitWrap::UnitTest::TestShocShearProd { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - compute_shr_prod_f(SDS.nlevi, SDS.nlev, SDS.shcol, SDS.dz_zi, SDS.u_wind, SDS.v_wind, SDS.sterm); - SDS.transpose(); // go back to C layout + compute_shr_prod(SDS); // Check test for(Int s = 0; s < shcol; ++s) { @@ -145,9 +143,7 @@ struct UnitWrap::UnitTest::TestShocShearProd { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - compute_shr_prod_f(SDS.nlevi, SDS.nlev, SDS.shcol, SDS.dz_zi, SDS.u_wind, SDS.v_wind, SDS.sterm); - SDS.transpose(); // go back to C layout + compute_shr_prod(SDS); // Check test // Verify that shear term is zero everywhere @@ -159,11 +155,11 @@ struct UnitWrap::UnitTest::TestShocShearProd { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ComputeShrProdData f90_data[] = { + ComputeShrProdData baseline_data[] = { // shcol, nlev ComputeShrProdData(10, 71, 72), ComputeShrProdData(10, 12, 13), @@ -172,45 +168,47 @@ struct UnitWrap::UnitTest::TestShocShearProd { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ComputeShrProdData cxx_data[] = { - ComputeShrProdData(f90_data[0]), - ComputeShrProdData(f90_data[1]), - ComputeShrProdData(f90_data[2]), - ComputeShrProdData(f90_data[3]), + ComputeShrProdData(baseline_data[0]), + ComputeShrProdData(baseline_data[1]), + ComputeShrProdData(baseline_data[2]), + ComputeShrProdData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - compute_shr_prod(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - compute_shr_prod_f(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); - d.transpose(); // go back to C layout + compute_shr_prod(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ComputeShrProdData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ComputeShrProdData); for (Int i = 0; i < num_runs; ++i) { - ComputeShrProdData& d_f90 = f90_data[i]; + ComputeShrProdData& d_baseline = baseline_data[i]; ComputeShrProdData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.sterm); ++k) { - REQUIRE(d_f90.sterm[k] == d_cxx.sterm[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.sterm); ++k) { + REQUIRE(d_baseline.sterm[k] == d_cxx.sterm[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } //run_bfb }; @@ -224,14 +222,14 @@ TEST_CASE("shoc_tke_shr_prod_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocShearProd; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_tke_shr_prod_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocShearProd; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp index 41c2ebc50bf..5b37bb1b5a1 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocTke { +struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Real mintke = scream::shoc::Constants::mintke; static constexpr Real maxtke = scream::shoc::Constants::maxtke; @@ -154,11 +154,7 @@ struct UnitWrap::UnitTest::TestShocTke { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - shoc_tke_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.dtime, SDS.wthv_sec, SDS.shoc_mix, SDS.dz_zi, SDS.dz_zt, - SDS.pres, SDS.tabs, SDS.u_wind, SDS.v_wind, SDS.brunt, SDS.zt_grid, SDS.zi_grid, SDS.pblh, - SDS.tke, SDS.tk, SDS.tkh, SDS.isotropy); - SDS.transpose(); // go back to C layout + shoc_tke(SDS); // Check test // Make sure that TKE has increased everwhere relative @@ -231,11 +227,7 @@ struct UnitWrap::UnitTest::TestShocTke { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - shoc_tke_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.dtime, SDS.wthv_sec, SDS.shoc_mix, SDS.dz_zi, SDS.dz_zt, - SDS.pres, SDS.tabs, SDS.u_wind, SDS.v_wind, SDS.brunt, SDS.zt_grid, SDS.zi_grid, SDS.pblh, - SDS.tke, SDS.tk, SDS.tkh, SDS.isotropy); - SDS.transpose(); // go back to C layout + shoc_tke(SDS); // Check the result @@ -254,11 +246,11 @@ struct UnitWrap::UnitTest::TestShocTke { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - ShocTkeData f90_data[] = { + ShocTkeData baseline_data[] = { ShocTkeData(10, 71, 72, 300), ShocTkeData(10, 12, 13, 100), ShocTkeData(7, 16, 17, 50), @@ -266,55 +258,55 @@ struct UnitWrap::UnitTest::TestShocTke { }; // Generate random input data - // Alternatively, you can use the f90_data construtors/initializer lists to hardcode data - for (auto& d : f90_data) { + // Alternatively, you can use the baseline_data construtors/initializer lists to hardcode data + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state ShocTkeData cxx_data[] = { - ShocTkeData(f90_data[0]), - ShocTkeData(f90_data[1]), - ShocTkeData(f90_data[2]), - ShocTkeData(f90_data[3]), + ShocTkeData(baseline_data[0]), + ShocTkeData(baseline_data[1]), + ShocTkeData(baseline_data[2]), + ShocTkeData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - shoc_tke(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - shoc_tke_f(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, - d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, - d.tke, d.tk, d.tkh, d.isotropy); - d.transpose(); // go back to C layout + shoc_tke(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(ShocTkeData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(ShocTkeData); for (Int i = 0; i < num_runs; ++i) { - ShocTkeData& d_f90 = f90_data[i]; + ShocTkeData& d_baseline = baseline_data[i]; ShocTkeData& d_cxx = cxx_data[i]; - REQUIRE(d_f90.total(d_f90.tke) == d_cxx.total(d_cxx.tke)); - REQUIRE(d_f90.total(d_f90.tke) == d_cxx.total(d_cxx.tk)); - REQUIRE(d_f90.total(d_f90.tke) == d_cxx.total(d_cxx.tkh)); - REQUIRE(d_f90.total(d_f90.tke) == d_cxx.total(d_cxx.isotropy)); - for (Int k = 0; k < d_f90.total(d_f90.tke); ++k) { - REQUIRE(d_f90.tke[k] == d_cxx.tke[k]); - REQUIRE(d_f90.tk[k] == d_cxx.tk[k]); - REQUIRE(d_f90.tkh[k] == d_cxx.tkh[k]); - REQUIRE(d_f90.isotropy[k] == d_cxx.isotropy[k]); + REQUIRE(d_baseline.total(d_baseline.tke) == d_cxx.total(d_cxx.tke)); + REQUIRE(d_baseline.total(d_baseline.tke) == d_cxx.total(d_cxx.tk)); + REQUIRE(d_baseline.total(d_baseline.tke) == d_cxx.total(d_cxx.tkh)); + REQUIRE(d_baseline.total(d_baseline.tke) == d_cxx.total(d_cxx.isotropy)); + for (Int k = 0; k < d_baseline.total(d_baseline.tke); ++k) { + REQUIRE(d_baseline.tke[k] == d_cxx.tke[k]); + REQUIRE(d_baseline.tk[k] == d_cxx.tk[k]); + REQUIRE(d_baseline.tkh[k] == d_cxx.tkh[k]); + REQUIRE(d_baseline.isotropy[k] == d_cxx.isotropy[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -328,14 +320,14 @@ TEST_CASE("shoc_tke_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocTke; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_tke_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocTke; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_unit_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_unit_tests.cpp index 71fe03f3cbb..f564c74fab4 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_unit_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_unit_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp index 82313e22ca7..4af28ede5eb 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,9 +14,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit { +struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 5; static constexpr Int nlev = 5; @@ -259,17 +259,10 @@ struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit { } // Call the C++ implementation - SDS.transpose(); // _f expects data in fortran layout - update_prognostics_implicit_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.num_tracer, SDS.dtime, - SDS.dz_zt, SDS.dz_zi, SDS.rho_zt, SDS.zt_grid, SDS.zi_grid, - SDS.tk, SDS.tkh, SDS.uw_sfc, SDS.vw_sfc, SDS.wthl_sfc, SDS.wqw_sfc, - SDS.wtracer_sfc, SDS.thetal, SDS.qw, SDS.tracer, SDS.tke, SDS.u_wind, SDS.v_wind); - SDS.transpose(); // go back to C layout + update_prognostics_implicit(SDS); // Call linear interp to get rho value at surface for checking - SDSL.transpose(); // _f expects data in fortran layout - linear_interp_f(SDSL.x1, SDSL.x2, SDSL.y1, SDSL.y2, SDSL.km1, SDSL.km2, SDSL.ncol, SDSL.minthresh); - SDSL.transpose(); // go back to C layout + linear_interp(SDSL); // Check the result @@ -341,11 +334,11 @@ struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit { } // run_property - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - UpdatePrognosticsImplicitData f90_data[] = { + UpdatePrognosticsImplicitData baseline_data[] = { UpdatePrognosticsImplicitData(10, 71, 72, 19, .5), UpdatePrognosticsImplicitData(10, 12, 13, 7, .25), UpdatePrognosticsImplicitData(7, 16, 17, 2, .1), @@ -353,63 +346,62 @@ struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit { }; // Generate random input data - for (auto& d : f90_data) { + for (auto& d : baseline_data) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state UpdatePrognosticsImplicitData cxx_data[] = { - UpdatePrognosticsImplicitData(f90_data[0]), - UpdatePrognosticsImplicitData(f90_data[1]), - UpdatePrognosticsImplicitData(f90_data[2]), - UpdatePrognosticsImplicitData(f90_data[3]), + UpdatePrognosticsImplicitData(baseline_data[0]), + UpdatePrognosticsImplicitData(baseline_data[1]), + UpdatePrognosticsImplicitData(baseline_data[2]), + UpdatePrognosticsImplicitData(baseline_data[3]), }; // Assume all data is in C layout - // Get data from fortran - for (auto& d : f90_data) { - // expects data in C layout - update_prognostics_implicit(d); + // Read baseline data + for (auto& d : baseline_data) { + d.read(Base::m_fid); } // Get data from cxx for (auto& d : cxx_data) { - d.transpose(); // _f expects data in fortran layout - update_prognostics_implicit_f(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, - d.dz_zt, d.dz_zi, d.rho_zt, d.zt_grid, d.zi_grid, - d.tk, d.tkh, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, - d.wtracer_sfc, d.thetal, d.qw, d.tracer, d.tke, d.u_wind, d.v_wind); - d.transpose(); // go back to C layout + update_prognostics_implicit(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(f90_data) / sizeof(UpdatePrognosticsImplicitData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(UpdatePrognosticsImplicitData); for (Int i = 0; i < num_runs; ++i) { - UpdatePrognosticsImplicitData& d_f90 = f90_data[i]; + UpdatePrognosticsImplicitData& d_baseline = baseline_data[i]; UpdatePrognosticsImplicitData& d_cxx = cxx_data[i]; - REQUIRE(d_f90.total(d_f90.thetal) == d_cxx.total(d_cxx.thetal)); - REQUIRE(d_f90.total(d_f90.qw) == d_cxx.total(d_cxx.qw)); - REQUIRE(d_f90.total(d_f90.tke) == d_cxx.total(d_cxx.tke)); - REQUIRE(d_f90.total(d_f90.u_wind) == d_cxx.total(d_cxx.u_wind)); - REQUIRE(d_f90.total(d_f90.v_wind) == d_cxx.total(d_cxx.v_wind)); - for (Int k = 0; k < d_f90.total(d_f90.thetal); ++k) { - REQUIRE(d_f90.thetal[k] == d_cxx.thetal[k]); - REQUIRE(d_f90.qw[k] == d_cxx.qw[k]); - REQUIRE(d_f90.tke[k] == d_cxx.tke[k]); - REQUIRE(d_f90.u_wind[k] == d_cxx.u_wind[k]); - REQUIRE(d_f90.v_wind[k] == d_cxx.v_wind[k]); + REQUIRE(d_baseline.total(d_baseline.thetal) == d_cxx.total(d_cxx.thetal)); + REQUIRE(d_baseline.total(d_baseline.qw) == d_cxx.total(d_cxx.qw)); + REQUIRE(d_baseline.total(d_baseline.tke) == d_cxx.total(d_cxx.tke)); + REQUIRE(d_baseline.total(d_baseline.u_wind) == d_cxx.total(d_cxx.u_wind)); + REQUIRE(d_baseline.total(d_baseline.v_wind) == d_cxx.total(d_cxx.v_wind)); + for (Int k = 0; k < d_baseline.total(d_baseline.thetal); ++k) { + REQUIRE(d_baseline.thetal[k] == d_cxx.thetal[k]); + REQUIRE(d_baseline.qw[k] == d_cxx.qw[k]); + REQUIRE(d_baseline.tke[k] == d_cxx.tke[k]); + REQUIRE(d_baseline.u_wind[k] == d_cxx.u_wind[k]); + REQUIRE(d_baseline.v_wind[k] == d_cxx.v_wind[k]); } - REQUIRE(d_f90.total(d_f90.tracer) == d_cxx.total(d_cxx.tracer)); - for (Int k = 0; k < d_f90.total(d_f90.tracer); ++k) { - REQUIRE(d_f90.tracer[k] == d_cxx.tracer[k]); + REQUIRE(d_baseline.total(d_baseline.tracer) == d_cxx.total(d_cxx.tracer)); + for (Int k = 0; k < d_baseline.total(d_baseline.tracer); ++k) { + REQUIRE(d_baseline.tracer[k] == d_cxx.tracer[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -424,14 +416,14 @@ TEST_CASE("update_prognostics_implicit_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestUpdatePrognosticsImplicit; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("update_prognostics_implicit_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestUpdatePrognosticsImplicit; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp index cbf66bc4a58..2c45e98e3f5 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp @@ -4,7 +4,7 @@ #include "physics/share/physics_constants.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -23,9 +23,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestShocVarorCovar { +struct UnitWrap::UnitTest::TestShocVarorCovar : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 4; @@ -116,13 +116,7 @@ struct UnitWrap::UnitTest::TestShocVarorCovar { } // Call the C++ implementation for variance - SDS.transpose(); - // expects data in fortran layout - calc_shoc_varorcovar_f(SDS.shcol, SDS.nlev, SDS.nlevi, - SDS.tunefac, SDS.isotropy_zi, - SDS.tkh_zi, SDS.dz_zi, - SDS.invar1, SDS.invar2, SDS.varorcovar); - SDS.transpose(); + calc_shoc_varorcovar(SDS); // Check the results for(Int s = 0; s < shcol; ++s) { @@ -179,13 +173,7 @@ struct UnitWrap::UnitTest::TestShocVarorCovar { } // Call the C++ implementation for covariance - SDS.transpose(); - // expects data in fortran layout - calc_shoc_varorcovar_f(SDS.shcol, SDS.nlev, SDS.nlevi, - SDS.tunefac, SDS.isotropy_zi, - SDS.tkh_zi, SDS.dz_zi, - SDS.invar1, SDS.invar2, SDS.varorcovar); - SDS.transpose(); + calc_shoc_varorcovar(SDS); // Check the results for(Int s = 0; s < shcol; ++s) { @@ -263,13 +251,7 @@ struct UnitWrap::UnitTest::TestShocVarorCovar { } // Call the C++ implementation for variance - SDS.transpose(); - // expects data in fortran layout - calc_shoc_varorcovar_f(SDS.shcol, SDS.nlev, SDS.nlevi, - SDS.tunefac, SDS.isotropy_zi, - SDS.tkh_zi, SDS.dz_zi, - SDS.invar1, SDS.invar2, SDS.varorcovar); - SDS.transpose(); + calc_shoc_varorcovar(SDS); // Check the results for(Int s = 0; s < shcol; ++s) { @@ -284,11 +266,11 @@ struct UnitWrap::UnitTest::TestShocVarorCovar { } } -static void run_bfb() +void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - CalcShocVarorcovarData SDS_f90[] = { + CalcShocVarorcovarData SDS_baseline[] = { // shcol, nlev, nlevi, tunefac CalcShocVarorcovarData(10, 71, 72, 1), CalcShocVarorcovarData(10, 12, 13, 1), @@ -297,49 +279,47 @@ static void run_bfb() }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state CalcShocVarorcovarData SDS_cxx[] = { - CalcShocVarorcovarData(SDS_f90[0]), - CalcShocVarorcovarData(SDS_f90[1]), - CalcShocVarorcovarData(SDS_f90[2]), - CalcShocVarorcovarData(SDS_f90[3]), + CalcShocVarorcovarData(SDS_baseline[0]), + CalcShocVarorcovarData(SDS_baseline[1]), + CalcShocVarorcovarData(SDS_baseline[2]), + CalcShocVarorcovarData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - calc_shoc_varorcovar(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - calc_shoc_varorcovar_f(d.shcol, d.nlev, d.nlevi, - d.tunefac, d.isotropy_zi, - d.tkh_zi, d.dz_zi, - d.invar1, d.invar2, d.varorcovar); - d.transpose(); + calc_shoc_varorcovar(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(CalcShocVarorcovarData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CalcShocVarorcovarData); for (Int i = 0; i < num_runs; ++i) { - CalcShocVarorcovarData& d_f90 = SDS_f90[i]; + CalcShocVarorcovarData& d_baseline = SDS_baseline[i]; CalcShocVarorcovarData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.varorcovar); ++k) { - REQUIRE(d_f90.varorcovar[k] == d_cxx.varorcovar[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.varorcovar); ++k) { + REQUIRE(d_baseline.varorcovar[k] == d_cxx.varorcovar[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -353,14 +333,14 @@ TEST_CASE("shoc_varorcovar_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocVarorCovar; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_varorcovar_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocVarorCovar; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp index 5f373f870b6..aeeb1ecd0fe 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp @@ -4,7 +4,7 @@ #include "ekat/ekat_pack.hpp" #include "ekat/kokkos/ekat_kokkos_utils.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/util/scream_setup_random_test.hpp" #include "shoc_unit_tests_common.hpp" @@ -14,13 +14,13 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestVdShocDecompandSolve { +struct UnitWrap::UnitTest::TestVdShocDecompandSolve : public UnitWrap::UnitTest::Base { - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - VdShocDecompandSolveData f90_data[] = { + VdShocDecompandSolveData baseline_data[] = { // shcol, nlev, nlevi, dtime, n_rhs VdShocDecompandSolveData(10, 71, 72, 5, 19), VdShocDecompandSolveData(10, 12, 13, 2.5, 7), @@ -28,55 +28,52 @@ struct UnitWrap::UnitTest::TestVdShocDecompandSolve { VdShocDecompandSolveData(2, 7, 8, 1, 1) }; - static constexpr Int num_runs = sizeof(f90_data) / sizeof(VdShocDecompandSolveData); + static constexpr Int num_runs = sizeof(baseline_data) / sizeof(VdShocDecompandSolveData); // Generate random input data. Diagonals in solver data will be overwritten // after results of decomp routine. for (Int i = 0; i < num_runs; ++i) { - VdShocDecompandSolveData& d_f90 = f90_data[i]; - d_f90.randomize(engine); + VdShocDecompandSolveData& d_baseline = baseline_data[i]; + d_baseline.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state VdShocDecompandSolveData cxx_data[] = { - VdShocDecompandSolveData(f90_data[0]), - VdShocDecompandSolveData(f90_data[1]), - VdShocDecompandSolveData(f90_data[2]), - VdShocDecompandSolveData(f90_data[3]) + VdShocDecompandSolveData(baseline_data[0]), + VdShocDecompandSolveData(baseline_data[1]), + VdShocDecompandSolveData(baseline_data[2]), + VdShocDecompandSolveData(baseline_data[3]) }; // Assume all data is in C layout - // Get data from fortran. + // Read baseline data. for (Int i = 0; i < num_runs; ++i) { - VdShocDecompandSolveData& d_f90 = f90_data[i]; - // expects data in C layout - vd_shoc_decomp_and_solve(d_f90); } // Get data from cxx for (Int i = 0; i < num_runs; ++i) { VdShocDecompandSolveData& d_cxx = cxx_data[i]; - - d_cxx.transpose(); // _f expects data in fortran layout - vd_shoc_decomp_and_solve_f(d_cxx.shcol, d_cxx.nlev, d_cxx.nlevi, d_cxx.n_rhs, - d_cxx.kv_term, d_cxx.tmpi, d_cxx.rdp_zt, - d_cxx.dtime, d_cxx.flux, d_cxx.var); - d_cxx.transpose(); // go back to C layout + vd_shoc_decomp_and_solve(d_cxx); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { for (Int i = 0; i < num_runs; ++i) { - VdShocDecompandSolveData& d_f90 = f90_data[i]; + VdShocDecompandSolveData& d_baseline = baseline_data[i]; VdShocDecompandSolveData& d_cxx = cxx_data[i]; - for (Int k = 0; k < d_f90.total(d_f90.var); ++k) { - REQUIRE(d_f90.total(d_f90.var) == d_cxx.total(d_cxx.var)); - REQUIRE(d_f90.var[k] == d_cxx.var[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.var); ++k) { + REQUIRE(d_baseline.total(d_baseline.var) == d_cxx.total(d_cxx.var)); + REQUIRE(d_baseline.var[k] == d_cxx.var[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } // run_bfb }; @@ -91,7 +88,7 @@ TEST_CASE("vd_shoc_solve_bfb", "[shoc]") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestVdShocDecompandSolve; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // empty namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp index 2b83169420b..f6e7f3cf8ea 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp @@ -3,7 +3,7 @@ #include "shoc_unit_tests_common.hpp" #include "physics/share/physics_constants.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "share/scream_types.hpp" #include "share/util/scream_setup_random_test.hpp" @@ -21,9 +21,9 @@ namespace shoc { namespace unit_test { template -struct UnitWrap::UnitTest::TestCalcShocVertflux { +struct UnitWrap::UnitTest::TestCalcShocVertflux : public UnitWrap::UnitTest::Base { - static void run_property() + void run_property() { static constexpr Int shcol = 2; static constexpr Int nlev = 4; @@ -96,10 +96,7 @@ struct UnitWrap::UnitTest::TestCalcShocVertflux { } // Call the C++ implementation - SDS.transpose(); - // expects data in fortran layout - calc_shoc_vertflux_f(SDS.shcol, SDS.nlev, SDS.nlevi, SDS.tkh_zi, SDS.dz_zi, SDS.invar, SDS.vertflux); - SDS.transpose(); + calc_shoc_vertflux(SDS); // Check the results for(Int s = 0; s < shcol; ++s) { @@ -133,11 +130,11 @@ struct UnitWrap::UnitTest::TestCalcShocVertflux { } } - static void run_bfb() + void run_bfb() { - auto engine = setup_random_test(); + auto engine = Base::get_engine(); - CalcShocVertfluxData SDS_f90[] = { + CalcShocVertfluxData SDS_baseline[] = { // shcol, nlev, nlevi CalcShocVertfluxData(10, 71, 72), CalcShocVertfluxData(10, 12, 13), @@ -146,46 +143,47 @@ struct UnitWrap::UnitTest::TestCalcShocVertflux { }; // Generate random input data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.randomize(engine); } - // Create copies of data for use by cxx. Needs to happen before fortran calls so that + // Create copies of data for use by cxx. Needs to happen before reads so that // inout data is in original state CalcShocVertfluxData SDS_cxx[] = { - CalcShocVertfluxData(SDS_f90[0]), - CalcShocVertfluxData(SDS_f90[1]), - CalcShocVertfluxData(SDS_f90[2]), - CalcShocVertfluxData(SDS_f90[3]), + CalcShocVertfluxData(SDS_baseline[0]), + CalcShocVertfluxData(SDS_baseline[1]), + CalcShocVertfluxData(SDS_baseline[2]), + CalcShocVertfluxData(SDS_baseline[3]), }; // Assume all data is in C layout - // Get data from fortran + // Read baseline data for (auto& d : SDS_f90) { - // expects data in C layout - calc_shoc_vertflux(d); + d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - d.transpose(); - // expects data in fortran layout - calc_shoc_vertflux_f(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); - d.transpose(); + calc_shoc_vertflux(d); } // Verify BFB results, all data should be in C layout - if (SCREAM_BFB_TESTING) { - static constexpr Int num_runs = sizeof(SDS_f90) / sizeof(CalcShocVertfluxData); + if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CalcShocVertfluxData); for (Int i = 0; i < num_runs; ++i) { - CalcShocVertfluxData& d_f90 = SDS_f90[i]; + CalcShocVertfluxData& d_baseline = SDS_baseline[i]; CalcShocVertfluxData& d_cxx = SDS_cxx[i]; - for (Int k = 0; k < d_f90.total(d_f90.vertflux); ++k) { - REQUIRE(d_f90.vertflux[k] == d_cxx.vertflux[k]); + for (Int k = 0; k < d_baseline.total(d_baseline.vertflux); ++k) { + REQUIRE(d_baseline.vertflux[k] == d_cxx.vertflux[k]); } } } // SCREAM_BFB_TESTING + else if (this->m_baseline_action == GENERATE) { + for (Int i = 0; i < num_runs; ++i) { + cxx_data[i].write(Base::m_fid); + } + } } }; @@ -200,14 +198,14 @@ TEST_CASE("shoc_vertflux_property", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCalcShocVertflux; - TestStruct::run_property(); + TestStruct().run_property(); } TEST_CASE("shoc_vertflux_bfb", "shoc") { using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestCalcShocVertflux; - TestStruct::run_bfb(); + TestStruct().run_bfb(); } } // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp index 39e9b63ba51..af1f7c468db 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" diff --git a/components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp index ad6e332e731..18b75639928 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp @@ -2,7 +2,7 @@ #include "shoc_unit_tests_common.hpp" #include "shoc_functions.hpp" -#include "shoc_functions_f90.hpp" +#include "shoc_test_data.hpp" #include "physics/share/physics_constants.hpp" #include "share/scream_types.hpp" From b7e95cf025ef8f726c6b7ee41832fed5385cd153 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 12 Nov 2024 16:16:47 -0700 Subject: [PATCH 255/529] builds --- .../physics/shoc/tests/infra/shoc_data.cpp | 8 +++---- .../physics/shoc/tests/infra/shoc_data.hpp | 4 ++-- .../shoc/tests/infra/shoc_main_wrap.cpp | 6 ++--- .../shoc/tests/infra/shoc_main_wrap.hpp | 5 ++-- .../shoc/tests/infra/shoc_test_data.hpp | 3 +++ .../shoc/tests/shoc_assumed_pdf_tests.cpp | 7 +++--- .../shoc/tests/shoc_brunt_length_tests.cpp | 7 +++--- .../shoc/tests/shoc_check_length_tests.cpp | 7 +++--- .../shoc/tests/shoc_check_tke_tests.cpp | 9 ++++---- .../shoc/tests/shoc_clip_third_moms_tests.cpp | 7 +++--- .../tests/shoc_compute_diag_third_tests.cpp | 7 +++--- .../shoc_compute_shoc_temperature_tests.cpp | 4 ++-- .../tests/shoc_compute_shoc_vapor_tests.cpp | 4 ++-- .../tests/shoc_diag_second_mom_srf_test.cpp | 2 +- .../shoc_diag_second_mom_ubycond_test.cpp | 6 ++--- ...shoc_diag_second_moments_lbycond_tests.cpp | 4 ++-- .../tests/shoc_diag_second_moments_tests.cpp | 4 ++-- .../shoc_diag_second_shoc_moments_tests.cpp | 4 ++-- .../shoc/tests/shoc_diag_third_tests.cpp | 7 +++--- .../tests/shoc_eddy_diffusivities_tests.cpp | 4 ++-- .../shoc/tests/shoc_energy_fixer_tests.cpp | 7 +++--- .../shoc/tests/shoc_energy_integral_tests.cpp | 7 +++--- .../tests/shoc_energy_update_dse_tests.cpp | 7 +++--- .../shoc/tests/shoc_l_inf_length_tests.cpp | 7 +++--- .../physics/shoc/tests/shoc_length_tests.cpp | 7 +++--- .../shoc/tests/shoc_linear_interp_tests.cpp | 4 ++-- .../physics/shoc/tests/shoc_main_tests.cpp | 4 ++-- .../shoc/tests/shoc_mix_length_tests.cpp | 7 +++--- .../tests/shoc_pblintd_check_pblh_tests.cpp | 4 ++-- .../tests/shoc_pblintd_cldcheck_tests.cpp | 10 ++++---- .../shoc/tests/shoc_pblintd_height_tests.cpp | 4 ++-- .../shoc/tests/shoc_pblintd_init_pot_test.cpp | 12 +++++----- .../tests/shoc_pblintd_surf_temp_tests.cpp | 4 ++-- .../physics/shoc/tests/shoc_pblintd_tests.cpp | 4 ++-- .../physics/shoc/tests/shoc_run_and_cmp.cpp | 23 ++++++++----------- .../src/physics/shoc/tests/shoc_tests.cpp | 14 ++--------- .../shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp | 4 ++-- .../shoc/tests/shoc_tke_column_stab_tests.cpp | 4 ++-- .../tests/shoc_tke_isotropic_ts_tests.cpp | 4 ++-- .../shoc/tests/shoc_tke_shr_prod_tests.cpp | 4 ++-- .../src/physics/shoc/tests/shoc_tke_tests.cpp | 4 ++-- ...shoc_update_prognostics_implicit_tests.cpp | 4 ++-- .../shoc/tests/shoc_varorcovar_tests.cpp | 7 +++--- .../shoc/tests/shoc_vertflux_tests.cpp | 7 +++--- 44 files changed, 137 insertions(+), 135 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp index 4da3ba46678..2e92a8a0551 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp @@ -9,7 +9,6 @@ using scream::Int; extern "C" { void shoc_init_c(int nlev, Real gravit, Real rair, Real rh2o, Real cpair, Real zvir, Real latvap, Real latice, Real karman, Real p0); - void shoc_use_cxx_c(bool use_cxx); } namespace scream { @@ -112,7 +111,7 @@ FortranDataIterator::getfield (Int i) const { return fields_[i]; } -void shoc_init(Int nlev, bool use_fortran, bool force_reinit) { +void shoc_init(Int nlev, bool force_reinit) { static bool is_init = false; if (!is_init || force_reinit) { using Scalar = Real; @@ -122,7 +121,6 @@ void shoc_init(Int nlev, bool use_fortran, bool force_reinit) { C::LatVap, C::LatIce, C::Karman, C::P0); is_init = true; } - shoc_use_cxx_c(!use_fortran); } int test_FortranData () { @@ -132,9 +130,9 @@ int test_FortranData () { return 0; } -int test_shoc_init (bool use_fortran) { +int test_shoc_init () { Int nz = 160; - shoc_init(nz, use_fortran); + shoc_init(nz); return 0; } diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp index 22d6ff70e42..7e4aee2f8dc 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp @@ -68,7 +68,7 @@ struct FortranDataIterator { }; // Initialize SHOC with the given number of levels. -void shoc_init(Int nlev, bool use_fortran=false, bool force_reinit=false); +void shoc_init(Int nlev, bool force_reinit=false); // We will likely want to remove these checks in the future, as we're not tied // to the exact implementation or arithmetic in SHOC. For now, these checks are @@ -77,7 +77,7 @@ void shoc_init(Int nlev, bool use_fortran=false, bool force_reinit=false); Int check_against_python(const FortranData& d); int test_FortranData(); -int test_shoc_init(bool use_fortran); +int test_shoc_init(); } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp index 957a67593f7..4dd055abb4d 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp @@ -218,9 +218,9 @@ void gen_plot_script(const std::vector >& data, } // end anonymous namespace -int test_shoc_ic (bool use_fortran, bool gen_plot_scripts) { +int test_shoc_ic (bool gen_plot_scripts) { Int nz = 160; - shoc_init(nz, use_fortran); + shoc_init(nz); // Here we: // 1. Initialize a standard case with settings identical to // scream-doc/ѕhoc_port/shocintr.py's example_run_case method @@ -238,7 +238,7 @@ int test_shoc_ic (bool use_fortran, bool gen_plot_scripts) { // 3. Run 100 steps, each of size dtime = 10 (as in that method) d->nadv = 100; d->dtime = 10; - shoc_main(*d,use_fortran); + shoc_main(*d); // 4. Generate a Python script that plots the results. { diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.hpp index 7ecfa1221a3..f11cf14992d 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.hpp @@ -12,13 +12,12 @@ namespace shoc { struct FortranData; // Run SHOC subroutines, populating inout and out fields of d. -ekat::Int shoc_main(FortranData& d, bool use_fortran); - +ekat::Int shoc_main(FortranData& d); // Test SHOC by running initial conditions for a number of steps and comparing // against reference data. If gen_plot_scripts is true, Python scripts are // emitted that plot initial and final conditions. -int test_shoc_ic(bool use_fortran, bool gen_plot_scripts = false); +int test_shoc_ic(bool gen_plot_scripts = false); } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 87497784c57..388a8a4b2ab 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1246,6 +1246,9 @@ void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, R Real* tk, Real* tkh, Real* isotropy); void compute_shoc_temperature_host(Int shcol, Int nlev, Real* thetal, Real* ql, Real* inv_exner, Real* tabs); +void shoc_energy_total_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, Real* zi_grid, Real* se_b, Real* ke_b, Real* wv_b, Real* wl_b, Real* se_a, Real* ke_a, Real* wv_a, Real* wl_a, Real* wthl_sfc, Real* wqw_sfc, Real* rho_zt, Real* pint, Real* te_a, Real* te_b); +// end _host function decls + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp index feea510aa49..3175f908af4 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp @@ -420,10 +420,12 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf : public UnitWrap::UnitTest: ShocAssumedPdfData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocAssumedPdfData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -434,7 +436,6 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf : public UnitWrap::UnitTest: // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocAssumedPdfData); for (Int i = 0; i < num_runs; ++i) { ShocAssumedPdfData& d_baseline = SDS_baseline[i]; ShocAssumedPdfData& d_cxx = SDS_cxx[i]; @@ -449,7 +450,7 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf : public UnitWrap::UnitTest: } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp index 3b679b609c8..3e39bb245e9 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp @@ -147,10 +147,12 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength : public UnitWrap::UnitTes ComputeBruntShocLengthData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeBruntShocLengthData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -161,7 +163,6 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength : public UnitWrap::UnitTes // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeBruntShocLengthData); for (Int i = 0; i < num_runs; ++i) { ComputeBruntShocLengthData& d_baseline = SDS_baseline[i]; ComputeBruntShocLengthData& d_cxx = SDS_cxx[i]; @@ -172,7 +173,7 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength : public UnitWrap::UnitTes } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp index 973cbc5c068..6a51a339e52 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp @@ -117,10 +117,12 @@ struct UnitWrap::UnitTest::TestCheckShocLength : public UnitWrap::UnitTest CheckLengthScaleShocLengthData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CheckLengthScaleShocLengthData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -131,7 +133,6 @@ struct UnitWrap::UnitTest::TestCheckShocLength : public UnitWrap::UnitTest // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CheckLengthScaleShocLengthData); for (Int i = 0; i < num_runs; ++i) { CheckLengthScaleShocLengthData& d_baseline = SDS_baseline[i]; CheckLengthScaleShocLengthData& d_cxx = SDS_cxx[i]; @@ -142,7 +143,7 @@ struct UnitWrap::UnitTest::TestCheckShocLength : public UnitWrap::UnitTest } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp index a4d6886530c..2d58e6f16db 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp @@ -99,21 +99,22 @@ struct UnitWrap::UnitTest::TestShocCheckTke : public UnitWrap::UnitTest::B CheckTkeData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CheckTkeData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } // Get data from cxx for (auto& d : SDS_cxx) { - check_tke_host(d); + check_tke(d); } // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CheckTkeData); for (Int i = 0; i < num_runs; ++i) { CheckTkeData& d_baseline = SDS_baseline[i]; CheckTkeData& d_cxx = SDS_cxx[i]; @@ -124,7 +125,7 @@ struct UnitWrap::UnitTest::TestShocCheckTke : public UnitWrap::UnitTest::B } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp index a76cf0a5b71..c1d8496b744 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp @@ -126,10 +126,12 @@ struct UnitWrap::UnitTest::TestClipThirdMoms : public UnitWrap::UnitTest:: ClippingDiagThirdShocMomentsData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ClippingDiagThirdShocMomentsData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -140,7 +142,6 @@ struct UnitWrap::UnitTest::TestClipThirdMoms : public UnitWrap::UnitTest:: // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ClippingDiagThirdShocMomentsData); for (Int i = 0; i < num_runs; ++i) { ClippingDiagThirdShocMomentsData& d_baseline = SDS_baseline[i]; ClippingDiagThirdShocMomentsData& d_cxx = SDS_cxx[i]; @@ -151,7 +152,7 @@ struct UnitWrap::UnitTest::TestClipThirdMoms : public UnitWrap::UnitTest:: } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp index ba27d5ed945..b5c0581bebf 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp @@ -212,10 +212,12 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest< ComputeDiagThirdShocMomentData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeDiagThirdShocMomentData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -226,7 +228,6 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest< // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeDiagThirdShocMomentData); for (Int i = 0; i < num_runs; ++i) { ComputeDiagThirdShocMomentData& d_baseline = SDS_baseline[i]; ComputeDiagThirdShocMomentData& d_cxx = SDS_cxx[i]; @@ -237,7 +238,7 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest< } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp index 21dfbf69cf8..f596a44b2b0 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp @@ -246,8 +246,8 @@ struct UnitWrap::UnitTest::TestComputeShocTemp : public UnitWrap::UnitTest } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp index 6aedf7a0adf..86fba68496e 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp @@ -136,8 +136,8 @@ struct UnitWrap::UnitTest::TestComputeShocVapor : public UnitWrap::UnitTestm_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp index 5ec4ac51e56..95abfefab98 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_srf_test.cpp @@ -52,7 +52,7 @@ struct UnitWrap::UnitTest::TestSecondMomSrf : public UnitWrap::UnitTest::B } // Call the C++ implementation - shoc_diag_second_moments_srf(SDS); + diag_second_moments_srf(SDS); // Verify the output for (Int s = 0; s < shcol; ++s){ diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp index c1c526a8cad..d931992be11 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp @@ -43,7 +43,7 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond : public UnitWrap::UnitTest 0); // Call the C++ implementation - shoc_diag_second_moments_ubycond(SDS); + diag_second_moments_ubycond(SDS); // Verify the result // all output should be zero. @@ -93,7 +93,7 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond : public UnitWrap::UnitTestm_baseline_action == COMPARE) { @@ -113,7 +113,7 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond : public UnitWrap::UnitTestm_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + uby_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp index 7966ca13595..406bab30d90 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp @@ -171,8 +171,8 @@ struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond : public UnitWrap::Un } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp index f06e0097023..01a0c04f2de 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp @@ -308,8 +308,8 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments : public UnitWrap::UnitTest< } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp index 2585e1aa07f..82eeb528d1d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp @@ -321,8 +321,8 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments : public UnitWrap::UnitT } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp index 0c60db01536..08b3dc6ab4d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp @@ -228,10 +228,12 @@ struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest:: DiagThirdShocMomentsData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(DiagThirdShocMomentsData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -242,7 +244,6 @@ struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest:: // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(DiagThirdShocMomentsData); for (Int i = 0; i < num_runs; ++i) { DiagThirdShocMomentsData& d_baseline = SDS_baseline[i]; DiagThirdShocMomentsData& d_cxx = SDS_cxx[i]; @@ -253,7 +254,7 @@ struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest:: } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp index 566dd2762bd..20c6638eb3d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp @@ -305,8 +305,8 @@ struct UnitWrap::UnitTest::TestShocEddyDiff : public UnitWrap::UnitTest::B } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp index dd1daf4a2c7..d5ed68e3550 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp @@ -287,10 +287,12 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer : public UnitWrap::UnitTest ShocEnergyFixerData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocEnergyFixerData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -301,7 +303,6 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer : public UnitWrap::UnitTest // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocEnergyFixerData); for (Int i = 0; i < num_runs; ++i) { ShocEnergyFixerData& d_baseline = SDS_baseline[i]; ShocEnergyFixerData& d_cxx = SDS_cxx[i]; @@ -312,7 +313,7 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer : public UnitWrap::UnitTest } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp index 7bc0e4d1aac..eb950dcf37a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp @@ -153,10 +153,12 @@ struct UnitWrap::UnitTest::TestShocEnergyInt : public UnitWrap::UnitTest:: ShocEnergyIntegralsData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocEnergyIntegralsData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -167,7 +169,6 @@ struct UnitWrap::UnitTest::TestShocEnergyInt : public UnitWrap::UnitTest:: // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocEnergyIntegralsData); for (Int i = 0; i < num_runs; ++i) { ShocEnergyIntegralsData& d_baseline = SDS_baseline[i]; ShocEnergyIntegralsData& d_cxx = SDS_cxx[i]; @@ -181,7 +182,7 @@ struct UnitWrap::UnitTest::TestShocEnergyInt : public UnitWrap::UnitTest:: } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp index 3aec754a542..ac59a33a8b7 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp @@ -162,10 +162,12 @@ struct UnitWrap::UnitTest::TestShocUpdateDse : public UnitWrap::UnitTest:: UpdateHostDseData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(UpdateHostDseData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -176,7 +178,6 @@ struct UnitWrap::UnitTest::TestShocUpdateDse : public UnitWrap::UnitTest:: // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(UpdateHostDseData); for (Int i = 0; i < num_runs; ++i) { UpdateHostDseData& d_baseline = SDS_baseline[i]; UpdateHostDseData& d_cxx = SDS_cxx[i]; @@ -187,7 +188,7 @@ struct UnitWrap::UnitTest::TestShocUpdateDse : public UnitWrap::UnitTest:: } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp index 2d12db2e050..9a9d091e31f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp @@ -131,10 +131,12 @@ struct UnitWrap::UnitTest::TestLInfShocLength : public UnitWrap::UnitTest: ComputeLInfShocLengthData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeLInfShocLengthData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -145,7 +147,6 @@ struct UnitWrap::UnitTest::TestLInfShocLength : public UnitWrap::UnitTest: // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeLInfShocLengthData); for (Int i = 0; i < num_runs; ++i) { ComputeLInfShocLengthData& d_baseline = SDS_baseline[i]; ComputeLInfShocLengthData& d_cxx = SDS_cxx[i]; @@ -156,7 +157,7 @@ struct UnitWrap::UnitTest::TestLInfShocLength : public UnitWrap::UnitTest: } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp index f35eed0e45c..0c9690c833a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp @@ -212,10 +212,12 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas ShocLengthData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocLengthData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -226,7 +228,6 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ShocLengthData); for (Int i = 0; i < num_runs; ++i) { ShocLengthData& d_baseline = SDS_baseline[i]; ShocLengthData& d_cxx = SDS_cxx[i]; @@ -238,7 +239,7 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp index 263e09e22b9..bd09f7ad94b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp @@ -388,8 +388,8 @@ struct UnitWrap::UnitTest::TestShocLinearInt : public UnitWrap::UnitTest:: } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp index 5dcd30068c0..5eb6335ea25 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp @@ -463,8 +463,8 @@ struct UnitWrap::UnitTest::TestShocMain : public UnitWrap::UnitTest::Base } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp index bdf5bd607f3..7277d33b67c 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp @@ -140,10 +140,12 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< ComputeShocMixShocLengthData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeShocMixShocLengthData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -154,7 +156,6 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(ComputeShocMixShocLengthData); for (Int i = 0; i < num_runs; ++i) { ComputeShocMixShocLengthData& d_baseline = SDS_baseline[i]; ComputeShocMixShocLengthData& d_cxx = SDS_cxx[i]; @@ -165,7 +166,7 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp index f254b4e077d..999525b1d99 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp @@ -129,8 +129,8 @@ struct UnitWrap::UnitTest::TestPblintdCheckPblh : public UnitWrap::UnitTestm_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp index a239d8f8eb9..73b96f8e4bf 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp @@ -80,7 +80,7 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck : public UnitWrap::UnitTest } // Call the C++ implementation - shoc_pblintd_cldcheck(SDS); + pblintd_cldcheck(SDS); // Check the result for(Int s = 0; s < shcol; ++s) { @@ -117,12 +117,12 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck : public UnitWrap::UnitTest }; // Read baseline data - for (auto& d : cldcheck_data_f90) { + for (auto& d : cldcheck_data_baseline) { d.read(Base::m_fid); } for (auto& d : cldcheck_data_cxx) { - shoc_pblintd_cldcheck(d); + pblintd_cldcheck(d); } if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { @@ -135,8 +135,8 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck : public UnitWrap::UnitTest } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cldcheck_data_cxx) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp index ec8337bab5a..1f167520c90 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp @@ -226,8 +226,8 @@ struct UnitWrap::UnitTest::TestPblintdHeight : public UnitWrap::UnitTest:: } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp index 888f5814ed2..5e136ad35c2 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp @@ -77,7 +77,7 @@ struct UnitWrap::UnitTest::TestPblintdInitPot : public UnitWrap::UnitTest: } // call the C++ implementation - shoc_pblintd_init_pot(SDS); + pblintd_init_pot(SDS); // Check the result. // Verify that virtual potential temperature is idential @@ -126,7 +126,7 @@ struct UnitWrap::UnitTest::TestPblintdInitPot : public UnitWrap::UnitTest: } // Call the C++ implementation - shoc_pblintd_init_pot(SDS); + pblintd_init_pot(SDS); // Check test // Verify that column with condensate loading @@ -173,12 +173,12 @@ struct UnitWrap::UnitTest::TestPblintdInitPot : public UnitWrap::UnitTest: }; // Read baseline data - for (auto& d : pblintd_init_pot_data_f90) { + for (auto& d : pblintd_init_pot_data_baseline) { d.read(Base::m_fid); } for (auto& d : pblintd_init_pot_data_cxx) { - shoc_pblintd_init_pot(d); + pblintd_init_pot(d); } if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { @@ -194,8 +194,8 @@ struct UnitWrap::UnitTest::TestPblintdInitPot : public UnitWrap::UnitTest: } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : pblintd_init_pot_data_cxx) { + d.write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp index 0efdfc5ba03..4c60eef381a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp @@ -168,8 +168,8 @@ struct UnitWrap::UnitTest::TestPblintdSurfTemp : public UnitWrap::UnitTest } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp index a201e60ce76..9437487158f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp @@ -192,8 +192,8 @@ struct UnitWrap::UnitTest::TestPblintd : public UnitWrap::UnitTest::Base { } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp index b98027ba5c8..ca9b519eec0 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp @@ -61,7 +61,7 @@ struct Baseline { params_.push_back({ic::Factory::standard, repeat, nsteps, ncol, nlev, num_qtracers, nadv, dt}); } - Int generate_baseline (const std::string& filename, bool use_fortran) { + Int generate_baseline (const std::string& filename) { auto fid = ekat::FILEPtr(fopen(filename.c_str(), "w")); EKAT_REQUIRE_MSG( fid, "generate_baseline can't write " << filename); Int nerr = 0; @@ -74,20 +74,18 @@ struct Baseline { // Run reference shoc on this set of parameters. const auto d = ic::Factory::create(ps.ic, ps.ncol, ps.nlev, ps.num_qtracers); set_params(ps, *d); - shoc_init(ps.nlev, use_fortran); + shoc_init(ps.nlev); if (ps.repeat > 0 && r == -1) { std::cout << "Running SHOC with ni=" << d->shcol << ", nk=" << d->nlev << ", dt=" << d->dtime << ", ts=" << ps.nsteps; - if (!use_fortran) { - std::cout << ", small_packn=" << SCREAM_SMALL_PACK_SIZE; - } + std::cout << ", small_packn=" << SCREAM_SMALL_PACK_SIZE; std::cout << std::endl; } for (int it = 0; it < ps.nsteps; ++it) { - Int current_microsec = shoc_main(*d, use_fortran); + Int current_microsec = shoc_main(*d); if (r != -1 && ps.repeat > 0) { // do not count the "cold" run duration += current_microsec; @@ -107,7 +105,7 @@ struct Baseline { return nerr; } - Int run_and_cmp (const std::string& filename, const double& tol, bool use_fortran) { + Int run_and_cmp (const std::string& filename, const double& tol) { auto fid = ekat::FILEPtr(fopen(filename.c_str(), "r")); EKAT_REQUIRE_MSG( fid, "generate_baseline can't read " << filename); Int nerr = 0, ne; @@ -122,12 +120,12 @@ struct Baseline { { const auto d = ic::Factory::create(ps.ic, ps.ncol, ps.nlev, ps.num_qtracers); set_params(ps, *d); - shoc_init(ps.nlev, use_fortran); + shoc_init(ps.nlev); for (int it = 0; it < ps.nsteps; it++) { std::cout << "--- checking case # " << case_num << ", timestep # = " << (it+1)*ps.nadv << " ---\n" << std::flush; read(fid, d_ref); - shoc_main(*d,use_fortran); + shoc_main(*d); ne = compare(tol, d_ref, d); if (ne) std::cout << "Ref impl failed.\n"; nerr += ne; @@ -209,7 +207,7 @@ int main (int argc, char** argv) { return 1; } - bool generate = false, use_fortran = false; + bool generate = false; scream::Real tol = SCREAM_BFB_TESTING ? 0 : std::numeric_limits::infinity(); Int nsteps = 10; Int dt = 150; @@ -222,7 +220,6 @@ int main (int argc, char** argv) { std::string device; for (int i = 1; i < argc-1; ++i) { if (ekat::argv_matches(argv[i], "-g", "--generate")) generate = true; - if (ekat::argv_matches(argv[i], "-f", "--fortran")) use_fortran = true; if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) { expect_another_arg(i, argc); ++i; @@ -285,10 +282,10 @@ int main (int argc, char** argv) { Baseline bln(nsteps, static_cast(dt), ncol, nlev, num_qtracers, nadv, repeat); if (generate) { std::cout << "Generating to " << baseline_fn << "\n"; - nerr += bln.generate_baseline(baseline_fn, use_fortran); + nerr += bln.generate_baseline(baseline_fn); } else { printf("Comparing with %s at tol %1.1e\n", baseline_fn.c_str(), tol); - nerr += bln.run_and_cmp(baseline_fn, tol, use_fortran); + nerr += bln.run_and_cmp(baseline_fn, tol); } } scream::finalize_scream_session(); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp index 1872cf1b93a..a44f2100056 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp @@ -26,11 +26,6 @@ TEST_CASE("FortranDataIterator", "shoc") { REQUIRE(static_cast(f.size) == d->shcol); } -TEST_CASE("shoc_init_f", "shoc") { - int nerr = scream::shoc::test_shoc_init(true); - REQUIRE(nerr == 0); -} - // This helper returns true if we've been asked to generate Python // plotting scripts, false otherwise. bool generating_plot_scripts() { @@ -51,18 +46,13 @@ bool generating_plot_scripts() { return gen_plot_scripts; } -TEST_CASE("shoc_ic_f", "shoc") { - int nerr = scream::shoc::test_shoc_ic(true, generating_plot_scripts()); - REQUIRE(nerr == 0); -} - TEST_CASE("shoc_init_c", "shoc") { - int nerr = scream::shoc::test_shoc_init(false); + int nerr = scream::shoc::test_shoc_init(); REQUIRE(nerr == 0); } TEST_CASE("shoc_ic_c", "shoc") { - int nerr = scream::shoc::test_shoc_ic(false); + int nerr = scream::shoc::test_shoc_ic(); REQUIRE(nerr == 0); } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp index 07a5fd4ecbd..06802cf7cc1 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp @@ -241,8 +241,8 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } }//run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp index ff01ef1dcf8..da560af2dab 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp @@ -167,8 +167,8 @@ struct UnitWrap::UnitTest::TestShocIntColStab : public UnitWrap::UnitTest: } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto &d : cxx_data) { + d.write(Base::m_fid); } } } //run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp index 5c1a73ff9df..597cd955a64 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp @@ -224,8 +224,8 @@ struct UnitWrap::UnitTest::TestShocIsotropicTs : public UnitWrap::UnitTest } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } }//run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp index a3349d8b55f..26664b3890f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp @@ -205,8 +205,8 @@ struct UnitWrap::UnitTest::TestShocShearProd : public UnitWrap::UnitTest:: } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } //run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp index 5b37bb1b5a1..da3fadfa2ce 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp @@ -303,8 +303,8 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp index 4af28ede5eb..8da7ce246d5 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp @@ -398,8 +398,8 @@ struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit : public UnitWrap::U } } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { - for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + for (auto& d : cxx_data) { + d.write(Base::m_fid); } } } // run_bfb diff --git a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp index 2c45e98e3f5..a3a915059ae 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp @@ -292,10 +292,12 @@ void run_bfb() CalcShocVarorcovarData(SDS_baseline[3]), }; + static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CalcShocVarorcovarData); + // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_f90) { + for (auto& d : SDS_baseline) { d.read(Base::m_fid); } @@ -306,7 +308,6 @@ void run_bfb() // Verify BFB results, all data should be in C layout if (SCREAM_BFB_TESTING && this->m_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CalcShocVarorcovarData); for (Int i = 0; i < num_runs; ++i) { CalcShocVarorcovarData& d_baseline = SDS_baseline[i]; CalcShocVarorcovarData& d_cxx = SDS_cxx[i]; @@ -317,7 +318,7 @@ void run_bfb() } // SCREAM_BFB_TESTING else if (this->m_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } diff --git a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp index f6e7f3cf8ea..a1f708402f1 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp @@ -156,10 +156,12 @@ struct UnitWrap::UnitTest::TestCalcShocVertflux : public UnitWrap::UnitTest::TestCalcShocVertflux : public UnitWrap::UnitTestm_baseline_action == COMPARE) { - static constexpr Int num_runs = sizeof(SDS_baseline) / sizeof(CalcShocVertfluxData); for (Int i = 0; i < num_runs; ++i) { CalcShocVertfluxData& d_baseline = SDS_baseline[i]; CalcShocVertfluxData& d_cxx = SDS_cxx[i]; @@ -181,7 +182,7 @@ struct UnitWrap::UnitTest::TestCalcShocVertflux : public UnitWrap::UnitTestm_baseline_action == GENERATE) { for (Int i = 0; i < num_runs; ++i) { - cxx_data[i].write(Base::m_fid); + SDS_cxx[i].write(Base::m_fid); } } } From fed2b20e1a40b1be00ea2c50c80738db6be9f888 Mon Sep 17 00:00:00 2001 From: xie7 Date: Fri, 8 Nov 2024 22:14:22 -0800 Subject: [PATCH 256/529] Modified code to add dev suite and better format 1.Separate the orographic drag (OD) schemes from gw_common.F90 to form a new od_common.F90 to have OD related schemes. 2.Modify the namelist names to all use OD as starting for OD-related options and schemes. 3.Added a new OD development suite for testing of the OD schemes in the model. 4.Made easier to read format coding throught the codes. [BFB] --- cime_config/tests.py | 14 ++- components/eam/bld/build-namelist | 4 +- .../namelist_files/namelist_defaults_eam.xml | 12 +-- .../eam/orodrag_ne30pg2/user_nl_eam | 8 ++ .../{orodrag => orodrag_ne4pg2}/user_nl_eam | 1 + components/eam/src/physics/cam/clubb_intr.F90 | 89 +++++++++---------- components/eam/src/physics/cam/gw_drag.F90 | 42 ++++----- components/eam/src/physics/cam/od_common.F90 | 47 +++++----- .../eam/src/physics/cam/phys_control.F90 | 6 +- 9 files changed, 113 insertions(+), 110 deletions(-) create mode 100644 components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne30pg2/user_nl_eam rename components/eam/cime_config/testdefs/testmods_dirs/eam/{orodrag => orodrag_ne4pg2}/user_nl_eam (50%) diff --git a/cime_config/tests.py b/cime_config/tests.py index e2ab71f0c53..0c1930292c6 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -191,14 +191,12 @@ "e3sm_orodrag_developer" : { "tests" : ( - "ERP.ne4pg2_oQU480.F2010.eam-orodrag", - "REP_Ln5.ne4pg2_oQU480.F2010.eam-orodrag", - "PET.ne4pg2_oQU480.F2010.eam-orodrag", - "PEM_Ln18.ne4pg2_oQU480.F2010.eam-orodrag", - "SMS_Ln5.ne30pg2_EC30to60E2r2.F2010.eam-orodrag", - "SMS_D_Ln5.ne4pg2_oQU480.F2010.eam-orodrag", - "SMS_Ln5.ne4pg2_oQU480.F2010.eam-orodrag", - "ERS.ne4pg2_oQU480.F2010.eam-orodrag" + "ERP.ne4pg2_oQU480.F2010.eam-orodrag_ne4pg2", + "REP_Ln5.ne4pg2_oQU480.F2010.eam-orodrag_ne4pg2", + "PET.ne4pg2_oQU480.F2010.eam-orodrag_ne4pg2", + "PEM_Ln18.ne4pg2_oQU480.F2010.eam-orodrag_ne4pg2", + "SMS_Ln5.ne30pg2_EC30to60E2r2.F2010.eam-orodrag_ne30pg2", + "SMS_D_Ln5.ne4pg2_oQU480.F2010.eam-orodrag_ne4pg2" ) }, diff --git a/components/eam/bld/build-namelist b/components/eam/bld/build-namelist index 293a03cdf3a..f967ba88c5c 100755 --- a/components/eam/bld/build-namelist +++ b/components/eam/bld/build-namelist @@ -4104,8 +4104,8 @@ if ($waccm_phys or $cfg->get('nlev') >= 60) { } add_default($nl, 'pgwv', 'val'=>'32'); add_default($nl, 'gw_dc','val'=>'2.5D0'); -add_default($nl, 'od_ls_ncleff ','val'=>'3.D0'); -add_default($nl, 'od_bl_ncd ','val'=>'3.D0'); +add_default($nl, 'od_ls_ncleff' ,'val'=>'3.D0'); +add_default($nl, 'od_bl_ncd' ,'val'=>'3.D0'); add_default($nl, 'od_ss_sncleff','val'=>'1.D0'); if ($nl->get_value('use_gw_oro') =~ /$TRUE/io) { diff --git a/components/eam/bld/namelist_files/namelist_defaults_eam.xml b/components/eam/bld/namelist_files/namelist_defaults_eam.xml index 4ad34edf4ea..2fb78fcf8a6 100755 --- a/components/eam/bld/namelist_files/namelist_defaults_eam.xml +++ b/components/eam/bld/namelist_files/namelist_defaults_eam.xml @@ -126,13 +126,13 @@ atm/cam/topo/USGS-gtopo30_64x128_c050520.nc -atm/cam/topo/USGS-gtopo30_ne4np4_16x_forOroDrag.c20241019.nc -atm/cam/topo/USGS-gtopo30_ne4np4pg2_16x_converted_forOroDrag.c20241019.nc +atm/cam/topo/USGS-gtopo30_ne4np4_16x.c20160612.nc +atm/cam/topo/USGS-gtopo30_ne4np4pg2_16x_converted.c20200527.nc atm/cam/topo/USGS-gtopo30_ne11np4_16xconsistentSGH.c20160612.nc atm/cam/topo/USGS-gtopo30_ne16np4_16xconsistentSGH.c20160612.nc atm/cam/topo/USGS-gtopo30_ne16np4pg2_16xdel2_20200527.nc atm/cam/topo/USGS-gtopo30_ne30np4_16xdel2-PFC-consistentSGH.nc -atm/cam/topo/USGS-gtopo30_ne30np4pg2_x6t-SGH_forOroDrag.c20241001.nc +atm/cam/topo/USGS-gtopo30_ne30np4pg2_x6t-SGH.c20210614.nc atm/cam/topo/USGS-gtopo30_ne30np4pg3_16xdel2.c20200504.nc atm/cam/topo/USGS-gtopo30_ne30np4pg4_16xdel2.c20200504.nc atm/cam/topo/USGS-gtopo30_ne45np4pg2_16xdel2.c20200615.nc @@ -1883,9 +1883,9 @@ with se_tstep, dt_remap_factor, dt_tracer_factor set to -1 1.0 0.375 .true. - 3 - 3 - 1 + 3.D0 + 3.D0 + 1.D0 2.5D0 268.15D0 13.8D0 diff --git a/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne30pg2/user_nl_eam b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne30pg2/user_nl_eam new file mode 100644 index 00000000000..8ab37d27978 --- /dev/null +++ b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne30pg2/user_nl_eam @@ -0,0 +1,8 @@ +use_gw_oro=.false. +use_od_ls=.true. +use_od_bl=.true. +use_od_ss=.true. +use_od_fd=.true. + + +bnd_topo='$DIN_LOC_ROOT/atm/cam/topo/USGS-gtopo30_ne30np4pg2_x6t-SGH_forOroDrag.c20241001.nc' diff --git a/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam similarity index 50% rename from components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam rename to components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam index e14e93f8374..185a235d4f5 100644 --- a/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag/user_nl_eam +++ b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam @@ -4,3 +4,4 @@ use_od_bl=.true. use_od_ss=.true. use_od_fd=.true. +bnd_topo='$DIN_LOC_ROOT/atm/cam/topo/USGS-gtopo30_ne4np4_16x_forOroDrag.c20241019.nc' diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index e44c3ab7fea..6b7fb38906a 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -930,7 +930,7 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) call addfld ('TPERTBLT', horiz_only, 'A', 'K', 'perturbation temperature at PBL top') ! if (use_od_fd) then - !!added for TOFD output + !added for turbulent orographic form drag (TOFD) output call addfld ('DTAUX3_FD',(/'lev'/),'A','m/s2','U tendency - fd orographic drag') call addfld ('DTAUY3_FD',(/'lev'/),'A','m/s2','V tendency - fd orographic drag') call addfld ('DUSFC_FD',horiz_only,'A','N/m2','fd zonal oro surface stress') @@ -1176,7 +1176,7 @@ subroutine clubb_tend_cam( & use model_flags, only: ipdf_call_placement use advance_clubb_core_module, only: ipdf_post_advance_fields #endif - use gw_common, only: grid_size,gw_oro_interface + use od_common, only: grid_size, oro_drag_interface use hycoef, only: etamid use physconst, only: rh2o,pi,rearth,r_universal implicit none @@ -1993,28 +1993,28 @@ subroutine clubb_tend_cam( & endif ! if (use_od_fd) then - gwd_ls=.false. - gwd_bl=.false. - gwd_ss=.false. - gwd_fd=use_od_fd - dummy_nm=0.0_r8 + gwd_ls =.false. + gwd_bl =.false. + gwd_ss =.false. + gwd_fd =use_od_fd + dummy_nm =0.0_r8 dummy_utgw=0.0_r8 dummy_vtgw=0.0_r8 dummy_ttgw=0.0_r8 - !sgh30 as the input for TOFD instead of sgh - call gw_oro_interface(state,cam_in,sgh30,pbuf,hdtime,dummy_nm,& - gwd_ls,gwd_bl,gwd_ss,gwd_fd,& - od_ls_ncleff,od_bl_ncd,od_ss_sncleff,& - dummy_utgw,dummy_vtgw,dummy_ttgw,& - dtaux3_ls=dummx3_ls,dtauy3_ls=dummy3_ls,& - dtaux3_bl=dummx3_bl,dtauy3_bl=dummy3_bl,& - dtaux3_ss=dummx3_ss,dtauy3_ss=dummy3_ss,& - dtaux3_fd=dtaux3_fd,dtauy3_fd=dtauy3_fd,& - dusfc_ls=dummx_ls,dvsfc_ls=dummy_ls,& - dusfc_bl=dummx_bl,dvsfc_bl=dummy_bl,& - dusfc_ss=dummx_ss,dvsfc_ss=dummy_ss,& - dusfc_fd=dusfc_fd,dvsfc_fd=dvsfc_fd) - ! + !sgh30 as the input for turbulent orographic form drag (TOFD) instead of sgh + call oro_drag_interface(state,cam_in,sgh30,pbuf,hdtime,dummy_nm,& + gwd_ls,gwd_bl,gwd_ss,gwd_fd,& + od_ls_ncleff,od_bl_ncd,od_ss_sncleff,& + dummy_utgw,dummy_vtgw,dummy_ttgw,& + dtaux3_ls=dummx3_ls,dtauy3_ls=dummy3_ls,& + dtaux3_bl=dummx3_bl,dtauy3_bl=dummy3_bl,& + dtaux3_ss=dummx3_ss,dtauy3_ss=dummy3_ss,& + dtaux3_fd=dtaux3_fd,dtauy3_fd=dtauy3_fd,& + dusfc_ls=dummx_ls,dvsfc_ls=dummy_ls,& + dusfc_bl=dummx_bl,dvsfc_bl=dummy_bl,& + dusfc_ss=dummx_ss,dvsfc_ss=dummy_ss,& + dusfc_fd=dusfc_fd,dvsfc_fd=dvsfc_fd) + call outfld ('DTAUX3_FD', dtaux3_fd, pcols, lchnk) call outfld ('DTAUY3_FD', dtauy3_fd, pcols, lchnk) call outfld ('DUSFC_FD', dusfc_fd, pcols, lchnk) @@ -3269,38 +3269,37 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) enddo if (use_od_ss) then - !add calculation of bulk richardson number here - ! - !compute the whole level th and thv for diagnose of bulk richardson number - thv_lv=0.0_r8 - th_lv=0.0_r8 + !add calculation of bulk richardson number here + !compute the whole level th and thv for diagnose of bulk richardson number + thv_lv=0.0_r8 + th_lv =0.0_r8 - !use the same virtual potential temperature formula as above (thv) except for all vertical levels - !used for bulk richardson number below in pblintd_ri - do i=1,ncol - do k=1,pver - th_lv(i,k) = state%t(i,k)*state%exner(i,k) - if (use_sgv) then - thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq) & - - state%q(i,k,ixcldliq)) - else - thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq)) - end if + !use the same virtual potential temperature formula as above (thv) except for all vertical levels + !used for bulk richardson number below in pblintd_ri + do i=1,ncol + do k=1,pver + th_lv(i,k) = state%t(i,k)*state%exner(i,k) + if (use_sgv) then + thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq) & + - state%q(i,k,ixcldliq)) + else + thv_lv(i,k) = th_lv(i,k)*(1.0_r8+zvir*state%q(i,k,ixq)) + end if + enddo enddo - enddo - !recalculate the kbfs stored in kbfs_pcol for bulk richardson number in pblintd_ri - kbfs_pcol=0.0_r8 - do i=1,ncol + !recalculate the kbfs stored in kbfs_pcol for bulk richardson number in pblintd_ri + kbfs_pcol=0.0_r8 + do i=1,ncol call calc_ustar( state%t(i,pver), state%pmid(i,pver), cam_in%wsx(i), cam_in%wsy(i), rrho, ustar(i) ) call calc_obklen( th(i), thv(i), cam_in%cflx(i,1), cam_in%shf(i), rrho, ustar(i), & kinheat, kinwat, kbfs, obklen(i) ) kbfs_pcol(i)=kbfs - enddo + enddo - !calculate the bulk richardson number - call pblintd_ri(ncol, gravit, thv_lv, state%zm, state%u, state%v, & - ustar, obklen, kbfs_pcol, state%ribulk) + !calculate the bulk richardson number + call pblintd_ri(ncol, gravit, thv_lv, state%zm, state%u, state%v, & + ustar, obklen, kbfs_pcol, state%ribulk) endif return diff --git a/components/eam/src/physics/cam/gw_drag.F90 b/components/eam/src/physics/cam/gw_drag.F90 index d0f26a3245c..352858905ba 100644 --- a/components/eam/src/physics/cam/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw_drag.F90 @@ -303,30 +303,30 @@ subroutine gw_init() character*11 :: subname='gw_init' ! subroutine name integer :: grid_id pblh_idx = pbuf_get_index('pblh') - ! grid_id = cam_grid_id('physgrid') - ! + if (use_od_ls.or.use_od_bl) then - if (.not. cam_grid_check(grid_id)) then - call endrun(trim(subname)//': Internal error, no "physgrid" grid') - end if - call cam_grid_get_dim_names(grid_id, dim1name, dim2name) - ! - call initialize_comsrf_OD() - call setup_initial_OD() - ncid_topo_OD=>topo_OD_file_get_id() - call infld('OC', ncid_topo_OD, dim1name, dim2name, 1, pcols, begchunk, & - endchunk, oc , found, gridname='physgrid') - !keep the same interval of OA,OL - call infld('OA', ncid_topo_OD,dim1name, 'nvar_dirOA', dim2name, 1, pcols, 1, nvar_dirOA, begchunk, & - endchunk, oadir(:,:,:), found, gridname='physgrid') - call infld('OL', ncid_topo_OD,dim1name, 'nvar_dirOL', dim2name, 1, pcols, 1, nvar_dirOL, begchunk, & - endchunk, ol , found, gridname='physgrid') - if(.not. found) call endrun('ERROR: OD topo file readerr') - ! - call close_initial_file_OD() + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + call initialize_comsrf_OD() + call setup_initial_OD() + + ncid_topo_OD=>topo_OD_file_get_id() + call infld('OC', ncid_topo_OD, dim1name, dim2name, 1, pcols, begchunk, & + endchunk, oc , found, gridname='physgrid') + !keep the same interval of OA,OL + call infld('OA', ncid_topo_OD,dim1name, 'nvar_dirOA', dim2name, 1, pcols, 1, nvar_dirOA, begchunk, & + endchunk, oadir(:,:,:), found, gridname='physgrid') + call infld('OL', ncid_topo_OD,dim1name, 'nvar_dirOL', dim2name, 1, pcols, 1, nvar_dirOL, begchunk, & + endchunk, ol , found, gridname='physgrid') + if(.not. found) call endrun('ERROR: OD topo file readerr') + call close_initial_file_OD() + endif - ! + ! Set model flags. do_spectral_waves = (pgwv > 0 .and. (use_gw_front .or. use_gw_convect)) orographic_only = (use_gw_oro .and. .not. do_spectral_waves) diff --git a/components/eam/src/physics/cam/od_common.F90 b/components/eam/src/physics/cam/od_common.F90 index d548e32b379..3eb81889e95 100644 --- a/components/eam/src/physics/cam/od_common.F90 +++ b/components/eam/src/physics/cam/od_common.F90 @@ -1,5 +1,4 @@ module od_common - ! ! This module contains code common to different orographic drag ! parameterizations. @@ -10,7 +9,7 @@ module od_common ! turbulent orographic form drag (Beljaars et al.,2004). ! use gw_utils, only: r8 -use ppgrid, only: nvar_dirOA,nvar_dirOL +use ppgrid, only: pver,nvar_dirOA,nvar_dirOL use cam_logfile, only: iulog implicit none @@ -25,14 +24,14 @@ module od_common !========================================================================== -subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm,& - gwd_ls, gwd_bl, gwd_ss, gwd_fd, & - od_ls_ncleff, od_bl_ncd,od_ss_sncleff,& - utgw, vtgw, ttgw, & - dtaux3_ls,dtauy3_ls,dtaux3_bl,dtauy3_bl, & - dtaux3_ss,dtauy3_ss,dtaux3_fd,dtauy3_fd, & - dusfc_ls, dvsfc_ls ,dusfc_bl, dvsfc_bl, & - dusfc_ss, dvsfc_ss ,dusfc_fd, dvsfc_fd) +subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm, & + gwd_ls, gwd_bl, gwd_ss, gwd_fd, & + od_ls_ncleff, od_bl_ncd,od_ss_sncleff, & + utgw, vtgw, ttgw, & + dtaux3_ls,dtauy3_ls,dtaux3_bl,dtauy3_bl, & + dtaux3_ss,dtauy3_ss,dtaux3_fd,dtauy3_fd, & + dusfc_ls, dvsfc_ls ,dusfc_bl, dvsfc_bl, & + dusfc_ss, dvsfc_ss ,dusfc_fd, dvsfc_fd) use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index use camsrfexch, only: cam_in_t @@ -76,12 +75,12 @@ subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, real(r8), intent(out), optional :: dvsfc_ss(pcols) real(r8), intent(out), optional :: dusfc_fd(pcols) real(r8), intent(out), optional :: dvsfc_fd(pcols) - ! + real(r8) :: ztop(pcols,pver) ! top interface height asl (m) real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m) real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) real(r8) :: dz(pcols,pver) ! model layer height - ! + !real(r8) :: g !pblh input integer :: pblh_idx = 0 @@ -215,30 +214,30 @@ subroutine dxygrid(dx,dy,theta_in,dxy) theta1=MOD(theta_in,360._r8) !set negative axis into 0~360 if (theta1.ge.-360._r8.and.theta1.lt.0._r8) then - theta1=theta1+360._r8 + theta1=theta1+360._r8 endif !in case the angle is not into the judgement theta=theta1 !transform of angle into first quadrant if (theta1.ge. 0._r8.and.theta1.lt. 90._r8) then - theta=theta1 + theta=theta1 else if (theta1.gt. 90._r8.and.theta1.lt.180._r8) then - theta=(180._r8-theta1) + theta=(180._r8-theta1) else if (theta1.gt.180._r8.and.theta1.lt.270._r8) then - theta=(theta1-180._r8) + theta=(theta1-180._r8) else if (theta1.gt.270._r8.and.theta1.lt.360._r8) then - theta=(360._r8-theta1) + theta=(360._r8-theta1) else if (theta1.eq.90._r8.or.theta1.eq.270._r8) then - theta=90._r8 + theta=90._r8 else if (theta1.eq.0._r8.or.theta1.eq.180._r8) then - theta=0._r8 + theta=0._r8 endif !get dxy if (theta.ge. 0._r8.and.theta.lt.atan2(dy,dx)/rad) then - dxy=dx/cos(theta*rad) + dxy=dx/cos(theta*rad) else if (theta.ge.atan2(dy,dx)/rad.and.theta.le.90._r8)then - dxy=dy/sin(theta*rad) + dxy=dy/sin(theta*rad) endif end subroutine dxygrid @@ -681,9 +680,8 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & real(r8),parameter :: odmin = 0.1_r8 real(r8),parameter :: odmax = 10._r8 real(r8),parameter :: erad = 6371.315e+3_r8 - ! - ! local variables - ! + + !local variables integer :: i,j,k,lcap,lcapp1,nwd,idir integer :: klcap,kp1,ikount,kk,nwd1!added nwd1 real(r8) :: rcs,rclcs,csg,fdir,cleff,cs,rcsks @@ -1220,7 +1218,6 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper vtendform(i,k)=-0.0759_r8*wsp*v1(i,k)* & EXP(-(za(i,k)/1500._r8)**1.5_r8)*a2*za(i,k)**(-1.2_r8)*ss_taper - ! enddo endif enddo diff --git a/components/eam/src/physics/cam/phys_control.F90 b/components/eam/src/physics/cam/phys_control.F90 index b82ad13ef28..1ac5d841dc4 100644 --- a/components/eam/src/physics/cam/phys_control.F90 +++ b/components/eam/src/physics/cam/phys_control.F90 @@ -184,7 +184,7 @@ module phys_control logical, public, protected :: use_od_fd = .false. real(r8),public, protected :: od_ls_ncleff = 3._r8 !tunable parameter for oGWD real(r8),public, protected :: od_bl_ncd = 3._r8 !tunable parameter for FBD -real(r8),public, protected :: od_ss_od_ss_sncleff = 1._r8 !tunable parameter for sGWD +real(r8),public, protected :: od_ss_sncleff = 1._r8 !tunable parameter for sGWD ! ! Switches that turn on/off individual parameterizations. ! @@ -383,9 +383,9 @@ subroutine phys_ctl_readnl(nlfile) call mpibcast(use_od_bl, 1 , mpilog, 0, mpicom) call mpibcast(use_od_ss, 1 , mpilog, 0, mpicom) call mpibcast(use_od_fd, 1 , mpilog, 0, mpicom) - call mpibcast(od_ls_ncleff 1 , mpilog, 0, mpicom) + call mpibcast(od_ls_ncleff, 1 , mpilog, 0, mpicom) call mpibcast(od_bl_ncd, 1 , mpilog, 0, mpicom) - call mpibcast(od_ss_sncleff 1 , mpilog, 0, mpicom) + call mpibcast(od_ss_sncleff, 1 , mpilog, 0, mpicom) call mpibcast(fix_g1_err_ndrop, 1 , mpilog, 0, mpicom) call mpibcast(ssalt_tuning, 1 , mpilog, 0, mpicom) call mpibcast(resus_fix, 1 , mpilog, 0, mpicom) From 6c0fb9d6212b5cf3d6804342d2fc41286e15c8b3 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 13 Nov 2024 08:53:01 -0700 Subject: [PATCH 257/529] Update add-grid-config.md --- .../adding-grid-support-step-by-step-guide/add-grid-config.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index 7d61c153ed5..50792bfe7cd 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -156,7 +156,7 @@ If you are creating a new grid that will be used by the land model the grid name valid_values= "512x1024,360x720cru,128x256,64x128,..."> Horizontal resolutions -Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools +Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for ELM tools ``` From 0336fa35355aa002b13264589908cb5b2a2f2923 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Thu, 14 Nov 2024 14:16:07 -0500 Subject: [PATCH 258/529] fix mkdocs typo for eamxx docs --- .github/workflows/eamxx-gh-pages.yml | 4 ++-- components/eamxx/{mkdocs.yaml => mkdocs.yml} | 0 2 files changed, 2 insertions(+), 2 deletions(-) rename components/eamxx/{mkdocs.yaml => mkdocs.yml} (100%) diff --git a/.github/workflows/eamxx-gh-pages.yml b/.github/workflows/eamxx-gh-pages.yml index 2e763c544cd..488c2b11a02 100644 --- a/.github/workflows/eamxx-gh-pages.yml +++ b/.github/workflows/eamxx-gh-pages.yml @@ -9,7 +9,7 @@ on: branches: [ master ] # Only if docs-related files are touched paths: - - components/eamxx/mkdocs.yaml + - components/eamxx/mkdocs.yml - components/eamxx/docs/** - components/eamxx/cime_config/namelist_defaults_scream.xml # Runs every time a PR is open against master @@ -17,7 +17,7 @@ on: branches: [ master ] # Only if docs-related files are touched paths: - - components/eamxx/mkdocs.yaml + - components/eamxx/mkdocs.yml - components/eamxx/docs/** - components/eamxx/cime_config/namelist_defaults_scream.xml diff --git a/components/eamxx/mkdocs.yaml b/components/eamxx/mkdocs.yml similarity index 100% rename from components/eamxx/mkdocs.yaml rename to components/eamxx/mkdocs.yml From 7030371316c8d39e2ced28a8ee5e104dff36b679 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Thu, 14 Nov 2024 14:16:40 -0500 Subject: [PATCH 259/529] add pyscream docs --- components/eamxx/docs/user/pyscream.md | 73 ++++++++++++++++++++++++++ components/eamxx/mkdocs.yml | 1 + 2 files changed, 74 insertions(+) create mode 100644 components/eamxx/docs/user/pyscream.md diff --git a/components/eamxx/docs/user/pyscream.md b/components/eamxx/docs/user/pyscream.md new file mode 100644 index 00000000000..e49993132ac --- /dev/null +++ b/components/eamxx/docs/user/pyscream.md @@ -0,0 +1,73 @@ +# PySCREAM + +PySCREAM is currently under heavy development and may contain some +rough edges. If you encounter any issues, please report them on the +team on +[github discussions](https://github.com/E3SM-Project/E3SM/labels/eamxx). +Likewise, if you have questions or would like to request features, +please post them on the +[github discussions](https://github.com/E3SM-Project/E3SM/labels/eamxx). + +## Quick Start + +For now, the only way to use pyscream is to either build it on your own +or use our prebuilt conda binaries. We prefer for you to use the latter. +In a conda environment, please use the following command to install it: + +```bash +conda install -c mahf708 pyscream=0.0.2 +``` + +It is recommended to use the latest version of pyscream, wich is +currently 0.0.2. As you can see, it is a young package with a lot of +potential. We do not guarantee that the API will remain stable, but we +will try to document any changes as frequently as we could. + +## Examples + +We provide an example to demo calling the radiation process (RRTMGP). +More examples are on the way. If you'd like to add your example, +please feel free to submit a PR. + +### RRTMGP + +```python +from mpi4py import MPI +import pyscream + +pyscream.init() + +dt = 1800 +t0_str = "2020-10-10-00000" + +ic_file = "/lcrc/group/e3sm/public_html/inputdata/atm/scream/init/screami_unit_tests_ne2np4L72_20220822.nc" +ncols = 218 +nlevs = 72 +pyscream.create_grids_manager(ncols,nlevs, ic_file) + +rad_dict = { + "column_chunk_size": 123, + "active_gases": ["h2o", "co2", "o3", "n2o", "co" , "ch4", "o2", "n2"], + "orbital_year": 1990, + "log_level": "info", + "do_aerosol_rad": False, + "rrtmgp_coefficients_file_sw": "/lcrc/group/e3sm/data/inputdata/atm/scream/init/rrtmgp-data-sw-g112-210809.nc", + "rrtmgp_coefficients_file_lw": "/lcrc/group/e3sm/data/inputdata/atm/scream/init/rrtmgp-data-lw-g128-210809.nc", + "rrtmgp_cloud_optics_file_sw": "/lcrc/group/e3sm/data/inputdata/atm/scream/init/rrtmgp-cloud-optics-coeffs-sw.nc", + "rrtmgp_cloud_optics_file_lw": "/lcrc/group/e3sm/data/inputdata/atm/scream/init/rrtmgp-cloud-optics-coeffs-lw.nc", +} + +rad = pyscream.AtmProc(rad_dict, 'RRTMGP') +rad.read_ic(ic_file) +rad.initialize(t0_str) + +t = rad.get_field("T_mid") +tm = t.get() + +print(tm[5,5], flush=True) + +rad.run(dt) +rad.run(dt) + +print(tm[5,5], flush=True) +``` diff --git a/components/eamxx/mkdocs.yml b/components/eamxx/mkdocs.yml index 4c82daab160..b1f5cace0a5 100644 --- a/components/eamxx/mkdocs.yml +++ b/components/eamxx/mkdocs.yml @@ -12,6 +12,7 @@ nav: - 'COSP': 'user/cosp.md' - 'Regionally Refined EAMxx': 'user/rrm_eamxx.md' - 'Doubly Periodic EAMxx': 'user/dp_eamxx.md' + - 'PySCREAM': 'user/pyscream.md' - 'Developer Guide': - 'Overview': 'developer/index.md' - 'Installation': 'common/installation.md' From 1521a07cf230cefefb68c3e7ff58c6b082be65a0 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Thu, 14 Nov 2024 14:21:27 -0500 Subject: [PATCH 260/529] fix typo in kokkos ekat docs --- components/eamxx/docs/developer/kokkos_ekat.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/components/eamxx/docs/developer/kokkos_ekat.md b/components/eamxx/docs/developer/kokkos_ekat.md index 2432290a67a..6ebf23ba1aa 100644 --- a/components/eamxx/docs/developer/kokkos_ekat.md +++ b/components/eamxx/docs/developer/kokkos_ekat.md @@ -56,8 +56,9 @@ where - `DataType`: scalar type of the view, given as `ScalarType`+`*`(x's number of run-time dimensions). E.g., a 2D view of doubles will have `DataType = double**`. There is also an ability to define compile-time dimensions by - using `[]`, see [Kokkos wiki section on views]( - wiki/API/core/view/view.html). + using `[]`, see + [Kokkos wiki section on views] + ( Date: Thu, 14 Nov 2024 17:31:15 -0600 Subject: [PATCH 261/529] Fix typos and add links Fix some typos. Add links to the otherwise blank user and developer guide main pages. Also change SCREAM to EAMxx in those. --- components/eamxx/docs/developer/index.md | 17 ++++++++++++++++- components/eamxx/docs/developer/processes.md | 2 +- components/eamxx/docs/index.md | 2 +- components/eamxx/docs/user/index.md | 13 ++++++++++++- 4 files changed, 30 insertions(+), 4 deletions(-) diff --git a/components/eamxx/docs/developer/index.md b/components/eamxx/docs/developer/index.md index 69673b12ebd..7216d6057cb 100644 --- a/components/eamxx/docs/developer/index.md +++ b/components/eamxx/docs/developer/index.md @@ -1 +1,16 @@ -# SCREAM Developer Guide +# EAMxx Developer Guide + +### [Installation](../common/installation.md) +### [Style Guide](style_guide.md) +### [Kokkos and EKAT](kokkos_ekat.md) +### [Source Tree](source_tree.md) +### Important Data Structures + * [Fields](field.md) + * [Grids and Remappers](grid.md) + * [Atmosphere Processes](processes.md) + * [Managers](managers.md) +### [I/O](io.md) +### Testing + * [Standalone](standalone_testing.md) + * [Full Model](cime_testing.md) + * [CI and Nightly Testing](ci_nightly.md) diff --git a/components/eamxx/docs/developer/processes.md b/components/eamxx/docs/developer/processes.md index adb90e2dfbc..a2f2d671e2e 100644 --- a/components/eamxx/docs/developer/processes.md +++ b/components/eamxx/docs/developer/processes.md @@ -54,7 +54,7 @@ of several steps: - After creating all fields (based on AP's requests), the AD passes a copy of each input and output field to the AP's. These fields will be divided in "required" and "computed", which differ in that the former are only passed - to the AP's as 'read-only' fields (see the [field](field.md#Field) + to the AP's as 'read-only' fields (see the [field](field.md) documentation for more details) - The AP's are queried for how much scratch memory they may need at run time. After all AP's communicate their needs, the AD will provide a pointer to diff --git a/components/eamxx/docs/index.md b/components/eamxx/docs/index.md index d243f3c2756..0f78e45dbd4 100644 --- a/components/eamxx/docs/index.md +++ b/components/eamxx/docs/index.md @@ -1,6 +1,6 @@ # The E3SM Atmosphere Model in C++ (EAMxx) -EAMxx +##EAMxx EAMxx is almost completely different in all ways from the atmosphere model used for E3SM versions 1-3. diff --git a/components/eamxx/docs/user/index.md b/components/eamxx/docs/user/index.md index 2e24e9fa736..11eb659f3fd 100644 --- a/components/eamxx/docs/user/index.md +++ b/components/eamxx/docs/user/index.md @@ -1,4 +1,4 @@ -# SCREAM User Guide +# EAMxx User Guide This section contains documentation on how to create, setup, and run CIME cases with EAMxx as the atmosphere component. It is assumed that the reader has a familiarity with [CIME case @@ -8,3 +8,14 @@ that the user knows how to create a case, and what the `case.setup`, `case.build This user guide is still under construction. In the meantime, in case you can't find the information you need, you may visit our public confluence [EAMxx user guide](https://acme-climate.atlassian.net/wiki/spaces/DOC/pages/3858890786/EAMxx+User+s+Guide). + +### [EAMxx case basics](eamxx_cases.md) +### [Model input](model_input.md) +### [Model output](model_output.md) +### [Nudging](nudging.md) +### [Extra radiation calls](clean_clear_sky.md) +### [COSP](cosp.md) +### [Regionally Refined EAMxx](rrm_eamxx.md) +### [Doubly Periodic EAMxx](dp_eamxx.md) +### [PySCREAM](pyscream.md) + From 8ae54785502e598663c37b400e677681da266b0a Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Thu, 14 Nov 2024 18:40:14 -0600 Subject: [PATCH 262/529] Reorg some content Reorg some content and clarify ELM, EAM and CIME --- .../add-grid-config.md | 152 ++++++++++-------- 1 file changed, 86 insertions(+), 66 deletions(-) diff --git a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md index 50792bfe7cd..bc45fadc964 100644 --- a/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md +++ b/docs/dev-guide/adding-grid-support/adding-grid-support-step-by-step-guide/add-grid-config.md @@ -1,10 +1,14 @@ # Add New Grid Configuration to E3SM -In addition to generating input data to support a new grid, several code modifications are required before E3SM can run with the grid. However, the specific changes will depend on how the grid will be used. The intendend model configuration for the new grid will change which files need to be modified. For instance, a grid intended for aquaplanet experiments does not require as many changes as a historical AMIP-style run. +In addition to generating input data to support a new grid, several modifications to XML files are required before E3SM can run with the grid. +However, the specific changes will depend on how the grid will be used. The intended model configuration for the new grid will change which files need to be modified. For instance, a grid intended for aquaplanet experiments does not require as many changes as a historical AMIP-style run. -The guidelines here are meant to outline various possible changes the user should consider when adding support for a new grid. This document cannot be exhaustive, and it is important that the user understands the changes they are making. It is often useful to use a pre-existing grid configuration as a template. Note that the guidelines here are only relevant for "horizontal" grids. Additional considerations are needed to support a new vertical grid, which is a topic not currently covered here. +The guidelines here are meant to outline various possible changes the user should consider when adding support for a new grid for the land and/or atmosphere. +This document cannot be exhaustive, and it is important that the user understands the changes they are making. It is often useful to use a pre-existing grid configuration as a template. +Note that the guidelines here are only relevant for "horizontal" grids in the atmosphere and/or land. +Additional considerations are needed to support a new vertical grid in the atmosphere, which is a topic not currently covered here. -When setting up a new grid you will need to edit some or all of these files: +When setting up a new grid for the atmosphere and/or land model, you will need to edit some or all of these files: - `cime_config/config_grids.xml` - `components/eam/bld/config_files/horiz_grid.xml` @@ -21,17 +25,24 @@ In practice, "bi" and "tri" grids are most commonly used and the main difference ## Grid Naming Conventions +### Atmosphere + The atmosphere grid name should always indicate the base "ne" value and whether the physgrid is being used, usually by adding ".pg2" at the end. For a regionally refined mesh (RRM) the grid name should always start with `ne0` followed a descriptive string that includes the region being refined and the degree of refinement. **Example**: `ne0np4_northamerica_30x4v1.pg2` Note that this example differs from how the North American grid is currently named as `ne0np4_northamericax4v1.pg2`, which indicates a `4x` refinement, but does not indicate the base resolution, which is useful to know. The more informative grid name `ne0np4_northamerica_30x4v1.pg2` makes it clear that unrefined regions are consistent with `ne30pg2`. +### River (or Land in tri-grid) + For a rectilinear lat-lon grid used by the land and/or river models the grid name should start with "r" and typically use spacing less than one degree, so they indicate the nominal grid spacing, starting with "0" and omitting the decimal. **Examples**: `r05` is 0.5 degree spacing and `r0125` is 1/8 or 0.125 degree spacing. -For a mono-grid the convention is that the grid is written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. A mono-grid is typically only used for idealized simulations such as aqua planet and RCE, but can also be used for F-compsets if the CICE sea-ice model is used in place of the MPAS sea-ice model (MPASSI). +### Grid Aliases + +Grid aliases are short strings used to represent the complete set of grids used in the model configuration. +For a mono-grid the convention is that the grid alias is the base mesh written twice to indicate that both atmosphere/land and ocean/sea-ice models are on the same grid. A mono-grid is typically only used for idealized simulations such as aqua planet and RCE, but can also be used for F-compsets if the CICE sea-ice model is used in place of the MPAS sea-ice model (MPASSI). **Example**: `ne30pg2_ne30pg2` @@ -43,7 +54,9 @@ Tri-grid options should indicate three different grids used for atmosphere, land **Example**: `ne30pg2_r05_IcoswISC30E3r5` -Note that the conventions discussed above refer to the "grid alias", but for any combination of grids the full grid definition has a long form representation that spells out the grid in more detail. +### Grid longnames + +For any combination of grids, the full grid definition has a long form representation that spells out the grid in more detail. **Example**: @@ -55,11 +68,72 @@ Note that the conventions discussed above refer to the "grid alias", but for any mask is: oQU240 ``` -## Grid Definition +## Defining a New Atmosphere Grid for EAM + +When defining a new atmosphere grid, information needs to be provided on how the grid is constructed. + +To define a new atmosphere grid a line must be added to `components/eam/bld/config_files/horiz_grid.xml` that indicates the number of elements and physics columns. In the lines below for `ne30np4` (without the physgrid) and `ne30pg2` (with the physgrid) you can see the value of `ne` is the same (number of elements along a cube edge), but the number of physics columns is different. + +```xml + + +``` + +An explanation of how to calculate the number of physics columns can be found here: [Atmosphere Grid Overview](../../../EAM/tech-guide/atmosphere-grid-overview.md). + +For a grid with regional refinement, follow the conventions of other grids in this file. There is no formula to calculate the number of columns for RRM grids, but the value can be obtained from the grid files used for mapping. + +```xml + +``` + +## Defining a New Land Grid for ELM + +If you are creating a new grid that will be used by the land model the grid name needs to be added to the list `valid_values` associated with the `res` entry in the file `components/elm/bld/namelist_files/namelist_definition.xml` that holds the definition of namelist variables used by the land model. + +```xml + +Horizontal resolutions +Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for ELM tools + +``` + +Simply add the name of your new grid to the list of `valid_values`. + +## Using New Grids in Default Namelists + +Each new grid will likely need various new default parameter values to be specified. These parameters can be set for individual simulations by editing the `user_nl_*` files in the case directory, but for these to become defaults any time the grid is used then new defaults need to be specified. + +The lists below show namelist parameters that may need to be specified for a new grid. The creator of a new grid is responsible for understanding these parameters and deciding when new defaults are appropriate. + +### Atmosphere Namelist Parameters + +- `drydep_srf_file` - Data file for surface aerosol deposition +- `bnd_topo` - Surface topography (smoothed for target grid) +- `mesh_file` - HOMME np4 mesh file (exodus format) +- `se_tstep` - HOMME time step [seconds] +- `dt_remap_factor` - HOMME vertical remap factor +- `dt_tracer_factor` - HOMME tracer advection factor +- `hypervis_subcycle_q` - HOMME tracer hyperviscosity factor + +### Land Namelist Parameters + +- `fsurdat` - Surface data file +- `finidat` - Land model initial condition file +- `flanduse_timeseries` - Time-evolving land-use data file + +## Defining a new grid for CIME + +The CIME Case Control system will configure a case according to the component set and grid alias you specify with the `--res` argument. +As part of that configuration, CIME needs to know +how to translate the grid alias and set the paths for domain and mapping files used by the grid so the model can find them at runtime. ### Adding a New Grid Alias -Grid aliases are defined in `cime_config/config_grids.xml` and are used to specify the grid for a case when calling `create_newcase` via the `--res` argument. Below is an example grid alias for the `ne30pg2_r05_IcoswISC30E3r5` grid used in E3SMv3 production simulations. +Grid aliases are defined in `cime_config/config_grids.xml`. Below is an example grid alias for the `ne30pg2_r05_IcoswISC30E3r5` grid used in E3SMv3 production simulations. ```xml @@ -73,6 +147,8 @@ Grid aliases are defined in `cime_config/config_grids.xml` and are used to speci ``` +Add a similar block for your new grid. Aliases must be unique within `config_grids.xml` + ### Domain Files Domain files are needed for each grid and are specified in the `` section of `cime_config/config_grids.xml`. The default domain files are grouped by the atmosphere grid. The section for the typical `ne30pg2` grid looks as follows: @@ -89,7 +165,7 @@ Domain files are needed for each grid and are specified in the `` secti ``` -Notice the ellipses `...` are used here to omit all entries that are not relevant to the `ne30pg2_r05_IcoswISC30E3r5` grid. Also, note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. See [Generating Domain Files](/generate_domain_files/) for information about creating domain files. +Notice the ellipses `...` are used here to omit all entries that are not relevant to the `ne30pg2_r05_IcoswISC30E3r5` grid. Also, note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. See [Generating Domain Files](../../../generate_domain_files/index.md) for information about creating domain files. ### Coupler Mapping Files @@ -125,63 +201,7 @@ The mapping files used by the component coupler to communicate fluxes between th ``` -Note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. - -### Defining a New Atmosphere Grid - -When defining a new atmosphere grid, information needs to be provided on how the grid is constructed. - -To define a new atmosphere grid a line must be added to `components/eam/bld/config_files/horiz_grid.xml` that indicates the number of elements and physics columns. In the lines below for `ne30np4` (without the physgrid) and `ne30pg2` (with the physgrid) you can see the value of `ne` is the same (number of elements along a cube edge), but the number of physics columns is different. - -```xml - - -``` - -An explanation of how to calculate the number of physics columns can be found here: [Atmosphere Grid Overview](../../../EAM/tech-guide/atmosphere-grid-overview.md). - -For a grid with regional refinement, follow the conventions of other grids in this file. There is no formula to calculate the number of columns for RRM grids, but the value can be obtained from the grid files used for mapping. - -```xml - -``` - -### Defining a New Land Grid - -If you are creating a new grid that will be used by the land model the grid name needs to be added to the list `valid_values` associated with the `res` entry in the file `components/elm/bld/namelist_files/namelist_definition.xml` that holds the definition of namelist variables used by the land model. - -```xml - -Horizontal resolutions -Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for ELM tools - -``` - -Simply add the name of your new grid to the list of `valid_values`. - -## Namelist Variable Defaults - -Each new grid will likely need various new default parameter values to be specified. These parameters can be set for individual simulations by editing the `user_nl_*` files in the case directory, but for these to become defaults any time the grid is used then new defaults need to be specified. - -The lists below show namelist parameters that may need to be specified for a new grid. The creator of a new grid is responsible for understanding these parameters and deciding when new defaults are appropriate. - -### Atmosphere Namelist Parameters - -- `drydep_srf_file` - Data file for surface aerosol deposition -- `bnd_topo` - Surface topography (smoothed for target grid) -- `mesh_file` - HOMME np4 mesh file (exodus format) -- `se_tstep` - HOMME time step [seconds] -- `dt_remap_factor` - HOMME vertical remap factor -- `dt_tracer_factor` - HOMME tracer advection factor -- `hypervis_subcycle_q` - HOMME tracer hyperviscosity factor - -### Land Namelist Parameters - -- `fsurdat` - Surface data file -- `finidat` - Land model initial condition file -- `flanduse_timeseries` - Time-evolving land-use data file +Note that all of these paths are relative to the input data path set as `DIN_LOC_ROOT` which has a default for each machine. Mapping files can be created with +the [ncremap](https://acme-climate.atlassian.net/wiki/spaces/DOC/pages/754286611/Regridding+E3SM+Data+with+ncremap) utility in NCO Back to step-by-step guide for [Adding Support for New Grids](../adding-grid-support-step-by-step-guide.md) From 63d191dd4f7f71ea2f367617dd79f4e4c8fcc9d9 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 25 Sep 2024 15:34:49 -0700 Subject: [PATCH 263/529] iadd P3DT output --- components/eam/src/physics/p3/eam/micro_p3_interface.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/components/eam/src/physics/p3/eam/micro_p3_interface.F90 b/components/eam/src/physics/p3/eam/micro_p3_interface.F90 index c6c533329a3..b9cf0e452ba 100644 --- a/components/eam/src/physics/p3/eam/micro_p3_interface.F90 +++ b/components/eam/src/physics/p3/eam/micro_p3_interface.F90 @@ -537,6 +537,8 @@ subroutine micro_p3_init(pbuf2d) call addfld(apcnst(ixcldrim), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldrim))//' after physics' ) call addfld(bpcnst(ixcldrim), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldrim))//' before physics' ) + call addfld ('P3DT',(/ 'lev' /), 'A','K/s','T tendency - P3 Microphysics') + ! microphysics cloud fraction fields call addfld('CLOUDFRAC_LIQ_MICRO', (/ 'lev' /), 'A', 'unitless', 'Grid box liquid cloud fraction in microphysics' ) call addfld('CLOUDFRAC_ICE_MICRO', (/ 'lev' /), 'A', 'unitless', 'Grid box ice cloud fraction in microphysics' ) @@ -995,6 +997,8 @@ subroutine micro_p3_tend(state, ptend, dtime, pbuf) real(rtype) :: precip_liq_surf(pcols) !precipitation rate, liquid m s-1 real(rtype) :: precip_ice_surf(pcols) !precipitation rate, solid m s-1 + real(rtype) :: ftem(pcols,pver) ! Temporary workspace for outfld variables + real(rtype) :: rho_qi(pcols,pver) !bulk density of ice kg m-1 real(rtype) :: pres(pcols,pver) !pressure at midlevel hPa real(rtype) :: qv2qi_depos_tend(pcols,pver) @@ -1429,6 +1433,10 @@ subroutine micro_p3_tend(state, ptend, dtime, pbuf) ptend%q(:ncol,:pver,ixcldrim) = ( max(0._rtype,qm(:ncol,:pver) ) - state%q(:ncol,:pver,ixcldrim) )/dtime ptend%q(:ncol,:pver,ixrimvol) = ( max(0._rtype,rimvol(:ncol,:pver) ) - state%q(:ncol,:pver,ixrimvol) )/dtime + ftem = 0 + ftem(:ncol,:pver) = ptend%s(:ncol,:pver)/cpair + call outfld('P3DT', ftem, pcols, lchnk ) + ! Update t_prev and qv_prev to be used by evap_precip t_prev(:ncol,:pver) = temp(:ncol,:pver) qv_prev(:ncol,:pver) = qv(:ncol,:pver) From b1f13ffc745779adc1c09249eb5793ace1d7a305 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 15 Nov 2024 12:18:33 -0800 Subject: [PATCH 264/529] remove P3DT --- components/eam/src/physics/p3/eam/micro_p3_interface.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/components/eam/src/physics/p3/eam/micro_p3_interface.F90 b/components/eam/src/physics/p3/eam/micro_p3_interface.F90 index b9cf0e452ba..c6c533329a3 100644 --- a/components/eam/src/physics/p3/eam/micro_p3_interface.F90 +++ b/components/eam/src/physics/p3/eam/micro_p3_interface.F90 @@ -537,8 +537,6 @@ subroutine micro_p3_init(pbuf2d) call addfld(apcnst(ixcldrim), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldrim))//' after physics' ) call addfld(bpcnst(ixcldrim), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldrim))//' before physics' ) - call addfld ('P3DT',(/ 'lev' /), 'A','K/s','T tendency - P3 Microphysics') - ! microphysics cloud fraction fields call addfld('CLOUDFRAC_LIQ_MICRO', (/ 'lev' /), 'A', 'unitless', 'Grid box liquid cloud fraction in microphysics' ) call addfld('CLOUDFRAC_ICE_MICRO', (/ 'lev' /), 'A', 'unitless', 'Grid box ice cloud fraction in microphysics' ) @@ -997,8 +995,6 @@ subroutine micro_p3_tend(state, ptend, dtime, pbuf) real(rtype) :: precip_liq_surf(pcols) !precipitation rate, liquid m s-1 real(rtype) :: precip_ice_surf(pcols) !precipitation rate, solid m s-1 - real(rtype) :: ftem(pcols,pver) ! Temporary workspace for outfld variables - real(rtype) :: rho_qi(pcols,pver) !bulk density of ice kg m-1 real(rtype) :: pres(pcols,pver) !pressure at midlevel hPa real(rtype) :: qv2qi_depos_tend(pcols,pver) @@ -1433,10 +1429,6 @@ subroutine micro_p3_tend(state, ptend, dtime, pbuf) ptend%q(:ncol,:pver,ixcldrim) = ( max(0._rtype,qm(:ncol,:pver) ) - state%q(:ncol,:pver,ixcldrim) )/dtime ptend%q(:ncol,:pver,ixrimvol) = ( max(0._rtype,rimvol(:ncol,:pver) ) - state%q(:ncol,:pver,ixrimvol) )/dtime - ftem = 0 - ftem(:ncol,:pver) = ptend%s(:ncol,:pver)/cpair - call outfld('P3DT', ftem, pcols, lchnk ) - ! Update t_prev and qv_prev to be used by evap_precip t_prev(:ncol,:pver) = temp(:ncol,:pver) qv_prev(:ncol,:pver) = qv(:ncol,:pver) From 4e9f98a8802fad3ef29933e47127bff86c1fdfec Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 15 Nov 2024 12:29:16 -0800 Subject: [PATCH 265/529] add namelist variables for gw_convect --- components/eam/bld/build-namelist | 3 +++ .../namelist_files/namelist_defaults_eam.xml | 2 ++ .../bld/namelist_files/namelist_definition.xml | 17 +++++++++++++++++ 3 files changed, 22 insertions(+) diff --git a/components/eam/bld/build-namelist b/components/eam/bld/build-namelist index 8dc532b6a3d..670390c6f66 100755 --- a/components/eam/bld/build-namelist +++ b/components/eam/bld/build-namelist @@ -830,6 +830,9 @@ add_default($nl,'use_hetfrz_classnuc'); add_default($nl,'hist_hetfrz_classnuc'); add_default($nl,'gw_convect_hcf') if (get_default_value('gw_convect_hcf')); add_default($nl,'hdepth_scaling_factor') if (get_default_value('hdepth_scaling_factor')); +add_default($nl,'gw_convect_hdepth_min') if (get_default_value('gw_convect_hdepth_min')); +add_default($nl,'gw_convect_storm_speed_min') if (get_default_value('gw_convect_storm_speed_min')); +add_default($nl,'use_gw_convect_old', 'val'=>'.true.'); add_default($nl,'linoz_psc_T'); if ($cfg->get('microphys') =~ /^mg2/) { add_default($nl,'micro_mg_dcs_tdep'); diff --git a/components/eam/bld/namelist_files/namelist_defaults_eam.xml b/components/eam/bld/namelist_files/namelist_defaults_eam.xml index 44e4e7e65ae..ba4b30bf446 100755 --- a/components/eam/bld/namelist_files/namelist_defaults_eam.xml +++ b/components/eam/bld/namelist_files/namelist_defaults_eam.xml @@ -1890,6 +1890,8 @@ with se_tstep, dt_remap_factor, dt_tracer_factor set to -1 10.0 0.50 1.0 +2.5 +10.0 0.375 .true. 2.5D0 diff --git a/components/eam/bld/namelist_files/namelist_definition.xml b/components/eam/bld/namelist_files/namelist_definition.xml index 8228c7d8d2e..6c00afd21e5 100644 --- a/components/eam/bld/namelist_files/namelist_definition.xml +++ b/components/eam/bld/namelist_files/namelist_definition.xml @@ -1110,6 +1110,23 @@ Scaling factor for the heating depth Default: 1.0 + +minimum hdepth for for convective GWD spectrum lookup table +Default: 2.5 + + + +minimum convective storm speed for convective GWD +Default: 10.0 m/s + + + +switch to revert to old calculation of Beres scheme for heating depth and max + + Efficiency associated with convective gravity waves from the Beres From 5c37d1b997514b3585f205188c4669afdecb072a Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 15 Nov 2024 12:29:50 -0800 Subject: [PATCH 266/529] refactor gw_convect to include stealth bug fix and expose namelist parameters --- components/eam/src/physics/cam/gw_convect.F90 | 189 +++++++++++------- components/eam/src/physics/cam/gw_drag.F90 | 36 ++-- 2 files changed, 139 insertions(+), 86 deletions(-) diff --git a/components/eam/src/physics/cam/gw_convect.F90 b/components/eam/src/physics/cam/gw_convect.F90 index fc2fce99214..82d6417ce81 100644 --- a/components/eam/src/physics/cam/gw_convect.F90 +++ b/components/eam/src/physics/cam/gw_convect.F90 @@ -4,10 +4,9 @@ module gw_convect ! This module handles gravity waves from convection, and was extracted from ! gw_drag in May 2013. ! - -use gw_utils, only: r8 - -use gw_common, only: pver, pgwv +use cam_logfile, only: iulog +use gw_utils, only: r8 +use gw_common, only: pver, pgwv implicit none private @@ -21,8 +20,8 @@ module gw_convect ! Dimension for mean wind in heating. integer :: maxuh -! Index for level at 700 mb. -integer :: k700 +! Index for level for storm/steering flow (usually 700 mb) +integer :: k_src_wind ! Table of source spectra. real(r8), allocatable :: mfcc(:,:,:) @@ -31,19 +30,20 @@ module gw_convect !========================================================================== -subroutine gw_convect_init(k700_in, mfcc_in, errstring) - ! Index at 700 mb. - integer, intent(in) :: k700_in - ! Source spectra to keep as table. - real(r8), intent(in) :: mfcc_in(:,:,:) - ! Report any errors from this routine. - character(len=*), intent(out) :: errstring - +subroutine gw_convect_init( plev_src_wind, mfcc_in, errstring) + use ref_pres, only: pref_edge + real(r8), intent(in) :: plev_src_wind ! previously hardcoded to 70000._r8 + real(r8), intent(in) :: mfcc_in(:,:,:) ! Source spectra to keep as table + character(len=*), intent(out) :: errstring ! Report any errors from this routine integer :: ierr errstring = "" - k700 = k700_in + do k = 0, pver + if ( pref_edge(k+1) < plev_src_wind ) k_src_wind = k+1 + end do + + if (masterproc) write (iulog,*) 'gw_convect: steering flow level = ',k_src_wind ! First dimension is maxh. maxh = size(mfcc_in,1) @@ -60,7 +60,9 @@ end subroutine gw_convect_init subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & zm, src_level, tend_level, tau, ubm, ubi, xv, yv, c, & - hdepth, maxq0, CF, hdepth_scaling_factor) + hdepth, maxq0_out, maxq0_conversion_factor, hdepth_scaling_factor, & + hdepth_min, storm_speed_min, & + use_gw_convect_old) !----------------------------------------------------------------------- ! Driver for multiple gravity wave drag parameterization. ! @@ -90,11 +92,20 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & real(r8), intent(in) :: zm(ncol,pver) ! Heating conversion factor - real(r8), intent(in) :: CF + real(r8), intent(in) :: maxq0_conversion_factor ! Scaling factor for the heating depth real(r8), intent(in) :: hdepth_scaling_factor + ! minimum hdepth for for spectrum lookup table + real(r8), intent(in) :: hdepth_min + + ! minimum convective storm speed + real(r8), intent(in) :: storm_speed_min + + ! switch for restoring legacy method + logical, intent(in) :: use_gw_convect_old + ! Indices of top gravity wave source level and lowest level where wind ! tendencies are allowed. integer, intent(out) :: src_level(ncol) @@ -110,19 +121,19 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & real(r8), intent(out) :: c(ncol,-pgwv:pgwv) ! Heating depth and maximum heating in each column. - real(r8), intent(out) :: hdepth(ncol), maxq0(ncol) + real(r8), intent(out) :: hdepth(ncol), maxq0_out(ncol) !---------------------------Local Storage------------------------------- ! Column and level indices. integer :: i, k - ! Zonal/meridional wind at 700mb. - real(r8) :: u700(ncol), v700(ncol) + ! Zonal/meridional source wind + real(r8) :: u_src(ncol), v_src(ncol) ! 3.14... real(r8), parameter :: pi = 4._r8*atan(1._r8) ! Maximum heating rate. - real(r8) :: q0(ncol) + real(r8) :: maxq0(ncol) ! Bottom/top heating range index. integer :: mini(ncol), maxi(ncol) @@ -135,36 +146,36 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & ! Source level tau for a column. real(r8) :: tau0(-PGWV:PGWV) ! Speed of convective cells relative to storm. - integer :: CS(ncol) + integer :: storm_speed(ncol) ! Index to shift spectra relative to ground. integer :: shift - ! Heating rate conversion factor. Change to take the value from caller and controllable by namelist (to tune QBO) - ! real(r8), parameter :: CF = 20._r8 - ! Averaging length. - real(r8), parameter :: AL = 1.0e5_r8 + ! fixed parameters (we may want to expose these in the namelist for tuning) + real(r8), parameter :: tau_avg_length = 1.0e5_r8 ! spectrum averaging length + real(r8), parameter :: heating_altitude_max = 20e3 ! max altitude to check heating (probably don't need this) + + integer :: ndepth_pos + integer :: ndepth_tot !---------------------------------------------------------------------- ! Initialize tau array !---------------------------------------------------------------------- - tau = 0.0_r8 + tau = 0.0_r8 hdepth = 0.0_r8 - q0 = 0.0_r8 - tau0 = 0.0_r8 + maxq0 = 0.0_r8 + tau0 = 0.0_r8 !------------------------------------------------------------------------ - ! Determine 700 mb layer wind and unit vectors, then project winds. + ! Determine source layer wind and unit vectors, then project winds. !------------------------------------------------------------------------ - ! Just use the 700 mb interface values for the source wind speed and - ! direction (unit vector). - - u700 = u(:,k700) - v700 = v(:,k700) + ! source wind speed and direction + u_src = u(:,k_src_wind) + v_src = v(:,k_src_wind) ! Get the unit vector components and magnitude at the surface. - call get_unit_vector(u700, v700, xv, yv, ubi(:,k700)) + call get_unit_vector(u_src, v_src, xv, yv, ubi(:,k_src_wind)) ! Project the local wind at midpoints onto the source wind. do k = 1, pver @@ -184,33 +195,62 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & ! which heating rate is continuously positive. !----------------------------------------------------------------------- - ! First find the indices for the top and bottom of the heating range. + ! Find indices for the top and bottom of the heating range. mini = 0 maxi = 0 - do k = pver, 1, -1 - do i = 1, ncol + + if (use_gw_convect_old) then + !--------------------------------------------------------------------- + ! original version used in CAM4/5/6 and EAMv1/2/3 + do k = pver, 1, -1 + do i = 1, ncol if (mini(i) == 0) then - ! Detect if we are outside the maximum range (where z = 20 km). - if (zm(i,k) >= 20000._r8) then - mini(i) = k - maxi(i) = k - else - ! First spot where heating rate is positive. - if (netdt(i,k) > 0.0_r8) mini(i) = k - end if + ! Detect if we are outside the maximum range (where z = 20 km). + if (zm(i,k) >= heating_altitude_max) then + mini(i) = k + maxi(i) = k + else + ! First spot where heating rate is positive. + if (netdt(i,k) > 0.0_r8) mini(i) = k + end if else if (maxi(i) == 0) then - ! Detect if we are outside the maximum range (z = 20 km). - if (zm(i,k) >= 20000._r8) then - maxi(i) = k - else - ! First spot where heating rate is no longer positive. - if (.not. (netdt(i,k) > 0.0_r8)) maxi(i) = k - end if + ! Detect if we are outside the maximum range (z = 20 km). + if (zm(i,k) >= heating_altitude_max) then + maxi(i) = k + else + ! First spot where heating rate is no longer positive. + if (.not. (netdt(i,k) > 0.0_r8)) maxi(i) = k + end if end if - end do - ! When all done, exit - if (all(maxi /= 0)) exit - end do + end do + ! When all done, exit + if (all(maxi /= 0)) exit + end do + !--------------------------------------------------------------------- + else + !--------------------------------------------------------------------- + ! cleaner version that addresses bug in original where heating max and + ! depth were too low whenever heating <=0 occurred in the middle of + ! the heating profile (ex. at the melting level) + do i = 1, ncol + do k = pver, 1, -1 + if ( zm(i,k) < heating_altitude_max ) then + if ( netdt(i,k) > 0.0_r8 ) then + ! Set mini as first spot where heating rate is positive + if ( mini(i)==0 ) mini(i) = k + ! Set maxi to current level + maxi(i) = k + end if + else + ! above the max check if indices were found + if ( mini(i)==0 ) mini(i) = k + if ( maxi(i)==0 ) maxi(i) = k + end if + end do + end do + !--------------------------------------------------------------------- + end if + ! Heating depth in km. hdepth = [ ( (zm(i,maxi(i))-zm(i,mini(i)))/1000._r8, i = 1, ncol ) ] @@ -223,19 +263,19 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & ! Maximum heating rate. do k = minval(maxi), maxval(mini) where (k >= maxi .and. k <= mini) - q0 = max(q0, netdt(:ncol,k)) + maxq0 = max(maxq0, netdt(:ncol,k)) end where end do !output max heating rate in K/day - maxq0 = q0*24._r8*3600._r8 + maxq0_out = maxq0*24._r8*3600._r8 ! Multipy by conversion factor - q0 = q0 * CF + maxq0 = maxq0 * maxq0_conversion_factor - ! Taking ubm at 700 mb to be the storm speed, find the cell speed where - ! the storm speed is > 10 m/s. - CS = int(sign(max(abs(ubm(:,k700))-10._r8, 0._r8), ubm(:,k700))) + ! Taking ubm at assumed source level to be the storm speed, + ! find the cell speed where the storm speed is > storm_speed_min + storm_speed = int(sign(max(abs(ubm(:,k_src_wind))-storm_speed_min, 0._r8), ubm(:,k_src_wind))) uh = 0._r8 do k = minval(maxi), maxval(mini) @@ -244,7 +284,7 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & end where end do - uh = uh - real(CS, r8) + uh = uh - real(storm_speed, r8) ! Limit uh to table range. uh = min(uh, real(maxuh, r8)) @@ -270,8 +310,19 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & !--------------------------------------------------------------------- ! Look up spectrum only if depth >= 2.5 km, else set tau0 = 0. !--------------------------------------------------------------------- - - if ((hdepth(i) >= 2.5_r8) .and. (abs(lat(i)) < (pi/2._r8))) then + if ((hdepth(i) >= hdepth_min)) then + ndepth_pos = 0 + ndepth_tot = 0 + do k = 1,pver + if ( k>=maxi(i).and.k<=mini(i) ) then + ndepth_tot = ndepth_tot + 1 + if ( netdt(i,k)>0 ) ndepth_pos = ndepth_pos + 1 + end if + end do + ! write (iulog,*) 'WHDEBUG - i: ',i,' Hd: ',hdepth(i),' Hn: ',ndepth_pos,' N: ',ndepth_tot + end if + + if ((hdepth(i) >= hdepth_min) .and. (abs(lat(i)) < (pi/2._r8))) then !------------------------------------------------------------------ ! Look up the spectrum using depth and uh. @@ -280,11 +331,11 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & tau0 = mfcc(NINT(hdepth(i)),NINT(uh(i)),:) ! Shift spectrum so that it is relative to the ground. - shift = -nint(real(CS(i), r8)/dc) + shift = -nint(storm_speed(i)/dc) tau0 = cshift(tau0,shift) ! Adjust magnitude. - tau0 = tau0*q0(i)*q0(i)/AL + tau0 = tau0*maxq0(i)*maxq0(i)/tau_avg_length ! Adjust for critical level filtering. Umini = max(nint(Umin(i)/dc),-PGWV) diff --git a/components/eam/src/physics/cam/gw_drag.F90 b/components/eam/src/physics/cam/gw_drag.F90 index 1c6b7920e85..99486f3c781 100644 --- a/components/eam/src/physics/cam/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw_drag.F90 @@ -118,6 +118,11 @@ module gw_drag ! namelist logical :: history_amwg ! output the variables used by the AMWG diag package + logical :: use_gw_convect_old ! switch to enable legacy behavior + real(r8) :: gw_convect_plev_src_wind ! reference pressure level for source wind for convective GWD + real(r8) :: gw_convect_hdepth_min ! minimum hdepth for for convective GWD spectrum lookup table + real(r8) :: gw_convect_storm_speed_min ! minimum convective storm speed for convective GWD + !========================================================================== contains !========================================================================== @@ -141,7 +146,9 @@ subroutine gw_drag_readnl(nlfile) namelist /gw_drag_nl/ pgwv, gw_dc, tau_0_ubc, effgw_beres, effgw_cm, & effgw_oro, fcrit2, frontgfc, gw_drag_file, taubgnd, gw_convect_hcf, & - hdepth_scaling_factor + hdepth_scaling_factor, gw_convect_hdepth_min, & + gw_convect_storm_speed_min, gw_convect_plev_src_wind, & + use_gw_convect_old) !---------------------------------------------------------------------- if (masterproc) then @@ -170,8 +177,12 @@ subroutine gw_drag_readnl(nlfile) call mpibcast(frontgfc, 1, mpir8, 0, mpicom) call mpibcast(taubgnd, 1, mpir8, 0, mpicom) call mpibcast(gw_drag_file, len(gw_drag_file), mpichar, 0, mpicom) - call mpibcast(gw_convect_hcf, 1, mpir8, 0, mpicom) - call mpibcast(hdepth_scaling_factor, 1, mpir8, 0, mpicom) + call mpibcast(gw_convect_hcf, 1, mpir8, 0, mpicom) + call mpibcast(hdepth_scaling_factor, 1, mpir8, 0, mpicom) + call mpibcast(gw_convect_hdepth_min, 1, mpir8, 0, mpicom) + call mpibcast(gw_convect_storm_speed_min, 1, mpir8, 0, mpicom) + call mpibcast(gw_convect_plev_src_wind, 1, mpir8, 0, mpicom) + call mpibcast(use_gw_convect_old, 1, mpilog, 0, mpicom) #endif dc = gw_dc @@ -224,7 +235,6 @@ subroutine gw_init() ! Index for levels at specific pressures. integer :: kfront - integer :: k700 ! output tendencies and state variables for CAM4 temperature, ! water vapor, cloud ice and cloud liquid budgets. @@ -451,20 +461,10 @@ subroutine gw_init() ttend_dp_idx = pbuf_get_index('TTEND_DP') - do k = 0, pver - ! 700 hPa index - if (pref_edge(k+1) < 70000._r8) k700 = k+1 - end do - - if (masterproc) then - write (iulog,*) 'K700 =',k700 - end if - ! Initialization of Beres' parameterization parameters call gw_init_beres(mfcc) - call gw_convect_init(k700, mfcc, errstring) - if (trim(errstring) /= "") & - call endrun("gw_convect_init: "//errstring) + call gw_convect_init(gw_convect_plev_src_wind, mfcc, errstring) + if (trim(errstring) /= "") call endrun("gw_convect_init: "//errstring) ! Output for gravity waves from the Beres scheme. call gw_spec_addflds(prefix=beres_pf, scheme="Beres", & @@ -765,7 +765,9 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) ! Determine wave sources for Beres04 scheme call gw_beres_src(ncol, pgwv, state1%lat(:ncol), u, v, ttend_dp, & zm, src_level, tend_level, tau, ubm, ubi, xv, yv, c, & - hdepth, maxq0, gw_convect_hcf, hdepth_scaling_factor) + hdepth, maxq0, gw_convect_hcf, hdepth_scaling_factor, & + gw_convect_hdepth_min, gw_convect_storm_speed_min, & + use_gw_convect_old) do_latitude_taper = .false. From 55f2a364f7b6c6000c7483a235a1445ee8a03018 Mon Sep 17 00:00:00 2001 From: Chloe Date: Fri, 15 Nov 2024 13:05:50 -0800 Subject: [PATCH 267/529] comment and white space changes --- components/elm/src/biogeophys/BalanceCheckMod.F90 | 2 +- .../elm/src/biogeophys/HydrologyDrainageMod.F90 | 12 +++--------- components/elm/src/biogeophys/SoilTemperatureMod.F90 | 1 + 3 files changed, 5 insertions(+), 10 deletions(-) diff --git a/components/elm/src/biogeophys/BalanceCheckMod.F90 b/components/elm/src/biogeophys/BalanceCheckMod.F90 index 48144b045e9..7737f2adbe3 100755 --- a/components/elm/src/biogeophys/BalanceCheckMod.F90 +++ b/components/elm/src/biogeophys/BalanceCheckMod.F90 @@ -167,7 +167,7 @@ subroutine ColWaterBalanceCheck( bounds, num_do_smb_c, filter_do_smb_c, & use elm_varcon , only : spval use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_perv, icol_road_imperv - use landunit_varcon , only : istice_mec, istice, istdlak, istsoil,istcrop,istwet + use landunit_varcon , only : istice_mec, istdlak, istsoil,istcrop,istwet use elm_varctl , only : create_glacier_mec_landunit use elm_initializeMod , only : surfalb_vars use CanopyStateType , only : canopystate_type diff --git a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 index 8356449be1a..fbd4d8e2b6f 100755 --- a/components/elm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/elm/src/biogeophys/HydrologyDrainageMod.F90 @@ -231,16 +231,10 @@ subroutine HydrologyDrainage(bounds, & ! In the following, we convert glc_snow_persistence_max_days to r8 to avoid overflow if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & .or. lun_pp%itype(l) == istice_mec ) then - qflx_glcice_frz(c) = qflx_snwcp_ice(c) - qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) - if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 + qflx_glcice_frz(c) = qflx_snwcp_ice(c) + qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 end if - - !if (lun_pp%itype(l)==istice) then - ! qflx_glcice_frz_diag(c) = qflx_snwcp_ice(c) - ! qflx_glcice_diag(c) = qflx_glcice_diag(c) + qflx_glcice_frz_diag(c) - !endif - end do ! Determine wetland and land ice hydrology (must be placed here diff --git a/components/elm/src/biogeophys/SoilTemperatureMod.F90 b/components/elm/src/biogeophys/SoilTemperatureMod.F90 index 927c0aac305..451b3cbccf2 100644 --- a/components/elm/src/biogeophys/SoilTemperatureMod.F90 +++ b/components/elm/src/biogeophys/SoilTemperatureMod.F90 @@ -1646,6 +1646,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & ! as computed in HydrologyDrainageMod.F90. l = col_pp%landunit(c) + if ( lun_pp%itype(l)==istice_mec) then if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater ! melting corresponds to a negative ice flux From cb6471f89ea4b98ac9213ef7de9f74b1dcda60ee Mon Sep 17 00:00:00 2001 From: James Foucar Date: Fri, 15 Nov 2024 15:24:46 -0700 Subject: [PATCH 268/529] progress --- components/eamxx/scripts/gen_boiler.py | 227 +++++++++++- .../physics/p3/tests/infra/p3_test_data.cpp | 4 +- .../src/physics/shoc/tests/CMakeLists.txt | 3 - .../shoc/tests/infra/shoc_test_data.cpp | 339 ++++++++---------- .../shoc/tests/infra/shoc_test_data.hpp | 48 --- .../tests/shoc_energy_dse_fixer_tests.cpp | 137 ------- .../shoc_energy_threshold_fixer_tests.cpp | 139 ------- .../tests/shoc_energy_total_fixer_tests.cpp | 167 --------- 8 files changed, 376 insertions(+), 688 deletions(-) delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp diff --git a/components/eamxx/scripts/gen_boiler.py b/components/eamxx/scripts/gen_boiler.py index d45197deeeb..f2225651620 100644 --- a/components/eamxx/scripts/gen_boiler.py +++ b/components/eamxx/scripts/gen_boiler.py @@ -138,21 +138,21 @@ )), ("cxx_f2c_bind_decl" , ( - lambda phys, sub, gb: f"{phys}_functions_f90.hpp", + lambda phys, sub, gb: f"tests/infra/{phys}_test_data.hpp", lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_f2c_bind_decl"), - lambda phys, sub, gb: get_cxx_close_block_regex(comment="end _f function decls"), # reqs special comment - lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_f"), # cxx_f decl + lambda phys, sub, gb: get_plain_comment_regex(comment="end _host function decls"), # reqs special comment + lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_host"), # cxx_host decl lambda phys, sub, gb: re.compile(r".*;\s*$"), # ; - lambda *x : "The f90 to cxx function declaration(_f)" + lambda *x : "The f90 to cxx function declaration(_host)" )), ("cxx_f2c_bind_impl" , ( - lambda phys, sub, gb: f"{phys}_functions_f90.cpp", + lambda phys, sub, gb: f"tests/infra/{phys}_test_data.cpp", lambda phys, sub, gb: expect_exists(phys, sub, gb, "cxx_f2c_bind_impl"), lambda phys, sub, gb: get_namespace_close_regex(phys), # insert at end of namespace - lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_f"), # cxx_f + lambda phys, sub, gb: get_cxx_function_begin_regex(sub + "_host"), # cxx_f lambda phys, sub, gb: get_cxx_close_block_regex(at_line_start=True), # terminating } - lambda *x : "The f90 to cxx function implementation(_f)" + lambda *x : "The f90 to cxx function implementation(_host)" )), ("cxx_func_decl", ( @@ -455,6 +455,12 @@ def get_cxx_struct_begin_regex(struct): struct_regex_str = fr"^\s*struct\s+{struct}([\W]|$)" return re.compile(struct_regex_str) +############################################################################### +def get_plain_comment_regex(comment): +############################################################################### + comment_regex_str = fr"^\s*//\s*{comment}" + return re.compile(comment_regex_str) + ############################################################################### def get_data_struct_name(sub): ############################################################################### @@ -1169,6 +1175,21 @@ def split_by_type(arg_data): return reals, ints, logicals +############################################################################### +def split_by_scalar_vs_view(arg_data): +############################################################################### + """ + Take arg data and split into two lists of names based on scalar/not-scalar: [scalars] [non-scalars] + """ + scalars, non_scalars = [], [] + for name, _, _, dims in arg_data: + if dims is not None: + non_scalars.append(name) + else: + scalars.append(name) + + return scalars, non_scalars + ############################################################################### def gen_cxx_data_args(physics, arg_data): ############################################################################### @@ -1441,6 +1462,30 @@ def check_existing_piece(lines, begin_regex, end_regex): return None if begin_idx is None else (begin_idx, end_idx+1) +############################################################################### +def get_data_by_name(arg_data, arg_name, data_idx): +############################################################################### + for name, a, b, c in arg_data: + if name == arg_name: + return [name, a, b, c][data_idx] + + expect(False, f"Name {arg_name} not found") + +############################################################################### +def get_rank_map(arg_data, arg_names): +############################################################################### + # Create map of rank -> [args] + rank_map = {} + for arg in arg_names: + dims = get_data_by_name(arg_data, arg, ARG_DIMS) + rank = len(dims) + if rank in rank_map: + rank_map[rank].append(arg) + else: + rank_map[rank] = [arg] + + return rank_map + # # Main classes # @@ -1505,10 +1550,10 @@ def _get_db(self, phys): db = parse_origin(origin_file.open(encoding="utf-8").read(), self._subs) self._db[phys].update(db) if self._verbose: - print("For physics {}, found:") + print(f"For physics {phys}, found:") for sub in self._subs: if sub in db: - print(" For subroutine {}, found args:") + print(f" For subroutine {sub}, found args:") for name, argtype, intent, dims in db[sub]: print(" name:{} type:{} intent:{} dims:({})".\ format(name, argtype, intent, ",".join(dims) if dims else "scalar")) @@ -1729,7 +1774,7 @@ def gen_cxx_f2c_bind_decl(self, phys, sub, force_arg_data=None): arg_data = force_arg_data if force_arg_data else self._get_arg_data(phys, sub) arg_decls = gen_arg_cxx_decls(arg_data) - return f"void {sub}_f({', '.join(arg_decls)});" + return f"void {sub}_host({', '.join(arg_decls)});" ########################################################################### def gen_cxx_f2c_bind_impl(self, phys, sub, force_arg_data=None): @@ -1809,8 +1854,166 @@ def gen_cxx_f2c_bind_impl(self, phys, sub, force_arg_data=None): impl = "" if has_arrays(arg_data): - # TODO - impl += " // TODO" + # + # Steps: + # 1) Set up typedefs + # 2) Sync to device + # 3) Unpack view array + # 4) Get nk_pack and policy + # 5) Get subviews + # 6) Call fn + # 7) Sync back to host + # + inputs, inouts, outputs = split_by_intent(arg_data) + reals, ints, bools = split_by_type(arg_data) + scalars, views = split_by_scalar_vs_view(arg_data) + all_inputs = inputs + inouts + all_outputs = inouts + outputs + + vreals = list(sorted(set(reals) & set(views))) + vints = list(sorted(set(ints) & set(views))) + vbools = list(sorted(set(bools) & set(views))) + + sreals = list(sorted(set(reals) & set(scalars))) + sints = list(sorted(set(ints) & set(scalars))) + sbools = list(sorted(set(bools) & set(scalars))) + + ivreals = list(sorted(set(vreals) & set(all_inputs))) + ivints = list(sorted(set(vints) & set(all_inputs))) + ivbools = list(sorted(set(vbools) & set(all_inputs))) + + ovreals = list(sorted(set(vreals) & set(all_outputs))) + ovints = list(sorted(set(vints) & set(all_outputs))) + ovbools = list(sorted(set(vbools) & set(all_outputs))) + + isreals = list(sorted(set(sreals) & set(all_inputs))) + isints = list(sorted(set(sints) & set(all_inputs))) + isbools = list(sorted(set(sbools) & set(all_inputs))) + + osreals = list(sorted(set(sreals) & set(all_outputs))) + osints = list(sorted(set(sints) & set(all_outputs))) + osbools = list(sorted(set(sbools) & set(all_outputs))) + + # + # 1) Set up typedefs + # + + # set up basics + impl += "#if 0\n" # There's no way to guarantee this code compiles + impl += " using SHF = Functions;\n" + impl += " using Scalar = typename SHF::Scalar;\n" + impl += " using Spack = typename SHF::Spack;\n" + impl += " using KT = typename SHF::KT;\n" + impl += " using ExeSpace = typename KT::ExeSpace;\n" + impl += " using MemberType = typename SHF::MemberType;\n\n" + + prefix_list = ["", "i", "b"] + type_list = ["Real", "Int", "bool"] + ktype_list = ["Spack", "Int", "bool"] + + # make necessary view types. Anything that's an array needs a view type + for view_group, prefix_char, typename in zip([vreals, vints, vbools], prefix_list, type_list): + if view_group: + rank_map = get_rank_map(arg_data, view_group) + for rank in rank_map: + if typename == "Real" and rank > 1: + # Probably this should be packed data + impl += f" using {prefix_char}view_{rank}d = typename SHF::view_{rank}d;\n" + else: + impl += f" using {prefix_char}view_{rank}d = typename SHF::view_{rank}d<{typename}>;\n" + + impl += "\n" + + # + # 2) Sync to device. Do ALL views, not just inputs + # + + for input_group, prefix_char, typename in zip([vreals, vints, vbools], prefix_list, type_list): + if input_group: + rank_map = get_rank_map(arg_data, input_group) + + for rank, arg_list in rank_map.items(): + impl += f" static constexpr Int {prefix_char}num_arrays_{rank} = {len(arg_list)};\n" + impl += f" std::vector<{prefix_char}view_{rank}d> {prefix_char}temp_d_{rank}({prefix_char}num_arrays_{rank});\n" + for rank_itr in range(rank): + dims = [get_data_by_name(arg_data, arg_name, ARG_DIMS)[rank_itr] for arg_name in arg_list] + impl += f" std::vector {prefix_char}dim_{rank}_{rank_itr}_sizes = {{{', '.join(dims)}}};\n" + dim_vectors = [f"{prefix_char}dim_{rank}_{rank_itr}_sizes" for rank_itr in range(rank)] + funcname = "ekat::host_to_device" if (typename == "Real" and rank > 1) else "ScreamDeepCopy::copy_to_device" + impl += f" {funcname}({{{', '.join(arg_list)}}}, {', '.join(dim_vectors)}, {prefix_char}temp_d_{rank});\n\n" + + # + # 3) Unpack view array + # + + for input_group, prefix_char, typename in zip([vreals, vints, vbools], prefix_list, type_list): + if input_group: + rank_map = get_rank_map(arg_data, input_group) + + for rank, arg_list in rank_map.items(): + impl += f" {prefix_char}view_{rank}d\n" + for idx, input_item in enumerate(arg_list): + impl += f" {input_item}_d({prefix_char}temp_d_{rank}[{idx}]){';' if idx == len(arg_list) - 1 else ','}\n" + impl += "\n" + + + # + # 4) Get nk_pack and policy, launch kernel + # + impl += " const Int nk_pack = ekat::npack(nlev);\n" + impl += " const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(shcol, nk_pack);\n" + impl += " Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) {\n" + impl += " const Int i = team.league_rank();\n\n" + + # + # 5) Get subviews + # + for view_group, prefix_char, typename in zip([vreals, vints, vbools], prefix_list, type_list): + if view_group: + for view_arg in view_group: + dims = get_data_by_name(arg_data, view_arg, ARG_DIMS) + if "shcol" in dims: + if len(dims) == 1: + impl += f" const Scalar {view_arg}_s = {view_arg}_d(i);\n" + else: + impl += f" const auto {view_arg}_s = ekat::subview({view_arg}_d, i);\n" + + impl += "\n" + + # + # 6) Call fn + # + kernel_arg_names = [] + for arg_name in arg_names: + if arg_name in views: + if "shcol" in dims: + kernel_arg_names.append(f"{arg_name}_s") + else: + kernel_arg_names.append(f"{arg_name}_d") + else: + kernel_arg_names.append(arg_name) + + impl += f" SHF::{sub}({', '.join(kernel_arg_names)});\n" + impl += " });\n" + + # + # 7) Sync back to host + # + for output_group, prefix_char, typename in zip([ovreals, ovints, ovbools], prefix_list, type_list): + if output_group: + rank_map = get_rank_map(arg_data, output_group) + + for rank, arg_list in rank_map.items(): + impl += f" std::vector<{prefix_char}view_{rank}d> {prefix_char}tempout_d_{rank}({prefix_char}num_arrays_{rank});\n" + for rank_itr in range(rank): + dims = [get_data_by_name(arg_data, arg_name, ARG_DIMS)[rank_itr] for arg_name in arg_list] + impl += f" std::vector {prefix_char}dim_{rank}_{rank_itr}_out_sizes = {{{', '.join(dims)}}};\n" + dim_vectors = [f"{prefix_char}dim_{rank}_{rank_itr}_out_sizes" for rank_itr in range(rank)] + funcname = "ekat::device_to_host" if (typename == "Real" and rank > 1) else "ScreamDeepCopy::copy_to_host" + impl += f" {funcname}({{{', '.join(arg_list)}}}, {', '.join(dim_vectors)}, {prefix_char}tempout_d_{rank});\n\n" + + impl += "#endif\n" + else: inputs, inouts, outputs = split_by_intent(arg_data) reals, ints, logicals = split_by_type(arg_data) diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp index 23a9998f43c..9e7ecab0f92 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp @@ -1299,7 +1299,7 @@ Int p3_main_host( } } - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); int counter = 0; view_2d @@ -1452,7 +1452,7 @@ Int p3_main_host( rho_qi, qv2qi_depos_tend, liq_ice_exchange, vap_liq_exchange, vap_ice_exchange, precip_liq_flux, precip_ice_flux, precip_liq_surf, precip_ice_surf }, - dim1_sizes_out, dim2_sizes_out, inout_views, true); + dim1_sizes_out, dim2_sizes_out, inout_views); return elapsed_microsec; } diff --git a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt index aeae4ad4039..72407a5fd0a 100644 --- a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt @@ -16,9 +16,6 @@ set(SHOC_TESTS_SRCS shoc_energy_fixer_tests.cpp shoc_energy_update_dse_tests.cpp shoc_energy_integral_tests.cpp - shoc_energy_total_fixer_tests.cpp - shoc_energy_dse_fixer_tests.cpp - shoc_energy_threshold_fixer_tests.cpp shoc_length_tests.cpp shoc_brunt_length_tests.cpp shoc_l_inf_length_tests.cpp diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 0be4b8fc04f..cae14bf7a35 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -54,364 +54,343 @@ void shoc_energy_integrals(ShocEnergyIntegralsData& d) shoc_energy_integrals_host(d.shcol, d.nlev, d.host_dse, d.pdel, d.rtm, d.rcm, d.u_wind, d.v_wind, d.se_int, d.ke_int, d.wv_int, d.wl_int); } -void shoc_energy_total_fixer(ShocEnergyTotalFixerData& d) -{ - shoc_init(d.nlev); - shoc_energy_total_fixer_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, - d.zt_grid, d.zi_grid, d.se_b, d.ke_b, d.wv_b, - d.wl_b, d.se_a, d.ke_a, d.wv_a, d.wl_a, d.wthl_sfc, - d.wqw_sfc, d.rho_zt, d.pint, d.te_a, d.te_b); -} - -void shoc_energy_threshold_fixer(ShocEnergyThresholdFixerData& d) -{ - shoc_init(d.nlev); - shoc_energy_threshold_fixer_host(d.shcol, d.nlev, d.nlevi, d.pint, d.tke, d.te_a, d.te_b, d.se_dis, d.shoctop); -} - -void shoc_energy_dse_fixer(ShocEnergyDseFixerData& d) -{ - shoc_init(d.nlev); - shoc_energy_dse_fixer_host(d.shcol, d.nlev, d.se_dis, d.shoctop, d.host_dse); -} - void calc_shoc_vertflux(CalcShocVertfluxData& d) { shoc_init(d.nlev); - calc_shoc_vertflux_host(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); + //calc_shoc_vertflux_host(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); } void calc_shoc_varorcovar(CalcShocVarorcovarData& d) { shoc_init(d.nlev); - calc_shoc_varorcovar_host(d.shcol, d.nlev, d.nlevi, d.tunefac, d.isotropy_zi, d.tkh_zi, d.dz_zi, d.invar1, d.invar2, d.varorcovar); + //calc_shoc_varorcovar_host(d.shcol, d.nlev, d.nlevi, d.tunefac, d.isotropy_zi, d.tkh_zi, d.dz_zi, d.invar1, d.invar2, d.varorcovar); } void compute_tmpi(ComputeTmpiData& d) { shoc_init(d.nlevi - 1); // nlev = nlevi - 1 - compute_tmpi_host(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); + //compute_tmpi_host(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); } void dp_inverse(DpInverseData& d) { shoc_init(d.nlev); - dp_inverse_host(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); + //dp_inverse_host(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); } void sfc_fluxes(SfcFluxesData& d) { shoc_init(1); // single layer function - sfc_fluxes_host(d.shcol, d.num_tracer, d.dtime, d.rho_zi_sfc, d.rdp_zt_sfc, d.wthl_sfc, d.wqw_sfc, d.wtke_sfc, d.wtracer_sfc, d.thetal, d.qw, d.tke, d.wtracer); + //sfc_fluxes_host(d.shcol, d.num_tracer, d.dtime, d.rho_zi_sfc, d.rdp_zt_sfc, d.wthl_sfc, d.wqw_sfc, d.wtke_sfc, d.wtracer_sfc, d.thetal, d.qw, d.tke, d.wtracer); } void impli_srf_stress_term(ImpliSrfStressTermData& d) { shoc_init(1); // single layer function - impli_srf_stress_term_host(d.shcol, d.rho_zi_sfc, d.uw_sfc, d.vw_sfc, d.u_wind_sfc, d.v_wind_sfc, d.ksrf); + //impli_srf_stress_term_host(d.shcol, d.rho_zi_sfc, d.uw_sfc, d.vw_sfc, d.u_wind_sfc, d.v_wind_sfc, d.ksrf); } void tke_srf_flux_term(TkeSrfFluxTermData& d) { shoc_init(1); // single layer function - tke_srf_flux_term_host(d.shcol, d.uw_sfc, d.vw_sfc, d.wtke_sfc); + //tke_srf_flux_term_host(d.shcol, d.uw_sfc, d.vw_sfc, d.wtke_sfc); } void integ_column_stability(IntegColumnStabilityData& d) { shoc_init(d.nlev); - integ_column_stability_host(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); + //integ_column_stability_host(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); } void check_tke(CheckTkeData& d) { shoc_init(d.nlev); - check_tke_host(d.shcol, d.nlev, d.tke); + //check_tke_host(d.shcol, d.nlev, d.tke); } void shoc_tke(ShocTkeData& d) { shoc_init(d.nlev); - shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); + //shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); } void compute_shr_prod(ComputeShrProdData& d) { shoc_init(d.nlev); - compute_shr_prod_host(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); + //compute_shr_prod_host(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); } void isotropic_ts(IsotropicTsData& d) { shoc_init(d.nlev); - isotropic_ts_host(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); + //isotropic_ts_host(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); } void adv_sgs_tke(AdvSgsTkeData& d) { shoc_init(d.nlev); - adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); + //adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); } void eddy_diffusivities(EddyDiffusivitiesData& d) { shoc_init(d.nlev); - eddy_diffusivities_host(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); + //eddy_diffusivities_host(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); } void shoc_length(ShocLengthData& d) { shoc_init(d.nlev); - shoc_length_host(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); + //shoc_length_host(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); } void compute_brunt_shoc_length(ComputeBruntShocLengthData& d) { shoc_init(d.nlev); - compute_brunt_shoc_length_host(d.nlev, d.nlevi, d.shcol, d.dz_zt, d.thv, d.thv_zi, d.brunt); + //compute_brunt_shoc_length_host(d.nlev, d.nlevi, d.shcol, d.dz_zt, d.thv, d.thv_zi, d.brunt); } void compute_l_inf_shoc_length(ComputeLInfShocLengthData& d) { shoc_init(d.nlev); - compute_l_inf_shoc_length_host(d.nlev, d.shcol, d.zt_grid, d.dz_zt, d.tke, d.l_inf); + //compute_l_inf_shoc_length_host(d.nlev, d.shcol, d.zt_grid, d.dz_zt, d.tke, d.l_inf); } void compute_shoc_mix_shoc_length(ComputeShocMixShocLengthData& d) { shoc_init(d.nlev); - compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); + //compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); } void check_length_scale_shoc_length(CheckLengthScaleShocLengthData& d) { shoc_init(d.nlev); - check_length_scale_shoc_length_host(d.nlev, d.shcol, d.host_dx, d.host_dy, d.shoc_mix); + //check_length_scale_shoc_length_host(d.nlev, d.shcol, d.host_dx, d.host_dy, d.shoc_mix); } void fterms_input_for_diag_third_shoc_moment(FtermsInputForDiagThirdShocMomentData& d) { shoc_init(1); // single level function - fterms_input_for_diag_third_shoc_moment_host(d.dz_zi, d.dz_zt, d.dz_zt_kc, d.isotropy_zi, d.brunt_zi, d.thetal_zi, &d.thedz, &d.thedz2, &d.iso, &d.isosqrd, &d.buoy_sgs2, &d.bet2); + //fterms_input_for_diag_third_shoc_moment_host(d.dz_zi, d.dz_zt, d.dz_zt_kc, d.isotropy_zi, d.brunt_zi, d.thetal_zi, &d.thedz, &d.thedz2, &d.iso, &d.isosqrd, &d.buoy_sgs2, &d.bet2); } void aa_terms_diag_third_shoc_moment(AaTermsDiagThirdShocMomentData& d) { shoc_init(1); // single level function - aa_terms_diag_third_shoc_moment_host(d.omega0, d.omega1, d.omega2, d.x0, d.x1, d.y0, d.y1, &d.aa0, &d.aa1); + //aa_terms_diag_third_shoc_moment_host(d.omega0, d.omega1, d.omega2, d.x0, d.x1, d.y0, d.y1, &d.aa0, &d.aa1); } void f0_to_f5_diag_third_shoc_moment(F0ToF5DiagThirdShocMomentData& d) { shoc_init(1); // single level function - f0_to_f5_diag_third_shoc_moment_host(d.thedz, d.thedz2, d.bet2, d.iso, d.isosqrd, d.wthl_sec, d.wthl_sec_kc, d.wthl_sec_kb, d.thl_sec_kc, d.thl_sec_kb, d.w_sec, d.w_sec_kc, d.w_sec_zi, d.tke, d.tke_kc, &d.f0, &d.f1, &d.f2, &d.f3, &d.f4, &d.f5); + //f0_to_f5_diag_third_shoc_moment_host(d.thedz, d.thedz2, d.bet2, d.iso, d.isosqrd, d.wthl_sec, d.wthl_sec_kc, d.wthl_sec_kb, d.thl_sec_kc, d.thl_sec_kb, d.w_sec, d.w_sec_kc, d.w_sec_zi, d.tke, d.tke_kc, &d.f0, &d.f1, &d.f2, &d.f3, &d.f4, &d.f5); } void omega_terms_diag_third_shoc_moment(OmegaTermsDiagThirdShocMomentData& d) { shoc_init(1); // single level function - omega_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f3, d.f4, &d.omega0, &d.omega1, &d.omega2); + //omega_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f3, d.f4, &d.omega0, &d.omega1, &d.omega2); } void x_y_terms_diag_third_shoc_moment(XYTermsDiagThirdShocMomentData& d) { shoc_init(1); // single level function - x_y_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f0, d.f1, d.f2, &d.x0, &d.y0, &d.x1, &d.y1); + //x_y_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f0, d.f1, d.f2, &d.x0, &d.y0, &d.x1, &d.y1); } void w3_diag_third_shoc_moment(W3DiagThirdShocMomentData& d) { shoc_init(1); // single level function - w3_diag_third_shoc_moment_host(d.aa0, d.aa1, d.x0, d.x1, d.f5, &d.w3); + //w3_diag_third_shoc_moment_host(d.aa0, d.aa1, d.x0, d.x1, d.f5, &d.w3); } void clipping_diag_third_shoc_moments(ClippingDiagThirdShocMomentsData& d) { shoc_init(d.nlevi - 1); // nlev = nlevi - 1 - clipping_diag_third_shoc_moments_host(d.nlevi, d.shcol, d.w_sec_zi, d.w3); + //clipping_diag_third_shoc_moments_host(d.nlevi, d.shcol, d.w_sec_zi, d.w3); } void diag_second_moments_srf(DiagSecondMomentsSrfData& d) { shoc_init(1); // single level function - shoc_diag_second_moments_srf_host(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); + //shoc_diag_second_moments_srf_host(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); } void linear_interp(LinearInterpData& d) { shoc_init(d.km1); - linear_interp_host(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); + //linear_interp_host(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); } void diag_third_shoc_moments(DiagThirdShocMomentsData& d) { shoc_init(d.nlev); - diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); + //diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); } void compute_diag_third_shoc_moment(ComputeDiagThirdShocMomentData& d) { shoc_init(d.nlev); - compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); + //compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); } void shoc_assumed_pdf(ShocAssumedPdfData& d) { shoc_init(d.nlev); - shoc_assumed_pdf_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); + //shoc_assumed_pdf_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); } void shoc_assumed_pdf_tilde_to_real(ShocAssumedPdfTildeToRealData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_tilde_to_real_host(d.w_first, d.sqrtw2, &d.w1); + //shoc_assumed_pdf_tilde_to_real_host(d.w_first, d.sqrtw2, &d.w1); } void shoc_assumed_pdf_vv_parameters(ShocAssumedPdfVvParametersData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_vv_parameters_host(d.w_first, d.w_sec, d.w3var, &d.skew_w, &d.w1_1, &d.w1_2, &d.w2_1, &d.w2_2, &d.a); + //shoc_assumed_pdf_vv_parameters_host(d.w_first, d.w_sec, d.w3var, &d.skew_w, &d.w1_1, &d.w1_2, &d.w2_1, &d.w2_2, &d.a); } void shoc_assumed_pdf_thl_parameters(ShocAssumedPdfThlParametersData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_thl_parameters_host(d.wthlsec, d.sqrtw2, d.sqrtthl, d.thlsec, d.thl_first, d.w1_1, d.w1_2, d.skew_w, d.a, d.dothetal_skew, &d.thl1_1, &d.thl1_2, &d.thl2_1, &d.thl2_2, &d.sqrtthl2_1, &d.sqrtthl2_2); + //shoc_assumed_pdf_thl_parameters_host(d.wthlsec, d.sqrtw2, d.sqrtthl, d.thlsec, d.thl_first, d.w1_1, d.w1_2, d.skew_w, d.a, d.dothetal_skew, &d.thl1_1, &d.thl1_2, &d.thl2_1, &d.thl2_2, &d.sqrtthl2_1, &d.sqrtthl2_2); } void shoc_assumed_pdf_qw_parameters(ShocAssumedPdfQwParametersData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_qw_parameters_host(d.wqwsec, d.sqrtw2, d.skew_w, d.sqrtqt, d.qwsec, d.w1_2, d.w1_1, d.qw_first, d.a, &d.qw1_1, &d.qw1_2, &d.qw2_1, &d.qw2_2, &d.sqrtqw2_1, &d.sqrtqw2_2); + //shoc_assumed_pdf_qw_parameters_host(d.wqwsec, d.sqrtw2, d.skew_w, d.sqrtqt, d.qwsec, d.w1_2, d.w1_1, d.qw_first, d.a, &d.qw1_1, &d.qw1_2, &d.qw2_1, &d.qw2_2, &d.sqrtqw2_1, &d.sqrtqw2_2); } void shoc_assumed_pdf_inplume_correlations(ShocAssumedPdfInplumeCorrelationsData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_inplume_correlations_host(d.sqrtqw2_1, d.sqrtthl2_1, d.a, d.sqrtqw2_2, d.sqrtthl2_2, d.qwthlsec, d.qw1_1, d.qw_first, d.thl1_1, d.thl_first, d.qw1_2, d.thl1_2, &d.r_qwthl_1); + //shoc_assumed_pdf_inplume_correlations_host(d.sqrtqw2_1, d.sqrtthl2_1, d.a, d.sqrtqw2_2, d.sqrtthl2_2, d.qwthlsec, d.qw1_1, d.qw_first, d.thl1_1, d.thl_first, d.qw1_2, d.thl1_2, &d.r_qwthl_1); } void shoc_assumed_pdf_compute_temperature(ShocAssumedPdfComputeTemperatureData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_compute_temperature_host(d.thl1, d.basepres, d.pval, &d.tl1); + //shoc_assumed_pdf_compute_temperature_host(d.thl1, d.basepres, d.pval, &d.tl1); } void shoc_assumed_pdf_compute_qs(ShocAssumedPdfComputeQsData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_compute_qs_host(d.tl1_1, d.tl1_2, d.pval, &d.qs1, &d.beta1, &d.qs2, &d.beta2); + //shoc_assumed_pdf_compute_qs_host(d.tl1_1, d.tl1_2, d.pval, &d.qs1, &d.beta1, &d.qs2, &d.beta2); } void shoc_assumed_pdf_compute_s(ShocAssumedPdfComputeSData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_compute_s_host(d.qw1, d.qs1, d.beta, d.pval, d.thl2, d.qw2, d.sqrtthl2, d.sqrtqw2, d.r_qwthl, &d.s, &d.std_s, &d.qn, &d.c); + //shoc_assumed_pdf_compute_s_host(d.qw1, d.qs1, d.beta, d.pval, d.thl2, d.qw2, d.sqrtthl2, d.sqrtqw2, d.r_qwthl, &d.s, &d.std_s, &d.qn, &d.c); } void shoc_assumed_pdf_compute_sgs_liquid(ShocAssumedPdfComputeSgsLiquidData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_compute_sgs_liquid_host(d.a, d.ql1, d.ql2, &d.shoc_ql); + //shoc_assumed_pdf_compute_sgs_liquid_host(d.a, d.ql1, d.ql2, &d.shoc_ql); } void shoc_assumed_pdf_compute_cloud_liquid_variance(ShocAssumedPdfComputeCloudLiquidVarianceData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_compute_cloud_liquid_variance_host(d.a, d.s1, d.ql1, d.c1, d.std_s1, d.s2, d.ql2, d.c2, d.std_s2, d.shoc_ql, &d.shoc_ql2); + //shoc_assumed_pdf_compute_cloud_liquid_variance_host(d.a, d.s1, d.ql1, d.c1, d.std_s1, d.s2, d.ql2, d.c2, d.std_s2, d.shoc_ql, &d.shoc_ql2); } void shoc_assumed_pdf_compute_liquid_water_flux(ShocAssumedPdfComputeLiquidWaterFluxData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_compute_liquid_water_flux_host(d.a, d.w1_1, d.w_first, d.ql1, d.w1_2, d.ql2, &d.wqls); + //shoc_assumed_pdf_compute_liquid_water_flux_host(d.a, d.w1_1, d.w_first, d.ql1, d.w1_2, d.ql2, &d.wqls); } void shoc_assumed_pdf_compute_buoyancy_flux(ShocAssumedPdfComputeBuoyancyFluxData& d) { shoc_init(1); // single level function - shoc_assumed_pdf_compute_buoyancy_flux_host(d.wthlsec, d.epsterm, d.wqwsec, d.pval, d.wqls, &d.wthv_sec); + //shoc_assumed_pdf_compute_buoyancy_flux_host(d.wthlsec, d.epsterm, d.wqwsec, d.pval, d.wqls, &d.wthv_sec); } void diag_second_moments_ubycond(DiagSecondMomentsUbycondData& d) { shoc_init(1); // single level function - shoc_diag_second_moments_ubycond_host(d.shcol, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec); + //shoc_diag_second_moments_ubycond_host(d.shcol, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec); } void pblintd_init_pot(PblintdInitPotData& d) { shoc_init(d.nlev, true); - shoc_pblintd_init_pot_host(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); + //shoc_pblintd_init_pot_host(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); } void pblintd_cldcheck(PblintdCldcheckData& d) { shoc_init(d.nlev, true); - shoc_pblintd_cldcheck_host(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); + //shoc_pblintd_cldcheck_host(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); } void diag_second_moments_lbycond(DiagSecondMomentsLbycondData& d) { shoc_init(1); // single level function - diag_second_moments_lbycond_host(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); + //diag_second_moments_lbycond_host(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); } void diag_second_moments(DiagSecondMomentsData& d) { shoc_init(d.nlev); - diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, - d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, - d.vw_sec, d.wtke_sec, d.w_sec); + // diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, + // d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, + // d.vw_sec, d.wtke_sec, d.w_sec); } void diag_second_shoc_moments(DiagSecondShocMomentsData& d) { shoc_init(d.nlev); - diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, - d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, d.qw_sec, - d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); + // diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, + // d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, d.qw_sec, + // d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); } void compute_shoc_vapor(ComputeShocVaporData& d) { shoc_init(d.nlev); - compute_shoc_vapor_host(d.shcol, d.nlev, d.qw, d.ql, d.qv); + //compute_shoc_vapor_host(d.shcol, d.nlev, d.qw, d.ql, d.qv); } void update_prognostics_implicit(UpdatePrognosticsImplicitData& d) { shoc_init(d.nlev); - update_prognostics_implicit_host(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, - d.dz_zt, d.dz_zi, d.rho_zt, d.zt_grid, d.zi_grid, - d.tk, d.tkh, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, - d.wtracer_sfc, d.thetal, d.qw, d.tracer, d.tke, d.u_wind, d.v_wind); + // update_prognostics_implicit_host(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, + // d.dz_zt, d.dz_zi, d.rho_zt, d.zt_grid, d.zi_grid, + // d.tk, d.tkh, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, + // d.wtracer_sfc, d.thetal, d.qw, d.tracer, d.tke, d.u_wind, d.v_wind); } void shoc_main(ShocMainData& d) { shoc_init(d.nlev, true); - shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, + d.elapsed_s = shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, 1/*d.npbl*/, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, d.pres, d.presi, d.pdel, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.wtracer_sfc, d.num_qtracers, d.w_field, d.inv_exner, d.phis, d.host_dse, d.tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.qtracers, d.wthv_sec, d.tkh, d.tk, d.shoc_ql, d.shoc_cldfrac, d.pblh, d.shoc_mix, d.isotropy, d.w_sec, d.thl_sec, d.qw_sec, d.qwthl_sec, d.wthl_sec, d.wqw_sec, - d.wtke_sec, d.uw_sec, d.vw_sec, d.w3, d.wqls_sec, d.brunt, d.shoc_ql2, &d.elapsed_s); + d.wtke_sec, d.uw_sec, d.vw_sec, d.w3, d.wqls_sec, d.brunt, d.shoc_ql2); } void shoc_main_with_init(ShocMainData& d) { using C = scream::physics::Constants; - shoc_init_for_main_bfb_host(d.nlev, C::gravit, C::Rair, C::RH2O, C::Cpair, C::ZVIR, C::LatVap, C::LatIce, C::Karman, C::P0, - d.pref_mid, d.nbot_shoc, d.ntop_shoc+1); + // shoc_init_for_main_bfb_host(d.nlev, C::gravit, C::Rair, C::RH2O, C::Cpair, C::ZVIR, C::LatVap, C::LatIce, C::Karman, C::P0, + // d.pref_mid, d.nbot_shoc, d.ntop_shoc+1); - shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, + d.elapsed_s = shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, 1/*d.npbl*/,d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, d.pres, d.presi, d.pdel, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.wtracer_sfc, d.num_qtracers, d.w_field, d.inv_exner, d.phis, d.host_dse, d.tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.qtracers, d.wthv_sec, d.tkh, d.tk, d.shoc_ql, d.shoc_cldfrac, d.pblh, d.shoc_mix, d.isotropy, d.w_sec, d.thl_sec, d.qw_sec, d.qwthl_sec, d.wthl_sec, d.wqw_sec, d.wtke_sec, d.uw_sec, d.vw_sec, d.w3, - d.wqls_sec, d.brunt, d.shoc_ql2, &d.elapsed_s); + d.wqls_sec, d.brunt, d.shoc_ql2); } void pblintd_height(PblintdHeightData& d) @@ -424,22 +403,22 @@ void vd_shoc_decomp_and_solve(VdShocDecompandSolveData& d) { shoc_init(d.nlev); // Call decomp subroutine - vd_shoc_decomp_host(d.shcol, d.nlev, d.nlevi, d.kv_term, d.tmpi, d.rdp_zt, d.dtime, d.flux, d.du, d.dl, d.d); - // Call solver for each problem. The `var` array represents 3d - // data with an entry per (shcol, nlev, n_rhs). Fortran requires - // 2d data (shcol, nlev) for each rhs. - const Int size = d.shcol*d.nlev; - for (Int n=0; n ptr_array = {isotropy_zi, tkh_zi, dz_zi, invar1, invar2, varorcovar}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); view_2d isotropy_zi_d (temp_d[0]), @@ -520,7 +499,7 @@ void calc_shoc_varorcovar_host(Int shcol, Int nlev, Int nlevi, Real tunefac, // Sync back to host std::vector inout_views = {varorcovar_d}; - ekat::device_to_host({varorcovar}, shcol, nlevi, inout_views, true); + ekat::device_to_host({varorcovar}, shcol, nlevi, inout_views); } void calc_shoc_vertflux_host(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, @@ -542,7 +521,7 @@ void calc_shoc_vertflux_host(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, std::vector ptr_array = {tkh_zi, dz_zi, invar, vertflux}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); view_2d tkh_zi_d (temp_d[0]), @@ -565,7 +544,7 @@ void calc_shoc_vertflux_host(Int shcol, Int nlev, Int nlevi, Real *tkh_zi, // Sync back to host std::vector inout_views = {vertflux_d}; - ekat::device_to_host({vertflux}, shcol, nlevi, inout_views, true); + ekat::device_to_host({vertflux}, shcol, nlevi, inout_views); } void shoc_diag_second_moments_srf_host(Int shcol, Real* wthl_sfc, Real* uw_sfc, Real* vw_sfc, Real* ustar2, Real* wstar) @@ -670,7 +649,7 @@ void update_host_dse_host(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* // Sync to device ScreamDeepCopy::copy_to_device({phis}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, shcol, nlev, temp_2d_d, true); + ekat::host_to_device(ptr_array, shcol, nlev, temp_2d_d); view_1d phis_d(temp_1d_d[0]); @@ -698,7 +677,7 @@ void update_host_dse_host(Int shcol, Int nlev, Real* thlm, Real* shoc_ql, Real* // Sync back to host std::vector inout_views = {host_dse_d}; - ekat::device_to_host({host_dse}, shcol, nlev, inout_views, true); + ekat::device_to_host({host_dse}, shcol, nlev, inout_views); } void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, @@ -731,7 +710,7 @@ void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w w3}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); view_2d w_sec_d (temp_d[0]), @@ -772,7 +751,7 @@ void compute_diag_third_shoc_moment_host(Int shcol, Int nlev, Int nlevi, Real* w // Sync back to host std::vector inout_views = {w3_d}; - ekat::device_to_host({w3}, shcol, nlevi, inout_views, true); + ekat::device_to_host({w3}, shcol, nlevi, inout_views); } void shoc_pblintd_init_pot_host(Int shcol, Int nlev, Real *thl, Real* ql, Real* q, @@ -788,7 +767,7 @@ void shoc_pblintd_init_pot_host(Int shcol, Int nlev, Real *thl, Real* ql, Real* static constexpr Int num_arrays = 3; std::vector temp_d(num_arrays); - ekat::host_to_device({thl, ql, q}, shcol, nlev, temp_d, true); + ekat::host_to_device({thl, ql, q}, shcol, nlev, temp_d); view_2d thl_d(temp_d[0]), ql_d (temp_d[1]), @@ -810,7 +789,7 @@ void shoc_pblintd_init_pot_host(Int shcol, Int nlev, Real *thl, Real* ql, Real* }); std::vector inout_views = {thv_d}; - ekat::device_to_host({thv}, shcol, nlev, inout_views, true); + ekat::device_to_host({thv}, shcol, nlev, inout_views); } void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* brunt, @@ -832,7 +811,7 @@ void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* bru // Sync to device ScreamDeepCopy::copy_to_device({l_inf}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, shcol, nlev, temp_2d_d, true); + ekat::host_to_device(ptr_array, shcol, nlev, temp_2d_d); view_1d l_inf_d (temp_1d_d[0]); @@ -862,7 +841,7 @@ void compute_shoc_mix_shoc_length_host(Int nlev, Int shcol, Real* tke, Real* bru // Sync back to host std::vector inout_views = {shoc_mix_d}; - ekat::device_to_host({shoc_mix}, shcol, nlev, inout_views, true); + ekat::device_to_host({shoc_mix}, shcol, nlev, inout_views); } void check_tke_host(Int shcol, Int nlev, Real* tke) @@ -877,7 +856,7 @@ void check_tke_host(Int shcol, Int nlev, Real* tke) std::vector temp_2d_d(1); // Sync to device - ekat::host_to_device({tke}, shcol, nlev, temp_2d_d, true); + ekat::host_to_device({tke}, shcol, nlev, temp_2d_d); view_2d tke_d(temp_2d_d[0]); @@ -894,7 +873,7 @@ void check_tke_host(Int shcol, Int nlev, Real* tke) // Sync back to host std::vector inout_views = {tke_d}; - ekat::device_to_host({tke}, shcol, nlev, inout_views, true); + ekat::device_to_host({tke}, shcol, nlev, inout_views); } void linear_interp_host(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2, Int ncol, Real minthresh) @@ -913,7 +892,7 @@ void linear_interp_host(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2 std::vector ptr_array = {x1, x2, y1}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); view_2d x1_d(temp_2d_d[0]), @@ -936,7 +915,7 @@ void linear_interp_host(Real* x1, Real* x2, Real* y1, Real* y2, Int km1, Int km2 // Sync back to host std::vector inout_views = {y2_d}; - ekat::device_to_host({y2}, ncol, km2, inout_views, true); + ekat::device_to_host({y2}, ncol, km2, inout_views); } void clipping_diag_third_shoc_moments_host(Int nlevi, Int shcol, Real *w_sec_zi, @@ -952,7 +931,7 @@ void clipping_diag_third_shoc_moments_host(Int nlevi, Int shcol, Real *w_sec_zi, // Sync to device std::vector temp_d(2); - ekat::host_to_device({w_sec_zi, w3}, shcol, nlevi, temp_d, true); + ekat::host_to_device({w_sec_zi, w3}, shcol, nlevi, temp_d); view_2d w_sec_zi_d(temp_d[0]), @@ -971,7 +950,7 @@ void clipping_diag_third_shoc_moments_host(Int nlevi, Int shcol, Real *w_sec_zi, // Sync back to host std::vector inout_views = {w3_d}; - ekat::device_to_host({w3}, shcol, nlevi, inout_views, true); + ekat::device_to_host({w3}, shcol, nlevi, inout_views); } void shoc_energy_integrals_host(Int shcol, Int nlev, Real *host_dse, Real *pdel, @@ -992,7 +971,7 @@ void shoc_energy_integrals_host(Int shcol, Int nlev, Real *host_dse, Real *pdel, std::vector ptr_array = {host_dse, pdel, rtm, rcm, u_wind, v_wind}; // Sync to device - ekat::host_to_device(ptr_array, shcol, nlev, temp_d, true); + ekat::host_to_device(ptr_array, shcol, nlev, temp_d); // inputs view_2d @@ -1124,7 +1103,7 @@ void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real std::vector ptr_array = {thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, zt_grid, shoc_mix, thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, dz_zi, zi_grid}; - ekat::host_to_device(ptr_array, dim1_array, dim2_array, temp_2d, true); + ekat::host_to_device(ptr_array, dim1_array, dim2_array, temp_2d); view_2d thetal_2d (temp_2d[0]), @@ -1202,7 +1181,7 @@ void diag_second_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real std::vector dim1(9, shcol); std::vector dim2 = {nlevi, nlevi, nlevi, nlevi, nlevi, nlevi, nlevi, nlevi, nlev }; std::vector host_views = {thl_sec_2d, qw_sec_2d, wthl_sec_2d, wqw_sec_2d, qwthl_sec_2d, uw_sec_2d, vw_sec_2d, wtke_sec_2d, w_sec_2d}; - ekat::device_to_host({thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec}, dim1, dim2, host_views, true); + ekat::device_to_host({thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec}, dim1, dim2, host_views); } void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* u_wind, Real* v_wind, Real* tke, @@ -1234,7 +1213,7 @@ void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, std::vector ptr_array = {thetal, qw, u_wind, v_wind, tke, isotropy, tkh, tk, zt_grid, shoc_mix, thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, dz_zi, zi_grid}; - ekat::host_to_device(ptr_array, dim1_array, dim2_array, temp_2d, true); + ekat::host_to_device(ptr_array, dim1_array, dim2_array, temp_2d); view_2d thetal_2d (temp_2d[0]), @@ -1320,7 +1299,7 @@ void diag_second_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* thetal, std::vector dim1(9, shcol); std::vector dim2 = {nlevi, nlevi, nlevi, nlevi, nlevi, nlevi, nlevi, nlevi, nlev }; std::vector host_2d_views = {thl_sec_2d, qw_sec_2d, wthl_sec_2d, wqw_sec_2d, qwthl_sec_2d, uw_sec_2d, vw_sec_2d, wtke_sec_2d, w_sec_2d}; - ekat::device_to_host({thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec}, dim1, dim2, host_2d_views, true); + ekat::device_to_host({thl_sec, qw_sec, wthl_sec, wqw_sec, qwthl_sec, uw_sec, vw_sec, wtke_sec, w_sec}, dim1, dim2, host_2d_views); } void compute_brunt_shoc_length_host(Int nlev, Int nlevi, Int shcol, Real* dz_zt, Real* thv, Real* thv_zi, Real* brunt) @@ -1339,7 +1318,7 @@ void compute_brunt_shoc_length_host(Int nlev, Int nlevi, Int shcol, Real* dz_zt, std::vector ptr_array = {dz_zt, thv, thv_zi, brunt}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); view_2d dz_zt_d (temp_d[0]), @@ -1362,7 +1341,7 @@ void compute_brunt_shoc_length_host(Int nlev, Int nlevi, Int shcol, Real* dz_zt, // Sync back to host std::vector inout_views = {brunt_d}; - ekat::device_to_host({brunt}, shcol, nlev, inout_views, true); + ekat::device_to_host({brunt}, shcol, nlev, inout_views); } void compute_l_inf_shoc_length_host(Int nlev, Int shcol, Real *zt_grid, Real *dz_zt, @@ -1380,7 +1359,7 @@ void compute_l_inf_shoc_length_host(Int nlev, Int shcol, Real *zt_grid, Real *dz // Sync to device std::vector temp_d(3); - ekat::host_to_device({zt_grid, dz_zt, tke}, shcol, nlev, temp_d, true); + ekat::host_to_device({zt_grid, dz_zt, tke}, shcol, nlev, temp_d); // inputs view_2d @@ -1429,7 +1408,7 @@ void check_length_scale_shoc_length_host(Int nlev, Int shcol, Real* host_dx, Rea std::vector temp_1d_d(2); std::vector temp_2d_d(1); ScreamDeepCopy::copy_to_device({host_dx,host_dy}, shcol, temp_1d_d); - ekat::host_to_device({shoc_mix}, shcol, nlev, temp_2d_d, true); + ekat::host_to_device({shoc_mix}, shcol, nlev, temp_2d_d); view_1d host_dx_d(temp_1d_d[0]), @@ -1452,7 +1431,7 @@ void check_length_scale_shoc_length_host(Int nlev, Int shcol, Real* host_dx, Rea // Sync back to host std::vector inout_views = {shoc_mix_d}; - ekat::device_to_host({shoc_mix}, shcol, nlev, inout_views, true); + ekat::device_to_host({shoc_mix}, shcol, nlev, inout_views); } void shoc_diag_obklen_host(Int shcol, Real* uw_sfc, Real* vw_sfc, Real* wthl_sfc, Real* wqw_sfc, Real* thl_sfc, @@ -1522,7 +1501,7 @@ void shoc_pblintd_cldcheck_host(Int shcol, Int nlev, Int nlevi, Real* zi, Real* std::vector dim2 = {nlevi, nlev}; std::vector cldcheck_2d(2); - ekat::host_to_device({zi, cldn}, dim1, dim2, cldcheck_2d, true); + ekat::host_to_device({zi, cldn}, dim1, dim2, cldcheck_2d); view_2d zi_2d (cldcheck_2d[0]), @@ -1573,7 +1552,7 @@ void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_ thv, brunt, shoc_mix}; // Sync to device ScreamDeepCopy::copy_to_device({host_dx, host_dy}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); // inputs view_1d @@ -1622,7 +1601,7 @@ void shoc_length_host(Int shcol, Int nlev, Int nlevi, Real* host_dx, Real* host_ // Sync back to host std::vector inout_views = {brunt_d,shoc_mix_d}; - ekat::device_to_host({brunt,shoc_mix}, shcol, nlev, inout_views, true); + ekat::device_to_host({brunt,shoc_mix}, shcol, nlev, inout_views); } void shoc_energy_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, @@ -1653,7 +1632,7 @@ void shoc_energy_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv // Sync to device ScreamDeepCopy::copy_to_device(ptr_array_1d, shcol, temp_1d_d); - ekat::host_to_device(ptr_array_2d, dim1_sizes, dim2_sizes, temp_2d_d, true); + ekat::host_to_device(ptr_array_2d, dim1_sizes, dim2_sizes, temp_2d_d); view_1d se_b_d(temp_1d_d[0]), @@ -1713,7 +1692,7 @@ void shoc_energy_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv // Sync back to host std::vector inout_views = {host_dse_d}; - ekat::device_to_host({host_dse}, shcol, nlev, inout_views, true); + ekat::device_to_host({host_dse}, shcol, nlev, inout_views); } void compute_shoc_vapor_host(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv) @@ -1730,7 +1709,7 @@ void compute_shoc_vapor_host(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv) // Sync to device std::vector temp_d(num_arrays); - ekat::host_to_device( {qw, ql, qv}, shcol, nlev, temp_d, true); + ekat::host_to_device( {qw, ql, qv}, shcol, nlev, temp_d); // Inputs/Outputs view_2d @@ -1752,7 +1731,7 @@ void compute_shoc_vapor_host(Int shcol, Int nlev, Real* qw, Real* ql, Real* qv) // Sync back to host std::vector inout_views = {qv_d}; - ekat::device_to_host({qv}, shcol, nlev, inout_views, true); + ekat::device_to_host({qv}, shcol, nlev, inout_views); } void update_prognostics_implicit_host(Int shcol, Int nlev, Int nlevi, Int num_tracer, Real dtime, @@ -1788,8 +1767,8 @@ void update_prognostics_implicit_host(Int shcol, Int nlev, Int nlevi, Int num_tr // Sync to device ScreamDeepCopy::copy_to_device({uw_sfc, vw_sfc, wthl_sfc, wqw_sfc}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d, true); - ekat::host_to_device({tracer}, shcol, nlev, num_tracer, temp_3d_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); + ekat::host_to_device({tracer}, shcol, nlev, num_tracer, temp_3d_d); view_1d uw_sfc_d(temp_1d_d[0]), @@ -1887,10 +1866,10 @@ void update_prognostics_implicit_host(Int shcol, Int nlev, Int nlevi, Int num_tr // Sync back to host std::vector inout_views_2d = {thetal_d, qw_d, u_wind_d, v_wind_d, tke_d}; - ekat::device_to_host({thetal, qw, u_wind, v_wind, tke}, shcol, nlev, inout_views_2d, true); + ekat::device_to_host({thetal, qw, u_wind, v_wind, tke}, shcol, nlev, inout_views_2d); std::vector inout_views = {qtracers_f90_d}; - ekat::device_to_host({tracer}, shcol, nlev, num_tracer, inout_views, true); + ekat::device_to_host({tracer}, shcol, nlev, num_tracer, inout_views); } void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, Real* thl_sec, @@ -1916,7 +1895,7 @@ void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, R dz_zi, zt_grid, zi_grid, w3}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); view_2d wsec_d(temp_d[0]), @@ -1969,7 +1948,7 @@ void diag_third_shoc_moments_host(Int shcol, Int nlev, Int nlevi, Real* w_sec, R // Sync back to host std::vector inout_views = {w3_d}; - ekat::device_to_host({w3}, shcol, nlevi, inout_views, true); + ekat::device_to_host({w3}, shcol, nlevi, inout_views); } void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wthv_sec, @@ -1989,7 +1968,7 @@ void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wth std::vector ptr_array = {shoc_mix, wthv_sec, sterm_zt, tk, tke, a_diss}; // Sync to device - ekat::host_to_device(ptr_array, shcol, nlev, temp_d, true); + ekat::host_to_device(ptr_array, shcol, nlev, temp_d); view_2d //input @@ -2020,7 +1999,7 @@ void adv_sgs_tke_host(Int nlev, Int shcol, Real dtime, Real* shoc_mix, Real* wth // Sync back to host std::vector inout_views = {tke_d, a_diss_d}; - ekat::device_to_host({tke, a_diss}, shcol, nlev, inout_views, true); + ekat::device_to_host({tke, a_diss}, shcol, nlev, inout_views); } void shoc_assumed_pdf_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* qw, Real* w_field, @@ -2047,7 +2026,7 @@ void shoc_assumed_pdf_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* q wqw_sec, qwthl_sec, w3, w_field, pres, zt_grid, zi_grid, shoc_cldfrac, shoc_ql, wqls, wthv_sec, shoc_ql2}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); // Inputs/Outputs view_2d @@ -2108,7 +2087,7 @@ void shoc_assumed_pdf_host(Int shcol, Int nlev, Int nlevi, Real* thetal, Real* q // Sync back to host std::vector out_views = {shoc_cldfrac_d, shoc_ql_d, wqls_d, wthv_sec_d, shoc_ql2_d}; - ekat::device_to_host({shoc_cldfrac, shoc_ql, wqls, wthv_sec, shoc_ql2}, shcol, nlev, out_views, true); + ekat::device_to_host({shoc_cldfrac, shoc_ql, wqls, wthv_sec, shoc_ql2}, shcol, nlev, out_views); } void compute_shr_prod_host(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_wind, Real* v_wind, Real* sterm) { @@ -2128,7 +2107,7 @@ void compute_shr_prod_host(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_ std::vector ptr_array = {dz_zi, u_wind, v_wind, sterm}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_d); view_2d //input @@ -2156,7 +2135,7 @@ void compute_shr_prod_host(Int nlevi, Int nlev, Int shcol, Real* dz_zi, Real* u_ // Sync back to host std::vector inout_views = {sterm_d}; - ekat::device_to_host({sterm}, shcol, nlevi, inout_views, true); + ekat::device_to_host({sterm}, shcol, nlevi, inout_views); } void compute_tmpi_host(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_zi, Real *tmpi) @@ -2173,7 +2152,7 @@ void compute_tmpi_host(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_ // Sync to device std::vector temp_d(num_arrays); - ekat::host_to_device({rho_zi, dz_zi, tmpi}, shcol, nlevi, temp_d, true); + ekat::host_to_device({rho_zi, dz_zi, tmpi}, shcol, nlevi, temp_d); // Inputs/Outputs view_2d @@ -2195,7 +2174,7 @@ void compute_tmpi_host(Int nlevi, Int shcol, Real dtime, Real *rho_zi, Real *dz_ // Sync back to host std::vector inout_views = {tmpi_d}; - ekat::device_to_host({tmpi}, shcol, nlevi, inout_views, true); + ekat::device_to_host({tmpi}, shcol, nlevi, inout_views); } void integ_column_stability_host(Int nlev, Int shcol, Real *dz_zt, @@ -2215,7 +2194,7 @@ void integ_column_stability_host(Int nlev, Int shcol, Real *dz_zt, // Sync to device std::vector temp_d(num_arrays); - ekat::host_to_device({dz_zt, pres, brunt}, shcol, nlev, temp_d, true); + ekat::host_to_device({dz_zt, pres, brunt}, shcol, nlev, temp_d); // Inputs view_2d @@ -2271,7 +2250,7 @@ void isotropic_ts_host(Int nlev, Int shcol, Real* brunt_int, Real* tke, // Sync to device ScreamDeepCopy::copy_to_device({brunt_int}, shcol, temp_1d); - ekat::host_to_device(ptr_array, shcol, nlev, temp_2d, true); + ekat::host_to_device(ptr_array, shcol, nlev, temp_2d); //inputs view_1d brunt_int_d(temp_1d[0]); @@ -2299,7 +2278,7 @@ void isotropic_ts_host(Int nlev, Int shcol, Real* brunt_int, Real* tke, const auto isotropy_s = ekat::subview(isotropy_d, i); //output // Hard code these runtime options for F90 - const Real lambda_low = 0.001; + const Real lambda_low = 0.001; const Real lambda_high = 0.04; const Real lambda_slope = 2.65; const Real lambda_thresh = 0.02; @@ -2309,7 +2288,7 @@ void isotropic_ts_host(Int nlev, Int shcol, Real* brunt_int, Real* tke, // Sync back to host std::vector inout_views = {isotropy_d}; - ekat::device_to_host({isotropy}, shcol, nlev, inout_views, true); + ekat::device_to_host({isotropy}, shcol, nlev, inout_views); } @@ -2327,7 +2306,7 @@ void dp_inverse_host(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_z // Sync to device std::vector temp_d(num_arrays); - ekat::host_to_device({rho_zt, dz_zt, rdp_zt}, shcol, nlev, temp_d, true); + ekat::host_to_device({rho_zt, dz_zt, rdp_zt}, shcol, nlev, temp_d); // Inputs/Outputs view_2d @@ -2349,7 +2328,7 @@ void dp_inverse_host(Int nlev, Int shcol, Real *rho_zt, Real *dz_zt, Real *rdp_z // Sync back to host std::vector inout_views = {rdp_zt_d}; - ekat::device_to_host({rdp_zt}, shcol, nlev, inout_views, true); + ekat::device_to_host({rdp_zt}, shcol, nlev, inout_views); } int shoc_init_host(Int nlev, Real *pref_mid, Int nbot_shoc, Int ntop_shoc) @@ -2414,14 +2393,14 @@ Int shoc_main_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npb std::vector ptr_array_2d = {zt_grid, zi_grid, pres, presi, pdel, thv, w_field, wtracer_sfc, inv_exner, host_dse, tke, thetal, qw, u_wind, v_wind, - wthv_sec, tk, shoc_cldfrac, shoc_ql, shoc_ql2, + wthv_sec, tk, shoc_cldfrac, shoc_ql, shoc_ql2, tkh, shoc_mix, w_sec, thl_sec, qw_sec, qwthl_sec, wthl_sec, wqw_sec, wtke_sec, uw_sec, vw_sec, w3, wqls_sec, brunt, isotropy}; ScreamDeepCopy::copy_to_device(ptr_array_1d, shcol, temp_1d_d); - ekat::host_to_device(ptr_array_2d, dim1_2d_sizes, dim2_2d_sizes, temp_2d_d, true); - ekat::host_to_device({qtracers}, shcol, nlev, num_qtracers, temp_3d_d, true); + ekat::host_to_device(ptr_array_2d, dim1_2d_sizes, dim2_2d_sizes, temp_2d_d); + ekat::host_to_device({qtracers}, shcol, nlev, num_qtracers, temp_3d_d); Int index_counter = 0; view_1d @@ -2603,11 +2582,11 @@ Int shoc_main_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npb qw_sec_d, qwthl_sec_d, wthl_sec_d, wqw_sec_d, wtke_sec_d, uw_sec_d, vw_sec_d, w3_d, wqls_sec_d, brunt_d, isotropy_d}; - ekat::device_to_host(ptr_array_2d_out, dim1_2d_out, dim2_2d_out, out_views_2d, true); + ekat::device_to_host(ptr_array_2d_out, dim1_2d_out, dim2_2d_out, out_views_2d); // 3d std::vector out_views_3d = {qtracers_f90_d}; - ekat::device_to_host({qtracers}, shcol, nlev, num_qtracers, out_views_3d, true); + ekat::device_to_host({qtracers}, shcol, nlev, num_qtracers, out_views_3d); return elapsed_microsec; } @@ -2624,7 +2603,7 @@ void pblintd_height_host(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* using MemberType = typename SHOC::MemberType; std::vector views_2d(5); - ekat::host_to_device({z, u, v, thv, rino}, shcol, nlev, views_2d, true); + ekat::host_to_device({z, u, v, thv, rino}, shcol, nlev, views_2d); view_2d z_2d (views_2d[0]), u_2d (views_2d[1]), @@ -2665,7 +2644,7 @@ void pblintd_height_host(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* ScreamDeepCopy::copy_to_host({pblh}, shcol, out_1d_views); std::vector out_2d_views = {rino_2d}; - ekat::device_to_host({rino}, shcol, nlev, out_2d_views, true); + ekat::device_to_host({rino}, shcol, nlev, out_2d_views); std::vector out_bool_1d_views = {check_1d}; ScreamDeepCopy::copy_to_host({check}, shcol, out_bool_1d_views); @@ -2700,8 +2679,8 @@ void vd_shoc_decomp_and_solve_host(Int shcol, Int nlev, Int nlevi, Int num_rhs, // Sync to device ScreamDeepCopy::copy_to_device({flux}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d, true); - ekat::host_to_device({var}, shcol, nlev, num_rhs, temp_3d_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); + ekat::host_to_device({var}, shcol, nlev, num_rhs, temp_3d_d); view_1d flux_d(temp_1d_d[0]); @@ -2740,7 +2719,7 @@ void vd_shoc_decomp_and_solve_host(Int shcol, Int nlev, Int nlevi, Int num_rhs, // Sync back to host std::vector inout_views = {var_d}; - ekat::device_to_host({var}, shcol, nlev, num_rhs, inout_views, true); + ekat::device_to_host({var}, shcol, nlev, num_rhs, inout_views); } void shoc_grid_host(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid, Real* pdel, Real* dz_zt, Real* dz_zi, Real* rho_zt) @@ -2762,7 +2741,7 @@ void shoc_grid_host(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid dz_zt, dz_zi, rho_zt}; // Sync to device - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); view_2d zt_grid_d(temp_2d_d[0]), @@ -2789,7 +2768,7 @@ void shoc_grid_host(Int shcol, Int nlev, Int nlevi, Real* zt_grid, Real* zi_grid // Sync back to host std::vector inout_views = {dz_zt_d, dz_zi_d, rho_zt_d}; - ekat::device_to_host({dz_zt, dz_zi, rho_zt}, {shcol, shcol, shcol}, {nlev, nlevi, nlev}, inout_views, true); + ekat::device_to_host({dz_zt, dz_zi, rho_zt}, {shcol, shcol, shcol}, {nlev, nlevi, nlev}, inout_views); } void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Real* tabs, Real* shoc_mix, Real* sterm_zt, @@ -2816,7 +2795,7 @@ void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Rea // Sync to device ScreamDeepCopy::copy_to_device({pblh}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, shcol, nlev, temp_2d_d, true); + ekat::host_to_device(ptr_array, shcol, nlev, temp_2d_d); view_1d pblh_d(temp_1d_d[0]); @@ -2854,7 +2833,7 @@ void eddy_diffusivities_host(Int nlev, Int shcol, Real* pblh, Real* zt_grid, Rea // Sync back to host std::vector inout_views = {tkh_d, tk_d}; - ekat::device_to_host({tkh, tk}, shcol, nlev, inout_views, true); + ekat::device_to_host({tkh, tk}, shcol, nlev, inout_views); } void pblintd_surf_temp_host(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, Real* obklen, Real* kbfs, Real* thv, Real* tlv, Real* pblh, bool* check, Real* rino) @@ -2867,7 +2846,7 @@ void pblintd_surf_temp_host(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar using view_2d = typename SHOC::view_2d; std::vector views_2d(3); - ekat::host_to_device({z, thv, rino}, shcol, nlev, views_2d, true); + ekat::host_to_device({z, thv, rino}, shcol, nlev, views_2d); view_2d z_2d (views_2d[0]), thv_2d (views_2d[1]), rino_2d(views_2d[2]); @@ -2908,7 +2887,7 @@ void pblintd_surf_temp_host(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar ScreamDeepCopy::copy_to_host({pblh, tlv}, shcol, out_1d_views); std::vector out_2d_views = {rino_2d}; - ekat::device_to_host({rino}, shcol, nlev, out_2d_views, true); + ekat::device_to_host({rino}, shcol, nlev, out_2d_views); std::vector out_bool_1d_views = {check_1d}; ScreamDeepCopy::copy_to_host({check}, shcol, out_bool_1d_views); @@ -2924,7 +2903,7 @@ void pblintd_check_pblh_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, using view_2d = typename SHOC::view_2d; std::vector views_2d(1); - ekat::host_to_device({z}, shcol, nlev, views_2d, true); + ekat::host_to_device({z}, shcol, nlev, views_2d); view_2d z_2d (views_2d[0]); std::vector views_1d(2); @@ -2976,7 +2955,7 @@ void pblintd_host(Int shcol, Int nlev, Int nlevi, Int npbl, Real* z, Real* zi, R // Sync to device ScreamDeepCopy::copy_to_device({ustar, obklen, kbfs}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); view_1d ustar_d(temp_1d_d[0]), @@ -3058,7 +3037,7 @@ void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, R // Sync to device ScreamDeepCopy::copy_to_device({pblh}, shcol, temp_1d_d); - ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d, true); + ekat::host_to_device(ptr_array, dim1_sizes, dim2_sizes, temp_2d_d); view_1d pblh_d(temp_1d_d[0]); @@ -3110,7 +3089,7 @@ void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, R const auto isotropy_s = ekat::subview(isotropy_d, i); // Hardcode for F90 testing - const Real lambda_low = 0.001; + const Real lambda_low = 0.001; const Real lambda_high = 0.04; const Real lambda_slope = 2.65; const Real lambda_thresh = 0.02; @@ -3127,7 +3106,7 @@ void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, R // Sync back to host std::vector inout_views = {tke_d, tk_d, tkh_d, isotropy_d}; - ekat::device_to_host({tke, tk, tkh, isotropy}, shcol, nlev, inout_views, true); + ekat::device_to_host({tke, tk, tkh, isotropy}, shcol, nlev, inout_views); } void compute_shoc_temperature_host(Int shcol, Int nlev, Real *thetal, Real *ql, Real *inv_exner, Real* tabs) @@ -3144,7 +3123,7 @@ void compute_shoc_temperature_host(Int shcol, Int nlev, Real *thetal, Real *ql, // Sync to device std::vector temp_d(num_arrays); - ekat::host_to_device({thetal, ql, inv_exner, tabs}, shcol, nlev, temp_d, true); + ekat::host_to_device({thetal, ql, inv_exner, tabs}, shcol, nlev, temp_d); // Inputs/Outputs view_2d @@ -3168,7 +3147,7 @@ void compute_shoc_temperature_host(Int shcol, Int nlev, Real *thetal, Real *ql, // Sync back to host std::vector out_views = {tabs_d}; - ekat::device_to_host({tabs}, shcol, nlev, out_views, true); + ekat::device_to_host({tabs}, shcol, nlev, out_views); } } // namespace shoc diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 388a8a4b2ab..745342a1d78 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -137,51 +137,6 @@ struct ShocEnergyIntegralsData : public PhysicsTestData { PTD_STD_DEF(ShocEnergyIntegralsData, 2, shcol, nlev); }; -struct ShocEnergyTotalFixerData : public ShocTestGridDataBase { - // Inputs - Int shcol, nlev, nlevi, nadv; - Real dtime; - Real *se_b, *ke_b, *wv_b, *wl_b, *se_a, *ke_a, *wv_a, *wl_a, *wthl_sfc, *wqw_sfc, *rho_zt, *pint; - - // Outputs - Real *te_a, *te_b; - - ShocEnergyTotalFixerData(Int shcol_, Int nlev_, Int nlevi_, Real dtime_, Int nadv_) : - ShocTestGridDataBase({{ shcol_, nlev_ }, { shcol_, nlevi_ }, { shcol_ }}, {{ &zt_grid, &rho_zt }, { &zi_grid, &pint }, { &se_b, &ke_b, &wv_b, &wl_b, &se_a, &ke_a, &wv_a, &wl_a, &wthl_sfc, &wqw_sfc, &te_a, &te_b }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_), nadv(nadv_), dtime(dtime_) {} - - PTD_STD_DEF(ShocEnergyTotalFixerData, 5, shcol, nlev, nlevi, dtime, nadv); -}; - -struct ShocEnergyThresholdFixerData : public PhysicsTestData { - // Inputs - Int shcol, nlev, nlevi; - Real *pint, *tke, *te_a, *te_b; - - // Outputs - Real *se_dis; - Int *shoctop; - - ShocEnergyThresholdFixerData(Int shcol_, Int nlev_, Int nlevi_) : - PhysicsTestData({{ shcol_, nlevi_ }, { shcol_, nlev_ }, { shcol_ }, { shcol_ }}, {{ &pint }, { &tke }, { &te_a, &te_b, &se_dis }}, {{ &shoctop }}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_) {} - - PTD_STD_DEF(ShocEnergyThresholdFixerData, 3, shcol, nlev, nlevi); -}; - -struct ShocEnergyDseFixerData : public PhysicsTestData { - // Inputs - Int shcol, nlev; - Real *se_dis; - Int *shoctop; - - // Inputs/Outputs - Real *host_dse; - - ShocEnergyDseFixerData(Int shcol_, Int nlev_) : - PhysicsTestData({{ shcol_ }, { shcol_, nlev_ }, { shcol_ }}, {{ &se_dis }, { &host_dse }}, {{ &shoctop }}), shcol(shcol_), nlev(nlev_) {} - - PTD_STD_DEF(ShocEnergyDseFixerData, 2, shcol, nlev); -}; - struct CalcShocVertfluxData : public PhysicsTestData { // Inputs Int shcol, nlev, nlevi; @@ -1076,9 +1031,6 @@ void shoc_diag_obklen (ShocDiagObklenData& d); void update_host_dse (UpdateHostDseData& d); void shoc_energy_fixer (ShocEnergyFixerData& d); void shoc_energy_integrals (ShocEnergyIntegralsData& d); -void shoc_energy_total_fixer (ShocEnergyTotalFixerData& d); -void shoc_energy_threshold_fixer (ShocEnergyThresholdFixerData& d); -void shoc_energy_dse_fixer (ShocEnergyDseFixerData& d); void calc_shoc_vertflux (CalcShocVertfluxData& d); void calc_shoc_varorcovar (CalcShocVarorcovarData& d); void compute_tmpi (ComputeTmpiData& d); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp deleted file mode 100644 index c2c4b2e167d..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_dse_fixer_tests.cpp +++ /dev/null @@ -1,137 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" - -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestShocEnergyDseFixer { - - static void run_property() - { - static constexpr Int shcol = 6; - static constexpr Int nlev = 5; - - // Tests for the SHOC function - // shoc_energy_dse_fixer - - // TEST - // For columns that are identical EXCEPT for the shoctop indicee, - // verify that given a positive value of energy imbalance that - // columns with a higher SHOC top were subject to more energy removal. - - // Host model dry static energy [J kg-1] - static constexpr Real host_dse_input[nlev] = {350e3, 325e3, 315e3, 310e3, 300e3}; - - // Energy disbalance. For this test we assume all columns have - // the same disbalance magnitude. - static constexpr Real se_dis = 0.1; - - // level indicee of SHOC top layer - static constexpr Int shoctop[shcol] = {5, 3, 1, 2, 4, 4}; - - // Initialize data structure for bridging to F90 - ShocEnergyDseFixerData SDS(shcol, nlev); - - // Test that the inputs are reasonable. - // for this test we need exactly six columns - REQUIRE( (SDS.shcol == 6 && SDS.nlev == nlev) ); - - // Fill in test data on zt_grid. - for(Int s = 0; s < shcol; ++s) { - SDS.shoctop[s] = shoctop[s]; - SDS.se_dis[s] = se_dis; - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - SDS.host_dse[offset] = host_dse_input[n]; - } - } - - // Check that the inputs make sense - - for(Int s = 0; s < shcol; ++s) { - // For this test we WANT se_dis > 0 - REQUIRE(SDS.se_dis[s] > 0.0); - REQUIRE(SDS.shoctop[s] >= 1); - REQUIRE(SDS.shoctop[s] <= nlev); - for (Int n = 0; n < nlev; ++n){ - const auto offset = n + s * nlev; - - REQUIRE(SDS.host_dse[offset] > 0.0); - } - } - - // Call the fortran implementation - shoc_energy_dse_fixer(SDS); - - // Check the results - Real temp_sum[shcol]; - for(Int s = 0; s < shcol; ++s) { - temp_sum[s] = 0.0; - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - temp_sum[s] += SDS.host_dse[offset]; - } - } - - // Verify that as shoctop values get lower that the - // summation of temperatures also gets lower. This is proportionally - // to the amount of energy we expect to be removed from a column. - for (Int s = 0; s < shcol-1; ++s) { - if (shoctop[s] < shoctop[s+1]){ - REQUIRE(temp_sum[s] < temp_sum[s+1]); - } - else if (shoctop[s] > shoctop[s+1]){ - REQUIRE(temp_sum[s] > temp_sum[s+1]); - } - else{ - REQUIRE(temp_sum[s] == temp_sum[s+1]); - } - } - - } - - static void run_bfb() - { - // TODO - } -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace { - -TEST_CASE("shoc_energy_dse_fixer_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyDseFixer; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_energy_dse_fixer_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyDseFixer; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp deleted file mode 100644 index 47da76a4fa2..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_threshold_fixer_tests.cpp +++ /dev/null @@ -1,139 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" - -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestShocEnergyThreshFixer { - - static void run_property() - { - static constexpr Real mintke = scream::shoc::Constants::mintke; - static constexpr Int shcol = 2; - static constexpr Int nlev = 5; - static constexpr auto nlevi = nlev + 1; - - // Tests for the SHOC function - // shoc_energy_threshold_fixer - - // TEST ONE - // Set up a reasonable profile verify results are as expected - - // Host model TKE [m2/s2] - Real tke_input[nlev] = {mintke, mintke, 0.01, 0.4, 0.5}; - // Pressure at interface [Pa] - Real pint[nlevi] = {500e2, 600e2, 700e2, 800e2, 900e2, 1000e2}; - - // Integrated total energy after SHOC. - static constexpr Real te_a = 100; - // Integrated total energy before SHOC - static constexpr Real te_b = 110; - - // convert pressure to Pa - for(Int n = 0; n < nlevi; ++n) { - pint[n] = pint[n]; - } - - // Initialize data structure for bridging to F90 - ShocEnergyThresholdFixerData SDS(shcol, nlev, nlevi); - - // Test that the inputs are reasonable. - REQUIRE( (SDS.shcol == shcol && SDS.nlev == nlev && SDS.nlevi == nlevi) ); - REQUIRE(SDS.shcol > 1); - REQUIRE(nlev+1 == nlevi); - - // Fill in test data on zt_grid. - for(Int s = 0; s < shcol; ++s) { - SDS.te_a[s] = te_a; - SDS.te_b[s] = te_b; - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - SDS.tke[offset] = tke_input[n]; - } - - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - - SDS.pint[offset] = pint[n]; - } - } - - // Check that the inputs make sense - - for(Int s = 0; s < shcol; ++s) { - for (Int n = 0; n < nlev; ++n){ - const auto offset = n + s * nlev; - - REQUIRE(SDS.tke[offset] >= mintke); - } - } - - // Call the fortran implementation - shoc_energy_threshold_fixer(SDS); - - // Verify the result - for(Int s = 0; s < shcol; ++s) { - // Make sure value of shoctop is within reasonable range - REQUIRE(SDS.shoctop[s] < nlev); - REQUIRE(SDS.shoctop[s] > 1); - - // Verify that shoctop represents what we want it to - // Make sure that thickness that bounds shoctop is positive - const auto offset_stopi = (SDS.shoctop[s]-1) + s * nlevi; - const auto offset_bot = (nlevi-1) + s * nlevi; - REQUIRE(SDS.pint[offset_bot] - SDS.pint[offset_stopi] > 0.0); - - if (SDS.shoctop[s] < nlev){ - const auto offset_stop = (SDS.shoctop[s]-1) + s * nlev; - REQUIRE(SDS.tke[offset_stop] == mintke); - REQUIRE(SDS.tke[offset_stop+1] > mintke); - } - } - - } - - static void run_bfb() - { - // TODO - } -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace { - -TEST_CASE("shoc_energy_threshold_fixer_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyThreshFixer; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_energy_threshold_fixer_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocEnergyThreshFixer; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp deleted file mode 100644 index 302b7607b30..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_total_fixer_tests.cpp +++ /dev/null @@ -1,167 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" - -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestShocTotEnergyFixer { - - static void run_property() - { - static constexpr Int shcol = 2; - static constexpr Int nlev = 5; - static constexpr auto nlevi = nlev + 1; - - // Tests for the SHOC function - // shoc_energy_total_fixer - - // FIRST TEST - // Surface flux test. Have two columns, one with zero surface fluxes - // and the other with positive surface fluxes. Verify the column - // with surface fluxes has greater total energy "before". - - // Timestep [s] - static constexpr Real dtime = 300; - // Number of macmic steps - static constexpr Int nadv = 2; - // Air density [km/m3] - static constexpr Real rho_zt[nlev] = {0.4, 0.6, 0.7, 0.9, 1.0}; - // Interface heights [m] - static constexpr Real zi_grid[nlevi] = {11000, 7500, 5000, 3000, 1500, 0}; - // Define integrated static energy, kinetic energy, water vapor, - // and liquid water respectively - static constexpr Real se = 200; - static constexpr Real ke = 150; - static constexpr Real wv = 0.5; - static constexpr Real wl = 0.1; - // Define surface sensible heat flux [K m/s] - static constexpr Real wthl_sfc = 0.5; - // Define surface total water flux [kg/kg m/s] - static constexpr Real wqw_sfc = 0.01; - // Pressure at interface [Pa] - static constexpr Real pint[nlevi] = {50000, 60000, 70000, 80000, 90000, 100000}; - - // Initialize data structure for bridging to F90 - ShocEnergyTotalFixerData SDS(shcol, nlev, nlevi, dtime, nadv); - - // Test that the inputs are reasonable. - // for this test we need exactly two columns - REQUIRE( (SDS.shcol == shcol && SDS.nlev == nlev && SDS.nlevi == nlevi && SDS.dtime == dtime && SDS.nadv == nadv) ); - REQUIRE(shcol == 2); - REQUIRE(nlevi == nlev+1); - - for(Int s = 0; s < shcol; ++s) { - // Set before and after integrals equal - SDS.se_a[s] = se; - SDS.se_b[s] = se; - SDS.ke_a[s] = ke; - SDS.ke_b[s] = ke; - SDS.wv_a[s] = wv; - SDS.wv_b[s] = wv; - SDS.wl_a[s] = wl; - SDS.wl_b[s] = wl; - - // Make first column be zero for the surface fluxes - SDS.wthl_sfc[s] = s*wthl_sfc; - SDS.wqw_sfc[s] = s*wqw_sfc; - - // Fill in test data on zt_grid. - for(Int n = 0; n < nlev; ++n) { - const auto offset = n + s * nlev; - - // For zt grid, set as midpoint of zi grid - SDS.zt_grid[offset] = 0.5*(zi_grid[n]+zi_grid[n+1]); - SDS.rho_zt[offset] = rho_zt[n]; - } - // Fill in test data on zi_grid. - for(Int n = 0; n < nlevi; ++n) { - const auto offset = n + s * nlevi; - - SDS.zi_grid[offset] = zi_grid[n]; - SDS.pint[offset] = pint[n]; - } - } - - // Check that the inputs make sense - - for(Int s = 0; s < shcol; ++s) { - for (Int n = 0; n < nlev; ++n){ - const auto offset = n + s * nlev; - - REQUIRE(SDS.zt_grid[offset] >= 0); - REQUIRE(SDS.rho_zt[offset] > 0); - - // Check that heights increase upward - if (n > nlev-1){ - REQUIRE(SDS.zt_grid[offset + 1] - SDS.zt_grid[offset] < 0); - } - } - for (Int n = 0; n < nlevi; ++n){ - const auto offset = n + s * nlevi; - - REQUIRE(SDS.zi_grid[offset] >= 0); - - // Check that heights increase upward - if (n > nlevi-1){ - REQUIRE(SDS.zi_grid[offset + 1] - SDS.zi_grid[offset] < 0); - } - } - } - - // Call the fortran implementation - shoc_energy_total_fixer(SDS); - - // Check test - - // For first column verify that total energies are the same - REQUIRE(SDS.te_a[0] == SDS.te_b[0]); - - // Verify that second column "before" energy is greater than - // the first column, since here we have active surface fluxes - REQUIRE(SDS.te_b[1] > SDS.te_b[0]); - } - - static void run_bfb() - { - // TODO - } -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace { - -TEST_CASE("shoc_energy_total_fixer_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocTotEnergyFixer; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_energy_total_fixer_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestShocTotEnergyFixer; - - TestStruct::run_bfb(); -} - -} // namespace From dce175c6af61078cedc11229d0cd0b5859f92f8f Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 18 Nov 2024 11:39:53 +0000 Subject: [PATCH 269/529] Bump DavidAnson/markdownlint-cli2-action from 17 to 18 Bumps [DavidAnson/markdownlint-cli2-action](https://github.com/davidanson/markdownlint-cli2-action) from 17 to 18. - [Release notes](https://github.com/davidanson/markdownlint-cli2-action/releases) - [Commits](https://github.com/davidanson/markdownlint-cli2-action/compare/v17...v18) --- updated-dependencies: - dependency-name: DavidAnson/markdownlint-cli2-action dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/e3sm-gh-md-linter.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/e3sm-gh-md-linter.yml b/.github/workflows/e3sm-gh-md-linter.yml index 46319b08658..ad24487695e 100644 --- a/.github/workflows/e3sm-gh-md-linter.yml +++ b/.github/workflows/e3sm-gh-md-linter.yml @@ -27,7 +27,7 @@ jobs: with: files: '**/*.md' separator: "," - - uses: DavidAnson/markdownlint-cli2-action@v17 + - uses: DavidAnson/markdownlint-cli2-action@v18 if: steps.changed-files.outputs.any_changed == 'true' with: config: 'docs/.markdownlint.json' From 5ff42fb17403dd47625c6aa1cc8d12421e522220 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 18 Nov 2024 07:47:13 -0800 Subject: [PATCH 270/529] bug fixes --- components/eam/bld/build-namelist | 1 + components/eam/bld/namelist_files/namelist_defaults_eam.xml | 1 + components/eam/bld/namelist_files/namelist_definition.xml | 6 ++++++ components/eam/src/physics/cam/gw_convect.F90 | 2 ++ 4 files changed, 10 insertions(+) diff --git a/components/eam/bld/build-namelist b/components/eam/bld/build-namelist index 670390c6f66..9ee99aa5a46 100755 --- a/components/eam/bld/build-namelist +++ b/components/eam/bld/build-namelist @@ -832,6 +832,7 @@ add_default($nl,'gw_convect_hcf') if (get_default_value('gw_convect_hcf')); add_default($nl,'hdepth_scaling_factor') if (get_default_value('hdepth_scaling_factor')); add_default($nl,'gw_convect_hdepth_min') if (get_default_value('gw_convect_hdepth_min')); add_default($nl,'gw_convect_storm_speed_min') if (get_default_value('gw_convect_storm_speed_min')); +add_default($nl,'gw_convect_plev_src_wind') if (get_default_value('gw_convect_plev_src_wind')); add_default($nl,'use_gw_convect_old', 'val'=>'.true.'); add_default($nl,'linoz_psc_T'); if ($cfg->get('microphys') =~ /^mg2/) { diff --git a/components/eam/bld/namelist_files/namelist_defaults_eam.xml b/components/eam/bld/namelist_files/namelist_defaults_eam.xml index ba4b30bf446..1299949d77b 100755 --- a/components/eam/bld/namelist_files/namelist_defaults_eam.xml +++ b/components/eam/bld/namelist_files/namelist_defaults_eam.xml @@ -1892,6 +1892,7 @@ with se_tstep, dt_remap_factor, dt_tracer_factor set to -1 1.0 2.5 10.0 +70000 0.375 .true. 2.5D0 diff --git a/components/eam/bld/namelist_files/namelist_definition.xml b/components/eam/bld/namelist_files/namelist_definition.xml index 6c00afd21e5..62dfbd9c865 100644 --- a/components/eam/bld/namelist_files/namelist_definition.xml +++ b/components/eam/bld/namelist_files/namelist_definition.xml @@ -1122,6 +1122,12 @@ minimum convective storm speed for convective GWD Default: 10.0 m/s + +Reference pressure value used for convective GWD storm/source speed +Default: 70000 Pa + + switch to revert to old calculation of Beres scheme for heating depth and max diff --git a/components/eam/src/physics/cam/gw_convect.F90 b/components/eam/src/physics/cam/gw_convect.F90 index 82d6417ce81..1e6f9b6a75a 100644 --- a/components/eam/src/physics/cam/gw_convect.F90 +++ b/components/eam/src/physics/cam/gw_convect.F90 @@ -5,6 +5,7 @@ module gw_convect ! gw_drag in May 2013. ! use cam_logfile, only: iulog +use spmd_utils, only: masterproc use gw_utils, only: r8 use gw_common, only: pver, pgwv @@ -36,6 +37,7 @@ subroutine gw_convect_init( plev_src_wind, mfcc_in, errstring) real(r8), intent(in) :: mfcc_in(:,:,:) ! Source spectra to keep as table character(len=*), intent(out) :: errstring ! Report any errors from this routine integer :: ierr + integer :: k errstring = "" From 039170192fb9341c474dc14115b7a08a3bd5d7ae Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 18 Nov 2024 07:54:55 -0800 Subject: [PATCH 271/529] bug fix --- components/eam/src/physics/cam/gw_drag.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/cam/gw_drag.F90 b/components/eam/src/physics/cam/gw_drag.F90 index 99486f3c781..8b3fa5f4bab 100644 --- a/components/eam/src/physics/cam/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw_drag.F90 @@ -148,7 +148,7 @@ subroutine gw_drag_readnl(nlfile) effgw_oro, fcrit2, frontgfc, gw_drag_file, taubgnd, gw_convect_hcf, & hdepth_scaling_factor, gw_convect_hdepth_min, & gw_convect_storm_speed_min, gw_convect_plev_src_wind, & - use_gw_convect_old) + use_gw_convect_old !---------------------------------------------------------------------- if (masterproc) then From ef10bb5c1deba857269a3ad49fe2409b5a6a5c9f Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 18 Nov 2024 07:55:50 -0800 Subject: [PATCH 272/529] clarify units of GWD parameters --- .../eam/bld/namelist_files/namelist_definition.xml | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/components/eam/bld/namelist_files/namelist_definition.xml b/components/eam/bld/namelist_files/namelist_definition.xml index 62dfbd9c865..950a43658ab 100644 --- a/components/eam/bld/namelist_files/namelist_definition.xml +++ b/components/eam/bld/namelist_files/namelist_definition.xml @@ -1100,31 +1100,32 @@ Default: set by build-namelist. -Heating rate conversion factor associated with convective gravity waves +Heating rate conversion factor associated with convective GWD [unitless]. +Also often interpretted as "convective fraction" [%]. Default: 20.0 -Scaling factor for the heating depth +Scaling factor for the heating depth [unitless] Default: 1.0 -minimum hdepth for for convective GWD spectrum lookup table -Default: 2.5 +minimum hdepth for for convective GWD spectrum lookup table [km] +Default: 2.5 km -minimum convective storm speed for convective GWD +minimum convective storm speed in m/s for convective GWD Default: 10.0 m/s -Reference pressure value used for convective GWD storm/source speed +Reference pressure value used for convective storm speed in m/s for convective GWD Default: 70000 Pa From e3967d84d74975291489d48ea9f9c1a09b09046e Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 18 Nov 2024 08:06:56 -0800 Subject: [PATCH 273/529] clarify units --- components/eam/src/physics/cam/gw_convect.F90 | 10 +++++++--- components/eam/src/physics/cam/gw_drag.F90 | 6 +++--- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/components/eam/src/physics/cam/gw_convect.F90 b/components/eam/src/physics/cam/gw_convect.F90 index 1e6f9b6a75a..dff87eec89c 100644 --- a/components/eam/src/physics/cam/gw_convect.F90 +++ b/components/eam/src/physics/cam/gw_convect.F90 @@ -33,7 +33,7 @@ module gw_convect subroutine gw_convect_init( plev_src_wind, mfcc_in, errstring) use ref_pres, only: pref_edge - real(r8), intent(in) :: plev_src_wind ! previously hardcoded to 70000._r8 + real(r8), intent(in) :: plev_src_wind ! reference pressure value [Pa] to set k_src_wind (previously hardcoded to 70000._r8) real(r8), intent(in) :: mfcc_in(:,:,:) ! Source spectra to keep as table character(len=*), intent(out) :: errstring ! Report any errors from this routine integer :: ierr @@ -153,8 +153,12 @@ subroutine gw_beres_src(ncol, ngwv, lat, u, v, netdt, & integer :: shift ! fixed parameters (we may want to expose these in the namelist for tuning) - real(r8), parameter :: tau_avg_length = 1.0e5_r8 ! spectrum averaging length - real(r8), parameter :: heating_altitude_max = 20e3 ! max altitude to check heating (probably don't need this) + real(r8), parameter :: tau_avg_length = 100e3 ! spectrum averaging length [m] + real(r8), parameter :: heating_altitude_max = 20e3 ! max altitude [m] to check for max heating + + ! note: the heating_altitude_max is probably not needed because there is + ! rarely any convective heating above this level and the performance impact + ! of skipping the iteration over higher levels is likely negilible. integer :: ndepth_pos integer :: ndepth_tot diff --git a/components/eam/src/physics/cam/gw_drag.F90 b/components/eam/src/physics/cam/gw_drag.F90 index 8b3fa5f4bab..ebbbaf80fe9 100644 --- a/components/eam/src/physics/cam/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw_drag.F90 @@ -119,9 +119,9 @@ module gw_drag logical :: history_amwg ! output the variables used by the AMWG diag package logical :: use_gw_convect_old ! switch to enable legacy behavior - real(r8) :: gw_convect_plev_src_wind ! reference pressure level for source wind for convective GWD - real(r8) :: gw_convect_hdepth_min ! minimum hdepth for for convective GWD spectrum lookup table - real(r8) :: gw_convect_storm_speed_min ! minimum convective storm speed for convective GWD + real(r8) :: gw_convect_plev_src_wind ! reference pressure level for source wind for convective GWD [Pa] + real(r8) :: gw_convect_hdepth_min ! minimum hdepth for for convective GWD spectrum lookup table [km] + real(r8) :: gw_convect_storm_speed_min ! minimum convective storm speed for convective GWD [m/s] !========================================================================== contains From 49c1786d20416e9366000e7f67af4567cdcd5d3b Mon Sep 17 00:00:00 2001 From: Darin Comeau Date: Tue, 19 Nov 2024 11:50:30 -0600 Subject: [PATCH 274/529] Turn on additional output for SORRMv3 mesh --- .../mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index f1ab05d2207..57e5bb29f1d 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -1138,6 +1138,7 @@ .false. +.true. .true. '0000-00-00_01:00:00' 'eddyProductVariablesOutput' @@ -1251,10 +1252,13 @@ .false. +.true. 'dt' 'conservationCheckOutput' .false. +.true. .false. +.true. .true. 'conservationCheckRestart' From b14506bb5699fed59d366d75551bcb05f449ce53 Mon Sep 17 00:00:00 2001 From: Darin Comeau Date: Tue, 19 Nov 2024 12:55:45 -0600 Subject: [PATCH 275/529] Change SORRMv3 ice runoff mapping --- cime_config/config_grids.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index b093285e59d..a6efa0287a0 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -5660,7 +5660,7 @@ - cpl/cpl6/map_r05_to_SOwISC12to30E3r3_cstmnn.r150e300.20240808.nc + cpl/cpl6/map_r05_to_SOwISC12to30E3r3_Ratio0.5_maxFlux0.001.Greenland100x+Antarctica100x.nc cpl/cpl6/map_r05_to_SOwISC12to30E3r3_cstmnn.r150e300.20240808.nc From 0b561561b03671776532e3be05d96811b748e8b5 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 15:24:45 -0700 Subject: [PATCH 276/529] progress --- .../src/physics/shoc/tests/CMakeLists.txt | 9 - .../shoc/tests/infra/shoc_test_data.cpp | 98 ++------- .../shoc/tests/infra/shoc_test_data.hpp | 100 --------- .../tests/shoc_aa_diag_third_moms_tests.cpp | 110 ---------- .../shoc_fterm_diag_third_moms_tests.cpp | 175 --------------- .../shoc_fterm_input_third_moms_tests.cpp | 112 ---------- .../tests/shoc_impli_sfc_fluxes_tests.cpp | 202 ------------------ .../tests/shoc_impli_srf_stress_tests.cpp | 131 ------------ .../shoc/tests/shoc_impli_srf_tke_tests.cpp | 101 --------- .../shoc_omega_diag_third_moms_tests.cpp | 106 --------- .../tests/shoc_w3_diag_third_moms_tests.cpp | 122 ----------- .../tests/shoc_xy_diag_third_moms_tests.cpp | 112 ---------- 12 files changed, 22 insertions(+), 1356 deletions(-) delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp delete mode 100644 components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp diff --git a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt index 72407a5fd0a..a5bd7d65796 100644 --- a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt @@ -8,9 +8,6 @@ set(SHOC_TESTS_SRCS shoc_diag_obklen_tests.cpp shoc_impli_comp_tmpi_tests.cpp shoc_impli_dp_inverse_tests.cpp - shoc_impli_sfc_fluxes_tests.cpp - shoc_impli_srf_stress_tests.cpp - shoc_impli_srf_tke_tests.cpp shoc_vertflux_tests.cpp shoc_varorcovar_tests.cpp shoc_energy_fixer_tests.cpp @@ -21,12 +18,6 @@ set(SHOC_TESTS_SRCS shoc_l_inf_length_tests.cpp shoc_check_length_tests.cpp shoc_mix_length_tests.cpp - shoc_fterm_input_third_moms_tests.cpp - shoc_fterm_diag_third_moms_tests.cpp - shoc_omega_diag_third_moms_tests.cpp - shoc_xy_diag_third_moms_tests.cpp - shoc_aa_diag_third_moms_tests.cpp - shoc_w3_diag_third_moms_tests.cpp shoc_clip_third_moms_tests.cpp shoc_tke_tests.cpp shoc_check_tke_tests.cpp diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index cae14bf7a35..cf95c6aea70 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -57,187 +57,133 @@ void shoc_energy_integrals(ShocEnergyIntegralsData& d) void calc_shoc_vertflux(CalcShocVertfluxData& d) { shoc_init(d.nlev); - //calc_shoc_vertflux_host(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); + calc_shoc_vertflux_host(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); } void calc_shoc_varorcovar(CalcShocVarorcovarData& d) { shoc_init(d.nlev); - //calc_shoc_varorcovar_host(d.shcol, d.nlev, d.nlevi, d.tunefac, d.isotropy_zi, d.tkh_zi, d.dz_zi, d.invar1, d.invar2, d.varorcovar); + calc_shoc_varorcovar_host(d.shcol, d.nlev, d.nlevi, d.tunefac, d.isotropy_zi, d.tkh_zi, d.dz_zi, d.invar1, d.invar2, d.varorcovar); } void compute_tmpi(ComputeTmpiData& d) { shoc_init(d.nlevi - 1); // nlev = nlevi - 1 - //compute_tmpi_host(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); + compute_tmpi_host(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); } void dp_inverse(DpInverseData& d) { shoc_init(d.nlev); - //dp_inverse_host(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); -} - -void sfc_fluxes(SfcFluxesData& d) -{ - shoc_init(1); // single layer function - //sfc_fluxes_host(d.shcol, d.num_tracer, d.dtime, d.rho_zi_sfc, d.rdp_zt_sfc, d.wthl_sfc, d.wqw_sfc, d.wtke_sfc, d.wtracer_sfc, d.thetal, d.qw, d.tke, d.wtracer); -} - -void impli_srf_stress_term(ImpliSrfStressTermData& d) -{ - shoc_init(1); // single layer function - //impli_srf_stress_term_host(d.shcol, d.rho_zi_sfc, d.uw_sfc, d.vw_sfc, d.u_wind_sfc, d.v_wind_sfc, d.ksrf); -} - -void tke_srf_flux_term(TkeSrfFluxTermData& d) -{ - shoc_init(1); // single layer function - //tke_srf_flux_term_host(d.shcol, d.uw_sfc, d.vw_sfc, d.wtke_sfc); + dp_inverse_host(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); } void integ_column_stability(IntegColumnStabilityData& d) { shoc_init(d.nlev); - //integ_column_stability_host(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); + integ_column_stability_host(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); } void check_tke(CheckTkeData& d) { shoc_init(d.nlev); - //check_tke_host(d.shcol, d.nlev, d.tke); + check_tke_host(d.shcol, d.nlev, d.tke); } void shoc_tke(ShocTkeData& d) { shoc_init(d.nlev); - //shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); + shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); } void compute_shr_prod(ComputeShrProdData& d) { shoc_init(d.nlev); - //compute_shr_prod_host(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); + compute_shr_prod_host(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); } void isotropic_ts(IsotropicTsData& d) { shoc_init(d.nlev); - //isotropic_ts_host(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); + isotropic_ts_host(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); } void adv_sgs_tke(AdvSgsTkeData& d) { shoc_init(d.nlev); - //adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); + adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); } void eddy_diffusivities(EddyDiffusivitiesData& d) { shoc_init(d.nlev); - //eddy_diffusivities_host(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); + eddy_diffusivities_host(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); } void shoc_length(ShocLengthData& d) { shoc_init(d.nlev); - //shoc_length_host(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); + shoc_length_host(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); } void compute_brunt_shoc_length(ComputeBruntShocLengthData& d) { shoc_init(d.nlev); - //compute_brunt_shoc_length_host(d.nlev, d.nlevi, d.shcol, d.dz_zt, d.thv, d.thv_zi, d.brunt); + compute_brunt_shoc_length_host(d.nlev, d.nlevi, d.shcol, d.dz_zt, d.thv, d.thv_zi, d.brunt); } void compute_l_inf_shoc_length(ComputeLInfShocLengthData& d) { shoc_init(d.nlev); - //compute_l_inf_shoc_length_host(d.nlev, d.shcol, d.zt_grid, d.dz_zt, d.tke, d.l_inf); + compute_l_inf_shoc_length_host(d.nlev, d.shcol, d.zt_grid, d.dz_zt, d.tke, d.l_inf); } void compute_shoc_mix_shoc_length(ComputeShocMixShocLengthData& d) { shoc_init(d.nlev); - //compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); + compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); } void check_length_scale_shoc_length(CheckLengthScaleShocLengthData& d) { shoc_init(d.nlev); - //check_length_scale_shoc_length_host(d.nlev, d.shcol, d.host_dx, d.host_dy, d.shoc_mix); -} - -void fterms_input_for_diag_third_shoc_moment(FtermsInputForDiagThirdShocMomentData& d) -{ - shoc_init(1); // single level function - //fterms_input_for_diag_third_shoc_moment_host(d.dz_zi, d.dz_zt, d.dz_zt_kc, d.isotropy_zi, d.brunt_zi, d.thetal_zi, &d.thedz, &d.thedz2, &d.iso, &d.isosqrd, &d.buoy_sgs2, &d.bet2); -} - -void aa_terms_diag_third_shoc_moment(AaTermsDiagThirdShocMomentData& d) -{ - shoc_init(1); // single level function - //aa_terms_diag_third_shoc_moment_host(d.omega0, d.omega1, d.omega2, d.x0, d.x1, d.y0, d.y1, &d.aa0, &d.aa1); -} - -void f0_to_f5_diag_third_shoc_moment(F0ToF5DiagThirdShocMomentData& d) -{ - shoc_init(1); // single level function - //f0_to_f5_diag_third_shoc_moment_host(d.thedz, d.thedz2, d.bet2, d.iso, d.isosqrd, d.wthl_sec, d.wthl_sec_kc, d.wthl_sec_kb, d.thl_sec_kc, d.thl_sec_kb, d.w_sec, d.w_sec_kc, d.w_sec_zi, d.tke, d.tke_kc, &d.f0, &d.f1, &d.f2, &d.f3, &d.f4, &d.f5); -} - -void omega_terms_diag_third_shoc_moment(OmegaTermsDiagThirdShocMomentData& d) -{ - shoc_init(1); // single level function - //omega_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f3, d.f4, &d.omega0, &d.omega1, &d.omega2); -} - -void x_y_terms_diag_third_shoc_moment(XYTermsDiagThirdShocMomentData& d) -{ - shoc_init(1); // single level function - //x_y_terms_diag_third_shoc_moment_host(d.buoy_sgs2, d.f0, d.f1, d.f2, &d.x0, &d.y0, &d.x1, &d.y1); -} - -void w3_diag_third_shoc_moment(W3DiagThirdShocMomentData& d) -{ - shoc_init(1); // single level function - //w3_diag_third_shoc_moment_host(d.aa0, d.aa1, d.x0, d.x1, d.f5, &d.w3); + check_length_scale_shoc_length_host(d.nlev, d.shcol, d.host_dx, d.host_dy, d.shoc_mix); } void clipping_diag_third_shoc_moments(ClippingDiagThirdShocMomentsData& d) { shoc_init(d.nlevi - 1); // nlev = nlevi - 1 - //clipping_diag_third_shoc_moments_host(d.nlevi, d.shcol, d.w_sec_zi, d.w3); + clipping_diag_third_shoc_moments_host(d.nlevi, d.shcol, d.w_sec_zi, d.w3); } void diag_second_moments_srf(DiagSecondMomentsSrfData& d) { shoc_init(1); // single level function - //shoc_diag_second_moments_srf_host(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); + shoc_diag_second_moments_srf_host(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); } void linear_interp(LinearInterpData& d) { shoc_init(d.km1); - //linear_interp_host(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); + linear_interp_host(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); } void diag_third_shoc_moments(DiagThirdShocMomentsData& d) { shoc_init(d.nlev); - //diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); + diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); } void compute_diag_third_shoc_moment(ComputeDiagThirdShocMomentData& d) { shoc_init(d.nlev); - //compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); + compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); } void shoc_assumed_pdf(ShocAssumedPdfData& d) { shoc_init(d.nlev); - //shoc_assumed_pdf_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); + shoc_assumed_pdf_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); } void shoc_assumed_pdf_tilde_to_real(ShocAssumedPdfTildeToRealData& d) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 745342a1d78..a751ed33b7f 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -195,49 +195,6 @@ struct DpInverseData : public PhysicsTestData { PTD_STD_DEF(DpInverseData, 2, shcol, nlev); }; -struct SfcFluxesData : public PhysicsTestData { - // Inputs - Int shcol, num_tracer; - Real dtime; - Real *rho_zi_sfc, *rdp_zt_sfc, *wthl_sfc, *wqw_sfc, *wtke_sfc, *wtracer_sfc; - - // Inputs/Outputs - Real *thetal, *qw, *tke, *wtracer; - - SfcFluxesData(Int shcol_, Int num_tracer_, Real dtime_) : - PhysicsTestData({{ shcol_ }, { shcol_, num_tracer_ }}, {{ &rho_zi_sfc, &rdp_zt_sfc, &wthl_sfc, &wqw_sfc, &wtke_sfc, &thetal, &qw, &tke }, { &wtracer_sfc, &wtracer }}), shcol(shcol_), num_tracer(num_tracer_), dtime(dtime_) {} - - PTD_STD_DEF(SfcFluxesData, 3, shcol, num_tracer, dtime); -}; - -struct ImpliSrfStressTermData : public PhysicsTestData { - // Inputs - Int shcol; - Real *rho_zi_sfc, *uw_sfc, *vw_sfc, *u_wind_sfc, *v_wind_sfc; - - // Outputs - Real *ksrf; - - ImpliSrfStressTermData(Int shcol_) : - PhysicsTestData({{ shcol_ }}, {{ &rho_zi_sfc, &uw_sfc, &vw_sfc, &u_wind_sfc, &v_wind_sfc, &ksrf }}), shcol(shcol_) {} - - PTD_STD_DEF(ImpliSrfStressTermData, 1, shcol); -}; - -struct TkeSrfFluxTermData : public PhysicsTestData { - // Inputs - Int shcol; - Real *uw_sfc, *vw_sfc; - - // Outputs - Real *wtke_sfc; - - TkeSrfFluxTermData(Int shcol_) : - PhysicsTestData({{ shcol_ }}, {{ &uw_sfc, &vw_sfc, &wtke_sfc }}), shcol(shcol_) {} - - PTD_STD_DEF(TkeSrfFluxTermData, 1, shcol); -}; - struct IntegColumnStabilityData : public PhysicsTestData { // Inputs Int shcol, nlev; @@ -431,54 +388,6 @@ struct CheckLengthScaleShocLengthData : public PhysicsTestData { PTD_STD_DEF(CheckLengthScaleShocLengthData, 2, shcol, nlev); }; -struct FtermsInputForDiagThirdShocMomentData { - // Inputs - Real dz_zi, dz_zt, dz_zt_kc, isotropy_zi, brunt_zi, thetal_zi; - - // Outputs - Real thedz, thedz2, iso, isosqrd, buoy_sgs2, bet2; -}; - -struct AaTermsDiagThirdShocMomentData { - // Inputs - Real omega0, omega1, omega2, x0, x1, y0, y1; - - // Outputs - Real aa0, aa1; -}; - -struct F0ToF5DiagThirdShocMomentData { - // Inputs - Real thedz, thedz2, bet2, iso, isosqrd, wthl_sec, wthl_sec_kc, wthl_sec_kb, thl_sec_kc, thl_sec_kb, w_sec, w_sec_kc, w_sec_zi, tke, tke_kc; - - // Outputs - Real f0, f1, f2, f3, f4, f5; -}; - -struct OmegaTermsDiagThirdShocMomentData { - // Inputs - Real buoy_sgs2, f3, f4; - - // Outputs - Real omega0, omega1, omega2; -}; - -struct XYTermsDiagThirdShocMomentData { - // Inputs - Real buoy_sgs2, f0, f1, f2; - - // Outputs - Real x0, y0, x1, y1; -}; - -struct W3DiagThirdShocMomentData { - // Inputs - Real aa0, aa1, x0, x1, f5; - - // Outputs - Real w3; -}; - struct ClippingDiagThirdShocMomentsData : public PhysicsTestData { // Inputs Int shcol, nlevi; @@ -1035,9 +944,6 @@ void calc_shoc_vertflux (CalcShocVertfluxData& d); void calc_shoc_varorcovar (CalcShocVarorcovarData& d); void compute_tmpi (ComputeTmpiData& d); void dp_inverse (DpInverseData& d); -void sfc_fluxes (SfcFluxesData& d); -void impli_srf_stress_term (ImpliSrfStressTermData& d); -void tke_srf_flux_term (TkeSrfFluxTermData& d); void integ_column_stability (IntegColumnStabilityData& d); void check_tke (CheckTkeData& d); void shoc_tke (ShocTkeData& d); @@ -1050,12 +956,6 @@ void compute_brunt_shoc_length (ComputeBruntShocLengthData& void compute_l_inf_shoc_length (ComputeLInfShocLengthData& d); void compute_shoc_mix_shoc_length (ComputeShocMixShocLengthData& d); void check_length_scale_shoc_length (CheckLengthScaleShocLengthData& d); -void fterms_input_for_diag_third_shoc_moment (FtermsInputForDiagThirdShocMomentData& d); -void aa_terms_diag_third_shoc_moment (AaTermsDiagThirdShocMomentData& d); -void f0_to_f5_diag_third_shoc_moment (F0ToF5DiagThirdShocMomentData& d); -void omega_terms_diag_third_shoc_moment (OmegaTermsDiagThirdShocMomentData& d); -void x_y_terms_diag_third_shoc_moment (XYTermsDiagThirdShocMomentData& d); -void w3_diag_third_shoc_moment (W3DiagThirdShocMomentData& d); void clipping_diag_third_shoc_moments (ClippingDiagThirdShocMomentsData& d); void diag_second_moments_srf (DiagSecondMomentsSrfData& d); void linear_interp (LinearInterpData& d); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp deleted file mode 100644 index 7c8223f3530..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_aa_diag_third_moms_tests.cpp +++ /dev/null @@ -1,110 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestAAdiagThirdMoms { - - static void run_property() - { - - // Tests for the SHOC function: - // aa_terms_diag_third_shoc_moment - - // Run test two times. One where 0 parameters stay the same - // and the other where 1 parameters vary. Verify that the aa0 - // term remains constant between the two tests. - - // omega0 term - constexpr static Real omega0 = 7.54e-2; - // omega1 term - constexpr static Real omega1 = 5.37e-3; - // omega2 term - constexpr static Real omega2 = 0.54; - // x0 term - constexpr static Real x0 = -4.31; - // y0 term - constexpr static Real y0 = 22.72; - // x1 term - constexpr static Real x1_test1a = 41.05; - // y1 term - constexpr static Real y1_test1a = 375.69; - - // Initialize data structure for bridging to F90 - AaTermsDiagThirdShocMomentData SDS; - - // Load up the data - SDS.omega0 = omega0; - SDS.x0 = x0; - SDS.y0 = y0; - SDS.omega1 = omega1; - SDS.x1 = x1_test1a; - SDS.y1 = y1_test1a; - SDS.omega2 = omega2; - - // Call the fortran implementation - aa_terms_diag_third_shoc_moment(SDS); - - // Save the output - Real aa0_test1a = SDS.aa0; - Real aa1_test1a = SDS.aa1; - - // Load up data where only the 1 terms have varies - SDS.x1 = 0.3*x1_test1a; - SDS.y1 = 0.3*y1_test1a; - - // Call the fortran implementation - aa_terms_diag_third_shoc_moment(SDS); - - // Check the result - REQUIRE(SDS.aa0 == aa0_test1a); - REQUIRE(SDS.aa1 < aa1_test1a); - - } - - static void run_bfb() - { - // TODO - } - -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace{ - -TEST_CASE("shoc_aa_diag_third_moms_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestAAdiagThirdMoms; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_aa_diag_third_moms_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestAAdiagThirdMoms; - - TestStruct::run_bfb(); - -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp deleted file mode 100644 index df99a555382..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_fterm_diag_third_moms_tests.cpp +++ /dev/null @@ -1,175 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestFtermdiagThirdMoms { - - static void run_property() - { - - // Tests for the SHOC function: - // f0_to_f5_diag_third_shoc_moment - - // TEST ONE - // Zero test. Given no gradients, verify that relevant - // terms are zero. - - // 1/grid spacing [m-1] - constexpr static Real thedz = 0.1; - // 1/grid spacing for two grids [m-1] - constexpr static Real thedz2 = 0.05; - // bet2 term (ggr/thetal) - constexpr static Real bet2 = 0.0327; - // return to isotropy timescale [s] - constexpr static Real iso = 1000; - // liquid water flux [K m/s] - constexpr static Real wthl_sec_zero = 0.01; - // thetal variance [K^2] - constexpr static Real thl_sec_zero = 2; - // vertical velocity variance [m2/s2] - constexpr static Real w_sec_zero = 0.4; - // TKE [m2/s2] - constexpr static Real tke_zero = 0.5; - - // Initialize data structure for bridging to F90 - F0ToF5DiagThirdShocMomentData SDS; - - // Fill in data - SDS.thedz = thedz; - SDS.thedz2 = thedz2; - SDS.bet2 = bet2; - SDS.iso = iso; - SDS.isosqrd = iso*iso; - // for the following moments, feed each level - // the same value for this test - SDS.wthl_sec = wthl_sec_zero; - SDS.wthl_sec_kc = wthl_sec_zero; - SDS.wthl_sec_kb = wthl_sec_zero; - SDS.thl_sec_kc = thl_sec_zero; - SDS.thl_sec_kb = thl_sec_zero; - SDS.w_sec = w_sec_zero; - SDS.w_sec_kc = w_sec_zero; - SDS.w_sec_zi = w_sec_zero; - SDS.tke = tke_zero; - SDS.tke_kc = tke_zero; - - // Be sure inputs are as we expect - REQUIRE(SDS.thedz > 0); - REQUIRE(SDS.thedz2 > 0); - REQUIRE(SDS.wthl_sec_kc == SDS.wthl_sec_kb); - REQUIRE(SDS.thl_sec_kc == SDS.thl_sec_kb); - REQUIRE(SDS.w_sec_kc == SDS.w_sec); - REQUIRE(SDS.tke_kc == SDS.tke); - - // Call the fortran implementation - f0_to_f5_diag_third_shoc_moment(SDS); - - // Check result, make sure all outputs are zero - REQUIRE(SDS.f0 == 0); - REQUIRE(SDS.f1 == 0); - REQUIRE(SDS.f2 == 0); - REQUIRE(SDS.f3 == 0); - REQUIRE(SDS.f4 == 0); - REQUIRE(SDS.f5 == 0); - - // TEST TWO - // Positive gradient test. Feed the function values of the second - // moments with positive gradients. All fterms should have positive values - - // liquid water flux [K m/s] - constexpr static Real wthl_sec = 0.01; - // liquid water flux [K m/s] above - constexpr static Real wthl_sec_kc = 0.02; - // liquid water flux [K m/s] below - constexpr static Real wthl_sec_kb = 0; - // thetal variance [K^2] above - constexpr static Real thl_sec_kc = 2.5; - // thetal variance [K^2] - constexpr static Real thl_sec_kb = 1.7; - // vertical velocity variance [m2/s2] - constexpr static Real w_sec = 0.4; - // vertical velocity variance [m2/s2] above - constexpr static Real w_sec_kc = 0.5; - // TKE [m2/s2] - constexpr static Real tke = 0.5; - // TKE [m2/s2] above - constexpr static Real tke_kc = 0.55; - - // Feed in data - SDS.wthl_sec = wthl_sec; - SDS.wthl_sec_kc = wthl_sec_kc; - SDS.wthl_sec_kb = wthl_sec_kb; - SDS.thl_sec_kc = thl_sec_kc; - SDS.thl_sec_kb = thl_sec_kb; - SDS.w_sec = w_sec; - SDS.w_sec_kc = w_sec_kc; - SDS.w_sec_zi = w_sec; - SDS.tke = tke; - SDS.tke_kc = tke_kc; - - // Verify input is what we want for this test - REQUIRE(wthl_sec > 0); - REQUIRE(wthl_sec_kc > wthl_sec_kb); - REQUIRE(thl_sec_kc > thl_sec_kb); - REQUIRE(w_sec_kc > w_sec); - REQUIRE(tke_kc > tke); - - // Call the fortran implementation - f0_to_f5_diag_third_shoc_moment(SDS); - - // Check result, make sure all outputs are greater than zero - REQUIRE(SDS.f0 > 0); - REQUIRE(SDS.f1 > 0); - REQUIRE(SDS.f2 > 0); - REQUIRE(SDS.f3 > 0); - REQUIRE(SDS.f4 > 0); - REQUIRE(SDS.f5 > 0); - - } - - static void run_bfb() - { - // TODO - } - -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace{ - -TEST_CASE("shoc_fterm_diag_third_moms_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestFtermdiagThirdMoms; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_fterm_diag_third_moms_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestFtermdiagThirdMoms; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp deleted file mode 100644 index e724cfe07d8..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_fterm_input_third_moms_tests.cpp +++ /dev/null @@ -1,112 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestFtermInputThirdMoms { - - static void run_property() - { - - // Tests for the SHOC function: - // fterms_input_for_diag_third_shoc_moment - - // TEST - // Given inputs, verify that output is reasonable - - // grid spacing on interface grid [m] - constexpr static Real dz_zi = 100; - // grid spacing on midpoint grid [m] - constexpr static Real dz_zt = 80; - // grid spacing on adjacent midpoint grid [m] - constexpr static Real dz_zt_kc = 120; - // Return to isotropic timescale [s] - constexpr static Real isotropy_zi = 1000; - // Brunt vaisalla frequency [s] - constexpr static Real brunt_zi = -0.05; - // Potential temperature on interface grid [K] - constexpr static Real thetal_zi = 300; - - // Initialize data structure for bridging to F90 - FtermsInputForDiagThirdShocMomentData SDS; - - SDS.dz_zi = dz_zi; - SDS.dz_zt = dz_zt; - SDS.dz_zt_kc = dz_zt_kc; - SDS.isotropy_zi = isotropy_zi; - SDS.brunt_zi = brunt_zi; - SDS.thetal_zi = thetal_zi; - - // Check that input is physical - REQUIRE(SDS.dz_zi > 0); - REQUIRE(SDS.dz_zt > 0); - REQUIRE(SDS.dz_zt_kc > 0); - REQUIRE(SDS.isotropy_zi > 0); - REQUIRE(SDS.thetal_zi > 0); - - // Call the fortran implementation - fterms_input_for_diag_third_shoc_moment(SDS); - - // Verify the result - - // Check that thedz2 is smaller than thedz. - REQUIRE(SDS.thedz2 < SDS.thedz); - - // Check that bet2 is smaller than thetal - REQUIRE(SDS.bet2 < SDS.thetal_zi); - - // Be sure that iso and isosqrd relationships hold - if (SDS.isotropy_zi > 1){ - REQUIRE(SDS.isosqrd > SDS.iso); - } - else{ - REQUIRE(SDS.isosqrd < SDS.iso); - } - - } - - static void run_bfb() - { - // TODO - } - -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace{ - -TEST_CASE("shoc_fterm_input_third_moms_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestFtermInputThirdMoms; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_fterm_input_third_moms_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestFtermInputThirdMoms; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp deleted file mode 100644 index 2b2942e7a3d..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_sfc_fluxes_tests.cpp +++ /dev/null @@ -1,202 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestImpSfcFluxes { - - static void run_property() - { - static constexpr Int shcol = 5; - static constexpr Int num_tracer = 10; - - // Tests for the SHOC subroutine - // sfc_fluxes - - // TEST - // Feed in several columns worth of data and make sure - // the output is consistent. - - // Surface density on the zi grid [kg/m3] - static constexpr Real rho_zi_sfc[shcol] = {1.2, 1.0, 0.9, 1.1, 1.15}; - // Rdp value on zt grid [ms^2/kg], same for all columns - static constexpr Real rdp_zt_sfc = 8.5e-3; - // heat flux at surface [K m/s] - static constexpr Real wthl_sfc[shcol] = {0.03, -0.03, 0.1, 0, -0.1}; - // moisture flux at surface [kg/kg m/s] - static constexpr Real wqw_sfc[shcol] = {2e-5, 1e-6, 0, -2e-5, 1e-4}; - // TKE flux at the surface [m3/s3] - static constexpr Real wtke_sfc[shcol] = {4e-2, 1e-3, -2e-3, 0, -1e-3}; - - // Supply input values - // liquid water potential temperature [K] - static constexpr Real thetal_in = 300; - // total water mixing ratio [kg/kg] - static constexpr Real qw_in = 0.015; - // turbulent kinetic energy [m2/s2] - static constexpr Real tke_in = 0.4; - - // time step [s] - static constexpr Real dtime = 300; - - // Input for tracer (no units) - Real tracer_in[num_tracer]; - - // Feed tracer random data from 1 to 1000 - for(Int t = 0; t < num_tracer; ++t) { - tracer_in[t] = rand()% 1000 + 1; - } - - // Initialize data structure for bridging to F90 - SfcFluxesData SDS(shcol, num_tracer, dtime); - - // Test that the inputs are reasonable. - REQUIRE(SDS.shcol == shcol); - REQUIRE(SDS.num_tracer == num_tracer); - REQUIRE(shcol > 1); - - // Fill in test data, column only - for(Int s = 0; s < shcol; ++s) { - SDS.rho_zi_sfc[s] = rho_zi_sfc[s]; - SDS.rdp_zt_sfc[s] = rdp_zt_sfc; - SDS.wthl_sfc[s] = wthl_sfc[s]; - SDS.wqw_sfc[s] = wqw_sfc[s]; - SDS.wtke_sfc[s] = wtke_sfc[s]; - - SDS.thetal[s] = thetal_in; - SDS.qw[s] = qw_in; - SDS.tke[s] = tke_in; - - for (Int t = 0; t < num_tracer; ++t){ - const auto offset = t + s * num_tracer; - SDS.wtracer[offset] = tracer_in[t]; - // Feed tracer flux random data from -100 to 100 - // note this is different for every point - SDS.wtracer_sfc[offset] = rand()% 200 + (-100); - } - - } - - // Check that the inputs make sense - for(Int s = 0; s < shcol; ++s) { - REQUIRE( (SDS.thetal[s] > 150 && SDS.thetal[s] < 350) ); - REQUIRE( (SDS.qw[s] > 0.0001 && SDS.qw[s] < 0.05) ); - REQUIRE( (SDS.tke[s] > 0 && SDS.tke[s] < 10) ); - REQUIRE( (SDS.rdp_zt_sfc[s] > 0 && SDS.rdp_zt_sfc[s] < 1) ); - REQUIRE( (SDS.rho_zi_sfc[s] > 0 && SDS.rho_zi_sfc[s] < 2) ); - REQUIRE(std::abs(SDS.wthl_sfc[s]) < 1); - REQUIRE(std::abs(SDS.wqw_sfc[s]) < 1e-3); - REQUIRE(std::abs(SDS.wtke_sfc[s]) < 0.1); - REQUIRE(SDS.dtime > 0); - } - - // Call the fortran implementation - sfc_fluxes(SDS); - - // Verify that output is reasonable - for(Int s = 0; s < shcol; ++s) { - - // Verify output falls within reasonable bounds - REQUIRE( (SDS.thetal[s] > 150 && SDS.thetal[s] < 350) ); - REQUIRE( (SDS.qw[s] > 0.0001 && SDS.qw[s] < 0.05) ); - REQUIRE( (SDS.tke[s] > 0 && SDS.tke[s] < 10) ); - - // Based on surface flux input, make sure that - // temperature, moisture, and tke all have output - // that is expected with respect to the input - - // Check temperature - if (wthl_sfc[s] > 0){ - REQUIRE(SDS.thetal[s] > thetal_in); - } - else if (wthl_sfc[s] < 0){ - REQUIRE(SDS.thetal[s] < thetal_in); - } - else{ - REQUIRE(SDS.thetal[s] == thetal_in); - } - - // Check moisture - if (wqw_sfc[s] > 0){ - REQUIRE(SDS.qw[s] > qw_in); - } - else if (wqw_sfc[s] < 0){ - REQUIRE(SDS.qw[s] < qw_in); - } - else{ - REQUIRE(SDS.qw[s] == qw_in); - } - - // Check TKE - if (wtke_sfc[s] > 0){ - REQUIRE(SDS.tke[s] > tke_in); - } - else if (wtke_sfc[s] < 0){ - REQUIRE(SDS.tke[s] < tke_in); - } - else{ - REQUIRE(SDS.tke[s] == tke_in); - } - - // Check tracer - for (Int t = 0; t < num_tracer; ++t){ - const auto offset = t + s * num_tracer; - if (SDS.wtracer_sfc[offset] > 0){ - REQUIRE(SDS.wtracer[offset] > tracer_in[t]); - } - else if (SDS.wtracer_sfc[offset] < 0){ - REQUIRE(SDS.wtracer[offset] < tracer_in[t]); - } - else{ - REQUIRE(SDS.wtracer[offset] == tracer_in[t]); - } - } - - } - - } - - static void run_bfb() - { - // TODO - } -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace { - -TEST_CASE("shoc_imp_sfc_fluxes_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpSfcFluxes; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_imp_sfc_fluxes_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpSfcFluxes; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp deleted file mode 100644 index 786d4ade1f8..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_stress_tests.cpp +++ /dev/null @@ -1,131 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestImpSfcStress { - - static void run_property() - { - static constexpr Int shcol = 5; - - // Tests for the SHOC subroutine - // impli_srf_stress_term - - // TEST ONE - // Feed in several columns worth of data and make sure - // the output is consistent. - - // Surface density on the zi grid [kg/m3] - static constexpr Real rho_zi_sfc[shcol] = {1.2, 1.0, 0.9, 1.1, 1.15}; - // Surface moment flux, zonal direction [m3/s3] - static constexpr Real uw_sfc[shcol] = {0.03, -0.03, 0.1, 0, -0.1}; - // Surface moment flux, meridional direction [m3/s3] - static constexpr Real vw_sfc[shcol] = {-0.01, -0.01, 0.3, 0, -0.3}; - // Surface wind, zonal direction [m/s] - static constexpr Real u_wind_sfc[shcol] = {5, -5, 0, 2, -10}; - // Surface wind, meridional direction [m/s] - static constexpr Real v_wind_sfc[shcol] = {-10, 2, 20, 0, 1}; - - // Initialize data structure for bridging to F90 - ImpliSrfStressTermData SDS(shcol); - - // Test that the inputs are reasonable. - REQUIRE(SDS.shcol == shcol); - REQUIRE(shcol > 1); - - // Fill in test data, column only - for(Int s = 0; s < shcol; ++s) { - SDS.rho_zi_sfc[s] = rho_zi_sfc[s]; - SDS.uw_sfc[s] = uw_sfc[s]; - SDS.vw_sfc[s] = vw_sfc[s]; - SDS.u_wind_sfc[s] = u_wind_sfc[s]; - SDS.v_wind_sfc[s] = v_wind_sfc[s]; - } - - // Call the fortran implementation - impli_srf_stress_term(SDS); - - // Verify that output is reasonable - for(Int s = 0; s < shcol; ++s) { - // term should be greater than zero and less than one given - // reasonable input values - REQUIRE( (SDS.ksrf[s] > 0 && SDS.ksrf[s] < 1) ); - } - - // TEST TWO - // Given inputs that are identical but the absolute value of - // the surface fluxes are INCREASING, verify ksrf value is larger. - // Can recycle input from surface fluxes from last test. - - // Fill in test data, column only - for(Int s = 0; s < shcol; ++s) { - SDS.rho_zi_sfc[s] = 1.2; // density [kg/m3] - SDS.u_wind_sfc[s] = 5; // zonal wind [m/s] - SDS.v_wind_sfc[s] = -10; // meridional wind [m/s] - } - - // Call the fortran implementation - impli_srf_stress_term(SDS); - - Real stress1, stress2; - // Verify that output is as expected and reasonable - for(Int s = 0; s < shcol; ++s) { - // term should be greater than zero and less than one given - // reasonable input values - REQUIRE( (SDS.ksrf[s] > 0 && SDS.ksrf[s] < 1) ); - if (s < shcol-1){ - stress1 = uw_sfc[s]*uw_sfc[s] + uw_sfc[s]*uw_sfc[s]; - stress2 = uw_sfc[s+1]*uw_sfc[s+1] + uw_sfc[s+1]*uw_sfc[s+1]; - if (stress1 > stress2){ - REQUIRE(SDS.ksrf[s] > SDS.ksrf[s+1]); - } - } - } - - } - - static void run_bfb() - { - // TODO - } -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace { - -TEST_CASE("shoc_imp_sfc_stress_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpSfcStress; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_imp_sfc_stress_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpSfcStress; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp deleted file mode 100644 index 4dd4b89e86b..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_srf_tke_tests.cpp +++ /dev/null @@ -1,101 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestImpTkeSfcStress { - - static void run_property() - { - static constexpr Int shcol = 5; - - // Tests for the SHOC subroutine - // impli_srf_stress_term - - // TEST ONE - // Feed in several columns worth of data and make sure - // the output is consistent. Make sure that columns with higher - // surface stress result in greater surface tke flux. - - // Surface moment flux, zonal direction [m3/s3] - static constexpr Real uw_sfc[shcol] = {0.03, -0.03, 0.1, 0, -0.1}; - // Surface moment flux, meridional direction [m3/s3] - static constexpr Real vw_sfc[shcol] = {-0.01, -0.01, 0.3, 0, -0.3}; - - // Initialize data structure for bridging to F90 - TkeSrfFluxTermData SDS(shcol); - - // Test that the inputs are reasonable. - REQUIRE(SDS.shcol == shcol); - REQUIRE(shcol > 1); - - // Fill in test data, column only - for(Int s = 0; s < shcol; ++s) { - SDS.uw_sfc[s] = uw_sfc[s]; - SDS.vw_sfc[s] = vw_sfc[s]; - } - - // Call the fortran implementation - tke_srf_flux_term(SDS); - - Real stress1, stress2; - // Verify that output is as expected and reasonable - for(Int s = 0; s < shcol; ++s) { - // term should be greater than zero and less than one given - // reasonable input values - REQUIRE(SDS.wtke_sfc[s] > 0); - if (s < shcol-1){ - stress1 = uw_sfc[s]*uw_sfc[s] + uw_sfc[s]*uw_sfc[s]; - stress2 = uw_sfc[s+1]*uw_sfc[s+1] + uw_sfc[s+1]*uw_sfc[s+1]; - if (stress1 > stress2){ - REQUIRE(SDS.wtke_sfc[s] > SDS.wtke_sfc[s+1]); - } - } - } - - } - - static void run_bfb() - { - // TODO - } -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace { - -TEST_CASE("shoc_imp_tkesfc_stress_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpTkeSfcStress; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_imp_tkesfc_stress_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestImpTkeSfcStress; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp deleted file mode 100644 index 45828793358..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_omega_diag_third_moms_tests.cpp +++ /dev/null @@ -1,106 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestOmegadiagThirdMoms { - - static void run_property() - { - - // Tests for the SHOC function: - // omega_terms_diag_third_shoc_moment - - // TEST ONE - // Call the function twice, with two different sets of terms. - // In the second test the fterms should be larger. Verify - // that the omega0 and omega1 terms are the same, but that the - // omega2 term has increased. - - // buoyancy term (isotropy squared * brunt vaisalla frequency) - constexpr static Real buoy_sgs2 = -100; - // f3 term - constexpr static Real f3_test1a = 14; - // f4 term - constexpr static Real f4_test1a = 5; - - // Initialize data structure for bridging to F90 - OmegaTermsDiagThirdShocMomentData SDS; - - // Load up the data - SDS.buoy_sgs2 = buoy_sgs2; - SDS.f3 = f3_test1a; - SDS.f4 = f4_test1a; - - // Call the fortran implementation - omega_terms_diag_third_shoc_moment(SDS); - - // Save test results - Real omega0_test1a = SDS.omega0; - Real omega1_test1a = SDS.omega1; - Real omega2_test1a = SDS.omega2; - - // Now load up data for second part of test - // Feed in LARGER values - SDS.f3 = 2*f3_test1a; - SDS.f4 = 2*f4_test1a; - - // Call the fortran implementation - omega_terms_diag_third_shoc_moment(SDS); - - // Now check the result - - // omega0 and omega1 should NOT have changed - REQUIRE(SDS.omega0 == omega0_test1a); - REQUIRE(SDS.omega1 == omega1_test1a); - - // omega2 should have increased - REQUIRE(SDS.omega2 > omega2_test1a); - - } - - static void run_bfb() - { - // TODO - } - -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace{ - -TEST_CASE("shoc_omega_diag_third_moms_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestOmegadiagThirdMoms; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_omega_diag_third_moms_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestOmegadiagThirdMoms; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp deleted file mode 100644 index af1f7c468db..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_w3_diag_third_moms_tests.cpp +++ /dev/null @@ -1,122 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestW3diagThirdMoms { - - static void run_property() - { - - // Tests for the SHOC function: - // w3_diag_third_shoc_moment - - // TEST ONE - // Do series of tests to make sure output is as expected - - // aa0 term - constexpr static Real aa0_test1 = -0.2; - // aa1 term - constexpr static Real aa1_test1 = 5.65; - // x0 term - constexpr static Real x0_test1 = -4.31; - // y0 term - constexpr static Real x1_test1 = 41.05; - // f5 term - constexpr static Real f5_test1 = 4; - - // Initialize data structure for bridging to F90 - W3DiagThirdShocMomentData SDS; - - // Load up the data - SDS.aa0 = aa0_test1; - SDS.aa1 = aa1_test1; - SDS.x0 = x0_test1; - SDS.x1 = x1_test1; - SDS.f5 = f5_test1; - - // Call the fortran implementation - w3_diag_third_shoc_moment(SDS); - - // Verify result is negative - REQUIRE(SDS.w3 < 0); - - // TEST TWO - // Modify parameters to decrease w3 - // decrease this term - constexpr static Real aa1_test2 = 2.65; - - SDS.aa1 = aa1_test2; - - // Call the fortran implementation - w3_diag_third_shoc_moment(SDS); - - // Verify result has decreased - REQUIRE(SDS.w3 < SDS.aa1); - - // TEST THREE - // Modify parameters to get positive result - // x0 term - constexpr static Real x0_test3 = -4.31; - // y0 term - constexpr static Real x1_test3 = -41.05; - // f5 term - constexpr static Real f5_test3 = -4; - - SDS.x0 = x0_test3; - SDS.x1 = x1_test3; - SDS.f5 = f5_test3; - - // Call the fortran implementation - w3_diag_third_shoc_moment(SDS); - - // Verify the result is positive - REQUIRE(SDS.w3 > 0); - - } - - static void run_bfb() - { - // TODO - } - -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace{ - -TEST_CASE("shoc_w3_diag_third_moms_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestW3diagThirdMoms; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_w3_diag_third_moms_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestW3diagThirdMoms; - - TestStruct::run_bfb(); -} - -} // namespace diff --git a/components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp deleted file mode 100644 index 18b75639928..00000000000 --- a/components/eamxx/src/physics/shoc/tests/shoc_xy_diag_third_moms_tests.cpp +++ /dev/null @@ -1,112 +0,0 @@ -#include "catch2/catch.hpp" - -#include "shoc_unit_tests_common.hpp" -#include "shoc_functions.hpp" -#include "shoc_test_data.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/scream_types.hpp" - -#include "ekat/ekat_pack.hpp" -#include "ekat/util/ekat_arch.hpp" -#include "ekat/kokkos/ekat_kokkos_utils.hpp" - -#include -#include -#include -#include - -namespace scream { -namespace shoc { -namespace unit_test { - -template -struct UnitWrap::UnitTest::TestXYdiagThirdMoms { - - static void run_property() - { - - // Tests for the SHOC function: - // x_y_terms_diag_third_shoc_moment - - // TEST ONE - // Call the function twice, with two different sets of terms. - // In the second test the fterms should be larger. Verify - // that the x0 and y0 terms are the same, but that the - // x1 and y1 terms have increased. - - // buoyancy term (isotropy squared * brunt vaisalla frequency) - constexpr static Real buoy_sgs2 = -100; - // f0 term - constexpr static Real f0_test1a = 13000; - // f3 term - constexpr static Real f1_test1a = 8500; - // f4 term - constexpr static Real f2_test1a = 30; - - // Initialize data structure for bridging to F90 - XYTermsDiagThirdShocMomentData SDS; - - // Load up the data - SDS.buoy_sgs2 = buoy_sgs2; - SDS.f0 = f0_test1a; - SDS.f1 = f1_test1a; - SDS.f2 = f2_test1a; - - // Call the fortran implementation - x_y_terms_diag_third_shoc_moment(SDS); - - // Save test results - Real x0_test1a = SDS.x0; - Real y0_test1a = SDS.y0; - Real x1_test1a = SDS.x1; - Real y1_test1a = SDS.y1; - - // Now load up data for second part of test - // Feed in LARGER values - SDS.f0 = 1.2*f0_test1a; - SDS.f1 = 1.2*f1_test1a; - SDS.f2 = 1.2*f2_test1a; - - // Call the fortran implementation - x_y_terms_diag_third_shoc_moment(SDS); - - // Now check the result - - // x0 and y0 terms should NOT have changed - REQUIRE(SDS.x0 == x0_test1a); - REQUIRE(SDS.y0 == y0_test1a); - - // x1 and y1 terms should have increased - REQUIRE(SDS.x1 > x1_test1a); - REQUIRE(SDS.y1 > y1_test1a); - - } - - static void run_bfb() - { - // TODO - } - -}; - -} // namespace unit_test -} // namespace shoc -} // namespace scream - -namespace{ - -TEST_CASE("shoc_xy_diag_third_moms_property", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestXYdiagThirdMoms; - - TestStruct::run_property(); -} - -TEST_CASE("shoc_xy_diag_third_moms_bfb", "shoc") -{ - using TestStruct = scream::shoc::unit_test::UnitWrap::UnitTest::TestXYdiagThirdMoms; - - TestStruct::run_bfb(); -} - -} // namespace From 9a0e9a63bc50db5f69e13297f15eb595032d51ea Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 15:48:07 -0700 Subject: [PATCH 277/529] shoc_pdf_vv_parameters --- .../shoc/tests/infra/shoc_test_data.cpp | 53 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 7 ++- .../tests/shoc_pdf_vv_parameters_tests.cpp | 1 + 3 files changed, 58 insertions(+), 3 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index cf95c6aea70..c1028d4b1a9 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -189,13 +189,13 @@ void shoc_assumed_pdf(ShocAssumedPdfData& d) void shoc_assumed_pdf_tilde_to_real(ShocAssumedPdfTildeToRealData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_tilde_to_real_host(d.w_first, d.sqrtw2, &d.w1); + shoc_assumed_pdf_tilde_to_real_host(d.w_first, d.sqrtw2, &d.w1); } void shoc_assumed_pdf_vv_parameters(ShocAssumedPdfVvParametersData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_vv_parameters_host(d.w_first, d.w_sec, d.w3var, &d.skew_w, &d.w1_1, &d.w1_2, &d.w2_1, &d.w2_2, &d.a); + shoc_assumed_pdf_vv_parameters_host(d.w_first, d.w_sec, d.w3var, d.w_tol_sqd, &d.skew_w, &d.w1_1, &d.w1_2, &d.w2_1, &d.w2_2, &d.a); } void shoc_assumed_pdf_thl_parameters(ShocAssumedPdfThlParametersData& d) @@ -3096,5 +3096,54 @@ void compute_shoc_temperature_host(Int shcol, Int nlev, Real *thetal, Real *ql, ekat::device_to_host({tabs}, shcol, nlev, out_views); } +void shoc_assumed_pdf_tilde_to_real_host(Real w_first, Real sqrtw2, Real* w1) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 1); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Real local_w1(*w1); + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack sqrtw2_(sqrtw2), w1_(local_w1), w_first_(w_first); + SHF::shoc_assumed_pdf_tilde_to_real(w_first_, sqrtw2_, w1_); + t_d(0) = w1_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *w1 = t_h(0); +} + +void shoc_assumed_pdf_vv_parameters_host(Real w_first, Real w_sec, Real w3var, Real w_tol_sqd, Real* skew_w, Real* w1_1, Real* w1_2, Real* w2_1, Real* w2_2, Real* a) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 6); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack w3var_(w3var), w_first_(w_first), w_sec_(w_sec), a_, skew_w_, w1_1_, w1_2_, w2_1_, w2_2_; + SHF::shoc_assumed_pdf_vv_parameters(w_first_, w_sec_, w3var_, w_tol_sqd, skew_w_, w1_1_, w1_2_, w2_1_, w2_2_, a_); + t_d(0) = a_[0]; + t_d(1) = skew_w_[0]; + t_d(2) = w1_1_[0]; + t_d(3) = w1_2_[0]; + t_d(4) = w2_1_[0]; + t_d(5) = w2_2_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *a = t_h(0); + *skew_w = t_h(1); + *w1_1 = t_h(2); + *w1_2 = t_h(3); + *w2_1 = t_h(4); + *w2_2 = t_h(5); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index a751ed33b7f..c8086daeb31 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -483,7 +483,7 @@ struct ShocAssumedPdfTildeToRealData { struct ShocAssumedPdfVvParametersData { // Inputs - Real w_first, w_sec, w3var; + Real w_first, w_sec, w3var, w_tol_sqd; // Outputs Real skew_w, w1_1, w1_2, w2_1, w2_2, a; @@ -1099,6 +1099,11 @@ void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, R void compute_shoc_temperature_host(Int shcol, Int nlev, Real* thetal, Real* ql, Real* inv_exner, Real* tabs); void shoc_energy_total_fixer_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Real* zt_grid, Real* zi_grid, Real* se_b, Real* ke_b, Real* wv_b, Real* wl_b, Real* se_a, Real* ke_a, Real* wv_a, Real* wl_a, Real* wthl_sfc, Real* wqw_sfc, Real* rho_zt, Real* pint, Real* te_a, Real* te_b); + +void shoc_assumed_pdf_tilde_to_real_host(Real w_first, Real sqrtw2, Real* w1); + +void shoc_assumed_pdf_vv_parameters_host(Real w_first, Real w_sec, Real w3var, Real w_tol_sqd, Real* skew_w, Real* w1_1, Real* w1_2, Real* w2_1, Real* w2_2, Real* a); + // end _host function decls } // namespace shoc diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp index c1a9cab2673..f923e1b47e2 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_vv_parameters_tests.cpp @@ -46,6 +46,7 @@ struct UnitWrap::UnitTest::TestShocVVParameters { SDS.w_first = w_first_sym; SDS.w_sec = w_sec_sym; SDS.w3var = w3var_sym; + SDS.w_tol_sqd = 0; // Verify input is physical REQUIRE(SDS.w_sec >= 0); From deb2d7d6ac07ec939ba4f26aec4c2982826d90c5 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 15:56:18 -0700 Subject: [PATCH 278/529] shoc_pdf_thl_parameters_property --- .../shoc/tests/infra/shoc_test_data.cpp | 31 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 4 +-- .../tests/shoc_pdf_thl_parameters_tests.cpp | 3 +- 3 files changed, 34 insertions(+), 4 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index c1028d4b1a9..24693c42db8 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -201,7 +201,7 @@ void shoc_assumed_pdf_vv_parameters(ShocAssumedPdfVvParametersData& d) void shoc_assumed_pdf_thl_parameters(ShocAssumedPdfThlParametersData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_thl_parameters_host(d.wthlsec, d.sqrtw2, d.sqrtthl, d.thlsec, d.thl_first, d.w1_1, d.w1_2, d.skew_w, d.a, d.dothetal_skew, &d.thl1_1, &d.thl1_2, &d.thl2_1, &d.thl2_2, &d.sqrtthl2_1, &d.sqrtthl2_2); + shoc_assumed_pdf_thl_parameters_host(d.wthlsec, d.sqrtw2, d.sqrtthl, d.thlsec, d.thl_first, d.w1_1, d.w1_2, d.skew_w, d.a, d.thl_tol, d.w_thresh, &d.thl1_1, &d.thl1_2, &d.thl2_1, &d.thl2_2, &d.sqrtthl2_1, &d.sqrtthl2_2); } void shoc_assumed_pdf_qw_parameters(ShocAssumedPdfQwParametersData& d) @@ -3145,5 +3145,34 @@ void shoc_assumed_pdf_vv_parameters_host(Real w_first, Real w_sec, Real w3var, R *w2_2 = t_h(5); } +void shoc_assumed_pdf_thl_parameters_host(Real wthlsec, Real sqrtw2, Real sqrtthl, Real thlsec, Real thl_first, Real w1_1, Real w1_2, Real skew_w, Real a, Real thl_tol, Real w_thresh, Real* thl1_1, Real* thl1_2, Real* thl2_1, Real* thl2_2, Real* sqrtthl2_1, Real* sqrtthl2_2) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 6); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack a_(a), skew_w_(skew_w), sqrtthl_(sqrtthl), sqrtw2_(sqrtw2), thl_first_(thl_first), thlsec_(thlsec), w1_1_(w1_1), w1_2_(w1_2), wthlsec_(wthlsec), sqrtthl2_1_, sqrtthl2_2_, thl1_1_, thl1_2_, thl2_1_, thl2_2_; + SHF::shoc_assumed_pdf_thl_parameters(wthlsec_, sqrtw2_, sqrtthl_, thlsec_, thl_first_, w1_1_, w1_2_, skew_w_, a_, thl_tol, w_thresh, thl1_1_, thl1_2_, thl2_1_, thl2_2_, sqrtthl2_1_, sqrtthl2_2_); + t_d(0) = sqrtthl2_1_[0]; + t_d(1) = sqrtthl2_2_[0]; + t_d(2) = thl1_1_[0]; + t_d(3) = thl1_2_[0]; + t_d(4) = thl2_1_[0]; + t_d(5) = thl2_2_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *sqrtthl2_1 = t_h(0); + *sqrtthl2_2 = t_h(1); + *thl1_1 = t_h(2); + *thl1_2 = t_h(3); + *thl2_1 = t_h(4); + *thl2_2 = t_h(5); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index c8086daeb31..0abe400f056 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -491,8 +491,7 @@ struct ShocAssumedPdfVvParametersData { struct ShocAssumedPdfThlParametersData { // Inputs - Real wthlsec, sqrtw2, sqrtthl, thlsec, thl_first, w1_1, w1_2, skew_w, a; - bool dothetal_skew; + Real wthlsec, sqrtw2, sqrtthl, thlsec, thl_first, w1_1, w1_2, skew_w, a, thl_tol, w_thresh; // Outputs Real thl1_1, thl1_2, thl2_1, thl2_2, sqrtthl2_1, sqrtthl2_2; @@ -1104,6 +1103,7 @@ void shoc_assumed_pdf_tilde_to_real_host(Real w_first, Real sqrtw2, Real* w1); void shoc_assumed_pdf_vv_parameters_host(Real w_first, Real w_sec, Real w3var, Real w_tol_sqd, Real* skew_w, Real* w1_1, Real* w1_2, Real* w2_1, Real* w2_2, Real* a); +void shoc_assumed_pdf_thl_parameters_host(Real wthlsec, Real sqrtw2, Real sqrtthl, Real thlsec, Real thl_first, Real w1_1, Real w1_2, Real skew_w, Real a, Real thl_tol, Real w_thresh, Real* thl1_1, Real* thl1_2, Real* thl2_1, Real* thl2_2, Real* sqrtthl2_1, Real* sqrtthl2_2); // end _host function decls } // namespace shoc diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp index 727f3951a2a..23ca0120a0a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp @@ -74,7 +74,8 @@ struct UnitWrap::UnitTest::TestShocThlParameters { SDS.w1_2 = w1_2_test1; SDS.skew_w = Skew_w_test1; SDS.a = a_test1; - SDS.dothetal_skew = dothetal_skew; + SDS.thl_tol = 0; + SDS.w_thresh = 0; // Verify input is physical REQUIRE(SDS.sqrtw2 >= 0); From 573cb41233d994ea52cea63d138a84179ac1e4b0 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:02:37 -0700 Subject: [PATCH 279/529] shoc_pdf_qw_parameters_property --- .../shoc/tests/infra/shoc_test_data.cpp | 31 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 5 ++- .../tests/shoc_pdf_qw_parameters_tests.cpp | 2 ++ 3 files changed, 36 insertions(+), 2 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 24693c42db8..09a5fffb526 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -207,7 +207,7 @@ void shoc_assumed_pdf_thl_parameters(ShocAssumedPdfThlParametersData& d) void shoc_assumed_pdf_qw_parameters(ShocAssumedPdfQwParametersData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_qw_parameters_host(d.wqwsec, d.sqrtw2, d.skew_w, d.sqrtqt, d.qwsec, d.w1_2, d.w1_1, d.qw_first, d.a, &d.qw1_1, &d.qw1_2, &d.qw2_1, &d.qw2_2, &d.sqrtqw2_1, &d.sqrtqw2_2); + shoc_assumed_pdf_qw_parameters_host(d.wqwsec, d.sqrtw2, d.skew_w, d.sqrtqt, d.qwsec, d.w1_2, d.w1_1, d.qw_first, d.a, d.rt_tol, d.w_thresh, &d.qw1_1, &d.qw1_2, &d.qw2_1, &d.qw2_2, &d.sqrtqw2_1, &d.sqrtqw2_2); } void shoc_assumed_pdf_inplume_correlations(ShocAssumedPdfInplumeCorrelationsData& d) @@ -3174,5 +3174,34 @@ void shoc_assumed_pdf_thl_parameters_host(Real wthlsec, Real sqrtw2, Real sqrtth *thl2_2 = t_h(5); } +void shoc_assumed_pdf_qw_parameters_host(Real wqwsec, Real sqrtw2, Real skew_w, Real sqrtqt, Real qwsec, Real w1_2, Real w1_1, Real qw_first, Real a, Real rt_tol, Real w_thresh, Real* qw1_1, Real* qw1_2, Real* qw2_1, Real* qw2_2, Real* sqrtqw2_1, Real* sqrtqw2_2) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 6); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack a_(a), qw_first_(qw_first), qwsec_(qwsec), skew_w_(skew_w), sqrtqt_(sqrtqt), sqrtw2_(sqrtw2), w1_1_(w1_1), w1_2_(w1_2), wqwsec_(wqwsec), qw1_1_, qw1_2_, qw2_1_, qw2_2_, sqrtqw2_1_, sqrtqw2_2_; + SHF::shoc_assumed_pdf_qw_parameters(wqwsec_, sqrtw2_, skew_w_, sqrtqt_, qwsec_, w1_2_, w1_1_, qw_first_, a_, rt_tol, w_thresh, qw1_1_, qw1_2_, qw2_1_, qw2_2_, sqrtqw2_1_, sqrtqw2_2_); + t_d(0) = qw1_1_[0]; + t_d(1) = qw1_2_[0]; + t_d(2) = qw2_1_[0]; + t_d(3) = qw2_2_[0]; + t_d(4) = sqrtqw2_1_[0]; + t_d(5) = sqrtqw2_2_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *qw1_1 = t_h(0); + *qw1_2 = t_h(1); + *qw2_1 = t_h(2); + *qw2_2 = t_h(3); + *sqrtqw2_1 = t_h(4); + *sqrtqw2_2 = t_h(5); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 0abe400f056..2ef553f3dfb 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -499,7 +499,7 @@ struct ShocAssumedPdfThlParametersData { struct ShocAssumedPdfQwParametersData { // Inputs - Real wqwsec, sqrtw2, skew_w, sqrtqt, qwsec, w1_2, w1_1, qw_first, a; + Real wqwsec, sqrtw2, skew_w, sqrtqt, qwsec, w1_2, w1_1, qw_first, a, rt_tol, w_thresh; // Outputs Real qw1_1, qw1_2, qw2_1, qw2_2, sqrtqw2_1, sqrtqw2_2; @@ -1104,6 +1104,9 @@ void shoc_assumed_pdf_tilde_to_real_host(Real w_first, Real sqrtw2, Real* w1); void shoc_assumed_pdf_vv_parameters_host(Real w_first, Real w_sec, Real w3var, Real w_tol_sqd, Real* skew_w, Real* w1_1, Real* w1_2, Real* w2_1, Real* w2_2, Real* a); void shoc_assumed_pdf_thl_parameters_host(Real wthlsec, Real sqrtw2, Real sqrtthl, Real thlsec, Real thl_first, Real w1_1, Real w1_2, Real skew_w, Real a, Real thl_tol, Real w_thresh, Real* thl1_1, Real* thl1_2, Real* thl2_1, Real* thl2_2, Real* sqrtthl2_1, Real* sqrtthl2_2); + +void shoc_assumed_pdf_qw_parameters_host(Real wqwsec, Real sqrtw2, Real skew_w, Real sqrtqt, Real qwsec, Real w1_2, Real w1_1, Real qw_first, Real a, Real rt_tol, Real w_thresh, Real* qw1_1, Real* qw1_2, Real* qw2_1, Real* qw2_2, Real* sqrtqw2_1, Real* sqrtqw2_2); + // end _host function decls } // namespace shoc diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp index 645abf9fef9..0aabe3da33b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_qw_parameters_tests.cpp @@ -75,6 +75,8 @@ struct UnitWrap::UnitTest::TestShocQwParameters { SDS.w1_2 = w1_2_test1; SDS.skew_w = Skew_w_test1; SDS.a = a_test1; + SDS.rt_tol = 0; + SDS.w_thresh = 0; // Verify input is physical REQUIRE(SDS.sqrtw2 >= 0); From 081bec92c37ebdb3bdc544769f78572ed2c323b0 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:07:37 -0700 Subject: [PATCH 280/529] shoc_pdf_inplume_corr_property --- .../shoc/tests/infra/shoc_test_data.cpp | 21 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 2 ++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 09a5fffb526..b75656b18fd 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -213,7 +213,7 @@ void shoc_assumed_pdf_qw_parameters(ShocAssumedPdfQwParametersData& d) void shoc_assumed_pdf_inplume_correlations(ShocAssumedPdfInplumeCorrelationsData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_inplume_correlations_host(d.sqrtqw2_1, d.sqrtthl2_1, d.a, d.sqrtqw2_2, d.sqrtthl2_2, d.qwthlsec, d.qw1_1, d.qw_first, d.thl1_1, d.thl_first, d.qw1_2, d.thl1_2, &d.r_qwthl_1); + shoc_assumed_pdf_inplume_correlations_host(d.sqrtqw2_1, d.sqrtthl2_1, d.a, d.sqrtqw2_2, d.sqrtthl2_2, d.qwthlsec, d.qw1_1, d.qw_first, d.thl1_1, d.thl_first, d.qw1_2, d.thl1_2, &d.r_qwthl_1); } void shoc_assumed_pdf_compute_temperature(ShocAssumedPdfComputeTemperatureData& d) @@ -3203,5 +3203,24 @@ void shoc_assumed_pdf_qw_parameters_host(Real wqwsec, Real sqrtw2, Real skew_w, *sqrtqw2_2 = t_h(5); } +void shoc_assumed_pdf_inplume_correlations_host(Real sqrtqw2_1, Real sqrtthl2_1, Real a, Real sqrtqw2_2, Real sqrtthl2_2, Real qwthlsec, Real qw1_1, Real qw_first, Real thl1_1, Real thl_first, Real qw1_2, Real thl1_2, Real* r_qwthl_1) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 1); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack a_(a), qw1_1_(qw1_1), qw1_2_(qw1_2), qw_first_(qw_first), qwthlsec_(qwthlsec), sqrtqw2_1_(sqrtqw2_1), sqrtqw2_2_(sqrtqw2_2), sqrtthl2_1_(sqrtthl2_1), sqrtthl2_2_(sqrtthl2_2), thl1_1_(thl1_1), thl1_2_(thl1_2), thl_first_(thl_first), r_qwthl_1_; + SHF::shoc_assumed_pdf_inplume_correlations(sqrtqw2_1_, sqrtthl2_1_, a_, sqrtqw2_2_, sqrtthl2_2_, qwthlsec_, qw1_1_, qw_first_, thl1_1_, thl_first_, qw1_2_, thl1_2_, r_qwthl_1_); + t_d(0) = r_qwthl_1_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *r_qwthl_1 = t_h(0); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 2ef553f3dfb..63c7c689cdd 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1107,6 +1107,8 @@ void shoc_assumed_pdf_thl_parameters_host(Real wthlsec, Real sqrtw2, Real sqrtth void shoc_assumed_pdf_qw_parameters_host(Real wqwsec, Real sqrtw2, Real skew_w, Real sqrtqt, Real qwsec, Real w1_2, Real w1_1, Real qw_first, Real a, Real rt_tol, Real w_thresh, Real* qw1_1, Real* qw1_2, Real* qw2_1, Real* qw2_2, Real* sqrtqw2_1, Real* sqrtqw2_2); +void shoc_assumed_pdf_inplume_correlations_host(Real sqrtqw2_1, Real sqrtthl2_1, Real a, Real sqrtqw2_2, Real sqrtthl2_2, Real qwthlsec, Real qw1_1, Real qw_first, Real thl1_1, Real thl_first, Real qw1_2, Real thl1_2, Real* r_qwthl_1); + // end _host function decls } // namespace shoc From 524fd71735c945641276808dda0fe72a434669c1 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:14:12 -0700 Subject: [PATCH 281/529] shoc_assumed_pdf_compute_temperature --- .../shoc/tests/infra/shoc_test_data.cpp | 21 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 4 +++- .../shoc/tests/shoc_pdf_computetemp_tests.cpp | 9 ++++---- 3 files changed, 27 insertions(+), 7 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index b75656b18fd..d6ebc5df2b6 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -219,7 +219,7 @@ void shoc_assumed_pdf_inplume_correlations(ShocAssumedPdfInplumeCorrelationsData void shoc_assumed_pdf_compute_temperature(ShocAssumedPdfComputeTemperatureData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_compute_temperature_host(d.thl1, d.basepres, d.pval, &d.tl1); + shoc_assumed_pdf_compute_temperature_host(d.thl1, d.pval, &d.tl1); } void shoc_assumed_pdf_compute_qs(ShocAssumedPdfComputeQsData& d) @@ -3222,5 +3222,24 @@ void shoc_assumed_pdf_inplume_correlations_host(Real sqrtqw2_1, Real sqrtthl2_1, *r_qwthl_1 = t_h(0); } +void shoc_assumed_pdf_compute_temperature_host(Real thl1, Real pval, Real* tl1) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 1); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack pval_(pval), thl1_(thl1), tl1_; + SHF::shoc_assumed_pdf_compute_temperature(thl1_, pval_, tl1_); + t_d(0) = tl1_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *tl1 = t_h(0); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 63c7c689cdd..5cd8f5bdcc1 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -515,7 +515,7 @@ struct ShocAssumedPdfInplumeCorrelationsData { struct ShocAssumedPdfComputeTemperatureData { // Inputs - Real thl1, basepres, pval; + Real thl1, pval; // Outputs Real tl1; @@ -1109,6 +1109,8 @@ void shoc_assumed_pdf_qw_parameters_host(Real wqwsec, Real sqrtw2, Real skew_w, void shoc_assumed_pdf_inplume_correlations_host(Real sqrtqw2_1, Real sqrtthl2_1, Real a, Real sqrtqw2_2, Real sqrtthl2_2, Real qwthlsec, Real qw1_1, Real qw_first, Real thl1_1, Real thl_first, Real qw1_2, Real thl1_2, Real* r_qwthl_1); +void shoc_assumed_pdf_compute_temperature_host(Real thl1, Real pval, Real* tl1); + // end _host function decls } // namespace shoc diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp index f850607ee45..f9044517b6a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_computetemp_tests.cpp @@ -37,7 +37,7 @@ struct UnitWrap::UnitTest::TestShocPdfComputeTemp { // Input liquid water potential temperature [K] static constexpr Real thl1 = 305; // Input basepressure [Pa] - static constexpr Real basepres = 100000; + static constexpr Real basepres = C::P0; // Input value of pval [Pa] Real pval = 110000; @@ -55,7 +55,6 @@ struct UnitWrap::UnitTest::TestShocPdfComputeTemp { // Fill in data SDS.thl1 = thl1; - SDS.basepres = basepres; SDS.pval = pval; Int num_tests = SDS.pval/abs(presincr); @@ -64,7 +63,7 @@ struct UnitWrap::UnitTest::TestShocPdfComputeTemp { REQUIRE(presincr < 0); // Make sure our starting pressure is greater than // basepres just so we test a range - REQUIRE(SDS.pval > SDS.basepres); + REQUIRE(SDS.pval > basepres); for (Int s = 0; s < num_tests; ++s){ @@ -81,11 +80,11 @@ struct UnitWrap::UnitTest::TestShocPdfComputeTemp { // If pressure is greater than basepressure then // make sure that temperature is greater than thetal - if (SDS.pval > SDS.basepres){ + if (SDS.pval > basepres){ REQUIRE(SDS.tl1 > SDS.thl1); } // otherwise temperature should be less than thetal - else if(SDS.pval < SDS.basepres){ + else if(SDS.pval < basepres){ REQUIRE(SDS.tl1 < SDS.thl1); } // otherwise if they are equal the temperatures From 2c973d89ee76b4bebf0965a986b5a48952234d31 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:19:45 -0700 Subject: [PATCH 282/529] shoc_assumed_pdf_compute_qs --- .../shoc/tests/infra/shoc_test_data.cpp | 29 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 2 ++ 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index d6ebc5df2b6..07fd77efbf1 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -225,7 +225,7 @@ void shoc_assumed_pdf_compute_temperature(ShocAssumedPdfComputeTemperatureData& void shoc_assumed_pdf_compute_qs(ShocAssumedPdfComputeQsData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_compute_qs_host(d.tl1_1, d.tl1_2, d.pval, &d.qs1, &d.beta1, &d.qs2, &d.beta2); + shoc_assumed_pdf_compute_qs_host(d.tl1_1, d.tl1_2, d.pval, &d.qs1, &d.beta1, &d.qs2, &d.beta2); } void shoc_assumed_pdf_compute_s(ShocAssumedPdfComputeSData& d) @@ -3241,5 +3241,32 @@ void shoc_assumed_pdf_compute_temperature_host(Real thl1, Real pval, Real* tl1) *tl1 = t_h(0); } +void shoc_assumed_pdf_compute_qs_host(Real tl1_1, Real tl1_2, Real pval, Real* qs1, Real* beta1, Real* qs2, Real* beta2) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using Smask = typename SHF::Smask; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 4); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack pval_(pval), tl1_1_(tl1_1), tl1_2_(tl1_2), beta1_, beta2_, qs1_, qs2_; + Smask active_entries(true); + SHF::shoc_assumed_pdf_compute_qs(tl1_1_, tl1_2_, pval_, active_entries, qs1_, beta1_, qs2_, beta2_); + t_d(0) = beta1_[0]; + t_d(1) = beta2_[0]; + t_d(2) = qs1_[0]; + t_d(3) = qs2_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *beta1 = t_h(0); + *beta2 = t_h(1); + *qs1 = t_h(2); + *qs2 = t_h(3); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 5cd8f5bdcc1..9285bce5b1f 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1111,6 +1111,8 @@ void shoc_assumed_pdf_inplume_correlations_host(Real sqrtqw2_1, Real sqrtthl2_1, void shoc_assumed_pdf_compute_temperature_host(Real thl1, Real pval, Real* tl1); +void shoc_assumed_pdf_compute_qs_host(Real tl1_1, Real tl1_2, Real pval, Real* qs1, Real* beta1, Real* qs2, Real* beta2); + // end _host function decls } // namespace shoc From 504d774ce4536199f84ade839e6f5b77fb341cf1 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:23:31 -0700 Subject: [PATCH 283/529] shoc_assumed_pdf_compute_s --- .../shoc/tests/infra/shoc_test_data.cpp | 27 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 2 ++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 07fd77efbf1..19c1fcab090 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -231,7 +231,7 @@ void shoc_assumed_pdf_compute_qs(ShocAssumedPdfComputeQsData& d) void shoc_assumed_pdf_compute_s(ShocAssumedPdfComputeSData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_compute_s_host(d.qw1, d.qs1, d.beta, d.pval, d.thl2, d.qw2, d.sqrtthl2, d.sqrtqw2, d.r_qwthl, &d.s, &d.std_s, &d.qn, &d.c); + shoc_assumed_pdf_compute_s_host(d.qw1, d.qs1, d.beta, d.pval, d.thl2, d.qw2, d.sqrtthl2, d.sqrtqw2, d.r_qwthl, &d.s, &d.std_s, &d.qn, &d.c); } void shoc_assumed_pdf_compute_sgs_liquid(ShocAssumedPdfComputeSgsLiquidData& d) @@ -3268,5 +3268,30 @@ void shoc_assumed_pdf_compute_qs_host(Real tl1_1, Real tl1_2, Real pval, Real* q *qs2 = t_h(3); } +void shoc_assumed_pdf_compute_s_host(Real qw1, Real qs1, Real beta, Real pval, Real thl2, Real qw2, Real sqrtthl2, Real sqrtqw2, Real r_qwthl, Real* s, Real* std_s, Real* qn, Real* c) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 4); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack beta_(beta), pval_(pval), qs1_(qs1), qw1_(qw1), qw2_(qw2), r_qwthl_(r_qwthl), sqrtqw2_(sqrtqw2), sqrtthl2_(sqrtthl2), thl2_(thl2), c_, qn_, s_, std_s_; + SHF::shoc_assumed_pdf_compute_s(qw1_, qs1_, beta_, pval_, thl2_, qw2_, sqrtthl2_, sqrtqw2_, r_qwthl_, s_, std_s_, qn_, c_); + t_d(0) = c_[0]; + t_d(1) = qn_[0]; + t_d(2) = s_[0]; + t_d(3) = std_s_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *c = t_h(0); + *qn = t_h(1); + *s = t_h(2); + *std_s = t_h(3); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 9285bce5b1f..c4cc8b1c833 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1113,6 +1113,8 @@ void shoc_assumed_pdf_compute_temperature_host(Real thl1, Real pval, Real* tl1); void shoc_assumed_pdf_compute_qs_host(Real tl1_1, Real tl1_2, Real pval, Real* qs1, Real* beta1, Real* qs2, Real* beta2); +void shoc_assumed_pdf_compute_s_host(Real qw1, Real qs1, Real beta, Real pval, Real thl2, Real qw2, Real sqrtthl2, Real sqrtqw2, Real r_qwthl, Real* s, Real* std_s, Real* qn, Real* c); + // end _host function decls } // namespace shoc From 52d9d69aaa6baa82a68da8183ca11630eb2ec96d Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:27:42 -0700 Subject: [PATCH 284/529] shoc_assumed_pdf_compute_sgs_liquid --- .../shoc/tests/infra/shoc_test_data.cpp | 20 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 2 ++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 19c1fcab090..2dd76cf2090 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -237,7 +237,7 @@ void shoc_assumed_pdf_compute_s(ShocAssumedPdfComputeSData& d) void shoc_assumed_pdf_compute_sgs_liquid(ShocAssumedPdfComputeSgsLiquidData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_compute_sgs_liquid_host(d.a, d.ql1, d.ql2, &d.shoc_ql); + shoc_assumed_pdf_compute_sgs_liquid_host(d.a, d.ql1, d.ql2, &d.shoc_ql); } void shoc_assumed_pdf_compute_cloud_liquid_variance(ShocAssumedPdfComputeCloudLiquidVarianceData& d) @@ -3293,5 +3293,23 @@ void shoc_assumed_pdf_compute_s_host(Real qw1, Real qs1, Real beta, Real pval, R *std_s = t_h(3); } +void shoc_assumed_pdf_compute_sgs_liquid_host(Real a, Real ql1, Real ql2, Real* shoc_ql) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 1); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack a_(a), ql1_(ql1), ql2_(ql2), shoc_ql_; + SHF::shoc_assumed_pdf_compute_sgs_liquid(a_, ql1_, ql2_, shoc_ql_); + t_d(0) = shoc_ql_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *shoc_ql = t_h(0); +} } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index c4cc8b1c833..4c65c7d3c41 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1115,6 +1115,8 @@ void shoc_assumed_pdf_compute_qs_host(Real tl1_1, Real tl1_2, Real pval, Real* q void shoc_assumed_pdf_compute_s_host(Real qw1, Real qs1, Real beta, Real pval, Real thl2, Real qw2, Real sqrtthl2, Real sqrtqw2, Real r_qwthl, Real* s, Real* std_s, Real* qn, Real* c); +void shoc_assumed_pdf_compute_sgs_liquid_host(Real a, Real ql1, Real ql2, Real* shoc_ql); + // end _host function decls } // namespace shoc From 1878caffab3be6c12261c72121cbb3a9a933a5a1 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:32:43 -0700 Subject: [PATCH 285/529] shoc_assumed_pdf_compute_cloud_liquid_variance --- .../shoc/tests/infra/shoc_test_data.cpp | 22 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 2 ++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 2dd76cf2090..1da2ffb797b 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -243,7 +243,7 @@ void shoc_assumed_pdf_compute_sgs_liquid(ShocAssumedPdfComputeSgsLiquidData& d) void shoc_assumed_pdf_compute_cloud_liquid_variance(ShocAssumedPdfComputeCloudLiquidVarianceData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_compute_cloud_liquid_variance_host(d.a, d.s1, d.ql1, d.c1, d.std_s1, d.s2, d.ql2, d.c2, d.std_s2, d.shoc_ql, &d.shoc_ql2); + shoc_assumed_pdf_compute_cloud_liquid_variance_host(d.a, d.s1, d.ql1, d.c1, d.std_s1, d.s2, d.ql2, d.c2, d.std_s2, d.shoc_ql, &d.shoc_ql2); } void shoc_assumed_pdf_compute_liquid_water_flux(ShocAssumedPdfComputeLiquidWaterFluxData& d) @@ -3311,5 +3311,25 @@ void shoc_assumed_pdf_compute_sgs_liquid_host(Real a, Real ql1, Real ql2, Real* Kokkos::deep_copy(t_h, t_d); *shoc_ql = t_h(0); } + +void shoc_assumed_pdf_compute_cloud_liquid_variance_host(Real a, Real s1, Real ql1, Real c1, Real std_s1, Real s2, Real ql2, Real c2, Real std_s2, Real shoc_ql, Real* shoc_ql2) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 1); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack a_(a), c1_(c1), c2_(c2), ql1_(ql1), ql2_(ql2), s1_(s1), s2_(s2), shoc_ql_(shoc_ql), std_s1_(std_s1), std_s2_(std_s2), shoc_ql2_; + SHF::shoc_assumed_pdf_compute_cloud_liquid_variance(a_, s1_, ql1_, c1_, std_s1_, s2_, ql2_, c2_, std_s2_, shoc_ql_, shoc_ql2_); + t_d(0) = shoc_ql2_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *shoc_ql2 = t_h(0); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 4c65c7d3c41..44493955d28 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1117,6 +1117,8 @@ void shoc_assumed_pdf_compute_s_host(Real qw1, Real qs1, Real beta, Real pval, R void shoc_assumed_pdf_compute_sgs_liquid_host(Real a, Real ql1, Real ql2, Real* shoc_ql); +void shoc_assumed_pdf_compute_cloud_liquid_variance_host(Real a, Real s1, Real ql1, Real c1, Real std_s1, Real s2, Real ql2, Real c2, Real std_s2, Real shoc_ql, Real* shoc_ql2); + // end _host function decls } // namespace shoc From ffd8ae1cc389e9085f533eb440636a465efd08cc Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:36:52 -0700 Subject: [PATCH 286/529] shoc_assumed_pdf_compute_liquid_water_flux --- .../shoc/tests/infra/shoc_test_data.cpp | 21 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 2 ++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 1da2ffb797b..03c571e4b55 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -249,7 +249,7 @@ void shoc_assumed_pdf_compute_cloud_liquid_variance(ShocAssumedPdfComputeCloudLi void shoc_assumed_pdf_compute_liquid_water_flux(ShocAssumedPdfComputeLiquidWaterFluxData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_compute_liquid_water_flux_host(d.a, d.w1_1, d.w_first, d.ql1, d.w1_2, d.ql2, &d.wqls); + shoc_assumed_pdf_compute_liquid_water_flux_host(d.a, d.w1_1, d.w_first, d.ql1, d.w1_2, d.ql2, &d.wqls); } void shoc_assumed_pdf_compute_buoyancy_flux(ShocAssumedPdfComputeBuoyancyFluxData& d) @@ -3331,5 +3331,24 @@ void shoc_assumed_pdf_compute_cloud_liquid_variance_host(Real a, Real s1, Real q *shoc_ql2 = t_h(0); } +void shoc_assumed_pdf_compute_liquid_water_flux_host(Real a, Real w1_1, Real w_first, Real ql1, Real w1_2, Real ql2, Real* wqls) +{ + using SHF = Functions; + + using Spack = typename SHF::Spack; + using view_1d = typename SHF::view_1d; + + view_1d t_d("t_d", 1); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack a_(a), ql1_(ql1), ql2_(ql2), w1_1_(w1_1), w1_2_(w1_2), w_first_(w_first), wqls_; + SHF::shoc_assumed_pdf_compute_liquid_water_flux(a_, w1_1_, w_first_, ql1_, w1_2_, ql2_, wqls_); + t_d(0) = wqls_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *wqls = t_h(0); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 44493955d28..f800aa21ac9 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -1119,6 +1119,8 @@ void shoc_assumed_pdf_compute_sgs_liquid_host(Real a, Real ql1, Real ql2, Real* void shoc_assumed_pdf_compute_cloud_liquid_variance_host(Real a, Real s1, Real ql1, Real c1, Real std_s1, Real s2, Real ql2, Real c2, Real std_s2, Real shoc_ql, Real* shoc_ql2); +void shoc_assumed_pdf_compute_liquid_water_flux_host(Real a, Real w1_1, Real w_first, Real ql1, Real w1_2, Real ql2, Real* wqls); + // end _host function decls } // namespace shoc From 8ac353cfa54981a29eda92e51620fb65e844f87c Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:42:35 -0700 Subject: [PATCH 287/529] shoc_assumed_pdf_compute_buoyancy_flux --- .../shoc/tests/infra/shoc_test_data.cpp | 21 ++++++++++++++++++- .../shoc/tests/infra/shoc_test_data.hpp | 4 +++- .../tests/shoc_pdf_compute_buoyflux_tests.cpp | 2 -- 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index 03c571e4b55..d61e7ad5804 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -255,7 +255,7 @@ void shoc_assumed_pdf_compute_liquid_water_flux(ShocAssumedPdfComputeLiquidWater void shoc_assumed_pdf_compute_buoyancy_flux(ShocAssumedPdfComputeBuoyancyFluxData& d) { shoc_init(1); // single level function - //shoc_assumed_pdf_compute_buoyancy_flux_host(d.wthlsec, d.epsterm, d.wqwsec, d.pval, d.wqls, &d.wthv_sec); + shoc_assumed_pdf_compute_buoyancy_flux_host(d.wthlsec, d.wqwsec, d.pval, d.wqls, &d.wthv_sec); } void diag_second_moments_ubycond(DiagSecondMomentsUbycondData& d) @@ -3350,5 +3350,24 @@ void shoc_assumed_pdf_compute_liquid_water_flux_host(Real a, Real w1_1, Real w_f *wqls = t_h(0); } +void shoc_assumed_pdf_compute_buoyancy_flux_host(Real wthlsec, Real wqwsec, Real pval, Real wqls, Real* wthv_sec) +{ + using PF = Functions; + + using Spack = typename PF::Spack; + using view_1d = typename PF::view_1d; + + view_1d t_d("t_d", 1); + const auto t_h = Kokkos::create_mirror_view(t_d); + + Kokkos::parallel_for(1, KOKKOS_LAMBDA(const Int&) { + Spack pval_(pval), wqls_(wqls), wqwsec_(wqwsec), wthlsec_(wthlsec), wthv_sec_; + PF::shoc_assumed_pdf_compute_buoyancy_flux(wthlsec_, wqwsec_, pval_, wqls_, wthv_sec_); + t_d(0) = wthv_sec_[0]; + }); + Kokkos::deep_copy(t_h, t_d); + *wthv_sec = t_h(0); +} + } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index f800aa21ac9..48cdccc690b 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -563,7 +563,7 @@ struct ShocAssumedPdfComputeLiquidWaterFluxData { struct ShocAssumedPdfComputeBuoyancyFluxData { // Inputs - Real wthlsec, epsterm, wqwsec, pval, wqls; + Real wthlsec, wqwsec, pval, wqls; // Outputs Real wthv_sec; @@ -1121,6 +1121,8 @@ void shoc_assumed_pdf_compute_cloud_liquid_variance_host(Real a, Real s1, Real q void shoc_assumed_pdf_compute_liquid_water_flux_host(Real a, Real w1_1, Real w_first, Real ql1, Real w1_2, Real ql2, Real* wqls); +void shoc_assumed_pdf_compute_buoyancy_flux_host(Real wthlsec, Real wqwsec, Real pval, Real wqls, Real* wthv_sec); + // end _host function decls } // namespace shoc diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp index 5eb8488a070..53c91a605c7 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_compute_buoyflux_tests.cpp @@ -24,7 +24,6 @@ struct UnitWrap::UnitTest::TestShocPdfCompBuoyFlux { static void run_property() { - static constexpr Real epsterm = scream::physics::Constants::ep_2; // Property tests for the SHOC function // shoc_assumed_pdf_compute_buoyancy_flux @@ -53,7 +52,6 @@ struct UnitWrap::UnitTest::TestShocPdfCompBuoyFlux { SDS.wqwsec = wqwsec_dry; SDS.wqls = wqls_dry; SDS.pval = pval; - SDS.epsterm = epsterm; // Call the fortran implementation shoc_assumed_pdf_compute_buoyancy_flux(SDS); From 3cacc63f30b76d1b3d106ad55aabc3cab8b2c01f Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 19 Nov 2024 16:44:59 -0700 Subject: [PATCH 288/529] progress --- .../shoc/tests/infra/shoc_test_data.cpp | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index d61e7ad5804..dc341fb9515 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -261,56 +261,56 @@ void shoc_assumed_pdf_compute_buoyancy_flux(ShocAssumedPdfComputeBuoyancyFluxDat void diag_second_moments_ubycond(DiagSecondMomentsUbycondData& d) { shoc_init(1); // single level function - //shoc_diag_second_moments_ubycond_host(d.shcol, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec); + shoc_diag_second_moments_ubycond_host(d.shcol, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec); } void pblintd_init_pot(PblintdInitPotData& d) { shoc_init(d.nlev, true); - //shoc_pblintd_init_pot_host(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); + shoc_pblintd_init_pot_host(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); } void pblintd_cldcheck(PblintdCldcheckData& d) { shoc_init(d.nlev, true); - //shoc_pblintd_cldcheck_host(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); + shoc_pblintd_cldcheck_host(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); } void diag_second_moments_lbycond(DiagSecondMomentsLbycondData& d) { shoc_init(1); // single level function - //diag_second_moments_lbycond_host(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); + diag_second_moments_lbycond_host(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); } void diag_second_moments(DiagSecondMomentsData& d) { shoc_init(d.nlev); - // diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, - // d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, - // d.vw_sec, d.wtke_sec, d.w_sec); + diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, + d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, + d.vw_sec, d.wtke_sec, d.w_sec); } void diag_second_shoc_moments(DiagSecondShocMomentsData& d) { shoc_init(d.nlev); - // diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, - // d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, d.qw_sec, - // d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); + diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, + d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, d.qw_sec, + d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); } void compute_shoc_vapor(ComputeShocVaporData& d) { shoc_init(d.nlev); - //compute_shoc_vapor_host(d.shcol, d.nlev, d.qw, d.ql, d.qv); + compute_shoc_vapor_host(d.shcol, d.nlev, d.qw, d.ql, d.qv); } void update_prognostics_implicit(UpdatePrognosticsImplicitData& d) { shoc_init(d.nlev); - // update_prognostics_implicit_host(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, - // d.dz_zt, d.dz_zi, d.rho_zt, d.zt_grid, d.zi_grid, - // d.tk, d.tkh, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, - // d.wtracer_sfc, d.thetal, d.qw, d.tracer, d.tke, d.u_wind, d.v_wind); + update_prognostics_implicit_host(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, + d.dz_zt, d.dz_zi, d.rho_zt, d.zt_grid, d.zi_grid, + d.tk, d.tkh, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, + d.wtracer_sfc, d.thetal, d.qw, d.tracer, d.tke, d.u_wind, d.v_wind); } void shoc_main(ShocMainData& d) @@ -376,7 +376,7 @@ void pblintd_surf_temp(PblintdSurfTempData& d) void pblintd_check_pblh(PblintdCheckPblhData& d) { shoc_init(d.nlev, true); - //pblintd_check_pblh_host(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.check, d.pblh); + pblintd_check_pblh_host(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.check, d.pblh); } void pblintd(PblintdData& d) From 5a108653afa1cced8ed3796362e3233b74b3c94e Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 13 Nov 2024 09:10:45 -0700 Subject: [PATCH 289/529] Update clubb_intr.F90 --- components/eam/src/physics/cam/clubb_intr.F90 | 42 +++++++++---------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index 6b7fb38906a..c69d76def44 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -930,24 +930,22 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in) call addfld ('TPERTBLT', horiz_only, 'A', 'K', 'perturbation temperature at PBL top') ! if (use_od_fd) then - !added for turbulent orographic form drag (TOFD) output - call addfld ('DTAUX3_FD',(/'lev'/),'A','m/s2','U tendency - fd orographic drag') - call addfld ('DTAUY3_FD',(/'lev'/),'A','m/s2','V tendency - fd orographic drag') - call addfld ('DUSFC_FD',horiz_only,'A','N/m2','fd zonal oro surface stress') - call addfld ('DVSFC_FD',horiz_only,'A','N/m2','fd merio oro surface stress') - call add_default('DTAUX3_FD', 1, ' ') - call add_default('DTAUY3_FD', 1, ' ') - call add_default('DUSFC_FD', 1, ' ') - call add_default('DVSFC_FD', 1, ' ') - if (masterproc) then + !added for turbulent orographic form drag (TOFD) output + call addfld ('DTAUX3_FD',(/'lev'/),'A','m/s2','U tendency - fd orographic drag') + call addfld ('DTAUY3_FD',(/'lev'/),'A','m/s2','V tendency - fd orographic drag') + call addfld ('DUSFC_FD',horiz_only,'A','N/m2','fd zonal oro surface stress') + call addfld ('DVSFC_FD',horiz_only,'A','N/m2','fd merio oro surface stress') + call add_default('DTAUX3_FD', 1, ' ') + call add_default('DTAUY3_FD', 1, ' ') + call add_default('DUSFC_FD', 1, ' ') + call add_default('DVSFC_FD', 1, ' ') + if (masterproc) then write(iulog,*)'Using turbulent orographic form drag scheme (TOFD)' - end if - ! - if (use_od_fd.and.do_tms) then - call endrun("clubb_intr: Both TMS and TOFD are turned on, please turn one off& - &by setting use_od_fd or do_tms as .false.") - end if - ! + end if + if (use_od_fd.and.do_tms) then + call endrun("clubb_intr: Both TMS and TOFD are turned on, please turn one off& + &by setting use_od_fd or do_tms as .false.") + end if end if ! Initialize statistics, below are dummy variables dum1 = 300._r8 @@ -1541,7 +1539,8 @@ subroutine clubb_tend_cam( & real(r8) :: sfc_v_diff_tau(pcols) ! Response to tau perturbation, m/s real(r8), parameter :: pert_tau = 0.1_r8 ! tau perturbation, Pa - !add par for tofd + + !variables for turbulent orographic form drag (TOFD) interface real(r8) :: dtaux3_fd(pcols,pver) real(r8) :: dtauy3_fd(pcols,pver) real(r8) :: dusfc_fd(pcols) @@ -1551,7 +1550,6 @@ subroutine clubb_tend_cam( & real(r8) :: dummy_utgw(pcols,pver) real(r8) :: dummy_vtgw(pcols,pver) real(r8) :: dummy_ttgw(pcols,pver) - ! real(r8) :: dummx_ls(pcols,pver) real(r8) :: dummx_bl(pcols,pver) real(r8) :: dummx_ss(pcols,pver) @@ -1564,7 +1562,7 @@ subroutine clubb_tend_cam( & real(r8) :: dummy3_ls(pcols,pver) real(r8) :: dummy3_bl(pcols,pver) real(r8) :: dummy3_ss(pcols,pver) - ! + real(r8) :: inv_exner_clubb_surf @@ -1991,7 +1989,7 @@ subroutine clubb_tend_cam( & tautmsx, tautmsy, cam_in%landfrac ) call t_stopf('compute_tms') endif - ! + if (use_od_fd) then gwd_ls =.false. gwd_bl =.false. @@ -2020,7 +2018,7 @@ subroutine clubb_tend_cam( & call outfld ('DUSFC_FD', dusfc_fd, pcols, lchnk) call outfld ('DVSFC_FD', dvsfc_fd, pcols, lchnk) endif - ! + if (micro_do_icesupersat) then call physics_ptend_init(ptend_loc,state%psetcols, 'clubb_ice3', ls=.true., lu=.true., lv=.true., lq=lq) endif From 67a0dc2f59223123ebcd3a2a2c94c4089846fd15 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 15 Nov 2024 10:47:37 -0600 Subject: [PATCH 290/529] fix topo file for ne4 oro drag testmod --- .../testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam index 185a235d4f5..f32cc8a6f93 100644 --- a/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam +++ b/components/eam/cime_config/testdefs/testmods_dirs/eam/orodrag_ne4pg2/user_nl_eam @@ -4,4 +4,4 @@ use_od_bl=.true. use_od_ss=.true. use_od_fd=.true. -bnd_topo='$DIN_LOC_ROOT/atm/cam/topo/USGS-gtopo30_ne4np4_16x_forOroDrag.c20241019.nc' +bnd_topo='$DIN_LOC_ROOT/atm/cam/topo/USGS-gtopo30_ne4np4pg2_16x_converted_forOroDrag.c20241019.nc' From dcd650c031fb2a5d0859d10663d590dae4ca1a5f Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 15 Nov 2024 10:51:23 -0600 Subject: [PATCH 291/529] cosmetic fix --- components/eam/src/physics/cam/hb_diff.F90 | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/components/eam/src/physics/cam/hb_diff.F90 b/components/eam/src/physics/cam/hb_diff.F90 index 7721cdef4a0..3d18ce50280 100644 --- a/components/eam/src/physics/cam/hb_diff.F90 +++ b/components/eam/src/physics/cam/hb_diff.F90 @@ -770,9 +770,7 @@ end subroutine austausch_pbl subroutine pblintd_ri(ncol ,gravit , & thv ,z ,u ,v , & ustar ,obklen ,kbfs ,rino_bulk) - !! use pbl_utils, only: virtem, calc_ustar, calc_obklen - !! integer, intent(in) :: ncol ! number of atmospheric columns real(r8), intent(in) :: gravit real(r8), intent(in) :: thv(pcols,pver) ! virtual temperature @@ -782,14 +780,14 @@ subroutine pblintd_ri(ncol ,gravit , & real(r8), intent(in) :: ustar(pcols) ! surface friction velocity [m/s] real(r8), intent(in) :: obklen(pcols) ! Obukhov length real(r8), intent(in) :: kbfs(pcols) ! sfc kinematic buoyancy flux [m^2/s^3] - !! + ! ! Output arguments ! real(r8) :: wstar(pcols) ! convective sclae velocity [m/s] real(r8) :: pblh(pcols) ! boundary-layer height [m] real(r8) :: bge(pcols) ! buoyancy gradient enhancment real(r8), intent(out) :: rino_bulk(pcols) ! bulk Richardson no. surface level - !! + ! !---------------------------Local parameters---------------------------- ! real(r8), parameter :: tiny = 1.e-36_r8 ! lower bound for wind magnitude @@ -811,12 +809,11 @@ subroutine pblintd_ri(ncol ,gravit , & do i=1,ncol check(i) = .true. rino(i,pver) = 0.0_r8 - rino_bulk(i) = 0.0_r8 + rino_bulk(i) = 0.0_r8 pblh(i) = z(i,pver) tref(i) = thv(i,pver)!if not excess then tref is equal to lowest level thv_lv end do ! - ! ! PBL height calculation: Scan upward until the Richardson number between ! the first level and the current level exceeds the "critical" value. ! @@ -845,9 +842,7 @@ subroutine pblintd_ri(ncol ,gravit , & phiminv(i) = (1._r8 - binm*pblh(i)/obklen(i))**onet rino(i,pver) = 0.0_r8 tlv(i) = thv(i,pver) + kbfs(i)*fak/( ustar(i)*phiminv(i) ) - ! tref(i) = tlv(i) - ! end if end do ! @@ -879,13 +874,13 @@ subroutine pblintd_ri(ncol ,gravit , & !following Holstag and Boville (1993) equation (2.8) ! do i=1,ncol - vvk = u(i,pver)**2 + v(i,pver)**2 + fac*ustar(i)**2 - vvk = max(vvk,tiny) - rino_bulk(i)=gravit*(thv(i,pver) - tref(i))*z(i,pver)/(thv(i,pver)*vvk) + vvk = u(i,pver)**2 + v(i,pver)**2 + fac*ustar(i)**2 + vvk = max(vvk,tiny) + rino_bulk(i)=gravit*(thv(i,pver) - tref(i))*z(i,pver)/(thv(i,pver)*vvk) enddo ! return - end subroutine pblintd_ri - !=============================================================================== + end subroutine pblintd_ri + !=============================================================================== end module hb_diff From 26b037f52546daf745fa1261fb53e80e6ad9006b Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 15 Nov 2024 10:56:37 -0600 Subject: [PATCH 292/529] refactor data handling for oro drag put data in pbuf rather than state and isolate orodrag register/init methods in od_common --- .../eam/src/control/startup_initialconds.F90 | 43 - components/eam/src/physics/cam/clubb_intr.F90 | 29 +- components/eam/src/physics/cam/comsrf.F90 | 32 +- components/eam/src/physics/cam/gw_drag.F90 | 85 +- components/eam/src/physics/cam/od_common.F90 | 1213 +++++++++-------- .../eam/src/physics/cam/physics_types.F90 | 28 +- components/eam/src/physics/cam/physpkg.F90 | 19 +- components/eam/src/physics/cam/ppgrid.F90 | 8 - 8 files changed, 732 insertions(+), 725 deletions(-) diff --git a/components/eam/src/control/startup_initialconds.F90 b/components/eam/src/control/startup_initialconds.F90 index a68195c731d..68f9a2f12a3 100644 --- a/components/eam/src/control/startup_initialconds.F90 +++ b/components/eam/src/control/startup_initialconds.F90 @@ -5,28 +5,16 @@ module startup_initialconds ! !----------------------------------------------------------------------- -use pio, only: file_desc_t - implicit none private save public :: initial_conds ! Read in initial conditions (dycore dependent) -!added for orographic drag -public topo_OD_file_get_id -public setup_initial_OD -public close_initial_file_OD -type(file_desc_t), pointer :: ncid_topo_OD !======================================================================= contains !======================================================================= -function topo_OD_file_get_id() - type(file_desc_t), pointer :: topo_OD_file_get_id - topo_OD_file_get_id => ncid_topo_OD -end function topo_OD_file_get_id - subroutine initial_conds(dyn_in) ! This routine does some initializing of buffers that should move to a @@ -72,35 +60,4 @@ subroutine initial_conds(dyn_in) end subroutine initial_conds -!======================================================================= - -subroutine setup_initial_OD() - use filenames, only: bnd_topo - use ioFileMod, only: getfil - use cam_pio_utils, only: cam_pio_openfile - use pio, only: pio_nowrite -! -! Input arguments -! -!----------------------------------------------------------------------- - include 'netcdf.inc' -!----------------------------------------------------------------------- - character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk - allocate(ncid_topo_OD) - call getfil(bnd_topo, bnd_topo_loc) - call cam_pio_openfile(ncid_topo_OD, bnd_topo_loc, PIO_NOWRITE) -end subroutine setup_initial_OD - -subroutine close_initial_file_OD - use pio, only: pio_closefile - call pio_closefile(ncid_topo_OD) - deallocate(ncid_topo_OD) - nullify(ncid_topo_OD) -end subroutine close_initial_file_OD -!======================================================================= - - - - - end module startup_initialconds diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index c69d76def44..0d45232f8a9 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -2139,14 +2139,14 @@ subroutine clubb_tend_cam( & dum_core_rknd = real((ksrftms(i)*state1%v(i,pver)), kind = core_rknd) vpwp_sfc = vpwp_sfc-(dum_core_rknd/rho_ds_zm(1)) endif - !----------------------------------------------------! - !Apply TOFD - !----------------------------------------------------! - !tendency is flipped already - if (use_od_fd) then + ! ------------------------------------------------- ! + ! Apply TOFD + ! ------------------------------------------------- ! + ! tendency is flipped already + if (use_od_fd) then um_forcing(2:pverp)=dtaux3_fd(i,pver:1:-1) vm_forcing(2:pverp)=dtauy3_fd(i,pver:1:-1) - endif + endif ! Need to flip arrays around for CLUBB core do k=1,pverp um_in(k) = real(um(i,pverp-k+1), kind = core_rknd) @@ -3170,7 +3170,7 @@ end subroutine clubb_tend_cam ! ! ! =============================================================================== ! - subroutine clubb_surface (state, cam_in, ustar, obklen) + subroutine clubb_surface (state, cam_in, pbuf, ustar, obklen) !------------------------------------------------------------------------------- ! Description: Provide the obukhov length and the surface friction velocity @@ -3192,7 +3192,7 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) use constituents, only: cnst_get_ind use camsrfexch, only: cam_in_t use hb_diff, only: pblintd_ri - + use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc implicit none @@ -3200,8 +3200,9 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) ! Input Auguments ! ! --------------- ! - type(physics_state), intent(inout) :: state ! Physics state variables - type(cam_in_t), intent(in) :: cam_in + type(physics_state), intent(inout) :: state ! Physics state variables + type(cam_in_t), intent(in) :: cam_in + type(physics_buffer_desc), pointer, intent(in) :: pbuf(:) ! ---------------- ! ! Output Auguments ! @@ -3231,6 +3232,9 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) integer :: ixq,ixcldliq !PMA fix for thv real(r8) :: rrho ! Inverse air density + integer :: oro_drag_ribulk_idx ! pbuf index of bulk richardson number for oro drag + real(r8), pointer :: oro_drag_ribulk(:) ! pbuf pointer for bulk richardson number + #endif obklen(pcols) = 0.0_r8 @@ -3295,9 +3299,12 @@ subroutine clubb_surface (state, cam_in, ustar, obklen) kbfs_pcol(i)=kbfs enddo + oro_drag_ribulk_idx = pbuf_get_index('oro_drag_ribulk') + call pbuf_get_field(pbuf, oro_drag_ribulk_idx, oro_drag_ribulk) + !calculate the bulk richardson number call pblintd_ri(ncol, gravit, thv_lv, state%zm, state%u, state%v, & - ustar, obklen, kbfs_pcol, state%ribulk) + ustar, obklen, kbfs_pcol, oro_drag_ribulk) endif return diff --git a/components/eam/src/physics/cam/comsrf.F90 b/components/eam/src/physics/cam/comsrf.F90 index 64e3750dd4e..7ac806c1032 100644 --- a/components/eam/src/physics/cam/comsrf.F90 +++ b/components/eam/src/physics/cam/comsrf.F90 @@ -17,7 +17,7 @@ module comsrf ! USES: ! use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4 - use ppgrid, only: pcols, begchunk, endchunk,nvar_dirOA,nvar_dirOL + use ppgrid, only: pcols, begchunk, endchunk use infnan, only: nan, assignment(=) use cam_abortutils, only: endrun @@ -31,8 +31,6 @@ module comsrf ! ! PUBLIC MEMBER FUNCTIONS: ! public initialize_comsrf ! Set the surface temperature and sea-ice fraction - !!added for separate input of ogwd parareters in gw_drag - public initialize_comsrf_OD ! ! Public data ! @@ -56,10 +54,6 @@ module comsrf real(r8), allocatable:: trefmxav(:,:) ! diagnostic: tref max over the day real(r8), allocatable:: trefmnav(:,:) ! diagnostic: tref min over the day - public oc, ol, oadir - real(r8), allocatable:: oc(:,:) ! Convexity - real(r8), allocatable:: oadir(:,:,:) ! Asymmetry - real(r8), allocatable:: ol(:,:,:) ! Effective length ! ! Private module data @@ -138,28 +132,4 @@ subroutine initialize_comsrf end if end subroutine initialize_comsrf - subroutine initialize_comsrf_OD - use cam_control_mod, only: ideal_phys, adiabatic -!----------------------------------------------------------------------- -! -! Purpose: -! Initialize surface data -! -! Method: -! -! Author: Mariana Vertenstein -! -!----------------------------------------------------------------------- - integer k,c ! level, constituent indices - - if(.not. (adiabatic .or. ideal_phys)) then - allocate (oc (pcols,begchunk:endchunk)) - allocate (oadir (pcols,nvar_dirOA,begchunk:endchunk)) - allocate (ol (pcols,nvar_dirOL,begchunk:endchunk)) - oc (:,:) = nan - oadir (:,:,:) = nan - ol (:,:,:) = nan - end if - end subroutine initialize_comsrf_OD - end module comsrf diff --git a/components/eam/src/physics/cam/gw_drag.F90 b/components/eam/src/physics/cam/gw_drag.F90 index 352858905ba..96ac9f70021 100644 --- a/components/eam/src/physics/cam/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw_drag.F90 @@ -24,7 +24,7 @@ module gw_drag !-------------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, pverp, nvar_dirOA, nvar_dirOL, begchunk, endchunk + use ppgrid, only: pcols, pver use hycoef, only: hyai, hybi, hyam, hybm, etamid use constituents, only: pcnst use physics_types, only: physics_state, physics_ptend, physics_ptend_init @@ -49,6 +49,7 @@ module gw_drag ! PUBLIC: interfaces ! public :: gw_drag_readnl ! Read namelist + public :: gw_register ! Register pbuf variables public :: gw_init ! Initialization public :: gw_tend ! interface to actual parameterization @@ -199,7 +200,16 @@ end subroutine gw_drag_readnl !========================================================================== -subroutine gw_init() +subroutine gw_register() + use od_common, only: oro_drag_register + + call oro_drag_register() + +end subroutine gw_register + +!========================================================================== + +subroutine gw_init(pbuf2d) !----------------------------------------------------------------------- ! Time independent initialization for multiple gravity wave ! parameterization. @@ -208,7 +218,7 @@ subroutine gw_init() use cam_history, only: addfld, horiz_only, add_default use interpolate_data, only: lininterp use phys_control, only: phys_getopts - use physics_buffer, only: pbuf_get_index + use physics_buffer, only: pbuf_get_index, physics_buffer_desc use ref_pres, only: pref_edge use physconst, only: gravit, rair @@ -218,12 +228,9 @@ subroutine gw_init() use gw_front, only: gw_front_init use gw_convect, only: gw_convect_init - use comsrf, only: oc, oadir, ol, initialize_comsrf_OD - use pio, only: file_desc_t - use startup_initialconds,only: topo_OD_file_get_id, setup_initial_OD, close_initial_file_OD - use ncdio_atm, only: infld - use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id,cam_grid_get_dim_names - + use od_common, only: oro_drag_init + !------------------------------Arguments-------------------------------- + type(physics_buffer_desc), pointer :: pbuf2d(:,:) !---------------------------Local storage------------------------------- integer :: l, k @@ -296,36 +303,8 @@ subroutine gw_init() character(len=128) :: errstring !----------------------------------------------------------------------- - !added for input of od parameters - type(file_desc_t), pointer :: ncid_topo_OD - logical :: found=.false. - character(len=8) :: dim1name, dim2name - character*11 :: subname='gw_init' ! subroutine name - integer :: grid_id - pblh_idx = pbuf_get_index('pblh') - grid_id = cam_grid_id('physgrid') - - if (use_od_ls.or.use_od_bl) then - if (.not. cam_grid_check(grid_id)) then - call endrun(trim(subname)//': Internal error, no "physgrid" grid') - end if - call cam_grid_get_dim_names(grid_id, dim1name, dim2name) - call initialize_comsrf_OD() - call setup_initial_OD() - - ncid_topo_OD=>topo_OD_file_get_id() - call infld('OC', ncid_topo_OD, dim1name, dim2name, 1, pcols, begchunk, & - endchunk, oc , found, gridname='physgrid') - !keep the same interval of OA,OL - call infld('OA', ncid_topo_OD,dim1name, 'nvar_dirOA', dim2name, 1, pcols, 1, nvar_dirOA, begchunk, & - endchunk, oadir(:,:,:), found, gridname='physgrid') - call infld('OL', ncid_topo_OD,dim1name, 'nvar_dirOL', dim2name, 1, pcols, 1, nvar_dirOL, begchunk, & - endchunk, ol , found, gridname='physgrid') - if(.not. found) call endrun('ERROR: OD topo file readerr') - call close_initial_file_OD() - - endif + call oro_drag_init(pbuf2d) ! Set model flags. do_spectral_waves = (pgwv > 0 .and. (use_gw_front .or. use_gw_convect)) @@ -699,9 +678,6 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) ! real(r8), pointer :: pblh(:) real(r8) :: dx(pcols),dy(pcols) - ! - logical :: gwd_ls,gwd_bl,gwd_ss,gwd_fd - ! !---------------------------Local storage------------------------------- @@ -998,22 +974,12 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) ttgw, qtgw, taucd, egwdffi, gwut(:,:,0:0), dttdf, dttke) endif ! - if (use_od_ls.or.& - use_od_bl.or.& - use_od_ss) then - !open ogwd,bl,ss, - !close fd - gwd_ls=use_od_ls - gwd_bl=use_od_bl - gwd_ss=use_od_ss - gwd_fd=.false. - ! + if ( use_od_ls .or. use_od_bl .or. use_od_ss) then utgw=0.0_r8 vtgw=0.0_r8 ttgw=0.0_r8 - ! call oro_drag_interface(state,cam_in,sgh,pbuf,dt,nm,& - gwd_ls,gwd_bl,gwd_ss,gwd_fd,& + use_od_ls,use_od_bl,use_od_ss,.false.,& od_ls_ncleff,od_bl_ncd,od_ss_sncleff,& utgw,vtgw,ttgw,& dtaux3_ls=dtaux3_ls,dtauy3_ls=dtauy3_ls,& @@ -1024,14 +990,13 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) dusfc_bl=dusfc_bl,dvsfc_bl=dvsfc_bl,& dusfc_ss=dusfc_ss,dvsfc_ss=dvsfc_ss,& dusfc_fd=dummx_fd,dvsfc_fd=dummy_fd) - endif - ! - ! Add the orographic tendencies to the spectrum tendencies - ! Compute the temperature tendency from energy conservation - ! (includes spectrum). - ! both old and new gwd scheme will add the tendency to circulation - ! + ! + ! Add the orographic tendencies to the spectrum tendencies + ! Compute the temperature tendency from energy conservation + ! (includes spectrum). + ! both old and new gwd scheme will add the tendency to circulation + ! if (use_gw_oro.or.& use_od_ls .or.& use_od_bl .or.& diff --git a/components/eam/src/physics/cam/od_common.F90 b/components/eam/src/physics/cam/od_common.F90 index 3eb81889e95..5d84e718b28 100644 --- a/components/eam/src/physics/cam/od_common.F90 +++ b/components/eam/src/physics/cam/od_common.F90 @@ -1,5 +1,5 @@ module od_common -! +!========================================================================== ! This module contains code common to different orographic drag ! parameterizations. ! It includes 4 parts: @@ -7,23 +7,159 @@ module od_common ! flow-blocking drag (Xie et al.,2020), ! small-scale orographic gravity wave drag (Tsiringakis et al. 2017), ! turbulent orographic form drag (Beljaars et al.,2004). -! -use gw_utils, only: r8 -use ppgrid, only: pver,nvar_dirOA,nvar_dirOL +!========================================================================== +use shr_kind_mod, only: i8 => shr_kind_i8, r8 => shr_kind_r8 +use shr_sys_mod, only: shr_sys_flush +use ppgrid, only: pcols, pver, begchunk, endchunk use cam_logfile, only: iulog +use cam_abortutils,only: endrun +use pio, only: file_desc_t +use phys_control, only: use_od_ls, use_od_bl, use_od_ss, od_ls_ncleff, od_bl_ncd, od_ss_sncleff +use physics_buffer,only: dtype_r8, physics_buffer_desc, pbuf_get_chunk +use physics_buffer,only: pbuf_get_index, pbuf_get_field, pbuf_add_field, pbuf_set_field implicit none private save ! Public interface. +public :: oro_drag_register +public :: oro_drag_init public :: oro_drag_interface public :: od_gsd,pblh_get_level_idx,grid_size +type(file_desc_t), pointer :: topo_file_ncid + +! dimensions for topo shape data +integer, parameter :: ndir_asymmetry = 2+1 ! add 1 to avoid bug reading file - not sure why this happens +integer, parameter :: ndir_efflength = 180 ! 1-degree resolution with opposite directions mirrored + +! pbuf indices for data read in from topo data file +integer :: oro_drag_convexity_idx = -1 ! Convexity +integer :: oro_drag_asymmetry_idx = -1 ! Asymmetry +integer :: oro_drag_efflength_idx = -1 ! Effective length +integer :: oro_drag_ribulk_idx = -1 ! bulk richardson number (calculated in CLUBB) + contains !========================================================================== +subroutine oro_drag_open_topo_file() + use filenames, only: bnd_topo + use ioFileMod, only: getfil + use cam_pio_utils,only: cam_pio_openfile + use pio, only: pio_nowrite + include 'netcdf.inc' + !----------------------------------------------------------------------- + character(len=256) :: bnd_topo_loc ! filepath of topo file on local disk + allocate(topo_file_ncid) + call getfil(bnd_topo, bnd_topo_loc) + call cam_pio_openfile(topo_file_ncid, bnd_topo_loc, PIO_NOWRITE) +end subroutine oro_drag_open_topo_file + +!========================================================================== + +subroutine oro_drag_close_topo_file + use pio, only: pio_closefile + call pio_closefile(topo_file_ncid) + deallocate(topo_file_ncid) + nullify(topo_file_ncid) +end subroutine oro_drag_close_topo_file + +!========================================================================== + +subroutine oro_drag_register() + !----------------------------------------------------------------------- + ! Register pbuf variables for orographic drag parameterizations + !----------------------------------------------------------------------- + ! create pbuf variables to hold oro drag data + if (use_od_ls.or.use_od_bl) then + call pbuf_add_field('oro_drag_convexity','physpkg',dtype_r8,(/pcols/), oro_drag_convexity_idx) + call pbuf_add_field('oro_drag_asymmetry','physpkg',dtype_r8,(/pcols,ndir_asymmetry/),oro_drag_asymmetry_idx) + call pbuf_add_field('oro_drag_efflength','physpkg',dtype_r8,(/pcols,ndir_efflength/),oro_drag_efflength_idx) + end if + if (use_od_ss) then + call pbuf_add_field('oro_drag_ribulk', 'physpkg',dtype_r8,(/pcols/), oro_drag_ribulk_idx) + end if + +end subroutine oro_drag_register + +!========================================================================== + +subroutine oro_drag_init(pbuf2d) + !----------------------------------------------------------------------- + ! Initialization for orographic drag parameterizations + !----------------------------------------------------------------------- + use pio, only: file_desc_t + use ncdio_atm, only: infld + use cam_grid_support, only: cam_grid_check, cam_grid_get_decomp, cam_grid_id,cam_grid_get_dim_names + use infnan, only: nan, assignment(=) + !----------------------------------------------------------------------- + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + !----------------------------------------------------------------------- + logical :: found + character(len=8) :: dim1name, dim2name + character*11 :: subname='oro_drag_init' + integer :: grid_id + integer :: c + + real(r8), allocatable:: oro_drag_convexity_tmp(:,:) + real(r8), allocatable:: oro_drag_asymmetry_tmp(:,:,:) + real(r8), allocatable:: oro_drag_efflength_tmp(:,:,:) + + type(physics_buffer_desc), pointer :: pbuf_chunk(:) ! temporary pbuf pointer for single chunk + !----------------------------------------------------------------------- + if (.not.(use_od_ls.or.use_od_bl)) return + + grid_id = cam_grid_id('physgrid') + if (.not. cam_grid_check(grid_id)) then + call endrun(trim(subname)//': Internal error, no "physgrid" grid') + end if + + ! Alocate variables for reading oro drag data + allocate( oro_drag_convexity_tmp(pcols,begchunk:endchunk) ) + allocate( oro_drag_asymmetry_tmp(pcols,ndir_asymmetry,begchunk:endchunk) ) + allocate( oro_drag_efflength_tmp(pcols,ndir_efflength,begchunk:endchunk) ) + oro_drag_convexity_tmp(:,:) = nan + oro_drag_asymmetry_tmp(:,:,:) = nan + oro_drag_efflength_tmp(:,:,:) = nan + + ! Read special orographic shape fields from topo file + call cam_grid_get_dim_names(grid_id, dim1name, dim2name) + call oro_drag_open_topo_file() + + found=.false. + call infld( 'OC', topo_file_ncid, dim1name, dim2name, 1, pcols, & + begchunk, endchunk, oro_drag_convexity_tmp(:,:), found, gridname='physgrid') + if(.not. found) call endrun('ERROR - oro_drag_init: topo file read error - OC') + + found=.false. + call infld( 'OA', topo_file_ncid, dim1name, 'ndir_asymmetry', dim2name, 1, pcols, 1, ndir_asymmetry, & + begchunk, endchunk, oro_drag_asymmetry_tmp(:,:,:), found, gridname='physgrid') + if(.not. found) call endrun('ERROR - oro_drag_init: topo file read error - OA') + + found=.false. + call infld( 'OL', topo_file_ncid, dim1name, 'ndir_efflength', dim2name, 1, pcols, 1, ndir_efflength, & + begchunk, endchunk, oro_drag_efflength_tmp(:,:,:), found, gridname='physgrid') + if(.not. found) call endrun('ERROR - oro_drag_init: topo file read error - OL') + + call oro_drag_close_topo_file() + + ! copy the oro drag data in pbuf + do c=begchunk,endchunk + pbuf_chunk => pbuf_get_chunk(pbuf2d, c) + call pbuf_set_field(pbuf_chunk, oro_drag_convexity_idx, oro_drag_convexity_tmp(:,c) ) + call pbuf_set_field(pbuf_chunk, oro_drag_asymmetry_idx, oro_drag_asymmetry_tmp(:,:,c) ) + call pbuf_set_field(pbuf_chunk, oro_drag_efflength_idx, oro_drag_efflength_tmp(:,:,c) ) + end do + + deallocate(oro_drag_convexity_tmp) + deallocate(oro_drag_asymmetry_tmp) + deallocate(oro_drag_efflength_tmp) + +end subroutine oro_drag_init +!========================================================================== + subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm, & gwd_ls, gwd_bl, gwd_ss, gwd_fd, & od_ls_ncleff, od_bl_ncd,od_ss_sncleff, & @@ -33,13 +169,12 @@ subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm, dusfc_ls, dvsfc_ls ,dusfc_bl, dvsfc_bl, & dusfc_ss, dvsfc_ss ,dusfc_fd, dvsfc_fd) use physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index use camsrfexch, only: cam_in_t use ppgrid, only: pcols,pver,pverp use physconst, only: gravit,rair,cpair,rh2o,zvir,pi use hycoef, only: etamid - - type(physics_state), intent(in) :: state ! physics state structure ! Standard deviation of orography. + !----------------------------------------------------------------------- + type(physics_state), intent(in) :: state ! physics state structure type(cam_in_t), intent(in) :: cam_in real(r8), intent(in) :: sgh(pcols) type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer @@ -81,17 +216,21 @@ subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm, real(r8) :: zmid(pcols,pver) ! middle interface height asl (m) real(r8) :: dz(pcols,pver) ! model layer height - !real(r8) :: g - !pblh input integer :: pblh_idx = 0 integer :: kpbl2d_in(pcols) integer :: kpbl2d_reverse_in(pcols) real(r8), pointer :: pblh(:) real(r8) :: dx(pcols),dy(pcols) - !needed index + + real(r8), pointer :: oro_drag_convexity(:) + real(r8), pointer :: oro_drag_asymmetry(:,:) + real(r8), pointer :: oro_drag_efflength(:,:) + real(r8), pointer :: oro_drag_ribulk(:) ! pbuf pointer for bulk richardson number + integer :: ncol integer :: i integer :: k + !----------------------------------------------------------------------- ncol=state%ncol !convert heights above surface to heights above sea level @@ -120,7 +259,7 @@ subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm, do k=1,pver do i=1,ncol - ! assign values for level top/bottom + ! assign values for level top/bottom ztop(i,k)=state%zi(i,k) zbot(i,k)=state%zi(i,k+1) enddo @@ -145,34 +284,41 @@ subroutine oro_drag_interface(state, cam_in, sgh, pbuf, dtime, nm, kpbl2d_reverse_in(i)=pverp-kpbl2d_in(i)!pverp-k end do + call pbuf_get_field(pbuf, oro_drag_convexity_idx, oro_drag_convexity ) + call pbuf_get_field(pbuf, oro_drag_asymmetry_idx, oro_drag_asymmetry ) + call pbuf_get_field(pbuf, oro_drag_efflength_idx, oro_drag_efflength ) + call pbuf_get_field(pbuf, oro_drag_ribulk_idx, oro_drag_ribulk) + !get grid size for dx,dy call grid_size(state,dx,dy) + !interface for orographic drag - call od_gsd(& - u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& - qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& - pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& - od_ls_ncleff=od_ls_ncleff,od_bl_ncd=od_bl_ncd,od_ss_sncleff=od_ss_sncleff,& - rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& - dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& - dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& - dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& - dtaux3d_fd=dtaux3_fd(:ncol,pver:1:-1),dtauy3d_fd=dtauy3_fd(:ncol,pver:1:-1),& - dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& - dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& - dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& - dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& - xland=cam_in%landfrac,br=state%ribulk(:ncol),& - var2d=sgh(:ncol),oc12d=state%oc(:ncol),& - oa2d=state%oadir(:ncol,:),ol2d=state%ol(:ncol,:),& - znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& - cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& - dt=dtime,dx=dx,dy=dy,& - kpbl2d=kpbl2d_reverse_in,gwd_opt=0,& - ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & - ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & - its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & - gwd_ls=gwd_ls,gwd_bl=gwd_bl,gwd_ss=gwd_ss,gwd_fd=gwd_fd ) + call od_gsd(u3d=state%u(:ncol,pver:1:-1),v3d=state%v(:ncol,pver:1:-1),t3d=state%t(:ncol,pver:1:-1),& + qv3d=state%q(:ncol,pver:1:-1,1),p3d=state%pmid(:ncol,pver:1:-1),p3di=state%pint(:ncol,pver+1:1:-1),& + pi3d=state%exner(:ncol,pver:1:-1),z=zbot(:ncol,pver:1:-1),& + od_ls_ncleff=od_ls_ncleff,od_bl_ncd=od_bl_ncd,od_ss_sncleff=od_ss_sncleff,& + rublten=utgw(:ncol,pver:1:-1),rvblten=vtgw(:ncol,pver:1:-1),rthblten=ttgw(:ncol,pver:1:-1),& + dtaux3d_ls=dtaux3_ls(:ncol,pver:1:-1),dtauy3d_ls=dtauy3_ls(:ncol,pver:1:-1),& + dtaux3d_bl=dtaux3_bl(:ncol,pver:1:-1),dtauy3d_bl=dtauy3_bl(:ncol,pver:1:-1),& + dtaux3d_ss=dtaux3_ss(:ncol,pver:1:-1),dtauy3d_ss=dtauy3_ss(:ncol,pver:1:-1),& + dtaux3d_fd=dtaux3_fd(:ncol,pver:1:-1),dtauy3d_fd=dtauy3_fd(:ncol,pver:1:-1),& + dusfcg_ls=dusfc_ls(:ncol),dvsfcg_ls=dvsfc_ls(:ncol),& + dusfcg_bl=dusfc_bl(:ncol),dvsfcg_bl=dvsfc_bl(:ncol),& + dusfcg_ss=dusfc_ss(:ncol),dvsfcg_ss=dvsfc_ss(:ncol),& + dusfcg_fd=dusfc_fd(:ncol),dvsfcg_fd=dvsfc_fd(:ncol),& + xland=cam_in%landfrac,br=oro_drag_ribulk(:ncol),& + var2d=sgh(:ncol),& + oc12d=oro_drag_convexity(:ncol),& + oa2d=oro_drag_asymmetry(:ncol,:),& + ol2d=oro_drag_efflength(:ncol,:),& + znu=etamid(pver:1:-1),dz=dz(:ncol,pver:1:-1),pblh=pblh(:ncol),& + cp=cpair,g=gravit,rd=rair,rv=rh2o,ep1=zvir,pi=pi,bnvbg=nm(:ncol,pver:1:-1),& + dt=dtime,dx=dx,dy=dy,& + kpbl2d=kpbl2d_reverse_in,gwd_opt=0,& + ids=1,ide=ncol,jds=0,jde=0,kds=1,kde=pver, & + ims=1,ime=ncol,jms=0,jme=0,kms=1,kme=pver, & + its=1,ite=ncol,jts=0,jte=0,kts=1,kte=pver, & + gwd_ls=gwd_ls,gwd_bl=gwd_bl,gwd_ss=gwd_ss,gwd_fd=gwd_fd ) end subroutine oro_drag_interface @@ -263,39 +409,39 @@ subroutine grid_size(state, grid_dx, grid_dy) integer :: i do i=1,state%ncol - ! determine the column area in radians - column_area = get_area_p(state%lchnk,i) - ! convert to degrees - degree = sqrt(column_area)*(180._r8/shr_const_pi) - - ! convert latitude to radians - lat_in_rad = state%lat(i)*(shr_const_pi/180._r8) - - ! Now find meters per degree latitude - ! Below equation finds distance between two points on an ellipsoid, derived from expansion - ! taking into account ellipsoid using World Geodetic System (WGS84) reference - mpdeglat = earth_ellipsoid1 - earth_ellipsoid2 * cos(2._r8*lat_in_rad) + earth_ellipsoid3 * cos(4._r8*lat_in_rad) - grid_dx(i) = mpdeglat * degree - grid_dy(i) = grid_dx(i) ! Assume these are the same + ! determine the column area in radians + column_area = get_area_p(state%lchnk,i) + ! convert to degrees + degree = sqrt(column_area)*(180._r8/shr_const_pi) + + ! convert latitude to radians + lat_in_rad = state%lat(i)*(shr_const_pi/180._r8) + + ! Now find meters per degree latitude + ! Below equation finds distance between two points on an ellipsoid, derived from expansion + ! taking into account ellipsoid using World Geodetic System (WGS84) reference + mpdeglat = earth_ellipsoid1 - earth_ellipsoid2 * cos(2._r8*lat_in_rad) + earth_ellipsoid3 * cos(4._r8*lat_in_rad) + grid_dx(i) = mpdeglat * degree + grid_dy(i) = grid_dx(i) ! Assume these are the same enddo end subroutine grid_size !========================================================================== subroutine od_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & - od_ls_ncleff,od_bl_ncd,od_ss_sncleff, & - rublten,rvblten,rthblten, & - dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & - dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd, & - dusfcg_ls,dvsfcg_ls,dusfcg_bl,dvsfcg_bl,dusfcg_ss,dvsfcg_ss, & - dusfcg_fd,dvsfcg_fd,xland,br, & - var2d,oc12d,oa2d,ol2d,znu,znw,p_top,dz,pblh, & - cp,g,rd,rv,ep1,pi,bnvbg, & - dt,dx,dy,kpbl2d,gwd_opt, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, & - gwd_ls,gwd_bl,gwd_ss,gwd_fd) + od_ls_ncleff,od_bl_ncd,od_ss_sncleff, & + rublten,rvblten,rthblten, & + dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & + dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd, & + dusfcg_ls,dvsfcg_ls,dusfcg_bl,dvsfcg_bl,dusfcg_ss,dvsfcg_ss, & + dusfcg_fd,dvsfcg_fd,xland,br, & + var2d,oc12d,oa2d,ol2d,znu,znw,p_top,dz,pblh, & + cp,g,rd,rv,ep1,pi,bnvbg, & + dt,dx,dy,kpbl2d,gwd_opt, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, & + gwd_ls,gwd_bl,gwd_ss,gwd_fd) !------------------------------------------------------------------------------- implicit none !------------------------------------------------------------------------------- @@ -375,8 +521,8 @@ subroutine od_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & !input topographic parameters real(r8), dimension( ims:ime ), intent(in), optional :: var2d real(r8), dimension( ims:ime ), intent(in), optional :: oc12d - real(r8), dimension( ims:ime,nvar_dirOL ),intent(in), optional :: ol2d - real(r8), dimension( ims:ime,nvar_dirOA ),intent(in), optional :: oa2d + real(r8), dimension( ims:ime,ndir_efflength ),intent(in), optional :: ol2d + real(r8), dimension( ims:ime,ndir_asymmetry ),intent(in), optional :: oa2d !input model parameters real(r8), intent(in), optional :: dt real(r8), intent(in), optional :: p_top @@ -426,8 +572,8 @@ subroutine od_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & real(r8), dimension( its:ite, kts:kte ) :: delprsi real(r8), dimension( its:ite, kts:kte ) :: pdh real(r8), dimension( its:ite, kts:kte+1 ) :: pdhi - real(r8), dimension( its:ite, nvar_dirOA ) :: oa4 - real(r8), dimension( its:ite, nvar_dirOL ) :: ol4 + real(r8), dimension( its:ite, ndir_asymmetry ) :: oa4 + real(r8), dimension( its:ite, ndir_efflength ) :: ol4 integer :: i,j,k,kpblmax !determine the lowest level for planet boundary layer do k = kts,kte @@ -454,58 +600,58 @@ subroutine od_gsd(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, & ol4(i,:) = ol2d(i,:) enddo endif - !call the od2d for calculatino of each grid - call od2d(dudt=rublten(ims,kms),dvdt=rvblten(ims,kms) & - ,dthdt=rthblten(ims,kms) & - ,ncleff=od_ls_ncleff,ncd=od_bl_ncd,sncleff=od_ss_sncleff & - ,dtaux2d_ls=dtaux2d_ls,dtauy2d_ls=dtauy2d_ls & - ,dtaux2d_bl=dtaux2d_bl,dtauy2d_bl=dtauy2d_bl & - ,dtaux2d_ss=dtaux2d_ss,dtauy2d_ss=dtauy2d_ss & - ,dtaux2d_fd=dtaux2d_fd,dtauy2d_fd=dtauy2d_fd & - ,u1=u3d(ims,kms),v1=v3d(ims,kms) & - ,t1=t3d(ims,kms) & - ,q1=qv3d(ims,kms) & - ,del=delprsi(its,kts) & - ,prsi=pdhi(its,kts) & - ,prsl=pdh(its,kts),prslk=pi3d(ims,kms) & - ,zl=z(ims,kms),rcl=1.0_r8 & - ,xland1=xland(ims),br1=br(ims),hpbl=pblh(ims) & - ,bnv_in=bnvbg(ims,kms) & - ,dz2=dz(ims,kms) & - ,kpblmax=kpblmax & - ,dusfc_ls=dusfc_ls,dvsfc_ls=dvsfc_ls & - ,dusfc_bl=dusfc_bl,dvsfc_bl=dvsfc_bl & - ,dusfc_ss=dusfc_ss,dvsfc_ss=dvsfc_ss & - ,dusfc_fd=dusfc_fd,dvsfc_fd=dvsfc_fd & - ,var=var2d(ims),oc1=oc12d(ims) & - ,oa4=oa4,ol4=ol4 & - ,g=g,cp=cp,rd=rd,rv=rv,fv=ep1,pi=pi & - ,dxmeter=dx,dymeter=dy,deltim=dt & - ,kpbl=kpbl2d(ims) & - ,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde & - ,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme & - ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte & - ,gsd_gwd_ls=gwd_ls,gsd_gwd_bl=gwd_bl,gsd_gwd_ss=gwd_ss,gsd_gwd_fd=gwd_fd) - !set the total stress output to each terms for the 4 drag schemes - do i = its,ite - dusfcg_ls(i)=dusfc_ls(i) - dvsfcg_ls(i)=dvsfc_ls(i) - dusfcg_bl(i)=dusfc_bl(i) - dvsfcg_bl(i)=dvsfc_bl(i) - dusfcg_ss(i)=dusfc_ss(i) - dvsfcg_ss(i)=dvsfc_ss(i) - dusfcg_fd(i)=dusfc_fd(i) - dvsfcg_fd(i)=dvsfc_fd(i) - enddo - !set the 3D output tendencies to each terms for the 4 drag schemes - dtaux3d_ls=dtaux2d_ls - dtaux3d_bl=dtaux2d_bl - dtauy3d_ls=dtauy2d_ls - dtauy3d_bl=dtauy2d_bl - dtaux3d_ss=dtaux2d_ss - dtaux3d_fd=dtaux2d_fd - dtauy3d_ss=dtauy2d_ss - dtauy3d_fd=dtauy2d_fd + !call the od2d for calculatino of each grid + call od2d(dudt=rublten(ims,kms),dvdt=rvblten(ims,kms) & + ,dthdt=rthblten(ims,kms) & + ,ncleff=od_ls_ncleff,ncd=od_bl_ncd,sncleff=od_ss_sncleff & + ,dtaux2d_ls=dtaux2d_ls,dtauy2d_ls=dtauy2d_ls & + ,dtaux2d_bl=dtaux2d_bl,dtauy2d_bl=dtauy2d_bl & + ,dtaux2d_ss=dtaux2d_ss,dtauy2d_ss=dtauy2d_ss & + ,dtaux2d_fd=dtaux2d_fd,dtauy2d_fd=dtauy2d_fd & + ,u1=u3d(ims,kms),v1=v3d(ims,kms) & + ,t1=t3d(ims,kms) & + ,q1=qv3d(ims,kms) & + ,del=delprsi(its,kts) & + ,prsi=pdhi(its,kts) & + ,prsl=pdh(its,kts),prslk=pi3d(ims,kms) & + ,zl=z(ims,kms),rcl=1.0_r8 & + ,xland1=xland(ims),br1=br(ims),hpbl=pblh(ims) & + ,bnv_in=bnvbg(ims,kms) & + ,dz2=dz(ims,kms) & + ,kpblmax=kpblmax & + ,dusfc_ls=dusfc_ls,dvsfc_ls=dvsfc_ls & + ,dusfc_bl=dusfc_bl,dvsfc_bl=dvsfc_bl & + ,dusfc_ss=dusfc_ss,dvsfc_ss=dvsfc_ss & + ,dusfc_fd=dusfc_fd,dvsfc_fd=dvsfc_fd & + ,var=var2d(ims),oc1=oc12d(ims) & + ,oa4=oa4,ol4=ol4 & + ,g=g,cp=cp,rd=rd,rv=rv,fv=ep1,pi=pi & + ,dxmeter=dx,dymeter=dy,deltim=dt & + ,kpbl=kpbl2d(ims) & + ,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde & + ,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme & + ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte & + ,gsd_gwd_ls=gwd_ls,gsd_gwd_bl=gwd_bl,gsd_gwd_ss=gwd_ss,gsd_gwd_fd=gwd_fd) + !set the total stress output to each terms for the 4 drag schemes + do i = its,ite + dusfcg_ls(i) = dusfc_ls(i) + dvsfcg_ls(i) = dvsfc_ls(i) + dusfcg_bl(i) = dusfc_bl(i) + dvsfcg_bl(i) = dvsfc_bl(i) + dusfcg_ss(i) = dusfc_ss(i) + dvsfcg_ss(i) = dvsfc_ss(i) + dusfcg_fd(i) = dusfc_fd(i) + dvsfcg_fd(i) = dvsfc_fd(i) + enddo + !set the 3D output tendencies to each terms for the 4 drag schemes + dtaux3d_ls = dtaux2d_ls + dtaux3d_bl = dtaux2d_bl + dtauy3d_ls = dtauy2d_ls + dtauy3d_bl = dtauy2d_bl + dtaux3d_ss = dtaux2d_ss + dtaux3d_fd = dtaux2d_fd + dtauy3d_ss = dtauy2d_ss + dtauy3d_fd = dtauy2d_fd end subroutine od_gsd ! @@ -513,21 +659,21 @@ end subroutine od_gsd ! !------------------------------------------------------------------------------- subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & - dtaux2d_ls,dtauy2d_ls, & - dtaux2d_bl,dtauy2d_bl, & - dtaux2d_ss,dtauy2d_ss, & - dtaux2d_fd,dtauy2d_fd, & - u1,v1,t1,q1, & - del, & - prsi,prsl,prslk,zl,rcl, & - xland1,br1,hpbl,bnv_in,dz2, & - kpblmax,dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & - dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd,var,oc1,oa4,ol4, & - g,cp,rd,rv,fv,pi,dxmeter,dymeter,deltim,kpbl, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, & - gsd_gwd_ls,gsd_gwd_bl,gsd_gwd_ss,gsd_gwd_fd) + dtaux2d_ls,dtauy2d_ls, & + dtaux2d_bl,dtauy2d_bl, & + dtaux2d_ss,dtauy2d_ss, & + dtaux2d_fd,dtauy2d_fd, & + u1,v1,t1,q1, & + del, & + prsi,prsl,prslk,zl,rcl, & + xland1,br1,hpbl,bnv_in,dz2, & + kpblmax,dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd,var,oc1,oa4,ol4, & + g,cp,rd,rv,fv,pi,dxmeter,dymeter,deltim,kpbl, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, & + gsd_gwd_ls,gsd_gwd_bl,gsd_gwd_ss,gsd_gwd_fd) ! This code handles the time tendencies of u v due to the effect of mountain ! induced gravity wave drag from sub-grid scale orography. It includes 4 parts: ! orographic gravity wave drag and flow-blocking drag (Xie et al.,2020),small-scale @@ -582,8 +728,8 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & real(r8), dimension(:), intent(in) :: dxmeter real(r8), dimension(:), intent(in) :: dymeter !input topo variables - real(r8), dimension( ims:ime,nvar_dirOA ), intent(in) :: oa4 - real(r8), dimension( ims:ime,nvar_dirOL ), intent(in) :: ol4 + real(r8), dimension( ims:ime,ndir_asymmetry ), intent(in) :: oa4 + real(r8), dimension( ims:ime,ndir_efflength ), intent(in) :: ol4 real(r8), dimension( ims:ime ) , intent(in) :: var real(r8), dimension( ims:ime ) , intent(in) :: oc1 !input atmospheric variables @@ -673,7 +819,7 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & real(r8),parameter :: tndmax = 400._r8 / 86400._r8 ! convert 400 m/s/day to m/s/s integer,parameter :: kpblmin = 2 !number of direction for ogwd - integer,parameter :: mdir=2*nvar_dirOL + integer,parameter :: mdir=2*ndir_efflength ! variables for flow-blocking drag real(r8),parameter :: frmax = 10._r8 real(r8),parameter :: olmin = 1.0e-5_r8 @@ -736,8 +882,8 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & real(r8),dimension( its:ite ) :: dely real(r8),dimension( its:ite ) :: dxy real(r8),dimension( its:ite ) :: dxyp - real(r8),dimension( its:ite,nvar_dirOL ):: dxy4 - real(r8),dimension( its:ite,nvar_dirOL ):: dxy4p + real(r8),dimension( its:ite,ndir_efflength ):: dxy4 + real(r8),dimension( its:ite,ndir_efflength ):: dxy4p !topo parameters real(r8),dimension( its:ite ) :: olp real(r8),dimension( its:ite ) :: od @@ -893,192 +1039,192 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & ! ! For ls and bl only IF (gsd_gwd_ls.or.gsd_gwd_bl) then - ! figure out low-level horizontal wind direction - ! order into a counterclockwise index instead - ! - do i = its,ite - wdir = atan2(vbar(i),ubar(i)) + pi!changed into y/x - wdir1 = wdir-pi - if (wdir1.ge.0._r8.and.wdir1.lt.pi) then - nwd = MOD(nint(fdir*wdir1),mdir) + 1 - else!(-pi,0) - nwd = MOD(nint(fdir*(wdir1+2._r8*pi)),mdir) + 1 - endif - !turn backwords because start is pi - !need turning - rad = 4.0_r8*atan(1.0_r8)/180.0_r8 - theta = (real(nwd,kind=r8)-1._r8)*(360._r8/real(mdir,kind=r8)) - !select OA - oa1(i) = oa4(i,1)*cos(theta*rad)+oa4(i,2)*sin(theta*rad) - !select OL - ol(i) = ol4(i,MOD(nwd-1,int(mdir/2))+1) - !calculate dxygrid, not so slow - call dxygrid(dxmeter(i),dymeter(i),theta,dxy(i)) + ! figure out low-level horizontal wind direction + ! order into a counterclockwise index instead ! - !----- compute orographic width along (ol) and perpendicular (olp) - !----- the direction of wind - !put wdir inside the (0,2*pi) section - !changing pi/2 either way is perpendicular - !wdir1=wdir-pi + do i = its,ite + wdir = atan2(vbar(i),ubar(i)) + pi!changed into y/x + wdir1 = wdir-pi + if (wdir1.ge.0._r8.and.wdir1.lt.pi) then + nwd = MOD(nint(fdir*wdir1),mdir) + 1 + else!(-pi,0) + nwd = MOD(nint(fdir*(wdir1+2._r8*pi)),mdir) + 1 + endif + !turn backwords because start is pi + !need turning + rad = 4.0_r8*atan(1.0_r8)/180.0_r8 + theta = (real(nwd,kind=r8)-1._r8)*(360._r8/real(mdir,kind=r8)) + !select OA + oa1(i) = oa4(i,1)*cos(theta*rad)+oa4(i,2)*sin(theta*rad) + !select OL + ol(i) = ol4(i,MOD(nwd-1,int(mdir/2))+1) + !calculate dxygrid, not so slow + call dxygrid(dxmeter(i),dymeter(i),theta,dxy(i)) + ! + !----- compute orographic width along (ol) and perpendicular (olp) + !----- the direction of wind + !put wdir inside the (0,2*pi) section + !changing pi/2 either way is perpendicular + !wdir1=wdir-pi if (wdir1.ge.0._r8.and.wdir1.lt.pi) then - nwd1 = MOD(nint(fdir*(wdir1+pi/2._r8)),mdir) + 1 - olp(i)=ol4(i,MOD(nwd1-1,int(mdir/2))+1) + nwd1 = MOD(nint(fdir*(wdir1+pi/2._r8)),mdir) + 1 + olp(i)=ol4(i,MOD(nwd1-1,int(mdir/2))+1) else!(-pi,0) - nwd1 = MOD(nint(fdir*(wdir1-pi/2._r8+2._r8*pi)),mdir) + 1 - olp(i)=ol4(i,MOD(nwd1-1,int(mdir/2))+1) + nwd1 = MOD(nint(fdir*(wdir1-pi/2._r8+2._r8*pi)),mdir) + 1 + olp(i)=ol4(i,MOD(nwd1-1,int(mdir/2))+1) endif theta=(real(nwd1,kind=r8)-1._r8)*(360._r8/real(mdir,kind=r8)) call dxygrid(dxmeter(i),dymeter(i),theta,dxyp(i)) - ! - ! - !----- compute orographic direction (horizontal orographic aspect ratio) - ! - od(i) = olp(i)/max(ol(i),olmin) - od(i) = min(od(i),odmax) - od(i) = max(od(i),odmin) - ! - !----- compute length of grid in the along(dxy) and cross(dxyp) wind directions - ! - enddo + ! + ! + !----- compute orographic direction (horizontal orographic aspect ratio) + ! + od(i) = olp(i)/max(ol(i),olmin) + od(i) = min(od(i),odmax) + od(i) = max(od(i),odmin) + ! + !----- compute length of grid in the along(dxy) and cross(dxyp) wind directions + ! + enddo ENDIF !============================================ ! END INITIALIZATION; BEGIN GWD CALCULATIONS: !============================================ IF (gsd_gwd_ls.or.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02) ) THEN - ! - !--- saving richardson number in usqj for migwdi - ! - do k = kts,kte-1 + ! + !--- saving richardson number in usqj for migwdi + ! + do k = kts,kte-1 + do i = its,ite + ti = 2.0_r8 / (t1(i,k)+t1(i,k+1)) + rdz = 1._r8/(zl(i,k+1) - zl(i,k)) + tem1 = u1(i,k) - u1(i,k+1) + tem2 = v1(i,k) - v1(i,k+1) + dw2 = rcl*(tem1*tem1 + tem2*tem2) + shr2 = max(dw2,dw2min) * rdz * rdz + bvf2 = g*(g/cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti + usqj(i,k) = max(bvf2/shr2,rimin) + bnv2(i,k) = max(bnv_in(i,k)**2,bnv2min ) + enddo + enddo + ! + !----compute the "low level" or 1/3 wind magnitude (m/s) + ! do i = its,ite - ti = 2.0_r8 / (t1(i,k)+t1(i,k+1)) - rdz = 1._r8/(zl(i,k+1) - zl(i,k)) - tem1 = u1(i,k) - u1(i,k+1) - tem2 = v1(i,k) - v1(i,k+1) - dw2 = rcl*(tem1*tem1 + tem2*tem2) - shr2 = max(dw2,dw2min) * rdz * rdz - bvf2 = g*(g/cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti - usqj(i,k) = max(bvf2/shr2,rimin) - bnv2(i,k) = max(bnv_in(i,k)**2,bnv2min ) + ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0_r8) + rulow(i) = 1._r8/ulow(i) enddo - enddo - ! - !----compute the "low level" or 1/3 wind magnitude (m/s) - ! - do i = its,ite - ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0_r8) - rulow(i) = 1._r8/ulow(i) - enddo - do k = kts,kte-1 + do k = kts,kte-1 + do i = its,ite + velco(i,k) = (0.5_r8*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) & + + (v1(i,k)+v1(i,k+1)) * vbar(i)) + velco(i,k) = velco(i,k) * rulow(i) + if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0._r8)) then + velco(i,k) = veleps + endif + enddo + enddo + ! + ! no drag when critical level in the base layer + ! do i = its,ite - velco(i,k) = (0.5_r8*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) & - + (v1(i,k)+v1(i,k+1)) * vbar(i)) - velco(i,k) = velco(i,k) * rulow(i) - if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0._r8)) then - velco(i,k) = veleps - endif + ldrag(i) = velco(i,1).le.0._r8 enddo - enddo - ! - ! no drag when critical level in the base layer - ! - do i = its,ite - ldrag(i) = velco(i,1).le.0._r8 - enddo - ! - ! no drag when velco.lt.0 - ! - do k = kpblmin,kpblmax + ! + ! no drag when velco.lt.0 + ! + do k = kpblmin,kpblmax + do i = its,ite + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0._r8 + enddo + enddo + ! + ! no drag when bnv2.lt.0 + ! + do k = kts,kpblmax + do i = its,ite + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0._r8 + enddo + enddo + ! + !-----the low level weighted average ri is stored in usqj(1,1; im) + !-----the low level weighted average n**2 is stored in bnv2(1,1; im) + !---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2 + !---- rdelks (del(k)/delks) vert ave factor so we can * instead of / + ! do i = its,ite - if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0._r8 + wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i) + bnv2(i,1) = wtkbj * bnv2(i,1) + usqj(i,1) = wtkbj * usqj(i,1) enddo - enddo - ! - ! no drag when bnv2.lt.0 - ! - do k = kts,kpblmax + + do k = kpblmin,kpblmax + do i = its,ite + if (k .lt. kbl(i)) then + rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i) + bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks + usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks + endif + enddo + enddo + do i = its,ite - if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0._r8 + ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0_r8 + ldrag(i) = ldrag(i) .or. ulow(i) .eq.1.0_r8 + ldrag(i) = ldrag(i) .or. var(i) .le.0.0_r8 enddo - enddo - ! - !-----the low level weighted average ri is stored in usqj(1,1; im) - !-----the low level weighted average n**2 is stored in bnv2(1,1; im) - !---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2 - !---- rdelks (del(k)/delks) vert ave factor so we can * instead of / - ! - do i = its,ite - wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i) - bnv2(i,1) = wtkbj * bnv2(i,1) - usqj(i,1) = wtkbj * usqj(i,1) - enddo - - do k = kpblmin,kpblmax + ! + ! set all ri low level values to the low level value + ! + do k = kpblmin,kpblmax + do i = its,ite + if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1) + enddo + enddo + do i = its,ite - if (k .lt. kbl(i)) then - rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i) - bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks - usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks + if (.not.ldrag(i)) then + bnv(i) = sqrt( bnv2(i,1) ) + fr(i) = bnv(i) * rulow(i) * 2._r8 * var(i) * od(i) + fr(i) = min(fr(i),frmax) + xn(i) = ubar(i) * rulow(i) + yn(i) = vbar(i) * rulow(i) endif enddo - enddo - - do i = its,ite - ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0_r8 - ldrag(i) = ldrag(i) .or. ulow(i) .eq.1.0_r8 - ldrag(i) = ldrag(i) .or. var(i) .le.0.0_r8 - enddo - ! - ! set all ri low level values to the low level value - ! - do k = kpblmin,kpblmax + ! + ! compute the base level stress and store it in taub + ! calculate enhancement factor, number of mountains & aspect + ! ratio const. use simplified relationship between standard + ! deviation & critical hgt + ! do i = its,ite - if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1) + if (.not. ldrag(i)) then + !maintain (oa+2) greater than or equal to 0 + efact = max(oa1(i)+2._r8,0._r8) ** (ce*fr(i)/frc) + efact = min(max(efact,efmin),efmax) + ! cleff (effective grid length) is highly tunable parameter + ! the bigger (smaller) value produce weaker (stronger) wave drag + cleff = sqrt(dxy(i)**2._r8 + dxyp(i)**2._r8) + !tune the times of drag + cleff = (3._r8/ncleff) * max(dxmax_ls,cleff) + coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) + xlinv(i) = coefm(i) / cleff + tem = fr(i) * fr(i) * 1.!oc1(i) + gfobnv = gmax * tem / ((tem + cg)*bnv(i)) + ! + if (gsd_gwd_ls) then + taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & + * ulow(i) * gfobnv * efact + else ! We've gotten what we need for the blocking scheme + taub(i) = 0.0_r8 + end if + else + taub(i) = 0.0_r8 + xn(i) = 0.0_r8 + yn(i) = 0.0_r8 + endif enddo - enddo - - do i = its,ite - if (.not.ldrag(i)) then - bnv(i) = sqrt( bnv2(i,1) ) - fr(i) = bnv(i) * rulow(i) * 2._r8 * var(i) * od(i) - fr(i) = min(fr(i),frmax) - xn(i) = ubar(i) * rulow(i) - yn(i) = vbar(i) * rulow(i) - endif - enddo - ! - ! compute the base level stress and store it in taub - ! calculate enhancement factor, number of mountains & aspect - ! ratio const. use simplified relationship between standard - ! deviation & critical hgt - ! - do i = its,ite - if (.not. ldrag(i)) then - !maintain (oa+2) greater than or equal to 0 - efact = max(oa1(i)+2._r8,0._r8) ** (ce*fr(i)/frc) - efact = min(max(efact,efmin),efmax) - ! cleff (effective grid length) is highly tunable parameter - ! the bigger (smaller) value produce weaker (stronger) wave drag - cleff = sqrt(dxy(i)**2._r8 + dxyp(i)**2._r8) - !tune the times of drag - cleff = (3._r8/ncleff) * max(dxmax_ls,cleff) - coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) - xlinv(i) = coefm(i) / cleff - tem = fr(i) * fr(i) * 1.!oc1(i) - gfobnv = gmax * tem / ((tem + cg)*bnv(i)) - ! - if (gsd_gwd_ls) then - taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & - * ulow(i) * gfobnv * efact - else ! We've gotten what we need for the blocking scheme - taub(i) = 0.0_r8 - end if - else - taub(i) = 0.0_r8 - xn(i) = 0.0_r8 - yn(i) = 0.0_r8 - endif - enddo ENDIF ! (gsd_gwd_ls .eq. .true.).or.(gsd_gwd_bl .eq..true.) !========================================================= @@ -1092,93 +1238,93 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & zq=0._r8 IF (gsd_gwd_ss.and.(ss_taper.GT.1.E-02)) THEN - ! - ! declaring potential temperature - ! - do k = kts,kte - do i = its,ite - thx(i,k) = t1(i,k)/prslk(i,k) + ! + ! declaring potential temperature + ! + do k = kts,kte + do i = its,ite + thx(i,k) = t1(i,k)/prslk(i,k) + enddo enddo - enddo - do k = kts,kte - do i = its,ite - tvcon = (1._r8+fv*q1(i,k)) - thvx(i,k) = thx(i,k)*tvcon + do k = kts,kte + do i = its,ite + tvcon = (1._r8+fv*q1(i,k)) + thvx(i,k) = thx(i,k)*tvcon + enddo enddo - enddo - ! - ! Defining layer height - ! - do k = kts,kte - do i = its,ite - zq(i,k+1) = dz2(i,k)+zq(i,k) + ! + ! Defining layer height + ! + do k = kts,kte + do i = its,ite + zq(i,k+1) = dz2(i,k)+zq(i,k) + enddo enddo - enddo - do k = kts,kte - do i = its,ite - za(i,k) = 0.5_r8*(zq(i,k)+zq(i,k+1)) + do k = kts,kte + do i = its,ite + za(i,k) = 0.5_r8*(zq(i,k)+zq(i,k+1)) + enddo enddo - enddo - do i=its,ite - hpbl2 = hpbl(i)+10._r8 - kpbl2 = kpbl(i) - kvar = 1 - do k=kts+1,MAX(kpbl(i),kts+1) - IF (za(i,k)>300._r8) then - kpbl2 = k - IF (k == kpbl(i)) then - hpbl2 = hpbl(i)+10._r8 - ELSE - hpbl2 = za(i,k)+10._r8 + do i=its,ite + hpbl2 = hpbl(i)+10._r8 + kpbl2 = kpbl(i) + kvar = 1 + do k=kts+1,MAX(kpbl(i),kts+1) + IF (za(i,k)>300._r8) then + kpbl2 = k + IF (k == kpbl(i)) then + hpbl2 = hpbl(i)+10._r8 + ELSE + hpbl2 = za(i,k)+10._r8 + ENDIF + exit ENDIF - exit - ENDIF - enddo + enddo - if(xland1(i).gt.0._r8 .and. 2._r8*var(i).le.hpbl(i))then - if(br1(i).gt.0._r8 .and. thvx(i,kpbl2)-thvx(i,kts) > 0._r8)then - cleff = sqrt(dxy(i)**2_r8 + dxyp(i)**2_r8) - cleff = (2.0_r8/sncleff) * max(dxmax_ss,cleff) - coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) - xlinv(i) = coefm(i) / cleff - govrth(i)=g/(0.5_r8*(thvx(i,kpbl2)+thvx(i,kts))) - bnrf=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) - - if(abs(bnrf/u1(i,kpbl2)).gt.xlinv(i))then - tauwavex0=0.5_r8*bnrf*xlinv(i)*(2._r8*MIN(var(i),varmax))**2_r8*ro(i,kvar)*u1(i,kvar) - tauwavex0=tauwavex0*ss_taper ! "Scale-awareness" - else - tauwavex0=0._r8 - endif + if(xland1(i).gt.0._r8 .and. 2._r8*var(i).le.hpbl(i))then + if(br1(i).gt.0._r8 .and. thvx(i,kpbl2)-thvx(i,kts) > 0._r8)then + cleff = sqrt(dxy(i)**2_r8 + dxyp(i)**2_r8) + cleff = (2.0_r8/sncleff) * max(dxmax_ss,cleff) + coefm(i) = (1._r8 + ol(i)) ** (oa1(i)+1._r8) + xlinv(i) = coefm(i) / cleff + govrth(i)=g/(0.5_r8*(thvx(i,kpbl2)+thvx(i,kts))) + bnrf=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) + + if(abs(bnrf/u1(i,kpbl2)).gt.xlinv(i))then + tauwavex0=0.5_r8*bnrf*xlinv(i)*(2._r8*MIN(var(i),varmax))**2_r8*ro(i,kvar)*u1(i,kvar) + tauwavex0=tauwavex0*ss_taper ! "Scale-awareness" + else + tauwavex0=0._r8 + endif - if(abs(bnrf/v1(i,kpbl2)).gt.xlinv(i))then - tauwavey0=0.5_r8*bnrf*xlinv(i)*(2._r8*MIN(var(i),varmax))**2._r8*ro(i,kvar)*v1(i,kvar) - tauwavey0=tauwavey0*ss_taper ! "Scale-awareness" - else - tauwavey0=0._r8 - endif + if(abs(bnrf/v1(i,kpbl2)).gt.xlinv(i))then + tauwavey0=0.5_r8*bnrf*xlinv(i)*(2._r8*MIN(var(i),varmax))**2._r8*ro(i,kvar)*v1(i,kvar) + tauwavey0=tauwavey0*ss_taper ! "Scale-awareness" + else + tauwavey0=0._r8 + endif - do k=kts,kpbl(i) !MIN(kpbl2+1,kte-1) - utendwave(i,k)=-1._r8*tauwavex0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 - vtendwave(i,k)=-1._r8*tauwavey0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 - enddo + do k=kts,kpbl(i) !MIN(kpbl2+1,kte-1) + utendwave(i,k)=-1._r8*tauwavex0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + vtendwave(i,k)=-1._r8*tauwavey0*2._r8*max((1._r8-za(i,k)/hpbl2),0._r8)/hpbl2 + enddo + endif endif - endif - enddo ! end i loop + enddo ! end i loop - do k = kts,kte - do i = its,ite - dudt(i,k) = dudt(i,k) + utendwave(i,k) - dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) - dtaux2d_ss(i,k) = utendwave(i,k) - dtauy2d_ss(i,k) = vtendwave(i,k) - dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) - dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) + do k = kts,kte + do i = its,ite + dudt(i,k) = dudt(i,k) + utendwave(i,k) + dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) + dtaux2d_ss(i,k) = utendwave(i,k) + dtauy2d_ss(i,k) = vtendwave(i,k) + dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) + dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) + enddo enddo - enddo ENDIF ! end if gsd_gwd_ss == .true. !================================================================ @@ -1240,108 +1386,108 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) enddo enddo - ENDIF ! end if gsd_gwd_fd == .true. + ENDIF ! end if gsd_gwd_fd == .true. !======================================================= ! More for the large-scale gwd component !======================================================= IF (gsd_gwd_ls.and.(ls_taper.GT.1.E-02) ) THEN - ! - ! now compute vertical structure of the stress. - ! - do k = kts,kpblmax - do i = its,ite - if (k .le. kbl(i)) taup(i,k) = taub(i) - enddo - enddo - - if (scorer_on) then - ! - !determination of the interface height for scorer adjustment - ! - do i=its,ite - iint=.false. - do k=kpblmin,kte-1 - if (k.gt.kbl(i).and.usqj(i,k)-usqj(i,k-1).lt.0.and.(.not.iint)) then - iint=.true. - zl_hint(i)=zl(i,k+1) - endif + ! + ! now compute vertical structure of the stress. + ! + do k = kts,kpblmax + do i = its,ite + if (k .le. kbl(i)) taup(i,k) = taub(i) enddo enddo - endif - do k = kpblmin, kte-1 ! vertical level k loop! - kp1 = k + 1 - do i = its,ite - ! - ! unstablelayer if ri < ric - ! unstable layer if upper air vel comp along surf vel <=0 (crit lay) - ! at (u-c)=0. crit layer exists and bit vector should be set (.le.) - ! - if (k .ge. kbl(i)) then - !we modify the criteria for unstable layer - !that the lv is critical under 0.25 - !while we keep wave breaking ric for - !other larger lv - icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric_rig)& - .or. (velco(i,k) .le. 0.0_r8) - brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared - brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency - endif - enddo + if (scorer_on) then + ! + !determination of the interface height for scorer adjustment + ! + do i=its,ite + iint=.false. + do k=kpblmin,kte-1 + if (k.gt.kbl(i).and.usqj(i,k)-usqj(i,k-1).lt.0.and.(.not.iint)) then + iint=.true. + zl_hint(i)=zl(i,k+1) + endif + enddo + enddo + endif - do i = its,ite - if (k .ge. kbl(i) .and. (.not. ldrag(i))) then - if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0_r8 ) then - temv = 1.0_r8 / velco(i,k) - tem1 = coefm(i)/(dxy(i)/ncleff)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5_r8 - hd = sqrt(taup(i,k) / tem1) - fro = brvf(i) * hd * temv - ! - ! rim is the minimum-richardson number by shutts (1985) - ! - tem2 = sqrt(usqj(i,k)) - tem = 1._r8 + tem2 * fro - rim = usqj(i,k) * (1._r8-fro) / (tem * tem) + do k = kpblmin, kte-1 ! vertical level k loop! + kp1 = k + 1 + do i = its,ite + ! + ! unstablelayer if ri < ric + ! unstable layer if upper air vel comp along surf vel <=0 (crit lay) + ! at (u-c)=0. crit layer exists and bit vector should be set (.le.) + ! + if (k .ge. kbl(i)) then + !we modify the criteria for unstable layer + !that the lv is critical under 0.25 + !while we keep wave breaking ric for + !other larger lv + icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric_rig)& + .or. (velco(i,k) .le. 0.0_r8) + brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared + brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency + endif + enddo - ! - ! check stability to employ the 'saturation hypothesis' - ! of lindzen (1981) except at tropospheric downstream regions - ! - if (rim .le. ric) then ! saturation hypothesis! - if ((oa1(i) .le. 0._r8).or.(kp1 .ge. kpblmin )) then - temc = 2.0_r8 + 1.0_r8 / tem2 - hd = velco(i,k) * (2.0_r8*sqrt(temc)-temc) / brvf(i) - taup(i,kp1) = tem1 * hd * hd - ! - ! taup is restricted to monotoncally decrease - ! to avoid unexpected high taup in calculation - ! - taup(i,kp1)=min(tem1*hd*hd,taup(i,k)) - ! - ! add vertical decrease at low level below hint (Kim and Doyle 2005) - ! where Ri first decreases - ! - if (scorer_on.and.k.gt.klowtop(i).and.zl(i,k).le.zl_hint(i).and.k.lt.kte-1) then - l1=(9.81_r8*bnv2(i,kp1)/velco(i,kp1)**2) - l2=(9.81_r8*bnv2(i,k)/velco(i,k)**2) - taup(i,kp1)=min(taup(i,k),taup(i,k)*(l1/l2),tem1*hd*hd) + do i = its,ite + if (k .ge. kbl(i) .and. (.not. ldrag(i))) then + if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0_r8 ) then + temv = 1.0_r8 / velco(i,k) + tem1 = coefm(i)/(dxy(i)/ncleff)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5_r8 + hd = sqrt(taup(i,k) / tem1) + fro = brvf(i) * hd * temv + ! + ! rim is the minimum-richardson number by shutts (1985) + ! + tem2 = sqrt(usqj(i,k)) + tem = 1._r8 + tem2 * fro + rim = usqj(i,k) * (1._r8-fro) / (tem * tem) + + ! + ! check stability to employ the 'saturation hypothesis' + ! of lindzen (1981) except at tropospheric downstream regions + ! + if (rim .le. ric) then ! saturation hypothesis! + if ((oa1(i) .le. 0._r8).or.(kp1 .ge. kpblmin )) then + temc = 2.0_r8 + 1.0_r8 / tem2 + hd = velco(i,k) * (2.0_r8*sqrt(temc)-temc) / brvf(i) + taup(i,kp1) = tem1 * hd * hd + ! + ! taup is restricted to monotoncally decrease + ! to avoid unexpected high taup in calculation + ! + taup(i,kp1)=min(tem1*hd*hd,taup(i,k)) + ! + ! add vertical decrease at low level below hint (Kim and Doyle 2005) + ! where Ri first decreases + ! + if (scorer_on.and.k.gt.klowtop(i).and.zl(i,k).le.zl_hint(i).and.k.lt.kte-1) then + l1=(9.81_r8*bnv2(i,kp1)/velco(i,kp1)**2) + l2=(9.81_r8*bnv2(i,k)/velco(i,k)**2) + taup(i,kp1)=min(taup(i,k),taup(i,k)*(l1/l2),tem1*hd*hd) + endif endif + else ! no wavebreaking! + taup(i,kp1) = taup(i,k) endif - else ! no wavebreaking! - taup(i,kp1) = taup(i,k) endif endif - endif + enddo enddo - enddo - if(lcap.lt.kte) then - do klcap = lcapp1,kte - do i = its,ite - taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) + if(lcap.lt.kte) then + do klcap = lcapp1,kte + do i = its,ite + taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) + enddo enddo - enddo - endif + endif ENDIF !END LARGE-SCALE TAU CALCULATION !=============================================================== @@ -1349,11 +1495,11 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & !=============================================================== IF (gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN - do i = its,ite - if(.not.ldrag(i)) then - ! - !------- determine the height of flow-blocking layer - ! + do i = its,ite + if(.not.ldrag(i)) then + ! + !------- determine the height of flow-blocking layer + ! kblk = 0 pe = 0.0_r8 @@ -1364,9 +1510,9 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & !divided by g*ro is to turn del(pa) into height pe = pe + bnv2(i,k)*(zl(i,komax(i))-zl(i,k))*del(i,k)/g/ro(i,k) ke = 0.5_r8*((rcs*u1(i,k))**2._r8+(rcs*v1(i,k))**2._r8) - ! - !---------- apply flow-blocking drag when pe >= ke - ! + ! + !---------- apply flow-blocking drag when pe >= ke + ! if(pe.ge.ke) then kblk = k kblk = min(kblk,kbl(i)) @@ -1376,9 +1522,9 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & enddo if(kblk.ne.0) then - ! - !--------- compute flow-blocking stress - ! + ! + !--------- compute flow-blocking stress + ! !dxmax_ls is different than the usual one !because the taper is very different @@ -1403,85 +1549,82 @@ subroutine od2d(dudt,dvdt,dthdt,ncleff,ncd,sncleff, & ! !taup(i,:) = taup(i,:) + taufb(i,:) ! Keep taup and taufb separate for now endif - endif - enddo + endif + enddo ENDIF ! end blocking drag !=========================================================== IF (gsd_gwd_ls.OR.gsd_gwd_bl.and.(ls_taper .GT. 1.E-02)) THEN - ! - ! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy - ! - - do k = kts,kte - do i = its,ite - taud_ls(i,k) = 1._r8 * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) - taud_bl(i,k) = 1._r8 * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) - enddo - enddo - ! - ! limit de-acceleration (momentum deposition ) at top to 1/2 value - ! the idea is some stuff must go out the 'top' - ! - - do klcap = lcap,kte - do i = its,ite - taud_ls(i,klcap) = taud_ls(i,klcap) * factop - taud_bl(i,klcap) = taud_bl(i,klcap) * factop - enddo - enddo - - ! - ! if the gravity wave drag would force a critical line - ! in the lower ksmm1 layers during the next deltim timestep, - ! then only apply drag until that critical line is reached. - ! - do k = kts,kpblmax-1 + ! + ! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy + ! + do k = kts,kte + do i = its,ite + taud_ls(i,k) = 1._r8 * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) + taud_bl(i,k) = 1._r8 * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) + enddo + enddo + ! + ! limit de-acceleration (momentum deposition ) at top to 1/2 value + ! the idea is some stuff must go out the 'top' + ! + do klcap = lcap,kte do i = its,ite - if (k .le. kbl(i)) then - if((taud_ls(i,k)+taud_bl(i,k)).ne.0._r8) & - dtfac(i) = min(dtfac(i),abs(velco(i,k) & - /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) - endif + taud_ls(i,klcap) = taud_ls(i,klcap) * factop + taud_bl(i,klcap) = taud_bl(i,klcap) * factop enddo - enddo + enddo + ! + ! if the gravity wave drag would force a critical line + ! in the lower ksmm1 layers during the next deltim timestep, + ! then only apply drag until that critical line is reached. + ! + do k = kts,kpblmax-1 + do i = its,ite + if (k .le. kbl(i)) then + if((taud_ls(i,k)+taud_bl(i,k)).ne.0._r8) & + dtfac(i) = min(dtfac(i),abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo + enddo - do k = kts,kte + do k = kts,kte do i = its,ite - taud_ls(i,k) = taud_ls(i,k) * dtfac(i) * ls_taper - !apply limiter for ogwd - !1.dudt < |c-u|/dt, so u-c cannot change sign(u^n+1 = u^n + du/dt * dt) - !2.dudt shr_kind_r8 - use ppgrid, only: pcols, pver, psubcols,nvar_dirOA,nvar_dirOL + use ppgrid, only: pcols, pver, psubcols use constituents, only: pcnst, qmin, cnst_name, icldliq, icldice use geopotential, only: geopotential_t use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv @@ -137,16 +137,6 @@ module physics_types cid ! unique column id integer :: ulatcnt, &! number of unique lats in chunk uloncnt ! number of unique lons in chunk - real(r8), dimension(:),allocatable :: & - oc !convexity of high-res grid height - real(r8), dimension(:,:),allocatable :: & - oadir !orographic asymmetry in a coarse grid - real(r8), dimension(:,:),allocatable :: & - ol !orographic length in a coarse grid - real(r8), dimension(:),allocatable :: & - pblh !get plantet boundary layer height - real(r8), dimension(:),allocatable :: & - ribulk end type physics_state !------------------------------------------------------------------------------- @@ -1839,21 +1829,7 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%cid(psetcols), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%cid') - allocate(state%oc(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%oc') - allocate(state%oadir(psetcols,nvar_dirOA), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%oadir') - allocate(state%ol(psetcols,nvar_dirOL), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ol') - allocate(state%pblh(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pblh') - allocate(state%ribulk(psetcols), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ribulk') - state%oc(:)=inf - state%oadir(:,:)=inf - state%ol(:,:)=inf - state%pblh(:)=inf - state%ribulk(:)=0.0_r8!inf + state%lat(:) = inf state%lon(:) = inf state%ulat(:) = inf diff --git a/components/eam/src/physics/cam/physpkg.F90 b/components/eam/src/physics/cam/physpkg.F90 index c7b8da3c893..1dd0e69a6d3 100644 --- a/components/eam/src/physics/cam/physpkg.F90 +++ b/components/eam/src/physics/cam/physpkg.F90 @@ -156,6 +156,7 @@ subroutine phys_register use radiation, only: radiation_register use co2_cycle, only: co2_register use co2_diagnostics, only: co2_diags_register + use gw_drag, only: gw_register use flux_avg, only: flux_avg_register use iondrag, only: iondrag_register use ionosphere, only: ionos_register @@ -316,6 +317,8 @@ subroutine phys_register call co2_register() call co2_diags_register() + call gw_register() + ! register data model ozone with pbuf if (cam3_ozone_data_on) then call cam3_ozone_data_register() @@ -906,7 +909,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out ) ! CAM3 prescribed ozone if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state) - call gw_init() + call gw_init(pbuf2d) call rayleigh_friction_init() @@ -1321,7 +1324,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & use cam_diagnostics,only: diag_deallocate, diag_surf - use comsrf, only: trefmxav, trefmnav, sgh, sgh30, fsds, oc, oadir, ol + use comsrf, only: trefmxav, trefmnav, sgh, sgh30, fsds use physconst, only: stebol, latvap #if ( defined OFFLINE_DYN ) use metdata, only: get_met_srf2 @@ -1329,7 +1332,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & use time_manager, only: get_nstep, is_first_step, is_end_curr_month, & is_first_restart_step, is_last_step use check_energy, only: ieflx_gmean, check_ieflx_fix - use phys_control, only: ieflx_opt,use_od_ls,use_od_bl + use phys_control, only: ieflx_opt use co2_diagnostics,only: get_total_carbon, print_global_carbon_diags, & co2_diags_store_fields, co2_diags_read_fields use co2_cycle, only: co2_transport @@ -1432,13 +1435,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & call t_startf('diag_surf') call diag_surf(cam_in(c), cam_out(c), phys_state(c)%ps,trefmxav(1,c), trefmnav(1,c)) call t_stopf('diag_surf') - ! for tranport of ogwd related parameters - if ( use_od_ls .or. use_od_bl ) then - phys_state(c)%oc (:) =oc (:,c) - phys_state(c)%oadir(:,:) =oadir (:,:,c) - phys_state(c)%ol (:,:) =ol (:,:,c) - endif - ! + call tphysac(ztodt, cam_in(c), & sgh(1,c), sgh30(1,c), cam_out(c), & phys_state(c), phys_tend(c), phys_buffer_chunk, phys_diag(c), & @@ -1840,7 +1837,7 @@ subroutine tphysac (ztodt, cam_in, & ! If CLUBB is called, do not call vertical diffusion, but still ! calculate surface friction velocity (ustar) and Obukhov length - call clubb_surface ( state, cam_in, surfric, obklen) + call clubb_surface ( state, cam_in, pbuf, surfric, obklen) ! Diagnose tracer mixing ratio tendencies from surface fluxes, ! then update the mixing ratios. (If cflx_cpl_opt==2, these are done in diff --git a/components/eam/src/physics/cam/ppgrid.F90 b/components/eam/src/physics/cam/ppgrid.F90 index 8ef5d205703..a2bbc5e7fad 100644 --- a/components/eam/src/physics/cam/ppgrid.F90 +++ b/components/eam/src/physics/cam/ppgrid.F90 @@ -21,8 +21,6 @@ module ppgrid public psubcols public pver public pverp - public nvar_dirOA - public nvar_dirOL ! Grid point resolution parameters @@ -32,9 +30,6 @@ module ppgrid integer psubcols ! number of sub-columns (max) integer pver ! number of vertical levels integer pverp ! pver + 1 - !added for ogwd - integer nvar_dirOA - integer nvar_dirOL #ifdef PPCOLS parameter (pcols = PCOLS) @@ -42,9 +37,6 @@ module ppgrid parameter (psubcols = PSUBCOLS) parameter (pver = PLEV) parameter (pverp = pver + 1 ) - !added for ogwd - parameter (nvar_dirOA =2+1 )!avoid bug when nvar_dirOA is 2 - parameter (nvar_dirOL =180)!set for 360 degrees wind direction ! ! start, end indices for chunks owned by a given MPI task ! (set in phys_grid_init). From 9e5799fc086b59b4719b905ed9095ea9498ffdb9 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 15 Nov 2024 11:40:34 -0600 Subject: [PATCH 293/529] cosmetic fix --- components/eam/src/control/startup_initialconds.F90 | 2 ++ components/eam/src/physics/cam/comsrf.F90 | 4 +++- components/eam/src/physics/cam/gw_common.F90 | 3 --- components/eam/src/physics/cam/physics_types.F90 | 1 + components/eam/src/physics/cam/ppgrid.F90 | 1 + 5 files changed, 7 insertions(+), 4 deletions(-) diff --git a/components/eam/src/control/startup_initialconds.F90 b/components/eam/src/control/startup_initialconds.F90 index 68f9a2f12a3..fed4cece646 100644 --- a/components/eam/src/control/startup_initialconds.F90 +++ b/components/eam/src/control/startup_initialconds.F90 @@ -60,4 +60,6 @@ subroutine initial_conds(dyn_in) end subroutine initial_conds +!======================================================================= + end module startup_initialconds diff --git a/components/eam/src/physics/cam/comsrf.F90 b/components/eam/src/physics/cam/comsrf.F90 index 7ac806c1032..856cc9d23a6 100644 --- a/components/eam/src/physics/cam/comsrf.F90 +++ b/components/eam/src/physics/cam/comsrf.F90 @@ -54,10 +54,12 @@ module comsrf real(r8), allocatable:: trefmxav(:,:) ! diagnostic: tref max over the day real(r8), allocatable:: trefmnav(:,:) ! diagnostic: tref min over the day - ! ! Private module data +!=============================================================================== CONTAINS +!=============================================================================== + !====================================================================== ! PUBLIC ROUTINES: Following routines are publically accessable !====================================================================== diff --git a/components/eam/src/physics/cam/gw_common.F90 b/components/eam/src/physics/cam/gw_common.F90 index 198c634f284..86881900e59 100644 --- a/components/eam/src/physics/cam/gw_common.F90 +++ b/components/eam/src/physics/cam/gw_common.F90 @@ -5,7 +5,6 @@ module gw_common ! parameterizations. ! use gw_utils, only: r8 -use cam_logfile, only: iulog implicit none private @@ -743,6 +742,4 @@ subroutine gw_drag_prof(ncol, ngwv, src_level, tend_level, do_taper, dt, & end subroutine gw_drag_prof -!========================================================================== - end module gw_common diff --git a/components/eam/src/physics/cam/physics_types.F90 b/components/eam/src/physics/cam/physics_types.F90 index ef0bbc8f2a0..2b7d78c1461 100644 --- a/components/eam/src/physics/cam/physics_types.F90 +++ b/components/eam/src/physics/cam/physics_types.F90 @@ -137,6 +137,7 @@ module physics_types cid ! unique column id integer :: ulatcnt, &! number of unique lats in chunk uloncnt ! number of unique lons in chunk + end type physics_state !------------------------------------------------------------------------------- diff --git a/components/eam/src/physics/cam/ppgrid.F90 b/components/eam/src/physics/cam/ppgrid.F90 index a2bbc5e7fad..88c5740a350 100644 --- a/components/eam/src/physics/cam/ppgrid.F90 +++ b/components/eam/src/physics/cam/ppgrid.F90 @@ -22,6 +22,7 @@ module ppgrid public pver public pverp + ! Grid point resolution parameters #ifdef PPCOLS From 817c664739b36d77807712b8eabf381c2328dc93 Mon Sep 17 00:00:00 2001 From: xie7 Date: Tue, 19 Nov 2024 12:34:36 -0800 Subject: [PATCH 294/529] Added docs for the new orographic drag schemes. new file: docs/figures/orodrag.png new file: docs/tech-guide/orodrag.md modified: docs/user-guide/namelist_parameters.md [BFB] --- components/eam/docs/figures/orodrag.png | Bin 0 -> 290236 bytes components/eam/docs/tech-guide/orodrag.md | 35 ++++++++++++++++++ .../docs/user-guide/namelist_parameters.md | 19 ++++++++++ 3 files changed, 54 insertions(+) create mode 100644 components/eam/docs/figures/orodrag.png create mode 100644 components/eam/docs/tech-guide/orodrag.md diff --git a/components/eam/docs/figures/orodrag.png b/components/eam/docs/figures/orodrag.png new file mode 100644 index 0000000000000000000000000000000000000000..de6e5cd8407274ecde0b7f2342ee75675bff53cc GIT binary patch literal 290236 zcmeFZWpo_Nk}hh2WieR{7Be$5TWB#ewWJm^Gcz+;%+O+snVDK-vBh99Uhgye%$%7u z_nr6qtygPRWmeP|k&%&+S(%m59igNkg#?cW|KY<2BpGRO;%`@bMq? z4_&?_#?!Qy0e2D*&m=F0+^he@+sDI`m|I*_F zrtSgCp9IccTFdFf2P}%eP6!!g^2+`TI%~?y@tW8H8I4TsjLjI`f%boKec*TJ z{gVZnIU5nX18r=bc-;j^|AFBBlmCm%L`wV*h_kf-siwRVv6!8s88Ig#Gb1ypAUrWK zF~6g!Ij^#~180{P_m{@ptc$k=3nOIpF{va5fJZznf z+!<`0$o@mfKjnyCp#OLzr?HA0-Oa|`Tqg_pXC24?LW9Q|BFqKg`NFx zrhldWPY$jBmE&Kj|C2+}5n%SmCV#0W$ntjy|4RFxcriPmy`!0v)4$^XmG(dJN|tuc zc7NK_5nv)?>ul!uhxzZ){%M5&JK}Fy{7io}$-gwwf3*KUsDB(l5T2juKb=Vs-mvL~ z{KE&~4>IB+s_qb{IUoJA7Z*dPC#s%p*JHS$6$8BrFj__VX@GqA;tZ<9Tb;*PW?8YCr@otp{>7ezh9(HoO-+Ncezuh7SC{desoHb`{_&%R;I{#Ao zTw7*+hEfwE3WSpuxSZmc@VzY>SeK{1e8+FhQV0mrXm&_u{BO_j0cM_77l?CpNB%ColJN-Xd<{uUN z`Hl-|W@cuX=y zA!M$<&8P7H7vedI{y^8gHJ{@DcTxY+;sLI(?vM?H#BU4#H!t{4)mFU!KplS@9f@84 zZ{G5sxW9Y}O!5n<=_)^Uoh;?H4$QfgRFM+2)cKoNYPV2)%iKa`r=RJ?9#&O>5q!MsaFx7dM_|r*eyp;`e!jLO)_lG2EFN5(KAA zv`8oUrhAKmVO6AiWUAlCl{w%`ccQdcA}90yKTO!;11wM6JVEQf(2 z@OSHYqb32r|9nII+!E{g9RL2s_YL^pdsBd2xUeW~oTYZiASW*)YjMINx_;z?Kdb{r zF)UhX!>wPQcT$ZBWFbosy;Nd`vRqKOoTdu35l<|u6$BuNNCr^j5d5}f8EG5u<98hb z8@?GQ!U=OmWt35)7cq_e9cb-P^V=YDl$uCqKmco@lnHTZ>*k+hPmhN1AEgW+$lt^N z`zx&HK#G_=FE-XhoDQMkdqepY7L$(o?JbhRGZP!xJg+Ntqu>Vbr)2!StY7iXp{rR! zYFja=+jtD5lWfVvY{_0yFd6#;J;w;-5A0Xz()nu#9Lrt!A&-P#L)ZcR1#)SHsaE0~ zQ5C6ITw=E{O;U(W0BcJr7^HK)WT-rhzwPtTMLNTJ?w!Xvv%{YeFpCuV)!Q>ff$oR~ z;%xkP5tM?I+WiiB1 z(fcwz%oIJ>a%5zK&1H|mU67A!V?PS6+1mZtp5ytD9=M#nT{QS&BH3eu!-!O&OyH_T z4Y#h?q2vA*^GB1>^QJw&2J)QLvClpQVR8p%bVg03<-O%h`L7)qrlLHn&dy#k8EZ@G zmPS9fB!SHT^N-1gL|wa`Zm<@JQFjca5Lm+CW*OVblK1WpLb_U$ir9(H5_&20CZ*7tvohoCy|A651iFKF?~g^*||aB;a4zb;X}(drql zP!jdZ@al%7bd?j&8J%c9JyDJc$N8O!9eo=)au3A8Od1)!-^wtidO4=7R5&QSNr&1t zu=8s@;O2Y3^l_KMIracs(E>z{Rak52Fs!nzoz7=}R&rFNMjd5;q?yGfdd!m}s_8AN z=>XXhKrLP%q3p{o-&DIP^Qig!^s~k-*>rSKo`#87msaLN+|2uX6zcJV4!EFz82!~d z(l--eK-`bp0`mn?b$uW8@CbrNSPsQWK8R4^2M2jmIGchc34sv&N2SM$+7N%M#AD?V zII9JrVEjcP4K5uEUIV&`_k;fHcFb^dcG%U8UrK`6{a*X*s5n76YHH53>y5Ai>7gniuQ)N7G{M-h)w#h0N@Tq9LjT@=RvHJd*qq zsdq=v-eB9|R8Wy^?uZZdpFt8WAfHoA#CRDOzA=u&L=LO#aMRPIJ;$N9n$yiAC!`@t zH!Haci&nA*!Nincy7Y0DJ84yY&60C}cad|yzy2=G`n-OAT5!p>YtK^K>@&}(L!ll) z8*?ITI9e3o#W;8Y<#p5~;W{aX4Q@t_cMwZTe#YA-BX!-~Bs!l|q zC8hCE7@w5pHZ*s>W{j7d=p)hVQlqET6^wS3r%;T%HNS{K*&HB5vs-(5LFki@^D#Dl zIp_H@GwEf8}J5m_h@JqLS^ReBh_J>x7m3ythkOZyPagAUY^b{VMkv9fQKQqpF=r?=np4=W~!Sv$IkZhmW!H4v1NG zJi~t*YJAe5AFcGYpq>(O5^dprGHnpC1x*-LBb4%+tv5VRH6?bGY!Y79cbsg%`a#r2 z*dE%0D;g>s4yMS60b=+WxO?3wZT*dRPclQ|n!}Y-^9N5{0fo_{2OQm0Amg}=q!?>| zMdcXa`y)#urt-Kj z!?o=D!sa5{rEO#yEPFRO_BE?1KpA1<9F?OOO&O&^J~8{IgV$yDcRxemCr5t}3qyvl zkh=*KZi-uAy!#|W{O2w*Y4=a)9BBQ^Ccwr;Rn{*W%i64sA3~I1M=N+MXK!~r$K^3h zjDgKI=N+zhgVW&Fh^SwZ;X)|a%@G)4^lhz#O@PcV}Z_PZxs^+lDny(pEVmHLoaBb|7?aO#MbJR}?G%D>k+aJ+_ipKSv z60Er{LHb#w>ftxD?FXjbGN!?m&es&8EZjF$jK?$2!7>lvS1lSxDcW^uIY$&1N+@_% z1#pO#VL1W+@|zAoo|;K1o|MyUNlt6bT}vF4gfhQZCJR~6L7gJFh?J(8tD>E}Jn1%Y znN)Gf-qjZ3NUCn*Fh>x{p<|-Qq4a5haMgJb!`iYz+-YJ*wE~rum=0zSg_W~#E4buo zqN!*M%A4#;ju`&9m5elK!a?zj&Ygm|QVr`X91*-AwBVQ%@4e?HMQSOh3wc?;h<+f| zg0D-6rl#`@R~xzBT#dSd1YRlj)CT^*$yZ$ub>0-Ae@=gTT4MdlgDwUWT+4D4s$kUM z2xWpnLnUR^Om=m}Q5q`^k+oOI_Ih_W*3r5qn* ze>#5Ox`zpMzI)wzM~4hZ{eB!ztAOzhTZBIO>{wNas(3UR-SJHp@KQ1xYAKuefr3(f zaoA>aPNLa;^lN36O#>qI>RccJ9Svjs+pCujZi#){YWNfS*KRqhmlC+^KhxE&kI?JE z!2vyJC=-2Fv$T<%>}-N%5?pP7XjjC^sYq>o#$!qFlSs?kq}bkl{6&F?V4L*$RtYo~Vd28#XD}>j%p^E!y zuwJw^s|;z4bqjgZiwl3L6v_mdLofnh>C}hCpkun5n`cEdQ59-B(ikcyD(39o(DJUR4HxZXwXJlY?dD*a#15kn>ucW4>Zi)n6q<2{ z?3|PK2yUOR9-vVx7L#dY3m!dwGg;LHPqcjl?d3w_Cb)P`JivHkQwc)~RcFYRdFK9Eeo||Yno=li_!S>2`UlraIP*dj;OGX!#kN6?F=6IKHVa-UjX9&Mm zuCP+o+7Bl9CU&&K07_a!QI%qU6m6-yGj@BbLQvz=I=yxDqX7yJ7Z8%LXw?$?EGehx z#{>}DhQftkFa{)J%b52vn6JV}bOx8p2ZEkNHe?dwY`pxaq|!pP_I*^Oq3RWJH{{}EI(|{9d)EA;7R+c z>uj#d{n?h%L`~Dfh6bh2@hqgyUGI!0=rA~FEajb%150+YLlybQx$PxYYdI1Amp-X8 z*;vJSj;WC1lOje1uX^aLBkJzC`~%N$=wQIIRi{;$46IbKKw&%jhb|-Xw~4>k_g$FK z%49t)=*#92;z1PzR$Rkbr`uGU4PiqHb#aGP4P(bJ)^fz!GLcE30ulKjOi>HUL^TJ6 zSeJ`TyD&n2u&?VJ#8M^V7Ee_}82N}L`@Hl4O5C5-fUt{_6l@YD;dB@8V7v1~^Xyuz zePArK=cvk7>DOZVkeR#87H7-@o%@|I>w2}NdUOSRhrk~bI_%p!88*@{Bv9~Y^&L!& zy`3FJ(0W_`x(Uy<7buVu7{y^|AQj4TxqQ-SOt+2uDn0unF?FT66rFDe;c~WkzfW7q zq`(XsIhJk8O*7C3Tigp_mZI!;w;p%D4b}k>+1iw{>6xs)92^>JxqNp`7Q?#Z0}3~YTRwo*v9Tj49+$7l~sr2bA&b(W_V5bQAKL0DY;ohGhs&-yP$Q-&dnc!p{lKDrGeDU%Xz__zo`5fO$rQ zsP9DyAHR_{3CAv_e(jG?b&wEOZf4Nz${swS#479f4#Ag)dcF;AZuXPfD=@hZFJl_9BtiH`o-T0>L% z<*P8NBrKbJ#jgghuonqU#0WBr=$`0yYsII+U-09j6ZM5Jxv4n`W=&ci>eT4TWIEcG zHyREjlKSEq?4}+AYVkQGm_eF4;r!UL@k^$nl%wluwUY}8sZM?IGQE5v!(?;c@=P%x zzgC%@&>d-PY)L1#jA%UhTEBt2ewJ-xX;s|fk|1ais$Ec3O9hfME+7S3+~)772SEP{ z?3BB3so{S7MKye#QdtFG91OkxS;UuyexzkekGOLK%5fV56+nvOv{S?ogbgRem1D2q znAwIE?j@2B>|!(Vq)MRzEVQ}vNIfqod0H~qgxA&mI*eajQYlrh?imF1HDqMnoUR64 zTYsh&3h}GE1a05eIvyNwRtR~flUM0BE-k66YOA}Z-k!{_HI!q^UlBwNsbQ4}ENL>~;VWWi7p}^@(kwYydQ-(T|UF01$YoB>Z`+FVjy#@=qyWVo0Fkle` z1X+&E8WseU(cm?95an6={dgmxGiVsA%7=m?4{Cqe`l%>Q9;wc>Q8v!CTh7L%87I@* zKDfxaJ68H+O6xYmPz`zc@!mKm~u;7{o@nQ<_&()yiCsvMF#DBW~ijs+1ZinBa+GK zcQ}>PuCRAlh*1+;-(C&kCm`=gtxqX~dY0!SzTvMxBK7vRyHW|_` zbAVB3s{%R+9~+4>MwDd9yY{@a#pIt)_1ubueu6%Y)=*AZ`QCKL zr}9r=5wDw;sw%m0CWZ#m@J9X@LC!`f*U!Lu+_{o^tBhC6X+#~6WpU^0Ht#sYRMU^H zRnAr^D%k~fttJu5F)G6ApQS{;R>Qe&O=|3i^SQqn8ci&+?6)$S?WczCqN3~?aoJMm zXReOH)j@==GgGdwX2V)2s*Gasy89>AX9X-5V6nJvL$q)0~7DrE)!4XZ1sol-%RSqCGrr$?z{gjD@sQ9qCx^YEjf1mpn}|B?dyZH0iq@!Rjtz>A+qbbF35T8=qST}#G3YJpRj3I zvwey=>jVESPY=BG>)eDMCe*97P;f_{6HUZv4^4Hn4$<-3HiVxS0iVE| zd?*2lk_RFKS~~SJ$b46nI_+H_&g&BEiN`}PnAdaLp2f$lNyt@J)o_&wX|2*$z6o_L zVpUO2KQz6XC$CUov)w`*2yVWD?O&}6# z@$3-f34dK$=gm*R-JR3t)43>vx;BsnfDP-Gx_Lf!YmM=Fa#kI3XpU6>hkfzJ^G{jM zgAf@`KeHeXjq+IZ46H^np44TUEts2g8>%lIX@q`zQ%luF{%d;~_s2|rmZ0Aa@5YDhlouS_k3__$X@uA0Mema$M zoYp21S@4n(3Be{z1fkmG)t}gUt*h4-ICErCABDt~3&$taD+EVvIq$b~m;rrd+7}YW z;-*Y3_hMCloKs>47ssZ0e=NoK=0lQ)bXZ4Vl5VT7s9&#Xy@snyRSILOVb;cl%lKSC zgC4=9jR+}Ze;tDn6*090mP)o(Nw7VSup>Q}1^rLtA=w%yD5;ayeiB2>~A( zjBfNaRq}S+D^C&V1^B6>f4I67x#@Vj^^~AsO&jl=Toboy3hpwBX3+ZD z_w0?8LMcF7#7^RPpmY@MIQcP2Va`1HbrDZD8($n1BWkVyYyQnL16<%kL6{D0B22$( zdK)9>tcO6x42mSRj2OtE<}z$pLgdQ`X$~3suB5F~2FxZWU1U|k0mY@T&*tu?XLE9F zuhk%{aLM1mk+H2Jw&8xjG5Z}II+VU|R&bRxD6TU>ULI}9S{ZG-H}e_4(lOBQbFB?I zhTkaJWuB<8c;YJEg|}f;T6MtQ2t4Ta7#|o#=m{3-urtY#HBnzct1ep?9UloH7zpMJ zZC4AtQ;u7d)l=irEcE8vz3DvFY*CK4`}h&=M0;tn-DSKfx+IY%RsqVvVpxz-D>l>IVm^ZNE1XF2RZ2U?)QYG3-56dfgtm>9l2abfP zO#LZ}cTihZm!z=1#A@fco=Q(b9bU>!zHMMjXeT6K48jzu!Z_{ zH#uCX@Z71kY!=rme*GCtw3=TdfhAQ*Kc126*VQGRrF&4fhIoM-kXcupQaS3Ds;0WQ z@|={W)eQwx`b3*cHhCfV-tJQu|1o3Y+Az9j@9nL0vvGWicVevJ1N=(jgNaB?*LP^&^}bbcJya5BLx;Q;k?l5FoawjU)2btV ziN5D=6|bX^QP-adUMngsxn>y)wF)^;V6^YgD<8QOdp0a-_Ek*ihGSY->|#Nm@7Lj{ zB3b0|YDp)LG`D}-AewPGJc(K-%fEO6xG7J=zq>UMfQ(LvEnPegqVLbjlHSaJFDvCW z5Vw6U#-cUqryw+3nMpRX`@xbn{mFImQsi#hFB`yjdwk07!LcbxJRZ0)DYTVj{R3^C zH9D4s5l~s6k>@k6@U}789LbwKVLUNH)4PPu8aeOZV-8^Y{P;pM6{m9_OLDRak>|4d5E#8oOy6)^qJ;xt#k`Ch zZKVDitJbD@1Es5n^0TYBD`Zu3RFSwYg)x^n5S`#m^OvBUeo#Qx;cetR*1RwkuF@7z zC=2o2dJFXkHN7MrIRh>*;CDoM!aF_zX)&tMddnL+j=@tIsoNEtEk9sQFs_jUX7Q7QajQG2OSm}HS(a`hFn7x`!fI1!H6@K9{xRub5z65l*uxx%4h2( zEh`ho9*0*97ct%7f4{5)FLe7Y?`Q~xgknLr%=6YMOnSr|^hl>Q8*b#7V`Bp{mlOCL zi9g?I?%D>lts;{T-Ub(z7#p~jZCw6%_HXMa)l=*`)$`l>Gp0)ri#!8rYFkE$CR<=e z3ZbvDQnD0RTsIxUZ+~S+(Iv&ItIzeq|3cVV)g!f5F?`B7MG8Ui9lx}a#iR2j&rXZJ5+#N( zr-j=mL=e>5dA~a8d9|K7n73k7x^9-Y=-h~CIsgrAsbE`!be?CjW;5U0jH_#%wKbgPR=#;{AW98w8Kr_=P;mL^zM2@{p?9Ky_$B!+tLCr?U=(*Pfz9JOt+ zW{6cTAujlL>F4DNQjyjW^`}^Z9U2LW2H4Mc2Sa$3`RhZmA{2cq(hrmPhnsI`z(g#P18(Czo!?$8V(Ykrgw&F3uOHyCo$sUWSnbi>jI%U zmXn!Y&lqj603~JoTTd#o&K})_gd5{$`r_57k=RwM8`7vIB%YH()5g$vK6K<+* zEkIJzLbN{U6MDlKlpU)rnJl5cgMw|oiV&v&;v13=BK|DWK7`C~jEzrPh}giE*n{-J zm-{_b(wYI+siBK?gbEq=hvzD*m%rO*%d=1uYH?=H)7BF#PCQ_brF_bM{_5Lo@Tlu$ zTy0}pd{V-M=(XGnszuQA{>lhRakE++{Ww>`qGixQu+7qqgzF2O+u9Asek$5H;+TX_ zn>F1Fz^!#Qj75EP?oM=m^KB&daeoVFhUp-}OQ}|0MwTP{x%sS46rZOm>6Sj=rIMkg zMNoI}1@?M&HI2?dg#RTFx+ogw0`Hi(Wn(6kJe#m(F>k7=^5ShKQ9^=Prl5hDs#8Dt z8<6Q(QpUV`(*2N-??3}Zn+HfDzQN{d%Vcikb;95YE)&@RuK7N=G4$yPBW@KXc(Ob8 ztG96*AL>4VlB`G*ai!IQ<>WIiyK-($ynt$$W{l`bt>`yIdVCZ%9or$z{XNJ_o$<~y z`fo2`RA;a7iyUJ}Tc?S`$5yzt<;$dT|25x6g2rL(>ImaZM`Pi3x>J6holOtrB)P$q zmLPg%3Qmk?CqfJSdfjj~6V%c~*nDJOobF1ka!rPAVW`*K{sqFWp;N#NtAnYbupC0A z(i&EU#5=C4(yH0X&n-&ecII6(t$A|EdohVr?bw@ZUB88tv>_*P zc;1>{A*RWS*67I+VpXGxcAN_ubzMKyDF04B_h6)K)ePj#m=n zE)YqF8c+06?ez!}R)d)PuMrSP0H$3T$1X=fqLvinWO=%0ru!D!ET*OkGK>R02JO^U zCd^*Qho;(;z7Ks5Nx|Pl?o4(wCHvHc;bmW=K~GMOEM$6ND8r=qGaTbfMpm6g6|=sr zpT!CGw$EAwfleAsVce&EV4d$S1EA*yr~3v$GoJVmkknIyjV|-L!~6K%!T@G!xqLaX z44t|f_`xG@br#ACth`Qp3R)&!+m48{vEqqxCKYr1&GOlI(YNc}{zRB}Uzs^;u=98f z#_MSnPCY=~1ZKbhF{62_M-Wv-Plkz+C{co5&M?4Vy^zmc5jSwWcv`rFjm?J7wk4?Z zVMW^Od6DZZa!voE%4pjSPHPnR-JZ|cSK_nCG!#DDn zXpgx3hjJFK_eoR18OcbjtlpB}tCzLorPfX}=K#&pOxtxqKkp&q_1J%#UU<+RVrEi- z-= zvyiPBX~;~8Iz?F)G>kQt_5sU3Cs^ zqya=YoUE69fBPZec1BZ_RmWZlz_s9lURQ(T;{5&^RdQm6t!I}4hd7jhEhEb|FeDN7 zVrcz*WwiE_3k08`V4@i-z+s-b5r<_;nHi2WqT5@uWGVR7b$jN8E|RkbYdJ_#TrJ^% z@n9*FufW*ml~+w?7+DWEc?~bOBWrWBlw+gk(W&S6s5#;UHiku-Xb(o(Dk;tJyCYH0 z{1&0OEUZgVnGDlglP&+R1|FHv91KVmx}IGg!QAWHTkt|EO9dD&JOJ^ zR3cUm-}W}U?m_5i+m^v!V{Is2KhKa|fWLpnN<;?H(G0gPs9bHWL$7W`zb`RAF8$Z; ztRE4CWYfh#!DwPhE#1=c>S}j4F4Y`tKCI<6)UN6!Zg^jM$a%{+D&Jc;q1J|2tYLqK zJx(KTX$qFpR4gBc8Tb-{Z!Nb2sSf|bldunsB+P!#hJU~+4@6%&r44w;d#=fGntOYg zHeyaTz~WMnF-3;iMf#S=jPyt&wT$R{L>1Wmge*wv4tdsbW6J!x7h2%6*mwi294NBF z^K&T+7U#$?0!0n4X20#E{W&F0RUOJvEJN{QCbAAh+t$FgI=ag>M`axBA912H>nk0Z z$sL5$A}v4=|4S1}=f#K$Hl;-c6C=jlsV$6%6_qv)H)DCUU>=bXBb5AP5*|xhaz@-2 zmpv|$$eUfX8taeXg2Nqn(JkGrBTs6PwwNd*zX5r4TQ_uQ=z_w)4y6ZxL*n~G+$ydSRu+|7|^nZ^9F%4~B<2!8nu@G{;j zS0znpQ=RDH@TU)6uv%rsabURU8vpgu|ua8?OX`_@Yzj)_EnNk$%P+-hseNkS5?87 zCSSDGXK*QqZqrDa;Ur|<3wtnX=J5dK(fB^Sx8G`ZetrBC1kgnY%?=_bMli7)Toi>R z-$iw!w+;E#otQzPuB#MoE$9vRUFP6PWfTWgU@qst^qj|c3N!Kp5-i4_J-#wv{zaSc z`*hM)KY52K7l%5ySL)pC{_PggyTrHwNxn#43PcnA+o%er=uSl^Z1hZ;54c5=J|y~c zTS^IR?<4C}U0<>u%ln42<}-Z;+|0D9)Lu4}$Uy)Kx1e)EGY-`1tz2$ofewUqd3>lV?hj)u(y<X^AE_3h? zOqTJ0);UX;t)S1RWjSSBt2RITgi&?YEaL>&aPK+db?7H3XZP^A^V81S)f8J+WwSko z_5gVWSF(@hu0!%DX8Q3K!(Z6JuHeG-21fs$DT^?d_;|tcuZHXW0Ax%af2Nm z$oxX3$zf|_Sr?kAy=JoJP50=&ulHAK*t(jta>2-b-;kr(;rg=Z79Ln$r zY20(@wfjk-A&acp3Rpa8P&a_Zpf`MOD~}j#6prU}ZL^Z!yVNO5v&0_H9=zL{v+z(_ z1%SsVsCF13uWgrv^gl1n{W-+!~is~+jg z%ChIqjn*T)D6-?{z2dWrpI_Hb&|&eeT)tllWrrG&sP`_XacMcgnX9Hx-k+=?K-9!x z?vbckYxGWwEpRH`cObuiL$aiWPPF$gemE5M_AwuGLk$CcO0CkgW)sXXbHe6q=bddc ziM<`ZKSbtsVxkpp6y8xd zd@AY!vcU0zAQFMb48*TWZ?sbANwn-FGjd4BVLOARs4kUds0A6WDpJ`h7E?y(>}e05 z)9*0X?$!{S1Uoy>P#C!MoR5*g>=gTL2@zsyYQ;Xhb{P!1KbDrNN*Q-f^-Y1p$g7;r zhJGheFfqp>L)h@$dBfj<=OBpw3N^YjA4+&Sb*>$hs$Smw1U6G)i#6K;VmbzM^c?N@ zvLJFhON`MxWQeEut&fjwwoYL;YOgURPxynI*O0HW$Ophj5YercHQ@b1F4LHGR>P0g zG>XwO(=GxgL5`f}lR)xuC8T!Z8yu_G?GtU*^Q!2vMM`x|xQ-Z*3?8v{q$f?=qV8z5 zqXX$=ZE-M(tU8N{n;ovA!ss{l^23cGYU#C_a@9wwW2(>JVdRJp8T5^brZf%5Q#Djv zahHm%V}VEtVxfow8rl5)#ak$j8;N#q0=Fq$`wBY#d(q9pYYIP;6teh}Rgl@tC;MF> zKI>D;O9XFyx2^~B8RNJ#r?<<7%!;qF&{l85mLi6S5XkXoQCA{@T&_vb8X8xkLkSNW zHHGJf*xFE8aWhxYMW4=^yY;Rg98E;U7O<){r_-5-muhRJ8Y=@>h>a=a+`Vq;>li-W zgKG3TwDo24#PO*XoLi6TUJT-T{NN#4+Ms>H*-MDTXV+jDT;en-ac9^3NG!ferYp}B~E=p{;g~KtijA}mV;4m!Q^%IM zO*~*s_CO(vs9&SbHd+MhaAnz--13QtQSk7Ie;MC$Op!PF$C%>Tzc+GZMV!9T`@Uk$ z6JaOs_K_@q@!13N*>?9nv|^N}n3)iLv8b$zGT$IjrZOe`6L&{;_r)m0GRWK%5F`P1 z7$+t-JL>%~--s}9a+!YqTZRAw%V3(=uDYv>>+=@=5ImSY3nlT5M zclM-(?BgzJOLG;Ky7r)1#cm<;U^W*9WT}gb!CRWg+7_hAj?syDV$O_FIivDI1X1p7 zL?j8B&ohMUay~0}uT)xKd#e^w$a-khnl=`oV1eVIn(N9hI;}4z3k-(&4T@~iC1!}u z_#$7(EE2dPd)gOV>wnmqzw)_|5P3v1C9{d&z_SbenT^}j%0Da!X7Ug<>e^2-z&K&% zRuFr-SW{Bj&!kQ>3 zh#WlliLkZOx7Lo@LJnBhIiuk7ylV#HYr>RE(c_0t=pSwCRYby= z3KO&&)}%gRv*hDD_wTYKDy&Cj$;()U%b+zT#HmHMe8CC;RxRtUwI}n+;E$PmkDJ}! zJ++rjW_R^b%I5%?e7V=u8LEX9N*O*oA$ODvfB$G{w}X!>RLNtBub9D#pOJNiiX=5! z4QIb`>!0u^f+*Hy>^NNRo4Gu_wg!i>h(CYFy{*q#lh+u@h}IB{lrw{#*AA(2}OQJS@^yWijT?o@$i)hJYSmzLzM{x7m^2-LaVISI-lb-|5oIg$dJdz-q&Uk zG$2hUFl9ws9*~`O&cwfylAJ@s(-* zwLI@Antp3&9G_C$`$ZI9MzaJ1J<)8Fl4^_;zovVi#mj8Y8@64tbn_w@Dp=6XvN&J2?v+jwb`(6j=vOb#qY#gQ(W=3 z*-5DNd`9EW?hgsf5wL2Tw+vqMWBd+PDl4jo6SI3UorFstNrAGk6^TC}*F041I*t?b z!0JJspQ!@K2u6$6M?ZTbPQQq@@?TkAM_2ailDrIbhC&(Js`sO^96sUVu z?SAlDgXY;2VPHgwQX;x2m4^u)oRCO5aMRiS8Gu`_g&Qxuw z=n`j<{b%(e#Si|%uzi)NB90^e%6w^rPri;1x$qDWc{f2xeMuMD`MSwb@p{j3EO&>M zdG$7~)AKH-^1-d?0*)8O&G!mHXWOM)gA=?LLgfiCFlUhL zl+YA1*hxpjV((qLZpec($sI-L7AA}R$OL)`(!RF}wwE#VGB5ejft_f(VU@A{POIYv z><~QZh17I6yhUV{mhBWcAMMQ7C?-z4bEW8fGlU`q7Y ze42*+I-cu&E+6bBH=fC-WTP!hX@CwU7U`R)qAm9e%XJ~rj0l%h3Z3EmZQ%t5YP==> zU=b-owqq3wE=-gsV%%ycp2X0fJ5Qq>l*%Kpa}&IY^kMbtOj#y1`1+=J&%#qsqcW_!@o`+b2sS3z`*|7I{a28-@|2uw4}*v=nPoP;fsWbo z)=RX2kZ&e~UL#gtoVaNI^&pjtl44T_fMje$2l>e8FxRt=@bUZXp89Jd7-8CKsOT*^ z=7VVs=AQox8F$#I9RpvqfyWuy9kn*rI18qYEwRbD#}~|Raso7CQ7f@)$aR%W0==#{ zv(s^JxU}1uy5FWK+DJOyV+~f`I&2Q@m!~r2Jb-f`E!RtsmmNn zW_;EKja2~Esj-{>yLHFI*z?)l^QL)HkRfla{Ktg|)9+}%#n{7h9}dlep>V^nP)D2E zqL$Yv{2tTf)A`4jL=qcE*|z71T1811YNQw6+|wIIrz5m$Z3kVCubx+G{akU3X8n|; zHYAPt@g;Xf1k5~KVqSkfRGucqY0M(E^%YZ>9~yQTjv0`+Bb=cu3mKyb+?7;oM%nR9 zH0$Q5=Blz;3Q<@FpLVXHcI@oTuQ*pl>0~=*jc`{x2-Nb@plHYA&-w1_GW0rJ&yB?# z>@daL!8!;4hR{2%pGtwW_$aDkawDHo$Eome>uzc;umQe(EPQJr7GFjOFrQ(N*CwdF?$4y!W=is*|y=`*q{Ngy zml1kS<4K%G$BtMSGfz@c!;4}eRHzFH-xL?@(o)P;bNP@!vc9(__$(l%eaWpVL6Nxj zAogYuIrE<%vlu#&3bV-=PJx34lj!L=%%Y3&{`p@3nZ&exnpxz`n7MIUu55w?2rMng zjU=JoGYvaEJK7^li%Qs6V#~>j@@Ab(0g5Bg1G?cMWks$J7 z_^4!*ec_!4o1$9cnBz*Pa4rOTx=UtXx_C3 zg^#X#UtZ7hP`WMlleG}BF?NTiK}mOK=88gWS_3f8M>xxSvBQCwV>m6tGhUpRHs>q13+a>p=O-fSm=_hhbP z1R3lVjwuG>*u&IvHDMToqm!u}Vwni*?XDp;?S9T17M3%M{6VoAdc_=3Mbr43+Q$=` zAaTw-ELx8>E9ZN;0d-LY{$Z42M^K`@m=Av@0AV$IB$1v{43V?}Rk8r-Sj%Q(yj?RE zbWD=9FIp5i>BZ`FY{LysA$?<;5l0$?XBdP00C8!s8_TJ>S6V5X%nnp`#IKy;G|q}$ zs%0~ER$ze^JVVs@uo_eHz%KJY6cR+~0SEky07HHSwOSFNx zTMW#cG|xhWMTnomR8kvq(bmNvJ&(o2IL|1))eG113=99bU(jG2VjSzk_}!x`KF;Sul%cmzBG|3w5e+I;5@ zt(3=@y)If(ZXZpb%V?pA8v~yPUri1f*nha!DC^(5s}(RIEMYgff~;cZ^94gX0s8EwhXZvpcIt^1Q8Ds z5Y|E}{h5jVEjPb}0E54mOyXmd3*{kPxB;3KbavR2uqaI_C5RSRX?*| zp7aBkC-;I#1F#L@V@7(Y352~zUVP8aJnL5c9f5f<<|LY^BjlL~Gtv=Z(jkFM|7su) zrhHs$$DjOnyXn4X?5>+HL?G_sgbC5gIwS;18%kB85py9jCqpbZ*-&1i2rw(wH`^gU z`-43<=6$@d4}jOmXObbI2Fyf~k~Y0xj{x}I^fh+y(bw7q=O1K$IPY*Pz-%alR;&bg z?S30;#N;Q6Mi?u#GV6{@y5YJe9WD@(AQDEDg=C!sBt)~)rL?N7RfXI?cWIMf0ht%n zyhwtH4DX=SWe<*-WEcJMpH{Jko&6BHULfru1A0~S%V2%0Ga?WP%qlyyFU5c)NtQo@4`o@fu? zn-MKU2qbN+OiQ6q2go>bGe~i8t^K#|1xSz)9lF4-03pJf^zi~a?~*%g@;eLB5MftR z%*2ui>8f{5vqjHKFeiWEc&0Tnd78_F;+h+uwOj6f-fp_`Ec?k3dpe<7RHo`h;JcMF zqW{pD9I1OsRj5n3x~g2ZU|OmLH~Evl`kEm8|b8qpurGl8Bkx!fjqndcJt1WGR_L7+W?t%wcXqsqG-2X@GOh2rCTXkQ4zvBFE zLZec|f0M%~Xi3u4KxxV*eX__ zW6!dG{Ph=h#)*4?V~}r`ahG$h@V>YTVXM9**zAYD1YC#K)dhcf*8X+hlT1|c7mQX1 zc8QD|n$*!JSx2<*Yn3tx;|#m%nrH3p_vYK9x1Mj^I^zRO`WQ+R7|3OVG_&K7B65A8 zl&HVYAkWfhls0-Z3vYN?B{52n{t8F1qwTE19PyINAFv1RdXv7CT}bm-L=X$iq%{QD z(Q>G-(rbLy(^0dW_H`>n^7B3<`~M_}_Hpjs^L zx?%V?%*>j_!ZLjkgouQ;x8I*{jb}qFQBS3DFWDi+09^se_wzGP(+Yi_=CVZUDg?m%cL#1-uelXG?16189#ehuSp}%PJrjtCeCj z&bGn)b?fnSZ1Q3Vuq+l1E9wb*5MZ8O>VA3SWW+Qw!J&GpS|+oV*Dc#HuWP3vH62N`&uFIl|(ww=Tk12 zTHkx`yLQ&4w^O$mQ|T9-Oru43`b1eiWFzwyFh12|ZeK?quZ0}RPAWGojIu8~ejKxK z3&{pYeWJGisGc_exdq6SJO=^&`fH!soYOG>UAe&SduI`2fW|i}M`PHII&3sP5j#N2 ziLgZuMc#@q?l5>#9v~0tF75d&a0w&dY4JZ;Y*T$@Y^U$nsFOhW41sl6ZdY--Y*?dR%HzmRjY(ty37cq3^F^#G zN6ID-;*rIJOy(#N7To2Q64uj-kWKUG8x%zpa$MuBp*fvOG=Kf!5%36j1Uv%Y6$ApQ z>${SgR63;nsIg}HC(CSY1wttkJ*{MGQkG<}53yP~YP-RhU84nq)AAgAia1|%8o1N{ z802+mGMmK&xqyu`LJ(8g5I2qZ>rq&ta98f-Irk!Y2#nd7i%9b*2t{ur7QiU2uc))5 zPQJn>e7Ka!UJ-;1!f~XEF`kKD5@}Sc)CeciTrx~=oUp;vQCd2djqs7v!Jc__f=!(| z%^tqv65D-;e#C)5in!r45fPA@(bR0fdAZWta_~EhQ|p`Wcm~%+Ol%q0H5ex`XLPH; z2v1IHht=GqNLp43lS#BE@txAtRAfIn^^f-6_?vC3e%(nY!ilhxe@mj!Ja~C|o$Yt{ z?`+mQR)I?pf)I$1et1SC09Yq54{;hb;*1b(!N={WhokpUp7ygYwev2x6I1jRcGYiB zMt%$4Pe9f{Z-8&M{Rs!$SN~%yi>3%XrP4$w2PcFEu}s)CCzLM!X&K*X0w6Rcg&}@@ zCVy06KRo2m_R!tu+OFFVB0a>*WJQkPHG!AU9+4=@j}y35Vw8I=<#Wb`x3g0t8^vg| zlz26~8Nw0d01^^;C~{hv(&|ehF8g7Uf>#@h55v+enZFNdr`0K^O_h8ut;8FWQ> z4k1*I(luGvCKTGxMglClNUq$HA^^o4Lr66>MXlN4fz}l1b=6Vn)Dcw8;P(dK(r`-M zq#WcA^S6Jx-)_BcEM`*Fvm$&Q5myL_D@hzi9kfO@VZ{k1tYk}2i{Xn%n{pTe;)131 z_M;>IY}Z0K{Nj`Ynbd)=G&o^znv;|-iAhSp6A4VdLf|j5Ni3k^Qh0LouN^xBv+Nk= za@1E%$k5JGU6+>KrVq8IAmggrs@`g2k3avO{rKnC5e=GprI3%{8E%H?m8ya2I3`(v z1|R2WBqu0$x2!GcvY?~YQ;t9T&As;Uvy<)Fdwz>)snQS-%p!8)5M#|Sh9V$!D4B{| z_2aX}tL(~~##kferNsmh_en@yL&G|jz_d70Yy0hsvw5^DGaDf&aZ+Cnv48S8x7)ZE zr_-Jxev1%@AyQ)y?g{0eNaZwNe^nMp*x-e;ew9NuIMdI(Kc&+4_~9jX-`(fgk^Afr zXk_p>lD|X9O=hWMV_$mDPW{DQRtdRj9l?S&A|FX{?dph-?fe0-AOLgfs(mOsgXv4L zo%7oV(MBLYY&IZG7^i1V(&RI?0TbOAlXGV0lqkN{&E5ZbVKEw5O)PV#$HTUR~XZ!3k$Z9KBTLJCs0kn)yKK({Vgkh6KU7^k}Q4kc& z1i7F%zyX4nf`*txgNeRDCSRIpB{4gkFlmXM_KUyUxCbugrC?D<^(9IhufvUoHh3c0 zJdc?sj_mbbQ*%c<`lKt-PGTa0SzbJvDsN5Ll?Em!8MLD~6Z3cmWl%`ljrFqgF8&uL z;;ZbE-yBbJL{yVDDhNG`z~Z-H0VnE;YiIlxN%G1&ACLw%i^%Ivzkom3`U;0%9AY+( z_J`_;`gGU1DsP2F_U?pvcIj33+nqQ3k~^eJWeo<>*wTgv4eWlMY92wf!i+;>U<14O z=3x`4Nxs^UiboGE$8Xn>r(A85KUr_qiMptTuQ(G(v9Hwkq{>-isPdy(E2NL=j{q%=NU^5^Pa^pmX4d1Sh^)Ak{Srzz9 z#1~{DKWU##_}HEuKi|$ecsthDSlywH#v#q}=qHN0^tApN+*umN3mQP|eZ{Kzi2b*9^8SYwOgSG1x46<#(SVQxXQ z^}yA{k9O%{)0fPn#nY!S&b`nXhcRX6lW9l9S@f5zA=f~cga)P`=~+jbe!$;M1ugUmpGL4Wk* z^E2#}-TK>|k56TsL#|YxQqyd^A2Q0e?g!a~S+g`LC1*p`A-}4>OUJU|U)PO*aV|;# zd5rN#?K{Gz{sUr{gC!+SY57h&XsFguMu|I8D1@r6%Wb3O|}N;@lWxjC2_kM4`c z_aN)S<}am%BL6b%>Kn$`ESb?m&dR5@le-w-MA60|wz9#fkUDx08{jZZ;y?>; z&9Wu->ihGoX8a^;pw2|_e;B6^?>%&Y9ku%~l<$zp(a6k%BxTDT%+&!0B2A0S5yqMV z$nT5JJJg1iWn#!BS(F-s94T{wX0-n5v3g+8W9Rn>oBegQuKmg^QB%QK(rrU(4<4T+U8F}v1oq9suLe?KKq_^!pdI(kz`PQi{ z&x)uQufOt!-S*T{NO$HFkl?NakQEq`kh`0$v`a_w^I4EILD`6VkxDdDF~1Ko#GZKw5(s>d2GVqraHZLvNVr;7hmSeqYMb!xa?611OeU*&55YlNCXET})-lVr z8rI3WcgKtY;z2$QXU$z}^FG52!jT#bfFe7S9c}sQgdO{{tL(W){%G3`>%zdvB$gF! z3C%Ht4!7G}8=+D8&?<8k6Yx+1r{q>+qqps4JMGw&ReXdv2#^H}%kAayvoQtLgp)y+ z{6-jbrW3qYQ{p0NVKb{_N0Gh$_0V%6MtLWI%E+?&3;ERBy6JrC6WN8+?rjJ6wB1MbwLU#XKAFv5U1@Kk$@S?x1PG}eX!Vw& zT)wKp&bjz@djV3gTPZ}52pyG=G`r9mZSNOOm?c@Z}8%(9b(W%lYT3+-1I-ERN5>gULFXr-cpIATCIb_!%i zKJqr_v$c?KYBtnIzNM=XX0qQ0v!yaj(}|GtT%mOM znRD@s9NYitn#b+dTc5LVVR!NkaVUXH#4wyrA-ltGwPj!0K>>mn{;DutUa+VNA8^a9 z9{;2wRi)t@f?R8im)SX&+y`+Iv7aBiKj-z-wKzNNme@`sv|}c|67dB!e?=YfNMI8c z1IbBU$w5PSSYO;5Ae1L$irQSv?vHS5;F)eOrhB z){eFlX3dQVyIGKpi9{|$@GUm(g|{q>Z$v!zW0FfbU<#H%E3TB?8@Jr5hxP7-uT~Zu zs+g?In_C01zY48AHcW8spWNfWsFt{oIpsPVbJuU}@cp-^j?uQkT78Z*O=r(vk6HMm zkdNdqvk^Q*I3t)xDlDTZ2mh44Z1kuu_~R-h{n@r^MUzdOGRLOQUO|78fS9c$n@kYn zXzi$8tDmFJXn`Xp6LQ)bSD3^>fidaPyrnHRA_?jtTSF`uSgh8Hm|%46*qOA~+4}0$ zwr*jw9dYtr&Nrv@MLwnf`TeC2qSXRf8fFnjM3>^`-4R>n+upkjwk{oM{}8ZINYK^G zEA91nX4{;lOtgqA#7>&h%1p9IGXb|2AJ1BfuTT6&x$=SlpudkoVroMP9bul2(`SaM z*K)B@hxsN92HbqqcGzwU8{V%Q{-?q$8r9fGbJp18>5F++^-EfrRM>D8R?<*+YStj95Q--El%cT0;iyw5G8^{-$CY}-cLTS39)NCX0wYJUHovj;wNaOV9i&r$- zhaWAn*^AdeKG1%p5z1sy?iMb;={Xy{!wB1d&*5O&?8q4Pm;UewY;FW3hlM3?(Ls0a z(%X(ZYzzC-t?#k!sD6q%4vBHmh4(oBu*d8?3~7Y6gDlp8jXJVe94%vvYobq2vI$Kz zR&Jjr*j<`_^=ln8_Spc_k5L1?p@x%k+fG;I+JplG%ucS?(X)E-0Z{F6pm z8GTz+mItJv0HS5B+-`{Apbu<0G|uQUA88xrp<$Uc-sA zm%8lE)wduQ6|e|Y!~*3J5WX*c__)=uh>b99(>_>WSKjitO2p5Tal^qur~vcd)(?n~SRGPchN`cHJ@ecrR_$bS#^~faD`uzjOU^&qM)ZMfW9*bQi^dNP8TDvZV%MRf;#o;MIy9ye z9E)dpXw=2f8tgl03p;eTK6dkyGq4USVy&{l?z;O$Gkg~s zXxD662564aV^BA$_h-a`k_2N%BQ9+!)~~UWp1qJOz?cQ=2%GL`!=c5iqqbuCIx8cb zTo$k7V>u_c5g8Ksi?j#YrW=;COSaOjF@ipP%VGV=z(?dq8}%UHvS26+i9`3he>B238&Vtd}>Czf;jikUvFehc!m(9mcap+PC!l-y8ofb2r9! zcEwI;k(;)3;xW6}F$ZsrF+~-K5l<`&8J0iHp|n^U=S?keOM74Gma<5)xyt%)H5k_h z@31wFG#WL2H`@y=UZ3)V9g$6&Ao_(1nw^mT>&v6|@XPaD{bcEqj4EHL1aFuNf94VJ z2zUfM0{>+MzC?of_ERU)L%Su4Tw1Xj4G#&54Dbwf3@9SVkdx5pDAL9YkRr}hn1PQm zb(4oSQPJ*#A%vzZRz?#zI@SOzGl}4bgk4SYh>GjFtX=0MEdTlPd+hDE5R>pX7jlzb zv|Y677j3YE4j6359=sJkUkF>8HWFx%*kpG6E{>i5asPO$sY7Fu!Nn* zxqq_>&)vWP%mkYVm2~A>lTrzZt%njs*m0anbMfNe?QOdZ@5ekJ(^st-Be-nUzsQCS z>uy)xJQjk0i6tw7aR|a>27+sLzD=8fZ?LLnRz{UZX~;pEkk@}c@VZTzwj3b}LQv!o ziB!I!Tp5z2+6j5&>|X4@^^-45SxN4xU2r|pAJ)*@t;AUHv4Xx57Z>Z|@b z#`eU_rZb!2gjwxeu`b(gyyF!(+6JB_hxkfFR6)_M%1%6Xq#bj>md@`?1QW(4%4hI^ zLfd=C0rv1SQ|y^n=CUG>uop&BL~Cir2TSd?yT;fR7oCK#B>F@LfBEf%I2Br(gSiBG zVV7nybjh#xvt5Rjuu3g65lRSW;|a`>7w_L_*W59V%|nC-^+<(}02jj4=<%@=?U+M% zu~FM}x2CFuUHr3M*ra8c&4S>&@S2A(8Nt^LX{JCOxnzlIJL-pf+8!gjV#UsGldM+f zmvu$Bsz;E7VC7MjG1IIsl!xSVQe=YsI6nKvG`r$&4_K(A6K{$bqz0(`5a>pXD6n6h z@B{0Pk5QSfhbeP%htu|$Eh^vIZocy!{PBSu+9P-!LZPq{%!=$c7vE*O4jalwLR}%( zsu7y^vSaq#iXGP)?3Na69}G8dlRiUF_A%K z;aY1Y3FPH^>&2qMZ_e7!`a$N0AbKL0i+#GP+{)0#EujsC(Fn*Wh}r#5zKvH@!DfC z5Kr$EIbNsUDR<``SU?aPC`2%!w?IM-DTETz8_D)QyHoz}&v$l~P1pdIzlYxZU^25a zzw-S)-}Zbz&*yobX;z9{Qfz4Yh`+RHUDD<)pzQ$1yx9_a;>o9BK?X2r_~;Ydh<=ml z+iJ(o9cfp5^gKW@j1)qu`Q9VH^)ZzsX_;Z4{q~PZ+Qd8x+d9_~V1SUNbNwsZiPKgG za}hcBH<@Fxs*LI{fX0f|ma8A&Fd*!N(Q*6AhnHZW$i-UpGA8=6!)z%@AYOQ7xBcVy zA0;^un@>viey7$P?L^a&KV^ zVjVK?Y7;oH@Th|QjUm8QNjTI_ZcWsa=sYX$z29!Tdlj}O#sFj0v6VH!urz+=gY#^` z%+buNDHt@G(*fb9_t{xX>g>9k*4jN!u#Sn5k6{7_Ph!>f*_XfeJv(~k^~AzenV3uX zPe*RNx{rl_3KIB>NI?3OA8_8sx_Qd!vjE1M?Y1X&Gw;&RF(P*)+w8&%ud#bBJkh@P z*)y%K1S1P5g<@%!08pe;ZMNpo&34tl-)t+N+=U(nXx2YRyww7F7#9vO(Y)7xxLDzg zH5o0^9rS#ZvJ?PI7Q>H1_f%1ivIsHs&^NsRLp^)9+OJo>z&K{m4LX=!+_=%$QJ9M` zU}+c-uXNOCyWkxY?8`T9W`1FPWiEbx3oI>#aL{^%UVG{p^KA^FHvHUQ3HZE#LVcPu z<$WQ*<}in=g?p~X?`tQyxs%CEbrVpep9aP>`X9tSEAA<=$$*~6V?e)SJwOrqVwMcX zKe(j>cANkoJaU*f7cE<2bLxv=sgdZBFd)LIw8llHXt}v^(1QnxpgB}wWH5vfX+(nFz+@*u{ zQ>v!Sqp{+wEuK5u%8Apc_={Q-`dS*Sv4#7EcrG3c&>+FYSjQ8^HmsCHj-FxY4Y(rX zJ@r4=-a^8zX4Io9=2qm(T&p=>=3gZ%lDg_+;SI1Zq;WZa@2RuwHxKTxy_Cg=?!Rm6 ztH_#C!Q4zkW|%N*hMhdSj=cqL(&*EQtJ{m5f+UuiK5?c^sD8v=+|T+0h}Ml^?)DX1 z?9_#`te&-BaiwFlQ>r&;pZV55*{XH>kqxZ&Ugl`REUkF>D!ib|&>;mxQ#VRF)S>;6 zva=sCV>}tBt4L0XmjLYv_0(=4l+lR`>+Jl+N1?ZH7p#yXOWgB^dtE_>snZvp|`VyHFob%&N{fEqSy z!UE88+(MUI?En)7&ew(yS78?Dr=H(s*Z*o2F&CvM0_0%DbaCQRB<5HO3F&j7B zD#Ar5jVMlvI|fs(gRF)p9Eoc;H~rTiuOY4>N)4H}QICNnAx!SepOm)>U@drRQ0FnWQDKSIVziE#Gqa_gu4jQ|-7Ho{a1E2p4arxRiK6 z#Ih3*(@i~#OG@m@51wwHyy|8^V$dTg`)t_dR@(;SYWcmJY%VT7kuXe%bR1KyJ6psmUa2$Nj<*cJWww@=vC-Ew`>c$I6c#$nou z*>L^ikk<%Q$ga9QKv;m*4igOu-Gvmqp*mB$VUu9xeF(8%Q|v8 z%*jh(vi`>%WKyTkAQ1KGEDW0cZC;Wm{lab{K4%~8D<)(MG5S`(W>)`FXa&VEO0fx% zOYM8lo@S>knd3r8#7MX$A#*K*C<>ybgngr|%+;~0oW17PzotmHzMA^t;IH0dAJ#LoGoif4p z?AzwD+P_K$<`!bL9Wix0o4*)LNy5s*e)JL^0!)uNCqtruUaPOHwwC67$eghU@Wn%6 z0+E@WWIKxgl;fuKmo3+kT!B-HF-7tKxxHrqO5=>rPhGme#*Zv_@(;pZQoj+Syt}){ zil)`u=K$ue`Hu%JDHk)CkY1SEP;%^nHM{KDm-gBsSfw%?rT9I~_@gA82iV{YGip;< zGwinFFoZsQ{sJ3W1w#ckOgLPfdlq%-f~78iV#3%m+rJhAjc&pCz$Ao0C}aCbvXKVl zPP35=AYVUYt4$#xG&wlYt2aC7)74X7i;><17!jxb8H^)6BpLYr4G*&hYAzAj4Hy7Z zM8CcJq{*x~6RilhIE_)o$I@D=e%Qt9^pj`Ui<@79jUKYf%1Wyn7PnD#BZx;@W_@jJ z7Gb=4T#zwWaCiTKF5ya4_@^L&KTiSz{(|(eC~*b5x<}YYKJpIh2`sm}R_%fj#~Q`h zOR<(+Pki1RZ(2zrwOU*?VIwkr+B-A0W!pXy*a4I$FiUbty3i znLos+3Zg@1U?M7Mp}=*}f5xI9cIGmGrz8L&Q!(oSV?No1P7o)01;6bR0ExcBT=K~M zo9q)L!8!%Ns2osg-3wdo509+318odYA7OjAj|@ACTiHbtC_n3!%setir6au-(|dcw z7M-@(COz;nF>fg{N#6qKgMBg*Fj0&fKg^bqtT2e48OO!ht zN8w3SZyv9uQ-+#u60?NxS}7_^0CB+vq{@DIp^(()=35@I7@ip3=4Pv&GS)6SeWBAq zvxFs*D|(_gZs)ycq206ow}63^higOBK@#*b-((XBd+!PL79=!BoCJZOasmw%HCewAeilue0?p?4=7~7$*L$60)SxcT!Dl+y~wue@k7ZgIR>WS{%g) zI!c+->+I?u;c^etU;WrCLlSES3$mSeQaw63eW?if(>ML-l374(4@8ODQ87Dx$^=%k!A!(qeW&!m+aLILc%hEM?c8sCVW^MJV zwf6gmUj`6G&t~u9CG?DAK{D1-0H{6>NiJC{W%zc6G&MKESFA>9ynO;OQy2wcglb=; zQN`EjDs5I(gI5lETD!cR*mIDg-EO$~VKSRH+ObEEg2b4#XP??+E7xqd&LmfAdw`)* z`-HX-oAO_0nyleF?EUXwV9#CkTRYIn-VYs3o>brY?_b-mRy=6q>LC{}95!v< zVF#MhRzls{hzrW@5m})lVJwyr+l5n6=i&Ff$|?=fb>X1|TKKLYfr11I5-3RE|EmPF z)V}Qw2STz?1OX|W-o--UEV?W!LJ@iaP5M~;Stt2kiY4bc>WbbER~-QW{N{cK@Z*m( ziiDI!ws3qcfJaV8@ zq$FZTA9Vyk5Z1%e7@4Apdr6RG#jxw{YO`K|+PeA?++nj@VDq<99prkc7vgjaakei@ zu<=&`EA~>!{^eKl1ElidUbF0^%07$8$eJJSdDB?%35&y*xzJP+l z;+<`T1b{0=48^gy10s>=P{rXKknF?9kiSg`0&)}pvP`vmL| zzbp-FvaP+*0w%yg zxS~uPNjC7AF6K{3qLeI&Sewy@*sBvevYlY?Z8jYsW&TmqZ6$050i`sOyHA??KDTZY zK=N@GCxEvs(E*sCiDt#M%*l+Faa~F8Dnp#j%dqNUSjhbrqrU`DOa+$7?d+`|+zVxW z^=e$vNzmdA0eJJD>m5ASPePP;E?aDqN0G4|SD!LiP(I4-SG+7-!+LtlkYO7DXv&tp zW3F9)^SxAweu><()XhU(Rz11iHofqQ%^W`pYjOY}KerKy6&-N(c&)6IMOCAg3ff;? zQ|dBlhS-z|+)!NAfuQ%VU3Ac=eCy=e3J|8T-5z}8DK=FaZ#s~$@E`Q4>1@WPP8`Jsx0tZ51l0#<&EUqv_CdtfT=q^j8~3k#+_u8Xvm&{w zvniF9&8Ik^_!-LpqiV{D)f6ShEG|>XMw=4>kX^)??O?ndJvVO0FW7Fk{eGPTy;Ldz zpils8)#J|*LSc^$ud88`;3H$^e%tucR`zXdqM4VpY0ePyEDli4UYS$R*9(*voj`x3ANl7VBZ< zqxQ;n7#acxG%*bvB*bB^O2Z0q%uO~MlJ($2V}2lbKSq&baD|>TVL z^KH=D+Dg1&!emU^Voz;Cw)A<|=d{Bi#^M7HuD0W5j-gH1n9$egHq6jGSF+bmP<@o& zsHlw|H_Rqa8qIhhX;~=&_yJ)DKg$O@qXa_-QOkG@-r5l2pt*^9aZlApK&TEq>@bJs zOvOERkRY=yg!rHN{-JfW2k^18z15Co zQ#|=!KgxWnts-p(TRP6BKb9E5hK%{t^=r*ll>7B!KTIhLUl%0s$4Nl!{s`=+c$_%g zWIX=trKj7d;j8TDE4CAA23-yV1CuZDiD9F^vfn&g!~$lmM^|A8Kz|ce7kvi6&4VWk zqthx%Gj_pcC)>MEo5$rC;b0{9dI7971Oez=Oksc&W=l7o9DdK0tj_!`0|B5N=ap1f z*vTi)vlp*_fNQ1CaZR|(o?H8>J@>c_f{a(@IO$EwF{=S!6h=YbGkpN1VM1P{Fz{86A7wQqe(P*xG%NfJ0O&pv%Y5To=!Lye zTXwP8Ij79DGThoz09FB5j=oURrp}#g%cebLw{6_XQ;LxtH%8_e^y~$5>TKeedY8yV zYmRivT$%DEe3N%gcLKD~p&~E}$BwJ9Nvtc6J`a%W6H__DTBLS1ppD=7j02aN3 zxjAm(Z2RS7cc3%J0Bg~cG4u*(e#db$Y&aoqLX^ixm=c8u$^z(~cIvTq$HULs)&{i` zb0oht665f?o9@R*N#9a?s@@oAMhq{pojV$6eHnQ1wj!qJPBI!zB_63NsN_8X&X2Ly zc6Ef%rxx4tyLQ?}n06sDOM8)bcd*kYPMT=P%$b3nNo-O2hFI#lfkHWj2+t9wub+GN zLfgH+$!@*(CA9E;z zYHj!Sq`lfipVEHI#Z-hhNSpcHfD>^-ioM31c1lI`4KxcG#yLlQL3<*_bQTe$16^$# zEX*bIN84@pY=eZz9>UYg^J8|;LmTbx`=8_rwF7`EAn~Z-!|~9w0fwpeZVU}A z7C2%UuGhrLgn>F`TAh97vg7P~*Wq12rf#j@9@0SV*_E`tyLUN#O3p47gr!+JZ=~J) zhqZ28DaLdf&k@(4^lX(^henc)KdK++E-Cz5kU&8K1ql=+@E4K*E5Y0E(8fux@&pP8 zn_;n5atBHTt49(LO~4@77OMzABnu0+u{W%U+sL69%B9V@+Ht;EHriXFO>jL*o&ZU{ z&?dLFt&4bMEN)`xXd#vY%OanK1~>^T;xsZjCdh(Y42TvElf@12!dctc#D=5T@o_OJ z#yWW9jFGnLnazM3TCh>Bap#kEx^+u4F6K=(wjMVSeeVvpocDk3f0JSi$XQogX$gSA zC_q;P*BxL0%8y$L)$YZTt4*;}w)t-GAvtO@uFbDDnrSi`?jzn}YnuQZohyZlvcoj2 zsEAqJhzeXK03h`<DkrD6j(o!cnf+aQlf>6EALOW1B=Vtard%SV6a8HDq}2(&m69 zCC?)}Pz%b$i|6tIg(GbDt$G2_Wiu91z#3$$xOGa5qYUCHl(9a5icMQlx+t5Aoktrf zRwsy!J@NDgJCnG1vcPfzufrTXZrY>~fFfZlEibWR=!sF>wNi3z!re6l11U&*g*w~p zSb&z5e^^JGQyyfMJBX1BISx_ zsjt3O07&hWMq!dN_sqJTD4{6a^hX+om)ZwL9`0xhjvhz7ipYaP`v83V$tWq9qO9bzLPvPp6EXS^SkyRupK1OV6adoZKV3g7E(H4@g!WTh#^Ff z|Dxg&2XIN&uKxl^B}ty)BZgu!-EQMYSK8jDtthe74HmD{laaydr`OvBXB~@i0>-8K zwd*5#KlspGFc#Ks4eZ@=Wpc#DFAR%B8&)aZX)%TAx9Vq)J-wOd$UR7NK#na;6Im6; zhdI;hVIRk>s08K%jNUvbs4`1t5wT3VT5S;`Y=)?tfd3jV1Zkz zx~qN;EYIE4UG|3mAW^{CN~F$m5GfybLg0nWdM-dxQ+tQA9K)Nz+T$2 zgK@_k$Gvo@2=1W09qZW1khz}*svsdyRb|3TNxY-vXM+J}wMP$?3&Sja-N8+h-7smi zwzvwoM&Y!9r@ihHdKz-3-8eO^>)1rTuz45Bqc~OB#kn+R*ddB70P$$%?efwDa~<^_+lBqD~Bw@_+m*UI`yw|)g z6~&7p<$)P}*6EW0%F=e@Evt!R$66%?iv&0hyn^)>hsk&LsYlvL^Xf2MK43T8vMr~c zq8}{3^-lZL1&eITsA0~aAp=r?gn;Q-4>)Gf7Gn^dJ>e;PVgp_s0DoEoORKAF=?Sx} z1S7NNE6pRCzw(DZ%5$a@_jJ%5%EDZPO5EGoWxW_^Qkr`~BFR^6k@6z@(kITefByGd z?UjA7t9^KVh<2_?75DX5ckIPrjZs&zU;+QK7)is-+vNakXPz_9?tW<}x;65^2&nZl zROGj%$6|2710upak^>-LD_g#dhkx&%r??~t5Ef=0s;nxqxp<{Ky7obA-WY3Sfb7cv zgiWww^ff>0jS@xnQLnjkW@D&cX?ypP{ao`Zx=f@L_x(l0|3gkbVlDdUBPopJ=4-RM z>QcM?IM=V((S(fo_+`sT`m@G;WVaPZmn?`D0tE>aB=F}-fEDTOcjOhY8YNmlKhcI?hXWc|@Yq7P-W`y~ z1w$MzmKNW467;yKsRf0i42z}KM8%n7(RB9#kdboAO*=>|(9}xoJr+$l`KS;A4fM}2 zz=yJgfIzvV5}y%;O^Tv(n^YmOsCv_-xY`8(^vZKs0AD*WN}F%oMw7TIH{cR7hK*yM z0Qq{b%H0$ND8%Lxw+58Ju-q$A1O(2Zf?@SUS;YJo6*EA>kPK9pL5DV?`c4T((kQEq zxH?lfsm|3~(sU!m8yP$pp zq)4#|Zy-Kka|;T#)3GEpIrN}FvCG{?Y?^JmP^8^+)m9V?(|j+@ zs{gy4yUEswuyV2NDAq# zDyd`Ca_i2{B-wQZWRbW7z{Mpg;=Fv{JoM3Wy%pn8!RJ-a!<~2NbqD=T-|8ci@4mex z=1`LW<_avJfOJ0?OYxYMR{*xeaBHQ#!zjl*ibFEu`La|?UYt7uaIKh(i0#TrBG5=3 znfr-0@#=mQU|mN0`kOb>F~ogsTn~(V{Qv0p8(Gk7^Z%xvFH-x@V8is8Nl`;3@`_jsr1IX z?Ur9W27>_u0&M_tPhB*JFn3T+f{1dx06>9YVw5ru9D1mXdemXcD$q>{RNTTqn^%@c zDJODaUKAiG&{{IdgV$=C1niUqiOYaWDTkgZcQ$4u=HjNNR+s!sZgYCBzGGBS&HlMb zbHDzkJVhi+D2DASpg;`ZJXoOi*0>0gja*D=Cnl~MIJhs;;P$H6TRS#20Pp|+KmbWZ zK~x6LR9~V`(5p$p)QI@_8wQOVgN$hbnjzwjC1A-$k%L^&1C&K`kj{}Dw2=<-U4s52 zpjC5<4+D>vI*4p5kT%EER{Q1zuje183Eo--3TG80Fr);~lIUh$<`we}W0+ywh%}LW z#cLH+C3gJrbFHbRm5>h2wtH8*HMb_w(D2S+e3q8Qtaf-A#vkIzNgpDnZV>m;;xGxz zD)7L7%^p-1V3}sSyKK_9(e|5bKWYu_upt@u#Tf8LjF|&?!u%K%0LrQ89-3#J0V+~w zCD9%`Vg4xM5KppAuk5myU>&yt$SC3AWY~MtCJbjTC-yGkX3kuCv>iKdD)#}%OH|p& za*{tW{sVYmWC24Nfedwy2j_*NW*Uz)SP?j2X4|gMaz3J-+D$+xF6{ zfJZsw(A)`iHv8y_xSX@z;Qp-XPV-cluo6MMLrO7TL%^IO+IQq$;~5Tb%t4IBec)E39~bM+9+$q6UC3B6XCgINjz7)!p{sJ5y$&xtkq$V&h&KR6;y2h`mKwwyLYpGF|X4OBVk~siH+?8^wZ?0 zmT<|0h)o?vS2*dknKoi(wPiYJJJ!BndC(@+kK%gTUuz_DZGO^}E+0ULiIqtA$$2=; zo9QE2<5=6%*kfCF?7$ei-`WA%MRFKkS&Tb&IgG$k1B#w(Ws4$#*l8Hc+*ki*1K-AT<|vX%G4KoIBzp4R@XBT zbjL<0b3Nk?xZ70{@S3hpChDOKvb95+hkuV3+V5$%)Lt|=|3|pa{T~JUqYcet4J`gy zwozwSEQTmH!!A5z=o~T21juOu)|&0(l$BL~N7Gc_qJI^o_wsn9CS2?O_7KHGR5#A= z)VL6rV6UZ%_!v>-3faG+xG!GMpw$67)i^9i3Dm3)UjgtOS^ z75Jn{jZK$;5dRd@#+Rv$_ka=jC&lU@=bu$*1}`J6NYzTepUrjTlYGQ~@(t7z=UtTU z2)+OuRq`pR5u*vJSk|2o`yh2|GFA zfs9Nwf`mZ+UX!FNC+gWuPsC6Yz`?t{k`7oO%OZHBgalh!5+MQ?v)~xyx{K&6=KMi` zRu3Ij+QWw&>5ijr*}Y$eFWHTbRxu55Q?jF^rVMh(@J&%iJXn>wpN)VfzEGOt@$n|| z`N;D(1uMmnSeIWJD0V%EwIIJzFhz~W2CzMb8EBya#!>`hMB2-37g*lw1`3X#2aObb z3j+}Em`tMAeFhv)$l-5#_@GYmy%2p{5H{ZhI{&?Ju_!XWWY!5sqVDcj`famwt;g4y zm+GTDek#-uq=x9sAVE1~8BKHE(%R8vurQq|aFb&9-#H5=z90)CFv>Vds_}Sje1Gx^ z7s<#Y15pe%B=gkDm;Nwy#TWBaCi{gUDEr$(9IQu?Pvp934ls**PpOfHLEsSk@sktC zgioHL_%2#EE4`hplOG6j_B#MYAEk_J1{7Pdu8xzZGVQVdbfRZc^TwuDi8=W#^!?Wd z$rO2H6LO6Nessqfba&L`F6C5yoJOkUGJj^_xYI@$4}xopIKn-I{Qa(+s!E_VrmrME z^CXiMPc!Up{ZJTG`55-@W6sCTqua`%e_wczEZGpJVCw-7ah96qNxcyt3Pc@R@$OTC zD!Z>+NTtTdA6t9Q9*@60^Lc2B7Mn==?5h&p?ax@6aNDNFCnfSv9#yB*7kcYu-H1R8 zD8ZEvmUSxe`w4Vn3BBkA z?Ta>Rd_ZX&S4avXAkkIwkoocjM_lUnw%tW`TKg2=ux#XWH~b|e?AtTikuhLIb$+;m zSh+iRRySI17OZEU5dt%Gi>xmS0YV{@J*6?5rNC3vSL-Ews4hD11|0UM)GRXQM_?nt zmG0=bLTF35BjC)P3dY)zO<78FFL8elF7yQL-WyIWfwLjO-*d=K7WE*n5a|xJi!$RW z2!+0K3M}c>2}v#pC$U?u7t!Q@FA13fZhzsLTD)%Nrv2d;3(2{eANi!K|^+aNb`8gn&P|FKvs)# zlS+zanA+GNLte@$HS&x0eXrNR8XUtNd;x%dTOi$ zX?J6x`9^9J`Nchwen>h)A*~AEnkWEFI}jc`7tOZ)Hu}9PJ$hLl04W3SYC~4FPK4V( zqrS(q1to(0N!YF+Xbqt&B@V5_T91mtV`+)4El@JX91Om(t`^!VmKSd=>8nWYF^icm z>6`1MI-AAKa%_LEHx);Sh9|~520Broz^T$61S25 zB<(Un-Bea)DFiQdZ=8Pw+`)`1ip=3}>z_<r;b<1vNL$|K3+sp2Jxi6ALQ ziOSsuOggY413kX6s9kZ+xBU$&S+q3w-E8Wct7Is$M{A=EWptb>6WQpWInfy`YMUSqLP$bVp?q5l@e2Iulw&GlsyWDFrAIkjMk{0S{}J_XUjsDS1E?IZ^K zALmBcT=cGHG`wvj$$@4o8PUbI7T6E2;@>24V>@sZrlL8DI;!l4so^&eSJYH#aNlg` zzIk5FWv5$g`dkPFBsCIvD(XQ8C$cH@u3lHv9LW8pGQlOIBE;nY=r*8U`ll{~`&>X} zq6%W8K1tznDk>f5N#Ns(16(4bz%_C_X%;;f^r{Yx5{bGk0%Zvytuai?kOjZ*T~hRT z%(UW0xbCAWK#0&)ZeKXb8wL^dB+{yHX<$WRxSqh$xR1pvb$w`O;2g$V#p#BW@Y2p{Iy7`rW@-R_HGN7f_uqog zU3v&eirVI(TWSU2OCo7UVaUcYWrYuMXlVS~hmv@a`3XEi`Y7zN!PpXw@l0p$33oL; z9muT$R99DI*HG4I1dTHFdTL0{FS7@I2_1y>QI==^3Qfov;lWmnqm?kx$IF7S$1cK^ zRuKgiwjn5Z|4@L`Oea%bwiEw-dKGNl91^@SIuuR^xQ#?i$|2-drBCkqQFfBZrA>=` zW%5%44d>P+)+Z!5-qEfiFLfN(&wqqs0s#u~ZIosGU<}t&l*pQU?Z6rNGm@{Z65GHc z8B{`g`>LAN1d=MXq(C1O8_etcjy|}z<&V*67V2O0b0hU}eq40~V7+o@QCCyTs-*zr z_kzZvAQK@?d?Eitf(1W2<syuCu&124C-LDvI)i$D@ zoMU4oH6X?c?RHn?&a3gj#po}Da;*6m-qvN=Pvux`;Yk#1 z^wiz|WYLpbQ~Ao?y6Gpf8y8f_T3r~(IiT(72k_RplzqG?-a8QAiSK+_H<-x5?m1g+ zPi7R5S&_#_^3sQ{Jpx7D2IA%VJO^fIj1%F9X9VI#Nf=Ud6MZ3pdJolh?N# z!?R#8F}fCg1m@Zf9VprKv`p*-bLiWu=+@RUCN7>l4JLW31n!o?1 zz7<64SV_u&;}kJdM~0+>Kgm;RI%_ZieYipJdzJE!JKY3&X%LvbQwBz;k9f`N*+gjO zM|eGyA>!c*?t^m=l1q3l`(PtDc5`~44myhC3=rXEb>Y8=NI&Y;qrL7ZR$2=N0Wvt( zfga+?56L`SRvY)Z@?mA}7*sic?4~9)*4Tdjfvk=sAdSH1b>+i`ez$~{4caSn>m5n^ z@3Hu-Mh8~L)ryn=v=h;c_uAV49{u`k7i7_iwtSEAY(dOXC75QB39Hdr)cG<9Mou3#wIM5{=bj!cf+=C3p9) z-5K<|s~;*Yh9<1?08Ouxhw~E*ODrRXFK(#HwIB)OT-yYg*liYnMwtF_QzAy3Wm2I^ zkqy&+L~eWD7AW*rw&RokcaH&<9*Ib7D3Fv(OwUD;t@n2&C_x5y>Yr&o&Tp;gml;TJ zOL$AIlQ1uS)mmyiJOU{&Y;4C@A|9mefRgybPKN4^DJ zgq^yodlew!v&~X1ijR=R660@5jbD1qRCW5Id#MFd_iB(NJ(ZR2RwWQp>HpaTyKvGN-&@fUX zSdbU!ey?>dVVY_hg$TY6K*mU@El`MWa5VXzZ3t01SrN7zJ8i#i$Yj6rbNln!#v-Ni zmug~+rC8OH(b!jTak;0-<$l>J5sF5-fW4$H9vr(ye0n)KVnB-l+Q7(s8t*eS41(ij zdWMYuuCGkrDeTUb7LxnL)t&zu5?_()HYL^g=MZLoJL*5JcKb03b~SJ3D8A1*dbfQB z412Wfo@=98toYtWP>`hpyrz}B=OwmH{}2^^%=pMYY{6N2>vtPo!K=U5Y!pE-wT5yl zqO3e!cdQpo;Tkf8twkkX;ij63#?;?Rsn&AqLLr8Lc%-`k@SaFPiDY>jU@{KI9Ya-_ zQRH(=iOvRQH4}`hAeL<}VpYIbPp^L|ZjJ-BpPtR!gK|qRZ*149^%30 z@x;!{h!VXW_lnMj3?oN6y}X7BL#NrWZwbz=KSy^_X$#_4S}Dw#cyOK&4Z&h5Ng6kl6^-A?i` zy8xd_qyLt27*>jik6QCGYa<40!8B9u7Hp&><}etFlv^gVB6nO~ePLg}aO#GBX+t4P zndSg8X-v!5QxP}m4>fw$l}9hg;WTH)06rlPd@3bu-sHtrPGUOah5cc9LTNbImtxbS z>>dAnJ5n=|g>qe{(PM$dRkqY2*m8cLcRohZZ!iRgJSHRRMQ&k2*4M_>~k@8bo0Ajr&(4y0P{6;s)=Z zEP>-&G(wV^p1Cq~@wUl?^h`VE8qx`+&j4cwMT^gMAMU5|fbSb&{qOls-S-f*?Vg&A zs31~rp)s*o9JwP%CDI-C@WFw~FsZ8A=TMd`hwCL#NDYLo9q+e4WDO|FoBvz@u=y1#X=xdQ|Tp@B~hq%ZN^gh9|D7dRZZ zkz7pD#es@spxkxG@=tH4=j&aO319SBJZ{B52s%%@-*&pp{UT7}6lzm31=#&N6g^#H z{jeRVt{TEMf}iV32|T%44kc5)7yPVUUUzgFPDjO- z75`RnBIFttjWQd%pxXC+50{U2Qd*k&wvlVQMnKQzM07#f)!c&)gHz4YT|Uq5zD(?% z!SUEg2p9IcK#Uos&8AEl2S>Bpj$xl z3PsAw@o(ZkO-cKC;ht4^9m5X)y^c_Kcm0u}c9>&b_(sBL%D6#|cmIC+ybhl6!yHe^ znshAj&doEw#va~G8=wjqEOws%NDzan@lM8Jb|3x!T>#xo0qb-x-TJWsX#3cdtx2?; zAEWTaYfp+A4FGIs1E>r-5R5&A6+N-n;HLYtyRACB0|s1TssRgN!weZJ9w2laK$}je z|M@X}*1ohMNo6qjv1ctv3rPsgM^+}jE~mkZ**xwB;;;=^DFlZh5b&>ydL)mJPx+=U zCK&v{Snc~5Mqkky2C0K=JWnS&0WV0`q>%brtl{I|zKiSqGMY7&NaN0tGM%-R*6>}9 z7yJ>5W%}ikha^Bmz#&Gt$K_rjtc&mkJFD{C2k6ez}v@Wg4o+GgYWuje85a<<-0Zh`GNN0^00tsWtQt^ z^SLDJI^0`=oYP%}S96~0c0qY7`x~vd&pQSVXJs)3;BUUB$En6D@P*mrN4 z9{Ga|uXHApoD47^N=I7Uso@hTKE{09l+W4rTWwHQ*F1#)WhxIZ)vc7s&)Ru~`Z;4N z{{z~za7Rc26-07Q6*{cH!h7-4^sRGdR_xG$Ew|3wQ4(G0!w&Nqi}kZ zPC-l!CFz5hMytTaaZ`N0xG134N!F77Q+y#1LJDl@NzrVdJc5>TDk2v%Ek!}5lPqV$ z?@+7V^!Yn8aSPn`bWlcp*gk}mLLrWa)g^`C{o}_T(%KdXli=S9#L-F3{3el+Gh&dV zdJHRky(p&ghK@F(E=yy>GNjx^&`ITaq0||Kid;V)r_l?ipzshJK;fcz0b zz>AEw>)8Xw_wW6vNR-RW z)_X{R?w@oy{A_!Y-f23hAJJArk-6W~SklTLDwAvI`(;>$?QwVEII#m*Rf1=uI)#}PyM{Wf>FBwoW%D6#RZXEs-G41`g zL2HB%t>J*Gw$$L+V5aT7%C*MEm2SyEC#iPIH#H#oR;_x=N}j)a+>Nc+cJhVLZN3tD zb(r6^GRx~GWuR?s^8JT-S(&O*_IruiUAz^>2ZO|RrG%h!Ob=2375Ex3Gu*T&t%t7j z#^!r~2DkWOJC{{>*PlyBm!poiXV0rsho#cY=Tn!ev0U?m@r3TU>H|_WGCO%*lmd2cMOcru?D1)tOM?(y7O-?@FjM z-SOsvoJFpAaCzDnUTR-|AX%5yax}r`6zID{9#vUaI_O0rMxmHkL?%QZGN}W1A(1H) zG6v=|O)-lOJDWlx+Iz^TZB;VeQ>kBJvXNwt8T+58z}Lp5ISja&`rXM+F%e(v@5u+EBW(NDc~3CD3Z9Co5%Zivil%Cp6_oO;b+zmcxny|wdyoiU36QFhcB-nB+}Fl}#Z zui1?SX?~Mkjtjbg1RGwkxdEqn_HlUladDC}W%*2#`Jp(F=^XM?je;dPPYB7nIT(hS zSGelXb6+5@jo$YffW2<*DF0pSXM-*D$T}5B@}g~BUc=P7df3llPwMpzQ=pNtt_>E& zLEE@$`r*gQ9Od5mzOgyDRc>+(Gm#zXw0pu5U?4BKAg^m&pVmh>;H^6){Q`m=Ky$Q@Qj`SV7VqaQes1I$%bh~Ak($eLPInvV0mpZb6}Uqe&FC{HMflTXpMDwOokXtzosX2!6|e==>dGz8o5*7+$^Z z4j>}iIms4~?eIk2^F7{^AmrHhl0WwF2N{Ph7|G#!VZj4g6%DrE(^`{NzZ(E+j0`X> z|9SHWlJ+?Jpw@4SV*HG?9cEKSP-}(v9ta*FEGnilOVe+`iLZh#lCLtV8d}%i#`Wb? zukBB}lz;juKjVMG1a{(nW3-wzK$?vKNY17v2fJJmto7Y>URp!8*8z(cwgkSRol-~H z4C1XXO04G~`^;ZxJ!60<-7%RV(xbm4!P(6*@|&ZwB*kOOn77si{CZSByhodEgv$5c zkWZc;4M2;k93Co9HrI9PCF|LSYW75z2D(7~dL3PE>)m{u^{=g5lWY^-`g?w-^rjUc z+zb)zdln^7vq%(Rq|?8?gKhz5!0qMIv+4g}6owc@n1?8oT-$KgVmXkyOI5Y8u#_%P zs%%`pB5CeBTGe??WPM~33qf!W2w#;GE~Bq%9b|ledNjba3Obe&+<-YJF{5ZsO!sW# z?+hWQ<^)S?T}9{$zBw}BEn&`gai6UYUjAc0H;nUu^J73qVl9;qQH?FsL*JymqKvWm z#E>GQ)G$d~(1YR8;aeSt-Z3=|gPRyVKX9&0tx^Y{(%&B|5ShGl?Ms9Z8bBH5v zxh2vNI%T(Q+-R}z;)NBg!0Lfs_nl7xAaAf+?b5tn6;W#dO_?#a-CI9eoyu^bE?@MN z+XgttSd@{rRJi-k)m+DVidGerh;^r9=ic4*tSDISb6&7RNMw9wI5gOt@Q&4VR4F=f4rsjnrhiagP-#|9ha%e zc+-R$2WxQjOZPowJIB`AzaRRh2HWmapBm6Di^bo9-mSipGf!@?Ps!Wxv#cbO-oDk#H%AnV zADOp&cM4?RORP@(DtfRn!A*_!)kzB}OGCm~>HfTu(|+HN8bCMg|2$(%#FuR#?mm-(C+A5{*CM0 zn%&K$agwCIpw5@0xoM>>X3b{pL9C)5fPqTlVqxVM@B^Tqr?ATZeq5xcE_TKMQVP&( zHMpb8d!ve`78?(RUJiE*N!@Q2L77KIu|sdf z9tMccrAp28hYsc_syJsQVe|VFsl@o`I-CEa-`7~oEG>lK$I$O?j$lUFvpuIBUc0>T zOYB0nhQuaeQJRfC?_Kb=Sxl^6{_0gz|D_TpOc0#6BBvey&xxb=wlN5Tz%8Q0E8?HH zJ|pA(GIrOUTshU7NO~6$Nmn7XNJyNc1H-*Wo5k-9w@a^V((f=KP%?M35njAS57*Tn zf4gobwJU%{TCPd2w&uvTCCi{}tUq~$Kk@JZ?Jb7%2PLOH;7c#2*IJXejZ^;4@t_-l zub(vq{$$i)ZU9Ri9;PbB8FpT&9U-YDgW@GOD6x+?c&5G8K8|N7>3`IR&Y(v`g8o&# z?X~3mK)keN$;7uM`UIb~J`JbdDhS4=-k5-S8-v7x*$K+>Tdp-yHxCb6{rj)}(f?1V{j#ay6iV9wU$Uy%R{0T>TtVL4jZ;!Yzg7C+_}?xJU_7|0s^n%~3u zy2ysDH5|~nxE6vM6y5LFX9A2M)f9%>i}XOeHO{QT3f?x{oc%q5aNDf8BV6|RKmqz- zWJ<;uV!h%1)r>HWwP-FdnlgqZUmG$UOJ!Eb3)CplC{9+8+i_y`TYrfl#}l7spyaob z%*97qUu6VrO ziEkO2I$e{lHPvlA5BThk{UFg+EM2D)sa_TEJy3ZazI^Lj6p&xk)u5SjRc`0sg>2lR zYV~@@(te+Sw|RO-aw`nGsWC1j09g=a%hw^;|Cuk2j#0@~03s zB{yY{p&X}E*Fb*vGt%94qT8n5PR}thJy_{6@hMsM*8zh$-Mi%PX#>>Kch(@*XXE^w z*kJlLgbDbyE&_>AOlDIv50W?0SLwN=7pR@+THP>`=WWLZg-^r+^rgZRAkQqoEPRfx z3C)o0)n`lNPKLw*JPO2P0Cfbc430Ge{gm-X^w*>uZz8b+*ta@$4jQt->Hi3HrSD=26?rhlu*#@T2q4c?G^{_0+R^8KyQ^hywt=9gbu+4cJ zk!&(~ps5%v+BU1{0t_Xyu>K{iqj>)#Z%h7FPOt~jpb{-(XJ#1SH^RC^(puN`&!26v zML~1Ux8|!i==>~SMtYQc>vc5gy#2Eg93@?Y4{Q*B@LyMtDbmr8UP1c%O2AvSigqNP(?ardWo#xAP9M~JqxsH`-0k_7a&d!D%#H!Ry)S_D;$j~*@vqWbqjg0eefN_ zm05W&i&R9W^X7Ye3;0H+#~Wsj?e-z(UvW5Lk*>d}(2aE)m%84LAD0y=%uof1_AzI4 zh6pgp7uATNlH+^~YT5cxd<-VXQAjYMFAZ7;m^S_^<)F$XY1g-y+H2{Tl(MBjS0l9=VpOr_o{ck z447`$cp6BrA5cgLa5#d=ol3I1lLMCOiE;@Hbdv;K#^Mk{$82#HE+^X*AHX+0iR|X%!i)q7_lK@eLfAZuewC{$)s~7kkM`78k zVi7tb6DsU3rKSX43I*WA|0f>!wjm)nUYqC>EODVE>2pq_tV&Eo-+Hzi*)4fCkZ+`S zR8n)D#lvtb#v@kc|Jr={MRK^oEa7fRZOytntD#7zsD9hkKH0gIT?yOEJD47ildX0V~9&cx<#i+VwBmQnt1MB zIT)g!`{Q@F+w-_>y{K^tL2`Lu6ht@*9W;bwTngLN`FvJ8@nPY>k!553R^#7I{}&s4 zv596h4IRVvTnOH2+n0T@5^Q{V-D(PSO{{qaQxvk9;X^(43QkF9Cg}I;DP#~{Ao;wF ziZ_kOP-{9w1&jn5O;Jo42&VN4JarV3Cs)=Z*xIYTf^O4P|MQH??UXpXj`;INarnU5 z@~{*n$c8K!(4(8`elZM%Jsvc&KET-4-nVWDAe0vU%=!;7E;9*+@p ztr-~VJ^G5Jb$-qzShs>{iz|zFaWApRh%MiQg|(b@#%v|NODGHPjN?AU%dm9{|HAZaSkz z+&dF4xm;~Kz|XxRr^yQOK+h~%fnZ9A#n4>>MzqZWj?u8%KFzmy;kD0_Xbmt*5{0G- zuOq?#2*MM;-e+F7=4tA%lKtkZ7C^=Xl~nf%4ttPY;vB|#q{`)!T9N+KvInYXe4J6s zX0If=>D14!gzYQ=p0Yv{S}&Y%SP0kIk^R^Q&<`#IqzVx4ZLzH-H(y$#X5`rz`iqHb z9Pbyat(wkK1Y`g&bHNTUKGCc?1GoAc0A>s{Ddu8=)p!oQAu6-V-U=9mi=j=lJT(*PVJDtDwDX+>&{u$cKNn0 zUHeOFmr^Ze?e6PZ51jnP-|P2w3oYpYr1=?ti&5uTYvL+DSp8Rsc;-o^71F~zX#zRe zi}Sjr_JMTOSp^gD-9QOJ6F4drJ<=*B^oYCH>4>klZms|Rca+`Mv{Ki9FG)s|mmDri zi!ar$@BxkH*pR@iZ3IqVRG`%(PZm#KPN_(s<HzkaEHN=Ws3J7%-Ve2eAVYD`56XIj*-ua z5O{Y(|Ia4E-#HQUKr`vCJgN-N;`J$kLz7o_!|#bT@t6*Jnyd8_-sKz@4Sa}MYTTL6 z6O)JU=c5I#;d!O3rpYr=t#1QKhsi9SXd zJ|2I3h}F7P1=Ms#eTb)y-Tlc^7%}Sq!*6*KAOo{i-AoO`LL|m-j87LeX&8T@cT_h^ zLQ-(KKHfVYcwVUC)%)Txh*gfc+d=Zf{# zwmS*vm30(mu*>3@ErnvcEF-Kn7>a#2Q7IK>q&;;Wshpha?CBfk*qx^^+MNFRd{;+N z5Bs4TP1f=SjXQmbq(r|3!*muk2Vh6AA)-sm!dGYKOIGJXl5Ac0YGon;%Hz@o)+tI< zMz~7EOc@HMqf=Lz0Q@T;V*n}3@-p(S{X}R((&aLRwK9V9&ow0>i&c#i6wXqFHd2lF zBGP3YAwjy<(=p0`z+po$Pu&XM)^;VC0o)#Sw%?R{Rr@J+b&px>^Rd5`tRMOAqWK#A z;?Au}>-3Z?0@f*7shu#=cfeeJny`a&tQwmUo0c$U8uXWsh124iDboW=VP+Hnz{C0- zCi-H8GB+N`ZPV4|xaAGx4vVxb?i=>a30IdFLWD{XB1t6C_rI=2-gm{N>pA-oTH_ zT6Ao=I`U%h8gXAWET;OzL?`$`Lp?Bdnmh$D#{Jv_%_`*EY)}!Lerh18;6liU`dH{7 zvWHVTS$7wjh))3vuEdiHo?e_7ui$WhFA3`D{d>T3z}(zEi>wX`P7(Uy1>r#VqO zbe@B*Pu)!c0}w}%tkl6^$tv=V(ach51Y>N{RTXw0J9==rRdwTYj8l6nmoRHA;(wR> zt=SWI{CFZXRvnn2FjUmArp93--J!Hl1Z&&=+JDE@re^#tYE&Qw>T}eJhvygTfaF_X37rhO5syd`%32>;&dZcvXokA`;ql2vBB> z4smomTt{%diX1uw{M79;*B$re1C0uS$}P;(bbS_ujaX%Cw$>fH`MN6uID>g56?gA_ zz!D}zD1$3-bk*Ttyptz$w8P$bY-UmS&aTBdxJ9C)+F>l*43_-7?-ELEZd$4TlveYY z027jRH`1M@g=t@VxZrJXj_|ZUw!b&|nt#9ccMSvyq;QloH@4h9t_q_uXVtpIE+9pH ze}vE(rUz^d2p?u&bd5x^V3QRzSHbo!V$v{$#^dy|EC)+DvHwjtwP%T%Hy>+V95i#; zgJJh*!Eb6$|7zNZx`-c7mkZSvyir0R`c0Jl%qP;VqD~j;c|IY1r(R3jsNl`4ValRY zWFS}ktDA|-J7O}2ZSca=qLQ!PuH@VnNfSBxkN`pp`${RNaGf&Pq?GWY`MJJiSu)B@ zo6zp0sFu?i+?nva6fxsO;eRth+n4g-TK($;3&=mLI!++@B++!?c*v{Cg_Tf_$(cJ%B_`;#%5VD7)R*!9qjfUD3ep_s z^uCTa8V$l}H`%NR(qc2|*&y>?_4I7{FCZKB)I8l?S8)bP?sB;`xN4}=1Jtym8r>QI z+-BkEhqVxhor`nAyfsr;;I{7Dv!@{o5+t_EikK-j4FHyY8;5>{XX(f>gCH=dWGro9 z+Ay=-YNR3ur(8HXJYzWR8$G6XRU<@At#6!bQ+x#CRY}wqhPSQ1G4(~F$B4loM)Kyl}+TtYO*8-@qZ5)gdtaTMd zpoj{|L1Rh`Jxz&8250!=Gz1q&UfNli@)R(+7%IbKko>Scwy`*CTb=LX<_1>dx{U-= zE{QM;%(Z2!qxgYx&GoKEKwc|KTNg}<71etHE|~Dz3XMXKm{p3MHvaIycrq_l(FOsE zt)xJoy2{@DI3KCZn3iPU6g7TyFnDT~5Fp z2rH|iE9STCV-TzCXu-ox>p?4IBth}pXUHXi!~qUTx0h5@w)Q?;Y+2h5U~g>wwc~jt z6!bg4>(w*Cpjr|86+@_Of6sQWrgZ>$L?f;ii4W69a@B`x z`f%Qq*TLM}!|Mcoqeqb%RZ?mxZ$fjg&MOggG?*ZD~H6f~BKj=I?7KNa&kKXE^Qt!%6uZF3+zCl5EkCs_>$H9Lut@s3c3v(OX` z51!KqK`dtsU|9}Q3}hiF_!`H)c&wp9gZ+1%9biHLljawi%W}$fHVJmlih*9w5Su zE>KZ4m9ZM}yI%R1Yn0O=@>Ld$ZAZ^#1PWIGzi zeka<4JupHe9aYG6?F*}^Gl{(j`nS3+_epLdB8^^mY(<1 zqJLuN`CizU`FY6ZWimBnBF^@&LBPK0KNf%sf*y`l;0Mipe#|d#?ca}U z7mIqQ7FNcUz2Rb6=(SSig>k8=hMWdS$j}lmkf2O3kBjp`#cT>|LY=k6x}58}E$;M! zB<8vd&7cRivl3m6IEM@joNBHzV33sQPskfc(Lu^i3gLI@U-sjMTGCJhGE;F`K3hy3 z*#Dymf9k^OxGt!=4PvSzz~pvyZ8q6&@n5;`i2R3H^j| cRK`=Z(8Z#I%>TIJ&9 zp%}OV_Pc<95iV=Q_tUj)ZQF*%Z`j`AAPF2Q10a+R_O=2Bm4u@@uAmq)eidW6M0^Z4 z`GE>o#xueA@SxS-P)riZiz#r0{1#Yo!5K1866(4Wgbh?9*dWMlhV=9oT0PB{WVFq! z5L(QDFnJ}979?oFl#jPLY$9*rOFCw$T1JkdE#!1{a#xZ0Nm&&d>v@BcI7*ymh2aLCRDAaFu@nQ_H`@Bq+bz1)T{k{vG&o*KCq^mVBm~LxOy4I z538ajLO^n!0sv5o^+0B~G)fdz+sZ^ui!%hwmQv`9hUSlN*l2ha$ zpJZI3MGmLtfAjh2i$#?nUsM8>Zy5#g+nV0N-=$)Vz=smMghoceNmxVFSGp>03K6Ri zwiTk+af{$}+x4H@R(bU;xWzqeDO3;441X<<#etj5L*W5X<+@s9WOT5As?GdG;}z>s z8WFEj27EcWFrcZWUV{@1fgr|04Uao#0u@eW))LMaw}+p*(!TjL&Sl()q?v`Eav{xT7d zK)1#JV*%{*moxrUcP&kd<41v2Z?payXpCE?LjgD7HHEI1yd;HA+>e$1yBOek2Z|TCu#c?RvyTJpYVZo|DM}p@B+3_) zZ^ev-A3~lTpnwk?sGKG@jwWk#DYT(WVO2J}^x=0f6Ks=A!x5N~pLqS!$WW1X2u!}d zaEu9Vg0{h)B!UFm!3CdO)0k2IPGK)qMgmsr<}7BS{miXlh|Lb_fvy11w}Ex=a;9%k zoJ^DUL?;Ou^*Cu1Hgt0>J-+-sItK+l&s=iOX2FhVL6yg*jFWTK9l^mcNs`%54^#0d zN=Esl%Yi4}{0HqY&f2*D;Jy}46^=F0@R2LO#Ut`z>rVu=HA$6cGqvC^11CZs!t}O zrnU8^^%>Y7K3v9((135P#EEd4{Zs&Xr5H%}zt6=Q|4%>f&(|$`GP3=pc^#VQK%4(Y z)&K8DcQg(sZLl<{5;f0|>k?GX_zJdazAfsJ8)UhC(_+dD@`Qi2 zKDXz>c%L`1!?k}8Q2eYJ_420oq$Dhti{N*vQ|Y8(*^U9NGw14pxI2dg;cP}ln$+_$alK_{t6=>A7awW72?~p@;yOnz3 zi;}?yD+g)S8fMURqR?T`NMM6oyzBfP#~!_>&TQ2Wh zCys7Oo+3#?@%|56-vAs5x2+pvVo&U3;)yk}ZF}O0ZQJ(5wr$()*tY%pzvrBL@2mG} zRdrRPx~liyz3}aCed~-^j^ha@f)s?+ae6mGxYSqwICRAI=(PC8E3ucPP(0;#WsGuz%tHhg5 zVd4R90kKLME>u@{b0N*$I16utlBgM-RSQsG6;QTIL%x{L3l&$(T18^Ji{l*$C$WFg8{(k5Q`K0`_sz!XA{Cfm}hV$~*K|%yn z)9A6nVegaK`dCR#ciQ(C%x!qMV%E5b?4tw=<^w^jN%brBGAvHaln}3Q6$Qn;))D`a zL{eM#FSYu=gqM~LcxX$ZP!?`wXw%*Lw=~gz4~j^$KTE$_M|H9rlpwGPggn||Caqj} zj@g`-Bgbyxi)Cf%W`5cS>F+md#@t!T-N>TU(yD>b@3LN?&*-59M$0%qRc)#zZhJ=! z6-3br;XF)B zBLRJiHm-4(?PT}<)iu^_GhZ~l&5oATqJJ|AeE)w;Uq^~azhKF!@~ngRX%#m%_7&zZ zUy@M%HFg2|cS}Po=HvyOviU4@K5s+A1@Fjn<;Ap=0ixLYb-#J`u^}RJD}0faLAxg0 zh&k*U%o@U)?pjC|44QcdhQN>gJH~Xal-H8Fow~AV(38B6SAC4xvY2(+F0v$LF?G?i z#bG$R<@MznAB~38+u3c2{EPe>&n(*hHkGSWCukmcW2^?cIRU~hH`U0)-&N}k_{k~G z#p0ngat7V~djgZMxc7Q?MLIq3L8(bwQa7vy{m7JVW;z%swuP}bDS3nB4wh;7?KtVx zLAH1X8DAU87E?)Ky}n|^RKm&O+EeEsUq}q zmJ4pGTCKO^ovI5i%SA&&tW{RzQFby^Gno5$k{QVHN=_lm!KZL%@XgE0(_eLZrag<} zo#?{b$_?gGm7(NjdLJ+ex53N)4mvZQJk{pfV}yrju?l~qT z4IxX#X=*nqg5EotSfQGW+nm+RwI-wdM--+3(kd7t-FmY`)3C$LrNDrBvSeVFgoe4X zWV_NO@eEX8d4MH+)!j9Lg4a$XS`&Vi6Rr5{hm9TZw}4B)OORTb5YFJ< z2$Er!E7xFrLSFi}3_dhN2z$ori(XYO?*KC)uA%_>%ZR@Ypsl+kBjHRijl#3m5jiIX zKbkd+8AJ9yNFKc6ehGMuVaJ9WXlX{+%6~h+ zsB(B}g|~P{dt_CIjtN+|3mUXPLwNF9b+XpkaUzVgdU(@#2r-*~Cyu7jHrlpzeG!SxM)iq?R4H??y2CwXs zw&Yx<2Y8+^HHF!K^pbd-O+sgYN7-&TT=l1;FhX7&`)hg%=YgihVX_>~J4HD^KQ-0h zH{tNJv6Q)q@|#0KWV!Ns58G#DpUSOl*>a!n0hZi9kKcpp5UWRPq&XgK@h_1MmfK`> zWI1<(Z2(qruZ?%#M?|Eeh)f!s|T1vOVYT*7F|Z+vXF=6iBY6|>M` zZ=LS_xdj+IOC3UsrfQaU^=@Qnj#hd3dTX1eBeZVTEw5THY+QG!zWJ%QlCtjIP__K^ zh@3co4(NW{xH=!Bsov-5ze@<4qE*EpZ@DO`oQH@D9Z~uIwnmJ>CkZ@Y|1rO6 zB`{nv&@`IZb)?eui}hb;?%d6p>lclUcWy6B&Yo7o_G|BXFZSaNjrdDwRcmAQOgA&>A<==qOIEu|Bs7KGyW1*Rex8*C;sJ^-cqa6zIAhzq1A9A zJ6T=#Uyd=A7<`^5Axwmk zKH*0Ew|t$8kt-_;w^~t>EwvmB8p68X&K`WUbu><=hK0qUuIm-R(hi4Kf~^HL+Trre z`UMdmOTnRCi=W}G4h^#eR>KEv~)Oy{gHl zlIkn{@o4E*@!fmlD@@=5a*pbiZc7e0Gg4ONml6V_g zB>4Uq;?QrEMv1#=Pu3Hzfi%^{Z|3sMOlsx-^=x7pO-nZ^Hp{B%d5dZ$hZ>8TrwcQ; zt)!nhC4%6*E7#PV*?eU)&GVEi^H*^HVQ{<>Dm!*m^gBBVuy=+XvQE)J`j7;979%#% zi=DbbhP|?GV>q$_#fuwlgJ)V2);FQY##p$Em(_OTml=HX7P>TX%PKe*_Tb+RCAXnA z%QN>=H?t|NPM&6zJW4yIQ-8_{9`>XiZloDOWob(*lu9A z8Obd+Hkso5L|ifpclk(LQ(f&(Fj^X&b91R^qdr>Z8bMAc%Ah`=r2(SfhvL@VF2A_U z*VJ~&Yv{>yT>M!y4t#17^%=1nK1pcM*y?)!kBV3Z42P1J7c^KE_7g@E;d%N(6ox_sU97&j%6yiCv#ClM%;71u_Cjl{M_Q+>7^vm22 zXp2K;O|xUyjqVSS!>jRyG@&5fsAvKrH}pi$(m_t-Z7yD3QSC<$H}@h9Aj<}7UMjj^ z|Ja2t7;$X@QZ#N=*Oa&S=_m+^ElPrFa&SfX!Ll#;Xq6o599ryW{Q5Ro4z8%MkO1hc z4cxq{f?(jPD>AaEuq?5kX*k>g8seOYb0vt?aJ!`~=>z^}lQ{o!!-xY7Q5o}c6A2p@ z1_laxPBKy-ml%ihiEzQuAwQ|C*i5PH*cH(e_;SlTCUvYlqe6FMNk?97yZG%wE3Y2Q z*SOn4=V>Afb^-|p&2KjiVn9rxTk^y(7R8?GbrQ+tjiCSF{s9(q6N0JdR|Ku6?th&X zziMhwp0^Y_EfdPWw*DJFUmvM45NLI)%1gn@PK{^uJflq;zjIhw7jDiEPG|`G=-qa2 z%E!8RQjo&L(hfp+0|~p&M;_OWx7h!4^cbl8yyV)~AnP$gP^m2|s%?bi_`OFHjw34h zV2@2uW=q5yXUz&pH5E$}!R6a>g$F_%QS9Q*NEP%gyf)0v7_ndchiwxsdp9Sm={r^~k6*+Iy*WLUcfMF~WM@j#4@w=Y{~@uDWed)|WzECwA)&+uNDN z5@jBLWFts`fyuU+3-caRpw51u+B~HgBRB5LklNECWM2s;Q`=g8BnFMMXtQ?8jF5+K zL~B^;y4IY&sJsn1Xu#hD$30~weAIes9?JL7A(Uv9cuVTDJ0iGS``1z3QiToNkI#yW z`E?tL?{z=h1iVff@bl)pdD%VZ`?@DRFNUCwpy*YSv5Ua6mnI}v*A5}1%zf`WvU^^u z<_?As{FNIfBjZSIo-OyUFVqFYR|4Cq*S&hM)gUB&fY^VHZL_(fks!i?kMJ}@NQTU@ zzw;~{@-$%Zdm!?=F3dq1xprS_tBe6ZK)5R@$G-q9yY{_xJUnv))R+4U4>Rt8vG75T({$as2sdY&6X@MpH?N`F_AvVXSSy?MjAo?fS|BH^{`QWE$JECeBp3=Q{|Hwvn^ z{#}3Q^GNYeyLVO#9z?BQ4cpWKdx)PY*4{PO1o?izaP4Zw-C1ISV3ve4IG8;CWU#C6 zfuMjrd`Z+Jl8TVSjfYqg=B+UQ3T9#3Qe*Iw2itk5aB9IPfLpcz5E5*~F1H$vZ*0a6 z@4sFCmq!HpGGy7QW9(MfSwZgiYtr-8BVA=zi;ytpv<9m#JD<1VC{y+BE*(0Jd9xGo ziMbo7BcW7tt)GkuJRp0@zc3tS4p$&VwCc=iKenOy)KfM-P=Ug-$7TM+CN@%rHde!` zi`NHD$}aV*>2Kk&%M%qzyCnNJ!-UQFF6%erD(wW4C+V=TBl0v99nnidE}jYh*-E{7 zi2Dj89mmS)Bd-vL``r=Yoj4O|5_d-M&@th;UanuYcvz9w`-VS|yZ=d9{Ob zS*#5C*by@o=O60~d-s3Y|97aFsU^=b?aX>f_Z;)W@|@4Vw8e?_E6N}EZpQUTmK_8R zfHkFEm&{h+%{?iOfA@b^pa0aM`u*{~Bg1Pp-5b%IhpGH$3SEK3g!yL7x~@Yp7lC`u z%|>+IpLO2=YL! zDi14VgXNC{2;BM&`Engiu|Ny3#Dfqref|YViWV~gNnF%j#wa({Edr6p(-kRN2ER|z znpVce<4`t{;i+jQ{e~P%1qBq|7FguqL*RdM4hIJZ_IvUb7`P~@n{^gn8Jmc$Af8Dk z99d0s|DHO9c{b)y+-P3h&WOnIP-IQp*nt4`(6N{w#y-||dCe%!iJmZ-zC*#KkrFGY zb8;`MNo7fkZ=Lz8=9M=$pITzfAgXoPFdC*QF5BFLL}2N&*eHJlFXHdnRB{;iqB^ci z-lgLV<5}cEb`$M=IxE`h$@-6&Ut2>yEUjL8WO_L+B>2Fdc}R$Z`hUf0%WYIMhUqs% zF@7#j;LtEnfhx;bLt~;OQu2d&DCE5Eu#zOqJzu46unCmdc-&`^gZ6(Vi2rM4Z^((_ zEvNnhneB06t5OV|=*V8NUL^C*0QVLhpTV%DQVxqosZ-xJ*m1J-^@0xnXmJn5sM1DW zQGZrjj-&=Mc}}n$%&00Ou?3v?hXrU@m>UW(=5H?);&cf8@J9M*6l*_2rf@j*gtJGc zjd0+j^F5k41+72ZZY{@XwUsF!jF>dp8Ay7Mjg@)V=wd$pfb7OsqsN7p!b1>=q5eQE zvC`m+=uqwsC#K9u$D!3h8pVlGmjETpKTBqk$YwPBo;Tl2s~GD{<|Loueliq|Cmc&% zeUCnuCdx)kv64(TRSk~BG>a3#w_Wkrh1OW9~VPD8oCmYW{|c(B_gAE z=WTDTRl1aHv$#P1AWQ+2><(ab{=W@S4AB<@y|Z+b?G5mD-H)-F-G#)A637xj51-*a zSn;}8F2)ONB0$H5AeQts`xM|3z3XjP|BzRW$kUgk`T30(^BZPva!!_b!vbnh5MGQ{ z8OkYQA5&InI}|C>i7ye>1GtpVhkHL(XnjXXj%SfVI#vIl z0DDn4PG1?}*s|ra;glkws%6vpuq?9A%Hf?tsbhM2E1$E=hfTitORKAFw8MNLCvbv%>%_;Ka4 z6&?|xb%5wiuh+G{>AHuoJd`IAVL30u?(~7p`bRnAXzM(?q9J<~w2ajiZUz*8dzn`{2 zjaL(DBBpqkyk8SKD>3VhsID}0`J2LA(Q|)T;>AWQRQMVFsgQ8J^-C)B`|bj2wmX%` zMWKl1&j9I0X(a?%t`HEtfM!T(A}jGHfULN2gg36h-kMD5qKGU#A~8zfQv!~OL{WKy z?CtMtvvf7K+|nZPg=F!q_$S0bDX)SsZ(b$Uq%@X%JXiV~4J24xsyX7HI920so?9z9 zyb$}vYdQSdpLE2Ud(Q*#5-TijO5Zy2?F3kcVuKnaQNY8#rAtipBx=nWVA(GnFMJ)& z(l~@j5ch5vK;6^fid$J#>HrBv)(a$Q^ex-|i)8XTI#zriCvsLdyMxX%0?@6;kJNWD zKJWbpZ__@XhTK;jcYln#P6)@7>FS%eyw}|Cj}0;`>qeIW9aT?GUXx!tNIo^)9~U;( z@#M{SSbCndce5U|B3K8P&THLYA6GhQOVFzV}12(t1@<>dpZFmDMplV8$d$|96}}$%$|oEOhZt%4BYl8|yrxLJiVB zd0|Rza-*!V&=xorB8+SD>&)+F2;sqw^r($HKUz(g=J55A9zw4j8tWNq{FBCu)Ml1{%1HM~%QCC;%zXY05r9J0itnpPC;SZt0@TOi8l4xbYpS2IXx= zie8w+)MG!zNpuYrSjaM+jpWrtQF=y6-9rCPPSe2RMW&)XJcvtVMZmIB>n{*n;_ z)oZ$vj{~#!0eOusIZ@x`j1W>Iu*LumKfhpm83Y*KN_S=+8*L=K-m({P&=RIeDdGTtELI3$6mY%lW#CA*u}T@yD4s&Y3s~{i{`D($1R_)p8O$nRf5PY+oX8D}D zn*05%82-x-f7J(ZEk!_Vb=PYdcL-&+XIw>)KO($HN+%`Vf&Yv+(iMtR$b%Ak>5<-bYRD5|UOzI^5ZZOP zwOYZ#)+p}5M1-K?Gb6RkijGwp(K}cw-9=4xdMnAzM7uYlEXEH-R)(9)^aqc&_lBq^ z`V=i}d!la?mB8U}d(z5Wd+vClHab}~vp<@x&Su(mitCIPm)p5QqFy20iHTh`o!84< zDyJ+#mTS~}G3bbUAziu4HoIxr<+bfC?{(Q2mjpJ3_tos_FVLq(X$`n+`#}SE-++Lo zJFr5v>i&3i7-pez1nzdrMfS(Jsq^Q{QFCIPdBaFw8nY=^!izk!Qv_X8jl&e@uzB4f z%1@~itnTL^i>K1!tU8GVidF|56_tbNFf;TMZC%|<@nQLlTVHU*ngAr;l}*n(nfABK z_KOg{_uTO-;C6YUp&r{p6m0vNs6!I41OOsE8&Zrh)NK{s(?7Zzxb9^}Hkx<-pX9Pe z6gG5!j)eJ_SES^b>_Ga@3d!sL8dC{ z0s5c@AX0OVevDNZpE{PQS=Eb40#jEOc{2Sx89Es=OEsfRN;4oF9bfh&!XZ&MXNmq# zME@%2Qgpt`@kG~4sdqUN2@<~f52hIE{AW=`jc2h4XcW_u&=2I48#7R3-GV&KC}JYU zMPYp|S%Jr51(`^NnA7+)mzCvMb$N}82;}vl7srBb$@p9nSE)D!FFNWW>hKN;|1U+?~qu`E*;eYTl48>XlIk zc|2VlFCb6JAn<-R$l&p4noop-ExUdmOQN}0HO+2B;(MPl>f`x60JCN{jBjF;gX5eC&&9Tkft^+?ONUWXrF*y#_x2-Ny!%^Niu2O`JmdoQ7DClX3*3`*7uNR znq|j}oL|)BboaclTCq&akINy-{X~T7kz7?J z2mSRB(bkZ_*MMwEWSD~$5goGThimKXZT-yx#ozI3KlE>#{{sANx=*RhP1-jV_6>nS8Hat=#5rHHrecs|hBQ_arbZ|{CoHUU!? zE;@0Yez{*afe9fEByiupX;wL1B+6+(8n2q=N2!wLqN5)i@qM*Yl}K90o7}k_WgdCr z9A4U3XlZ(r@ELorb43yG0L+aa&sXPpUyt)K>unFvK&h-`$q|^bY&dt}e#s}|Bq0*f z4mR#HtXwwu0O+Zz9^OW*E4z_HHkj*(SfP0(0Zur)iW;*zqZ8BG zvc`~Sf-Qlzc4SY0TP4>gLltew!@h^$LCcw?M^R&KGBcj|qa+~(;?0CChdsgPOSV*4 zH*=dtSJhwe7Uja*z`pf0kW5=y&$~fm?oea(tEL(QLm-aBQ7kC>E@ulQYshE-Q*C)| zSczg)`L*3lp|et3S5A*)qUrFCUs`>-Y9my4arxDerg=_KfetwxjECdPdAkyUF}xzK z-)4s=PR0p=Ducz#uao%`Eu+3Ac#CzZ-XksQ`}%Mb9_Kn&3iaHMJv6`C5);7vHOxGM zSZP$ugg%q{HqFnZd4POZ#$Jo`r2obCL(!zrmq_;aZvAgJR&7i%s%mOSG69GoS&X2_ z${wZ(#p(+48YJFKt1F+Mi$&ArwR!5f4}c#-LM_=*-&dw3rNW8yAfZ5`9mNZ*ZBG{{ z%TyCq|7f*HPmRuV$jYfRDS$tv)S!~&q@)NQ?y#4%wN2@Ixa39o*pw|U6jk_Se_OM^ z|B1_%(~N;3Uwp>dD3Tt_+PD8|{~!di_d0?}Yg20>!>I#us>hg+FTWysTZsP#l2 z#O8Udk2_Odo`kWtpfd&FB=keSe*!uPcj*m3?S(2_413ufrII#!!}*);+s_a*tDRkU zt%iayhu=%BN?8x5qi%R?Gr{-g@Mg%dh_C4~XYUfcRlAFT#H54>n5!x)Po7+CMz71? zRWUJ^m=6pGz$tLz>Mo~*>)m6bh^2M6d4jx5L=emnX7S*z^!vV^N18;ChTnz?-x&KE z6QbBO>ZqoZ?RY7tQ%wow(oNv7$Sd105x{N}llL`JWY@EKQp1D~z1m%B`vlDtKs=Sv zAYO^K-Q_PX3xcsaNI8kQS&>IRf``zb6dGmzGWAo)r5Q#f7ge?uAx4FSCZ!BiTBLZM zZPb?|;Hw*VawlmCbXf~t!cT?0h1|L6L|g{X%H&)9ui77w2I2o?F;Fn*a9%sim96Ke z;Fx8cAk#Ei^67jPWqSJ=tp%>h=gxlCh-n;O>y|!gfU*PrbQlbjd5~fREg^?lB5@I( zEE?KJtu1kOlBNoZ5i*EX4uATo&JPi+70B5KbZ%92Yeq{EDydOki0!jfJM23e#h_tf zj+oj&u7BuH3fB?HcofFbZVHMq5z8OPk*9V*nlqw{6*2^LWF@bCth)$2)D~p;J6!~2 zTndR&lK*EJAb4~5Dnj_G8P z#9scehh%ywxvJ~+j~K5coC45+Ef&dTTVv_E=1R~gcKxvF{%}qht&@%@jH0Y-P%4&n z-VLK{D-(&VqN8$+_M{CjNFzdfTPW`EW2@&3de~c~ zUUewG$AHWEu-N61FZ5+eX|8yU5OU>Y?+}x3i*zmi<9x(W}_S;1Ky9Y)61k?j{GbO=u{==RD`VY4`IncpIvRSKK)zT3P&KKQU%i5^*H%F}| zh#Bz)fe1FR)H^HwZZMCFm-3%zWsN{RQc;iH6C|tIZ$>1Od?pw8H_&!?xzUoLt5@f2 zee@h}Vr=^P^pT|B+ed!Zl!%6WS6YgtZ{$JZ+2H-lfiMGrozLeQ8L7Bvk>K;#&tkst zt7TYA!&*0yQZ+-yfvbyLP-q%yBG9l#+H$ILy3#y31&^MCk6ucH%;xk-)3JZxJ1;%r zt67CRBgUUiR_>o8K#zqC3~xzVRn$=Mi~7DWD9dZ@!+r0IPkae7iAYpF$ri8vQ-@ns zu3hBu9xmZx4wta*hS2NJxEjp*Y3i$l&&Ej+owz{bVtxUT6w)>}#c_d*%kvxA%bz$( zsNoNU?7WSNM;t96P8+$rO-&L!nU@3i$q#HY=ix%P*sOH80gDM=5^LgNW zd*iV-8*+JQv`cUF+9#gzKyd;`2;@-(p0Tc?H(Pvtc5FC5p|KghN&>s*cyGm}R=pgL zZ}OPnAq1IwyT)!k*9_hSoOd|+>UO-^W`()736rM1Qq5+{0-POr7ME8smU;BQT#xB8 z>h%j3S?#5tqT0V&L<<{f>Tu^)f4ltxuUqP5vVJ?S&HVUe57Cf=`J|OSEtJ3qPH^gA z5%9YG?~4^PA5>(Cq8#uLJp0i3U*Uc}##H(zP;Vzs&P@?MUrID(W;H`xabY9_M)VUF zarU4Z!xmFJ$QKw2MXY8Bc*J<5R-!15GBVOl+|qgZpsmFn%6svrs8#dpZ5Be?$xqdf zkQXJog&;I-{gcnbaSrF=*OxJD8H}dAAknc9d{m<(qCPN^wld1; zVZF2#AX>+fBT^TrZdBzMahd)s0^Ow&9BUu)dgN#iYB;fT-tgiQ2CPi2b(S^cs~~D6 zdQ7(V`qk1knH`SOhTtCD*hC>YJZcsF@32)#h|GU&9{8O%oYdAFrg<_o>ZZ!8j70`@ z*EpAIub)|$wf9EE(hzBW*NMv%UNo&u0ddQ1&$&(8egyjCv2+MJu=8r4k8`lKx`+XVAwtpQ9=aOEHQeAW%Wq zF4FW5D7hdO7iX0;jc+5>TWugDToP|o;``G;54}{olhw&vya#U;d>x9B}Q?*kbNWJJL^9~8ORzEl3ji_UY^ z)%77)9^(~KVIHBP#5VFO@I4_tFj8|k=ksoZ&O@zFEBVtMunhtmT!=Y#6xpCHW<2UU zupJ_TmMnS9qwqh-f{&BMF$uXUGG;E_?^lt|^CD~-gUsAC@|fkz31Z{rI@h<6NjhI2 zNHmw_P4scs`;A{ajGag9QUKgGGNQ|Ek(!|T8Veh6XDwkTem${Vea|Fr$OXtG*bN<+ z`DxErl)O!~avwvN?`NgX1K#<^xH)0##4oAA6QGK{xFYA5VtTa+a-EPDoYZuMT@b=> znm%?SD2Yf!FbgouyW{h2kJ~Fq=cT5f)AXJ9EEYY=!`C141$!FGU9*ywMzka{bO?T7 z@O5B+NHzeN8SZjl8Y6ko2@OAbdsG7`^x*yJqnxw)Bkf7D4nZ}s>T6@Vt%~(*BPKJ1 z+C@eReea5}Z!96*I8!e5`jT^5-KYC)0NvT{gH@g9EZp{ARwuy|_6r1n%6l3(h2;fx zTwjrQ2v$GddZvJ4J||T(EN$kcs+L3g2u!EpIZcL1GAAN5Uza8*r>EKc3gj%#eohDP z;O{<6X^jy!UNf>^^Bca>M#{>4ZbAS%7)yY&ev0b8*pG~$XG32a9K%NdwA4l8-skV- z^Jkm(*FH4MyQsHTZ`flfqD~Fb_e0-=lRn^#zYUS)ReW}yVceqiide(H?J!39q{g5# zD1fC@GSX;3M;nF5_GsASHk#>L;nCNMx7#|wc}T~io!F*?=qX`3Vw`9DQC!MJpq{o^ zfz*@;=W_PQxhwYP(J19iv@jTg*c9&aeY+CwdCOP(l6A|AdHY`Q{ETo=WN?Snh_+^W z=(?d}xCPUn`Wa20oy4>Av?E@@#g596k~541ab#&gh^3K|UN~-*#z$T9etFe>UCB&N%1bIZr+qelrrS zx*l=DlL-1fb=Htxod}b}m`%Un!BvR4YTXemzUio^J+*I^C!(ED^f7^|N;B;+-0?0l zFew`+iCJ;p#ywS^F2Coqz%3HeG1;i{gawKZhwK-5-_ns){Z*=ia}rt@!r$L8&~|fu85^ImnD7wGd>< zAh3r&(&Ny>j#x5o8OLd_q(4`Q!VhBQo(JQG(gVm4llMmyt@w=?=QY*9Vfw10N22(Z zzFiMAnE*k&O$1-WxSt#)Q+WbVVJH~A(6C8Xn)<_d-aqIe%PXn)e#4bBHy!mBubI}* z$d<>BaU3#EXhy(H{GevXaZevh&gOBV(&|aa)*FrpH41nd7hHgESAQ|QF1Soh~Y>MV&+5GvBlH z+uLM!txhwZ3FAI>r3C0b3r@L{85e=eEym+6jS?~2Nq1YhLzTC_KOxAnH{yYME zyn5Hwx+7*NbD0s#4v0mI*~?-)&6D5h)cZpdjE zbBPs{NXw|j%n_W<#DE;ggLS17vcvaA+a`%b0b(jv7M+xrq^7@O{lsFr`bg`}$rttG zCJWU^Ae8*eRa_VUbJfJpoxs1<<)uS5@Ab5?yiZEo_r^2E{hWC-f8Il=XVk3gkdAPS zh-hyeta{Z!`iaN*y(1-PHV`%t_aPUs027Uh7!+DgYAb^Zhh)$QQXS^I?;=jEvhlC=n58lnqcDFk2)iQRw{*;($nK zY)(qIF3M{FV;3MRg>p~D{!@V>*l>zHzlP$<$H1P6D^D>ejcze6Z(1fYAEhEyGGCHE z!+=mEZ|K+oVxB-|3hK%SC3d0ICpy)LeLv5r7=)!SrHnfc3!;e1w?>6WLVVj1d~YDW zAXq{*q;upXA%))~(N{Xgru85>xhf3i{Vw~LOP>RR+*UT7LH?K$N0MYlseP{xT2}i6 zaCe?@Y<(Tx7vwcnWIbywUPZM0IlPNzK3(T19)|DQFpwsKCx3*!)%L}Zl?>OfRxi1& zO@yEy8g@x0O3qYQp5-tNqJOO>D+|4g@4@!;;8mDK9r^{IZ5Q*)QD_ZIGdZ_m^T><* zhE0Sixu$^{@xzz^i@(idT`Kp0{3LkWV=yS3Ol=)`MYuFy+l8*Hb>^&>N^)MxzU+;& z!S}>Tx1dtKFw;@5b`V*A+;FqNjc&EpsO1MH%y5&NZa!U|KQ9gW^%+y)D`i;#5Pdj1 z`vmUKA}}L_+_9wB`CWf7A8(Gfn&22(Vf`!P-$BUnk+H|xKpYM?n(@uFqAnx8_#38( zO!+cYOc^@aMk%DTgTM@2EQH5rZgB&k{mltQ5o<*TXQ(#uBjhihA z*?t)OMl=Arp}kh)6A2zQ?^tQYRX6dt+0^Vb+`u!*%IfiG@3GT3`uJJEKTjgKfju?) zKIr6pip{>d;=xeUl|$+i3=17+msWx$(caY*JXdD z8oM`Ti~Y>+5}|U(+xx=DYSYbT7d~AO>`5u*WznLg7rM^-F%PTaN@yTAjwU?~IpJp{ z3NHtJ=R0u*w?pYpNxV*!c6QvskMlP1Aj@JP1w&(iSGe-s| z(rQh1H4MPlF=U13t)ty?;ls;{w5lCu8nOB#6b48){}+SLECm%gSqWl!S=VFI`(^wq zBy7*=9?kNb#^X@?{JAgbbUiLTC#)LNhH(sdU=MwOVVFAaci%9b8r%jg<{K;^%71-Y z`z-E1yZ0OnkoYEdmHDlNwDERf@T5tZ-%> zJyI8T3L7=K{=;wmrxKM3i!yseGA;%=gyiO)04pAys)XtGqGV4YdK9bh6_7V6E&@30 zE?0U6{}aFE7O5vQ17{mJM2OVLS|}h%pJq6`+o$Rey>Kxk)Q+4Fnv2ttF^g9?vLvK1lF9(D5oE9PcA0i-&lapo?5m^!uc~Z z`tGV4F=aRc0S+QR+D5ANt>_jBjy)?G;YH zT(r8E6NQt~hRzAsZmF6Vd1lL=i#n;9vQysIms@+sr5PU-9Wl{~ zQbd^*XSuv=U4(JVhAcpW2+DG0^MMHY*=H8RKftg^icWQWXR7vzQGDAN4N;GoLSBju zuT`ha2;%gyqqfd0WG%BMeGB<~2nP;7v%u^n49n9ny{Y`6RA8wTbOT};-X9|t9Fp)N5C&uZ}$GIlp3Y!&P7r96I=uD{{LtJSmd`5h(u8H zD?o9szdzNoeFkuvF=3MWm=l1Up16R?tSZH9K@!IFuj&PCkrj;iO%!cdb@PY;c~q_= zLo&Xx_(=z%NXj@O;!H%r|Bv!nWh@>E;zReZI;BljZsYL5H!ql)Ktf;%}{XvR)x05yp1rqkT{WAdv>YWkUX zpJ^Gc&c=V=>v8ev1o|T+Hu2XS#30qcU+=9>_WD_H;>7yj|yi$;vt~u)Q-%X>T z0q1gR>qxMz3$Kr~6x;G@xXOc_ZT%DwasKNAi8@c3$uZf3i!`v0EGV0aSd=&!c*1p2 z>h6>mp;tDh8{xCgfq2ovt+6OVWUZ+24H;I9@5tOQf4kS_g5A$ll1x=LsIB&U1e(SX zGumT<(QhMjymDhOH23!3{zD@Ehwe&-jOxjx*Yyanu-qSsx=`zW#UPx&z4&Vk=8${g zwsLim?hsSkkGMu~mWdO|1hWo}84Ww^$BIWCpgx`e%Q%q562&huB_ojz%Y_mSyBPv| z+XCxiE&ztH(3Bk6@1jo)(+(zM@`o^X93>PLt9mB2;ahL4eZ-3JhXRVzHhZVeL-gW6 zYmHrC8=l?Kb%Jfib<~LXE1;u=T7+dTdW63+sSoM*M>13)^AV=P$*W8@%T0K}_P+mYeukqL#SMrvbM+)?9w7psce^7~Ap7vm zczpD!z*A8YPK9hw$7N&D1pV?S(^L9HCZ$aJe%p*HGQrDOqMRJL2u}*%fH0pjy`u|y8o_WS z_`#fP6_0p-Fz0DI5%1ceq$|a8GJ;~UP*}idD!}j9t;;#r@#%j4*oTSqE)cMVz6ME~ zRYe6K?b}+6p9siDCK7?Tf4&jOSWT6A>rn$0zs&%#S2$a2p9r@lQ&)&Jg=Cr*^}C6O zix#!8>Y~%FnZVR1X@?-GL%x_mA?4Db+Lu)@NXw9!5-cm2DMJt8_%kna9%f1*7%eUo z;TY=(oRielw&#}&j+E8Pp^Oa)jj)478`-_F9& zHGqMn8m-QR#*DW?aqpCT%usvu3@PwR@yW9o!J0(qBrMz;C-DD@8x+b*j=7@1>pkM!5E^B$AsHkZRyRPhZY^4d%C9dCI!SsbPgO{bL^ z686RvWVcA!xc=@Gb}X3eJC;aFs0JVaiv3aXtxih9&L~PJ*1SV_C-CP`NuQj}lB{^& z3FcY(Y)!r1c{K@wsu$4F{6@A~7&Md6^*BRwz6cuT0Mpp^=$*rOT$#W6JrodZh8M52 zjj@%Z+MT#MN;h-47Kjwokc9r|>o81)+tdkqSIiYUV;H@%QKaL_@DaT#y5XTgII@_f z!ehA*N-gzUG7C(6oaJ;Ci?Zq}F0)rStP~_#$URbd7#3rm5GfyaE+r9bVY>B3x6esRi%}1FJWE1?C&|mpCOE zU7h?PSzt!0pF`-2Swg3p)olFq{nT@WOmEGt$xu)u{CjH+qP{djcwbu+Nf!)#^%J0-PleV>zU6v=l(wTKd^t8 z_w2P7Ue~oczp{i)KK>J>S0vp5^e-8|?Qr>BY$~4@vnMr5@LGZPr_4h+NBG$X_bZzT zC7a8#_fY~QV}miZ+}7eu3X;X$;M;QC-F1|%C3uu{;ypzEkYjSzV!xIE$@&p1#RK!^ zi6&Hjsu@uJc!2s0cPm@P8>I0AU{P17Q?K8ySIDeSyAy7Zw)_f=wLlh56cuv`# zHl;611m?e(5j3U2rA_*Wfx?M3PR85%J--X5{!%7vfiCTS0#m4eQOsU1TD?MS{_TOe z)7Jlh=XMY8r=6$*Eem}LlsX98ihp=U+X;uz&`Dal@fMIY)uaC(2{AW4bwjYSC-c>Kd5$P!OW_%me$w2m#Ch4W zwhE@RF3R&9L%G4T@SwK_6jGtCGG1GTuN|#(U@oso?>XrG%$Tu<1WoXtO4@_D{=NK} z#;y0~`=cV*0VL>YF!Sa2&5F7IXX?x2)m5|VdgY+ybx;@dQUmmm(eJ9#IOAaPKx-p^ z2Sl4MkdjV;FzeC9ywRT>1ugjBpt!#_B2Kc$$xp=0g)e3F!8c|8erl_bLbAv8f7_h5 zqj+_v*3dNiLbAl8@<(02Zi4|N8)DO8I?y?RDn46E-!kyV6rNhy)P+nC4N!7vX1}|c z#SIgPH>=hElU>gQW0|?dhzLPZlz~t+N#8sT2)t2(ktn2IK`NbMgIrU1vMKDo-iUfQ zcB^Ai$SImbYGpABHiVMU#&D%lhbEUNO$%;L63VrVyZM=2_BYxeI+j-Ku7-xdveSWk ztpi88=DQm%{a2<&p6{|>zK%`U!1R#HUFUfB36dr(vb0;fK>8Mv1t$ge2VaNyr#l82HdMJhvv$$ zV4r208X+rUIa->ag*v%EM{-)X8btfzP)Wssh%c^xq?iI~m7;gv+rgHgWgbAW!HpBg z7-c;nk3|@=CJ3#=0x~$xblnyzzBvoUQ=!{lGk@LHo;x;BwGdvhBRpID^=G_oIySa# znkPv_^@|h6-3~#OZo?lrZo1~Hi>8{*k0e|yGvu5(UYTBoi!R>4j;VaknU{YTVVOp0 ziaA`%LItotE~A}Ob}bH+kzLO_I~^i_dHu@B%n&EZf_%8+jl`Ew|GiipE=HVh?Pd5% zc#8d06Nx+}vMrk!K-NaC$XYWlvLyH{uojcuz(1uGV{{Y}l;^my1zrx?#564E0-J%!_e9v#@%?)if>yoCfrt;=V7@kvg3%gK}$j} z@*(-JB;QkxA%YoH?VnM6kqd{;>o3Ec$KnF3mptdX@E%9U`}hQxcIuPDR+Z;7`E}NQ z(_M#j-Lq5CVPQnDx>7mfo_?oLyo_8-q!RC)nV}SAE#;)GIF$XXY(WIy|DKYLV*Gj4 z|85P2DLn$oAJ?6PaWw|et&)8oKVCgJfVeAD+J#_mdvgQ`RKN}n6dX^J*^bWN`GKW5 z-}H7DdDpZy-xxQ8E6MS8hucVkWJkClqQAhZrK-@n=nW*-3dWSAO2bYf+flw4V=2W# z`FXa)xV&T$4Z6iL*;}mALU_=1Yoe`xr8=DrKbiR8mgCzg%_dIB>O%M{-svCIlxU!! zWMu~*r^JrTEnI*!HA@!VnwE+51=?#F*KfuqS2`{p$kYJTC^pqfH*z~1-F2J)w3Qc% zkhjY`0Wa=e0g)1=FBN1gw+PSuaHK0mAOC2qYw7P!IjJPoNrVHt1aCnUi9>IfUcKw7 znwW&l-TzYWFE`gqJ=)5f@0axXr})tAfg;!`e9H{pU`lN|Xa{`EhFZjALWYD$><}g$ zjhd!jjzgJBm~I*a7y)SsIO5-OSuGWO`VZ`_0Xkf&lO_p&cysHzz27glLJ!Y2-GLck zXM)WCz>$mJ%SH~F%SvMhE9OZa;T0D2cgHLMCH)AjXzAJVGFCdq>Hqk3IvbGj(N*9h z|IttFl=?x|U#Kv@(Nn4e>2z}5glaEz-NE28A0(JrF5*C+`BA+ErkQcJ3TqIoasus& zMoL(biFoR3E?)zTAdU4PFH(cC$YuwvM!F(a%3~!kMd91}?SYY2^TCyuTC>0A#`!!# zszXfF{$PPxkcF@$zYUW!?82y?p{?GZG>>g$LmKmbKZ}cvW77>*+!7M>0X;M-0VE_P z1@Pix{>8y&gOH<=Hj3i0%VNn@$@t0Kz9KwfB;cBtcQ5??@QzF%9X&@2{Ir@j`X-;b zwCdVScy^--pK2N}qM#rLMM=YMl!G@Bm0;y<*+HKSn>=`R;O`F^3+*~?y02ckj~uRl zRk&GWJ;P)ZE?EtaA&>SAu9!A2>Yn?k!+5 zI;;TjOfH8j$xUGsm`(KEK-|gJ>-bMXwcSrO_|?Kp8k$~rGUF!#?~T$b5~5#xBS9<) zFE)9kOn>6Ss;%Dryjpjld`;F2zF{92&KfX!5=4gP<=CTt5RkXBDC+4pK|G2hBKk zg?EUHU>LyoNRT&|aq5Z`-H{*NVtQ!l8C*c#TA*Ca;+20s+ic?;VfsscA+Wx=$A43s zc4k5r1AdHiRC1HCZa=5H2!AA`f7M_I4L zyA(|r=2@X`zqL#AmsK=067zSs``-$Jsx6X#s|2VuP@ZlTb|^pFC>|QKw!Bvl8FxwO zRGjgf!+cOB_M5QO?aM4T;F-JG2f-Fj1VokuHKWk10f-KNf~Q+v3-i{{U$1Pt{WP}S zgQzG=hfsG;0Pg|)q^W9O)^Iy2{4x8FyxPkHM{(4JRDt|yN7r-j zptnB2c~z~uF>_gHJA^VJD4>Ebo`z9E2E-CVw1VtRs_Xp;XGs(WN(p|m5Qe)aKfMlR zp_eWd%_-{%_J;o5X#A{^JqSgVq%0X7nyj(F`m^kK9M(f+gLt_$ z7-zAnl(izi-XXgb0)MG&BqE1ycXHq$N^i9Epu!0nW*}}<5{Qxfv)vdd{Hv`Uej0iYrKOZ;bfg7v)%1zZBg6!B9dW>C&jD%NaJwjN8ONJ zZF{+798V60cw^?aLq!X&4e5=kjdqfz!;TWm*f^e~v=v*nVzQ{K;l=gn}UKWVRDckEnU zX)sq5LdOo5$_+x?F5??Wr;pkQ*a=L@n#0nVdkBVr+Gtq|1S{J%9u|J7Yp4BO&$&AS zM>w}0zu)p9z7o4F84?7iZ_xr7{#fn41K|it^M>J<)w)gjPEy3$Mq{k!N1ED(2Zf`R zk6WJ~UU4|)j{Lw#ai16&|LcCZg2=LH`9&Hv^^{S~pEA4ViM-`yfs2^ms=w(E+0!Du zKa9zn7|ML#L{El9()(t2R-Jp?GF^@BE4B^66_=M0JP45YvB^8YE>?wa$8gj0jD|`k z>y3)AS&_~AR&x22EWRg~o0j4(QvJp(mgboSUtF8<3dADl_ARM|kedL^=o}sCq&y@2)Xh6)S}L(k*J3ZxRz+WOgVPig zZ*Nq89j`?^jr?V zEMP|bNvj)eb0d=*vgJ6(`k|{zXbtWS;<>6pTVr8DxGikc1D>l>1NS z?{gY?-EjG)LTQ&PK_7Diu>J`orntth@!g3fPvmghy}N6u-4w!wud4B6!YP&a7B8 z^Dj7gB`#<+6)C4&-L9r5xFRQv!>;A17c{Oq&HTnS&b1Bd_-D$0@&t9!O7q#*A?8R= zkbYKDi0fMj=9~UU#9R*{D^fl-cZx6IU0>ij{>x^XVb24nA)<|s_jpBkwY~SLr@;H) zbk|`&0|Ua}e%AV?Hy-OgYG0=o%KC8lPO^rnS0V4HCTYy<+_$4m67oNBKz$@?=wzl9 z=4$fz9PG=TBLCnsOD2vGqY}Tzqa80*Au{arksO5z<~bqzC2uSQR%KD*WTu55Zd3Q6yTi{N=z|Z(nF6kr^VjNpH#snordx7_V^Gbv2ITG1& zP#O~7F5BFzYi>?+DqT+SzhAH{E?jqSW5PahQw*x9FIryvLplNIvNr z5giqv0jl%_D9SvGX{PTqkepu`C&`NR%qBAQt%Ed(Lot3aJn6uPV26cIK|UG$ljNgq zq$i*|%wPOMfWWj{95VAGUxo){aZ;1Q46BM~a}Fcu(3FI%)z=)q3e3@^Q6*=H?9yDg zf)CdrXk=F^WQhJ9Nyah^h>Dz{v|YxR$eheZ=}j9--;W>@&K*YWlXqj&=DIb<8cydI zhB=An4Mc3z5E4JQ6^MurV}&^q>xmR;xg;7Fri8NCAxc(W)}{cr#t^=K${?y>SsEux zKSK1xlg(h*ELxGZ5<8by@zt^Y@Z9HKYonVS$YZ!cX@!-=f^e;#I(8~0*$)c^^DNm6 zbC2+0X|6E&4HlQ1tuYi7Iy|=>f_HVtaHR#~k1nSn-q@j{YKjsPMux#9$>}!3DvD-8 z@*I)zyI%a6w>Ai|5%SX(XLPfr@Un-kf9o9Iq6iY4e!pl5} zZ@uW%cm5N8Hr7{Ge)}Ex+fkY_&!2AGskj*qTZO7xzXuyCPUO+uMRJ{>4qo2Y^XtJk zqDa;9G8kI6dJkj6kV9dh+)w4A!cMz{_4a#^f?nKo+=zh9AF^dQ?CGhWTVP>%r&dv( z>%>WyoX{Fgs`^ona*+_D$Nu4>63mq98hE^F2z|9Qx+(fOD!)xH6I}QFkl~(Uhu%N` zt9s!uS_8s9n$k27qnOH^zKW1&7B3kd2<#&l(Ei7d=qx97mXFlc&bE^%!uNgkurKb< z%x7vkv5MLdluoV|qzbA;13%Dg0bLe2W`lnL=FjcU{e<6|0{+QD3B(s8L;YiuFtN(~ zO(^0#sYPMGl3cq~=hWcQKWc&=ZVGWPbc=|#cfKC4FQW7h9)$u50Lb$-X@q|gRmdpL zp;1>0q2wEMyuJ3D&X)u_+>eGXie};^E z6yrNeDrQOFSuV;}jTTv(Hu-dPjtt1&w1+vv&bev?B#JuX{9ufx z&HXZ*ZGl_-PB(fk`&(Q%c!g+kg^dGGYk{hU)aoe~?-G`#{lquSA`QAJc^JhOUQlM- z%%2c8$GztI2brLPj5Ke!wo2x+{Fl$>w1Yv>HB^Mt4a=;4E;E)MD)kMt=Bf$p+bkO_ z6vMb;3Al1K195*!nKL%Dro#juy5(}*J$cN}oF`QVQOx;v$>;@)Y&xs;oh-M%jj(xa zZYcq`s{*g?FBo3T4Ej0J0IFzZAzvcQRez@al3Bw+KxNv`$(D)QAW&`Rlf|i$O975< zWd%BwIfu|*K{cVpz0tb8eP=w09#SeS(OXSS;{9));U0v&Y8`#d*u%0sV zHjhYb4+Ha=;((haKd`5RUttS-OmyK)_GT24+W*!-il+xVyUr8}Dh75b3EUj{v-~}Y zgs5)%Y5dZM%6o~}`BA**P&LJ;OL3_f-ifj3Qbh&Q-$qhp4odO;N?qL#tPyH=BHuR9 zkZd-vc4ew#2!L*Rh_Lr zSVwmr?JVLW<0$*Htx&%x8zsm2rP>7abIkNUZ8JX2$nML(F{&}~J@jd7do@9pdMQeT zCCp%GVOR)?u=9^PFb0+!d^zvhUZ5vG*Zr3-Nuls}HRJv9>|nEh2BjG@_n+~#Q#GTM z&`WZEAqT363y@>R1VX6tV=%D~l7q0F!-4 zl?#Uz94BLQrz9m*c;^w(`M;or;pg%Pl?CubG$zw34a&=iNi2Ql9>d*zGyXkc zTWwSVbxp3eLbj zhS{e{1zQl4Ih|^Dej^S>I(d4MuOl~`{sDC^Q{Z20?B}$AfbAtC{K$U@6!PjH^1oCY zi#+_&a%#5ONbtHn55wh~)&u&UmnT< zmm44k-Y_eZbQ8wdOFRe*>-}X`=FkTxUJD;D_-?U@D5Cfj-q=?tTc{)KQI+Ei(n;zG zW?4OMnfsb3Z9U8ju4tB;7!ie~RT}l9b-$;I7n@tiD*3EgW<$*6(z#TLv&Uy`>h-Q+ zkELGv*Qczgc7K}5L-`5%8q8%|k9k*pBW)+2GTpNf+lPmemme{Jy&l=s@s4kh2OQuN ztycI+m70=%GM5>xIa@1iAt0l=J!WlX+r$NFIBZVHJ;Bd;?EL?+(Y{E!kS|fCHz$S) z$-%vMs=|{wgt5+;wNK9DMCdBJn;DI~POH)5a7`I?Q{ma|%v9>7z_x9< z(NfPzhnq3?QPs#CXiT?ku&^;I(>b~njoI}G-ei5c1MEQJel&(!roUIY{>p4FrwaA9 z+=&ONdBIxiwNqanVWCT#N&2bVYS9sN`y}j0p5$ODU9%`^hR7Nit7u_QUTO*k-u=;R z#I)Cy_Auku)N-KZ9++y4;)O?)p>iCri$NkF8QO(N2zTcw3j?R@?QP%@JZ8BvgVv{+wp&M!^b}$GO0JmVJAm;+pwGP0uE^B?q_AvoU!OT%JC;lp+bKpp6Z)f`3$grZ}681}lzR?b@U z^2CF8DK+^D#NucgcR@GyDf7H5KwH~@$re5Ou>{;+Q%n0$j7;e6uF+wmrM#3YRS7mums}{&PYvM#0ziOh)2HnOQD>LaR#%T zs%fHs(H7`k_;8&Pf4E-pVpI!_?Y8pJT*~2>4?N?85aX1P;h08TXZ5?ePr4|(VL$IP zE~cPM&?TyT$%)4@o#yYiV%9rRDVi+*6(Y2|hmp26OYzFKo@h+&@64BGt9^R+ zQj_bJx(1mtz9DV#FcRjwHX`n~DxG#+624Sgi;W&eUrBh;m`Boh!6m%qi(}eCpU`n= z*Ea=n18?-E^4v0aT76IIu}={z_MKPG@ka6=ot4{gbSK5#REUKPZSC&RT>CCW#pQLw zrc@#0k&+Ffshg|qJV597-XdnnDGr*$lgLX+?C>lJ-pm?NrY5*Ymf@CpmX&uH7;QQa zkv3`(13kQczVH(^ov~zjMKQvym@Drx;Hx_sk|ItQ-(62X>3aVA;ivm(_Jw=7i~~k8 zjhf7JHgDKNWR9ulMQM!+UZw7`%e_O){h@(8Adc+)_Qr+I0fd+G%X;1JD!|GOX9>f^ zx=^vG0nnSqsWo1@gB`@TDrY8tEx9UFPb9NmY`GNog}>xQdkw-|3QTSuu3NSWS^k!A z$O;d&qX;dxg`zyfkk@o?Du1K)^BPd_gR2=HMq*ve?(VbN33CF>{{@lGy%#9 z9`!?h;Qua1Oc1JlQwn?zbC}dx-U_BDY=UL@Y!OJjPBkA6&oD3ksiOt|q4;hXm>8MV zr_G*-2nmbmg|k|kv*@{^{AqIogwdyzM*Vzx`ZS^uHHBt0=&^_>Bf zunFW3d;7MwGo&eO82HT<`s8cqtY+@rXaF{J?=QA$=0|bf>wCQBvX_B<=X`q1OS=)% z+RyP{@2EMP=0f*5hTFEd6)Kt7+Y+|X({Lrwu_(D_V8KV9{Pz-Blm9$lCYXCSTq%OR znps;&l13_Jw(Q~_Hap@!FQ~42<-QwYBu_6uA+z{u7!wM$)y;p4^ zayeR~Xw3(kO0ksUAKDyC@I-2KJWtb{m#-JX;L^gQtn}MLAc}_5dGT+wek1Nfdq)kH z-tJYA(8~^{oowMV=3O8jZZ*f48-9KX;~7XZ{9-I|-9P9raKi2{6u8`hLG<%`H0@@% z`SfAgECzjj6luU_p|2^Cf7+Yl9}+Uf_l&d)EC_9mbp~2W^<8Lq#}bl*mb-^MO!OB^ zRm-=qe~nMZ&_ks zW^>0y*~?bJ9(&dp$}yIG*onVe0vM{v$s~_|)yZdBUZiimO?4P}IdX}QB zgYMbwoBnRlP%xw!h;HYkU$FRQqY(1^p;j!4kfN}lZH%q|u-R4X{22Lp!HoM38gECP zXK{A<7H^)bDg7mHl*AiUNX)%uTejAQ57-tU_(o7&Z_(cUxMrAb9Cx0$x}Vc@F_bpL zP5=A}wxI}CJRls|%He(k{MQr&q)`aM=Jhe;&cbVh&}V!Jd z{qrX1+o2XKQ^A@Z92xULX{H^+cPc{h=WADITBXzrQL)FS*+S*4Qx)m zMGt6|&|6)rWwd{Q6W}j3B+q8NYJuE*UYGt7HOmZILFxP?fGjIg zs~_Sy2%6!5R`vF)=+y5~2~rGwGBF{9c2ZKc=b>kcT!(l>de~a7d1O7?5b5($&aPH~ za%QG1i8Ds9k-F{;LHjw-^xKm;*wWo7jep?+c(-7g%>w34G^8sm!;6?0@F3pv z{$P1}%3`iMXvZ`D6@~gOiW-lVC`h+QQm^1XnWIu$G0{N>N^kVbwjcX?osBEX>{WJxfj$-x&-uB!#Hfj zy-F)^PD;wM?Y&IRG<1@l96nWR^~Bx)v@L~A?Fwtjo(f%ueaVJvXGbEX4JB7#hdsCm z>oh}d+predKvm3o+GoLE`Goe_eZEhXYW-GSlv5v;O!Yp0(hDN`x7h1Ncmf&1N8~6y z@uACn706{6XxNBuVC#V(N~jPYW1^EQ@Hiys>h3{#w<n+CwIeT$_jb!0Le0b>*K?8T+tN;pt>Ez(e+O3+agh-)Lu^NCH>k9 z6!k#<%Xn1i6DuLwJR>pk(zW1>FHq5`kb4vM_VVi4^|;rEm$QW)_Z9AHUH|e^qbH|b zjj3lF%hunX$e=^aBp}|SI+RSnCDZ?L4mHnw{P}}tT*#_kDHvAMbD6hP2WC+{KUq#vWb;5 ze$H){_bDIw9Q8Pf3m={5-zw)M6j{9<4d?s_(I(t7e{6G1ndg#dBNpo0J_t;8X_b{9 zbmMv-{!I%(^&R^E1T#sD3TH@4>j}7D&N^a}k;5`cwThO{r;E2YN1rm8^f+s31ki*M zV-pBb_31D>`=q*0XKI!BZGZt;WRlEeSzW+WhgOXZ<&#Vp{BEE>e8e#R1x`($l>|?; z!DO7gEga1?3*-dDIon^#0`6x8%y>Lsrjf;vmHuk)H=*>4=b8%M!#iT%%e7k84HxT) zaZW$7e3ks2*70NL)ok3i2GI_*wu!b=f~uZPI%ieMIdu4RrfB-+L-Bw73}MTqc&s*X z3mYbaTELp6gN6rsCRupz(Q%(y4S9}6iSg}6w>s5dfpj2QdlU!#qZk)tka{N@`i zy!bZlZX9Zm3;?tO0^V8q3q2uk59_G1W8Y&Vve3DoIS%TaZ{gIviH(le6*EE^t1rml z#cc-#<5MKTLOMzLo)K1Bc6P2y2NpBDL)b7Roi;MPLz9oiv=WP<-`4Uqr=}q21mB@f zXq|s~2rlSZbFl#NgWTWF?*Q^C!GUfzR!X1T$9%LS_X3wIxEzHORSe>Su$B1N{akuK zP;J1k+xf03=bD)CMKUv1AeR-(VFOz62I&NMpPUQ(VVq+y2QAhWg3jtJrx1NOYZ?o) zg>{`KrvypIp1-Z<#w-Rb1P|gP57uM$t`W3ZFm>e5@$SKwvC9C`u{Y!8Y#w=k(pexU zEv5X!IZ_%g5|^0FR&+=oQf4D^>7^N&_g{K{4v}w8WGmFINyoMub4`s8vd|l+hS5$~ z320c>?lz&>(Rl}9%t65brB>HBq3r+&Ouf|(homl+7k;0e)w=7$kuVMkF!);pu`WH$tBhAd#diK-rMBqgU=M;<(pYu`XmyYNdp!d-^^dBKOJDFByOl`x^{A+?Wx$;9?|u#Fq`Xm7b7UzmZ;RO zVKtq##1RI1|xvp+Q}OaI^X{E85QNF#Df zdIO+rGl_j#IhJYD8v$`bDQ89AS5COq`6HR4s3(RF(oZ3!;0;=|OQ~U2ut|OILx7L$ z+%8{LO0+XlCh>V7j#ipngNaf{)COd@g7;lUv)-E6;vs8NMXhGu;8|6d1Gs78%&>>( zDbz$(#{0NIyv@bp%x{s|G@-N|*#z*B^_3+N#ut@4u3HyJ6NX7$ba_i=`Lwa*ba+Ua zaSFTWTG;JM$zz0Qp*}J7V&Q(3^pxt627fgJjsLYyzPNBM;UxL=ts$Xt`X%o?{w(4i zb5SG^%@5s%C1=Hm5n(ecDf2ue@iCJKdN!GJy6wkBGTni{K{ZnYVET!Sb2tLMlf$); za1RUAs;uIXd#%23G;-t!JAM6%pP#1{l8t2awv=~Hx2Q&1Ozn9cVMfZ|ANOuTGP&Td zREHW(*anLr`VqmSx!A@F7ct9*jrKd#K91q7rEu4L%~3~4irjJbd9GYkQO7+}yf4gy zvii>Ztcf*wqIrT+`k{;%XA1goboOb~Xe|E1#Kr%a_Ceq}#;FcO8`rRzV_Row=&2%nKbsQ8VC^0Oju3l0a2R*d|}{wNIDZ(R3ogrsn@U1NCIEYCfOl30qt;pIN@6w)Fx_*oGNT<@=r6l_Vn9wWjRkifR+eWcO@z zd$=T1$@MJv`=+oVB>**)ro`B|vQauj<_sgCiAYOwm_}%wWhx2^S3u)2zA0+4G2oO! zY;(!lr~cbMXLChKsU$h_ElMCXd8A={xOAypp5D#v;k)+4YuZsxIDMX1_+S7hX3ZRB z!T`0AcV=3yCNzRlu1xE^o=n2N_b+Tr@*t)cG_;W9KQ@b!cB0XAU937gvu0? zR7TSjQH%nlWka2Q7)z%V`j^&}2M0Ux1%0}SkH5h6mciY5Jc!G*<7@+7*gM~)iuROFer550VnK#1$vAp5J zo%MgW&xe?CBu-4hnS#SByu+47pPCQ%BQQ$k6yT5B7z4e3@}v|3`jn1@Me^Z^Slyo@p9C4Z3u8@dH*u~Q{aYk+p+<<$0Ej(K;{=aFZ-1kQGzFxP( zt-l7mU~a|oa-*F(?yOWc?RqlyY4@r4<(>Hm6ja4MHj!kMV14#2H6&TspGga;ZT!KA zcGdUaM^=1Ri`M_Sn<1%~70LfyOM01@@MzcusmgF!?_-?3OFhic_3u42}|VwB360VO1L zXkkZXxT?1scLoSZTJ#J3uGLmU+jw;S)OJo0swClMWL2eQIpd3Rdc?)d?Fg#4h1OI< zOVcG?;&P?%HWbbGQYkTabuczM;EWf^=u_?~N?j7*SF<*;WUXnFMWYAv4V*hsBn<{wbmAk#OXI@rULp;hak)|`pPVUB=PUnIs9P~TiT3Bh>@|?~%mB&F4ygw!QFk-!_@M>==^r$! zocPEEP^u!NUhvObK3;aGhU(<%%1~nx62kN|C{$AQ<)TCC=}2(BL=XGhnOxpr6aW}h zRdU49UsJ{$8D>e^lkWd37^AX8BCyF4uqhdG2gonm!~jsNM44d# z#)tES2=7n{QfKknncx{IhOj;u?UQ*D^~}r$ zO)jDv8tSd?)2O~KIh4qXvI<~jdINF>`k+XvQ(u-*$7CWF2}g!2{_Ftg(RIVC#DWo% zObsMEtSFkf7+4IOE6nMBke&2U0k~66vJrw@#lZh9LRlADKFvC+S(e#JiHF@4yl8LD zocFwQ+J)J7AuKba@F5XELQG1-|>% zR0I`SHB3p01tq~F17W5gc`XBF;xw*SJ77kyE$lITbzhFdj4G0X-V@8feSRAwKbIh` zP4*Y{x+_Mb_R%3Fp=lOAMVK=>=0F?S+bky?;#K?cTf5Y4w-_r*!0PvF36L0f06{Ao z6D1~H#I7KKn3$Qa!A~*1oYwhQM!a9bt5bA#`+zTo80D2E)?a4T`ucbX%tU+$B?IOL zGCYc)V9fAEljyqUw(x5rgys8%6)c_H0XCe=MNN#;%c~+>6Xe?AF75hEn|a|C^Z0A$ zhnX$Hw$Q!5eY^x>tbg@Wj)i$h8Yo=q%&vt-uPDqFhApKi*4?=-p%_^?SZiikB5ON7%#H$rk!I+osdGR7<_HtGZ7YA7p z9znK2_juK#z6C~Y>m{P2^rx98t7AQgCwR{&{DrN26?^~nKhKvMrU{?OT{0PX|4O|3 z<%TXS8VLixr~PPel*~v}J>$F6Gieu!@5JWvKd}njr}yx481y%NS?;2@AZvO~pkaPg zu%3vo%5mcVy?5#85G5rUs#{STHS4~Uj6}JUD*zeV`13GqEEopZ@#&2yI)nf50*Lst zgHuZjDOMkx-H*Ihy~m5_=dZd@A|mP%R*b&R7FLVSXafW15`|-pCAm@mf@hXlLWh0i058%T+H%Y|!N zlfWodNE&@lvUiGxk z)C>1`Gr}-TrvPyU6ln^VRH{WgNt7_^q5zn_zmwbP#bd05hL zgXbdrNQB_;p74L`7I4iWvWi)Ms<4{mo=l;_Q4a~(isfiiW(flyOJpw&G0?M;7!ewI zH_T_Pf4TlqQ$P6OjdB*S-t<|FSodSQ-&2dnG-z6AHS(yyVU=dI*=|i(=r9;g6qntj zq=>-+(@JJotLAikdFvx`bWlbIcMgH*oqQ~co>G)rL5JFI`9oRBVV$71yM8Tfr8RIK z_4y*H*Wx3z*Mgso08acL8|%OAPzCzoZ?ZRY2kGSi22&rYtZRQMKzi zGkv;?V;9ZChl^dD!&yG_S**G}KR?cv--F-<(L`;5`Sq}Q=RuF)6@R(lDB~y@MXa|c zd%1BHBO#7>#dd`$BT`Xk%yBy!F5-niRgfJ@JHQz zxY}6z&GWh#@ISpyX&}T~Q-XCF(J%eh+R4KAFl1sriNAhVf_F|Vn9qvYT-t%gFG(9L z=Vo^cqt+sf(l`)DP5)AUyBgN~ziW&eg2*hQ2f(7ErM)JVrcdPg{Lu`AZLMzA_v_x| zJ1bbOS6=URINMljndS?6wI20f!^2`?WGhRcb zT(zZE|M>>I%c@Qz8`7Lal3K#IT8><2CQ7t?=mIAZua+!T3O_rbA`og9cHn#PAp6lB zFCdps$=X)-$?24N)MSl)KV)6)H%|e4RmePpjYs;%nLpYxmv-K5o$2k7X zCa2ob*x%DV=RHlzN8s<_G~xMR`D)E?tTb&`5WxRf;E@0N@UgZ_W9fTA#(Kgo4I9TDCIt50imFXmg!VOXYnU8!jspx{;hd;}2v|oqeud<7V zFfNGZxv9(=?Pw2Mq$Fu5!&TyR!w33vtp2a}f-UdZT23>#UUsi^OlWRSf<+i_NoKFj z)&WUz^HJR`^)*gKJ);qZ+8e%GAO1;kU*=EPXrL2{Z$o(b`hdHZ<)BHw;9dj#ovoYc54R%+gYe}3#L@xcB-@ER!mu=rx8 zr{|-h1Mm)!ln#%xaj>LbQ$xMZ&FinvPX_%K1xK)Z_{pCiVax5Y&VB6xV7-&;B7Zb9uic7O=cm=`5nQW7;3M-kNyNgV%_{g?|YuiEFagzfSvH1GQY zj;n?TB}a@zW8w;4jKrG)C>a1_8goL$@M4^78>ODiMTL8D0*h*G(B@8oY7M_@q}DeS zvrRV1kJmt*LKKenTTd=Z#1`JAY*zZDTFUQ#I#S=E$J2w4R{wuoU3FB}S=UuU2?c?N z?vzgH2I-Jcq`SL2C8awg1q22&)H}1vm*zM zC9Om9%Yo&O)LP%A6l22<>*d|GTGv&KNPK9Nk^9TaV`)j`-baA*!m?Cbq8k~DUoKXELc%PIf zmzpS^v^w>)bK7pYE5%lAz)#2XPz;yLHjD3|6?VY9;vV=`q*{2sQFxViy7eH-^N@Dl zpJQkoXuijLWvUzCJRkHhSh=k6yy%=iPiU%CPjud#AH^1iR_Mvl^IUw|`^Db=h~Tfu zG~Zubs&f`l$!)zPOF=#wHeBu5>v`|LkFMtb_(7PTwUc zNOn%@+!`<4aqDNVD&O8@g#@q-A^)t}uiE-xrF8;`wxbMzQb>vPURNh9WM^yrsjEPN zC|dlns!J|SHci_D4CZGi<*&Ax-`mVDts2_RxV@x!Rnw)4ix%a|jYwE%^gC#viE@Uk7#&td2MYiF)|5GR!Ftl2i=XSg%Zm3gZ zoj%k*ReyfW?+qLWQ=B36G{qW^M;*!x)`Re^Z3*1=&$h=0-=+c2G^H=nnEP?=Z)p&| zKEl8fbKvnpONgEAbVpIl96BC>r`SFkd z1-)vUX#2ts!pLpWXzK1j2L(hlubI%ajBV*sjPSdd_u~5c*_3UVq=#ia^=U~6q_K!@ zBBXq647_9ztGB-Nk5#Px_`8|_D7BwGd8@0Itb9AF-~HXSOm)=i>T@Ybc*F zH<&FP9*AFb;>sXKMdhyd+4KbL&$u!1ODOQUnci1Yrq9O<)z~&CD_#n8cP3X45KmWI z#R30Fb(LaGGxXpQ`0@G=qhE7v=9{~=V#jYz$91UAh>KRJ4eczwzkP3^8CWu0oSCmQ zi&J9~j8kG>_Czvhy+i33}USd5y~bSj0>=D+?(af=nia4FBt&FukhgL+d3 z$zxtBX*oUO#$uT2I0K*9Wq^wvD*0<=g#w+H=99hI2FWO)mvPxwOnY??BL!YLok2ac zOSJhNbmX2bc*?vDjk$pdJx|Q8JH}JL9HIP#73#?}EcPj|*9cc>A(XC|S&u&r{Lp>0 zHiS5wv(EKUe{^X?hUpZqAq0Bz))!6TF>9+ePCit2WJ&*Qg(M_IFBTu=cuSKaQaCmx zEscQdH5)B?|6~yYBC^;GDQZwpk06!jA*u)SOwn*4jV!Kmc^fD>?9L_Fb`Uz;`VgTB z%oI?>A7R~L2D;6{YLe!#+_5RuEY(=QbIXT}-Y--l>s^70cv{x4zMIQqx;Z!}aU+o| z3K8KH*(`Jy>FQ=rvoDh8?@jb9`Kcnyif15(86JDwn(J=pvnrT@Vb|9BVvZUd~!D1H}Ky_)Ik{qBv z7ELM|KC$MJ;m`!w`+OElZoE3{0-gM!@)l!-F|Pwoc1ca}XeUgVDm>dr0VOt=sZdy5nevD&Tc>5)9nFu>O^nZ72PcK6Y+V3*R1 zA4{OD8`JSof6s#W^^qFOKGe?y9*qg%0~xZTAY#za(*)EKkvr3}rpqY5&f%kIF`>v+ z28!}Gq0wnFUsqbH`f5#)WF#5>zjAumjW9EXl$2tb^Ts!ZnMi|FvG|N? zpY@o$VYq3Vx8jQrUbo=HAeu%Uyjk*TQ55>VZbIq0f|j*P*vZt)xz~Jc&3)K`5pmGf zH$-_EE-u5SzCE0fm=a;8<&q_$7!$Zx3t>0Y>!}-Ri@8-x(oo-LN#&@i)HlqgRo93F zu7#SSGLq_zc75UD&&UOob_{Q%Lf;qWWSsy`W)Ct`qiz>%-a1e5F+0jvP83t&f5C|UbHwR5XML`aO{gFwwQF+ z(#q5%=k=FBYB5P@{a5cFTLf&@qqK>E*;Nc2K?dnOPL>JdiRbBoOD<+u1A${n^uSz_ zc6eXdY(Vsy)&m^kiTumemlMn$f9u{H7+o+!Z0`DL`b~qETa=H#a%d@4gdbhOY2Yd@`(heWmu zq0*}yRUOK5h{&*;EE{YMZ4MM!1sfQXp?;?XmB%5cjfM;J%}y<3qVNl05q^;ojTo2u z(X8ije_P))WMgZr$bz2JAf_V$hC=K$)pmL3KsOO@jbl_kvu1;{)f;xLofMi+Dg_Yo zTdhGJpVJI^X|rGvYUF)vt<&9P72n+Jh9U=)-s{1(+NisM|d`C3J;?MJ2UxCy3cgbNJ~gf5Wf8aRYidYHJ18To+_#LSRv(l2UF2#gdqfsh2@h zGVDA`u;2PdxVlnpr7QPKee379m&D!&WtT$z$JSwzdv1P)fr;eNzEv4H)aRS|nM9Qn zthNh6OowG$)HK=Lof6sx@O?!ZHSYDgSXNl|i>$CU3}fn%*<_uf8q^#-of2cp3We_q z63v$O_u=95dG~7D1KdlO$O9)}6GRugar`$oH@kK(b}9zX@IqNotc*=kKTZ}1Bchm( z6>d@rOvzZ0;rQ@brk2lvEj@~AjH+92gvBGuH7zl*D?&n*<7p(ZitSnxU6BaqDIx|{ z@*ee+dQ3&-)wnk;*5fMQLe+ColbnApIKXs(dwi`o8X8mi;l})E+`czUX7NJ}EOF^} zPl16>!XAIU`|Eh}PK=;zG8x9D5}$*+ZdQ{4RP?RvUkcHdGo|ks>uX#1t~Gftjkh3D z((hJNc3=w_<~%HNt7>_+9eZi+S#0T%RGrRYnt*i zpx1(0X{0kX@I!)?MGc?H;Jo{G(bC}2aJ3P!b4%@wYlO|`0(RuM{h_Lv8sg4v#U+%jmqAA03^5(qg<2%pTcv(eqJjGVg!f_9)>z9O}$RNA+Y;^q9pd*^Eoo z{y5o@1=~525%Kv)_BK)Wj?jj^dQzgr&z2@%nx4Wu?jrKsE~=3&VlHdD&(i_n4U z>L}P>nCp!#%{xxb>uZCVHnH(TBM~sGjc&)ftGwN{hV%AN264Ws@gss|ymF9U%O*em zRH9a4yy!LGK_ip;r> zHXFz03DVZR&fSRJ1o1g6sbv{Ec1A!>*EB&twKM1@Cw1+jt&!#x+VEb-t4hjOH0(Xq z(&E^;y2W$ovxVk$*PB7X`{Zw|?e#6k)y1{jmusmu;Z-!#%0H{ex2t#VuqHhmYO865 zh!~G}{<9C!8(OB_w3Rb3Q_;L>cRCR1tF z(;OnxJdbFOM$_uLW`}M`@v-7e9csh87no*IZ&u7?6fHOH<&Z_GUh92s6)g~6KP_}Q z`);6-cIrHzv0VL?$0Jfh!!o@;akfN9@NzMjShi4ForATZq94v`no+ZMNK+o$ybDr^ zDC;^`|7yB=h6mYzY|3(oAh=Cc&no@YxrN%hI>Nz%fsw{_glyQYxYX;~#kxC^u+#j_ zxC2#+-e(ezo5Su@uQMCB(l+i4v*`PFH66U`zAk=X;(9!ny>Y!&P=W_l_VF5RN)Ke* zXeOh;*f_YW81kB(KP{~IQhGe#t`1YdeD*SqfO~M$d-GPV{5+S;GVHv>TrBz9fbieg z+wXGOkCnU?)iV$?F60UK+n{GnD&ATb6^=WOp(`tEt-Cmhks%(EGCc|*(FH2SNq$M1 z6tjbT$i%w$;x0F}Xp+6}XP$xT)K9imCg!;dCVfgZnfJ7I?*}In#qh2161qXY zqUq&oCc%{2!26%nVoIxDLO zhXD%FSLVYIIRw%7mg;Y?-k}5%$E~VvHw6>9_ZWV0j_gd1kE4>aSCImFA$Q*OD~zXQ z3WoHB%rOy8R>n878h5wnI_(`q#HKQ6(PhHD!D@9@i`PMA=rk}RAF98KV6Wp_*M3LH zc0Bh1=AIo?ZHF#|7>5V^J#81c5GJ*=-RYMrop1u4Hq3EXpA&VwFFOr2Oaz-5Z-b|5 zv~}zdAoj$E|&zMoIn*6nug=N>!RJ~8F5 z5e-(3nLK}a>D=Y=;>D96)w>#`0%UqmgKXg!m*3mIy7GZ7PTB9xAtz4I8M>gMQX{P~5+^c2H(`Zb@iUV4lBx!V5mfb)RY zbksh3U+FCf9wY-Q`{L$6mB?@nH{gD=csnPo?Y>D#{v#bseCmpgNKE7S9!}UEX;D+1 zF%A5u2RkA(0eQ<#?tUXDD!iexrMh#q+uIAdQ;ACN^E7YDIdEo0u)k^2Zg4JApvZk> z39qQ_1Gt#D!ZC^8z})vF0A}I|?*Xj%YQ(5)y!^lb1^_YWCW&_M;sRKE`vsta>S|p=K}q%k}w|6=3omXw|J1?_m_NRtv-9m{{pwmlm#G4IM$I!a6-<0VBind? z_w>axQA#>;xWuT+#lCp{hH;W?%0TI6QyMd!aF<>$7dz53gWaiap#amDyHiz|^%dp& zSy>9N{M$ZaFPr4$8$snb=SfOL!adI>Uxtf~F1{e%ZFJJ8hbyGasS2uS8ZC0WJX#g! z%cf&SW|JPBiWoDmp4i?!6FL=3uko5FvVs;B<*X9%eTNj+{`Q-a*u&gv2V&}xNu>f6h6mte=kw&zKG|%?C1-eI6htZ|H~*^$ z2L#{jvm|L$;2{Z(=ZM_wIltbxNsXlrfF&@9**Bv@!9Jk;e8a5oF_^X!8$#AXQgc-&L*| z5-2c8Jn>S6NX` z2CKE8?R6^WcD?H&cLXW;T*eR2eogazcFrorKa;Eb*pUG%BtfEAjeqb%f~*(r^_Hqy zi#1yZdua3=CGShjkA&*bN}D|Ch)=(mU(!tt{Z`|OBEmGYllaUu2K9f98RyBB0D2l9Qkns`MZ7~qm@aI?T z@0EW@Fqa#(eiOr^7u7Bun5cDwVy^^xFQ)*h_=)|hm2 zyRtv=`37GUIs-Z%9#jB7Q;zyooIg_LU$z08CHCLb`N!*422Wx1_Tcx|!WqOAf_E1N z%XmE#hBuD}(U(H=W;X6fU=sSOu{)ejLd-3bZ3xAz`oEgJSgf|5M4{{ElofNG@E-Q< zPp5oE@x*S>2iLKe#O*5OC5h(SUTm^-2B`DA_k?=6;m5|itL>u)jF65x@`r;k z1nC=ON#aFZ4}=O|B+aqArlSj@{hE1Zr)7Yjh(3D81nKf)_#~-f>DASvvd8&9`Z;IA z4LLZM+x0a`cdK|_ASk?YL<(+pC{`)L>sT{y{-xc0*O3Bysxjf_<2Cu+vQL8O*yc$f z8*#CCnGi2{f!UWSYImP`^%Ga&eX2p0Nm=8 zH#WDLa?ijkqbwT% zDU>xLnP%ENexN{BMioA2m17?u03Bgb00 zXTg+lc3_g5eM>nyAV=-Nw+WAPnfH(Zsyx>$I+@j*yVE3TmnkV<4AbfAqRWOuVAGV0 z69h0|RxFQaib4f16X{ACM=Vd944C7gs9jyT@5pASHLA>wI+pBlRi7%te0ePd-=hTc zZT4TdJ+)uEoG)W_rEYHOJOC4!07OHl+qnXHW^Z2+@tx=kYp9i5?7Ke701;;Y)8`P0 zxYocQ28zbs3hUJUWdTAVvTsC1f*;@NX^lQBTPBJFfPD(;DA6`le<1s-v2!{^6F3W) zEY;o~w4-)0{M44fR?Mi$rWbon8|8+e+gn#DLY5v$$ct35J|b5w9)Tww@)?=3q<3I| zrR=cUYFb|t6Pr;pB$sd=>O*($PiOw*s+729CSbR=d3uMya3awwr0%_#`+2j%lau|Y zNvF$Rshef!)Yvdl{AbA@H+x>wLI{dBdcI%s+D;lJ^@?F@y=8P57Cyts+TgNZk>oz^ zV>^Gpm4S{x0&}L*@#s^z{JZ~z;$t7UjckeG!@KK!&coZnTI0^z592FH==?JF_N+6) z1>|%#4soZI!v0r1BO1ti{$-Lc(BNaNGVLZoHbSVMSCsI@hY|c?NZ6gO{xQeDDIV|& z%hy)#OoMQgwYLIg^(sHGxgohcvmJ7xhyCQb93ykDkdxE4Scm>*gS$t{_Vy?J!6#9Z;A3iE8MK7uqtN1fR>(9D)d*9{O?e2zg={{N0EYEGCl|9oZ1 z<-3OcW;&M{yI?7}MXb&+*~hEyZ5fXRNLVx_TLpX40=X{dY{5~>(x5VNtjFD&-+#4Jtw#U2wT`zvIXjurY*bG--S7oZ(%uAKE z$31J~(TQoT$5VFX15o=HofdDAvVN>;ChA8@z7878lg`uC)^V9@1EO6UHY>mnBQ~A4 zhAh&M;&q2YFH}sUq&6lkQ{yCuop_m6Ttcjk=iu?CvoSWC1YH*lx zkSx&M(w2Ngwz3Np>NjZhEcz?zi z#rTc4(^5a=ts4=;X8*}s+Yl6Fm%~yNHfdAR(|6H`(#bwGHCv1qAAxp^6sX0H0$cbD z(9FcRrw2T?vAU^6imz;{_-+m)Rn?lGS~StCUIgkjlEew8jw@JJxU0!CF5#{jWk+1+ zJP~ixq_GXn&HK_5csszxI2?XmJI@;1MBrJreQ|R7Q+8c z0sB)9{?LpN$ zGfJ~%(kTnqVqL^okk&{|RdTC!MfkuPz>%jqL5llp416aN!(MYta?`l(Cd5rwC$f}; zC(e6o(7)Gl_)_NHVQVV-eU#y3cdkjJxamy2^0H{b_Nk)5_>bBoY)xCgUUZ9wMLa7+ zWMsBR9PE)4q4whWqtac}%Gp{wWp51D^(lMGmz=*!O=s)5Uk@m@6@I_JYk14pvc$SP z)z2-PdKRJSb^2>fy}V2%yHFP$zuy0UYMaRiw9%*`r=IAaiK?HpL~Cg145L>4TY14- z$2dsWn8WuOlg}?EK@$=e%r;MR9Fba^NTXgvt$)jAyhwl$&Fix3m!K2B=_jH=1kV}n z&m62&qD_eF8$Jd^=jN;{ZRX!qvo&_`sTht*>fM`1oLp;OV``COr4`j)URxnv*VZcrHKtYCY+= zux6vkA8)_ue{!%K7)1I!laFu-;K?6d5%{ZM0@Yg3fm|R!sMoLg8;zUjgQ^s4v-As!cP^L-$|8b7h5wPn|SYf6k($ z$+(b+MqujLI6pw}=u~!dcHQ!uSD#|(PL30?b{)+~r5P;9qVreRGuMB_3i>3)L|Mezj_BdCy`|_ciO5}B-=n!coL-t{^I+fFggO6H(hXE)3!#p7J z7|nd55jf)UC=TF4dSx@b$ldbeow?Bo6zlR_Yu)tAkvsf?obI#MN zsi_&ys>m)UmN@TDrN~Y^$9r{vUgf&`9nxi;i)lETCr47w03Pa2mBVU=9+W!q&OL^^ zEw$ZC$(3izjT_dDpoL2wJ~9L78X0Cj`^5NtVceb$4%=^Ol{e&r}-!z~9{d|8tP!f`Fm1@S?Z6)FPhpb)FqciFjHoG8 zlmnA)P3(1$C^Z3v%bZg|rIkxLuK%*S-rzuYU6n%?lx3Ms$%8pwzlv{ zP)SKC;E=)R=1`&}amWAo55PQJ9L|wIjbh&XRSH88EefDPxi0H<$J!v!Km>>}lhJsw z)_`(-$=^K^5?w?PZmn}X>9zknhJ}nMbpyph9UZ?l@6~Vf!K7nOPEfsi^;R3OejGBo zDbWs5ItGve_5{pG*Q;Y4i1%w8=?jUgD~`EA6}<|W6483?K`A^90@~NN=krj2kVJ3f z$?0jOxNEn!?E+~4qikV2_mq=^jA9As;T?fGOj=Vj&CF(84~4b|6&g5Nx1QngaE8VI z{P~uRmu@H)3P20ln;#s+gD?UO~HKom{+VJA8U203v%L%nC=4K)|hr)$=tR{(J{QmeL1Nol!_ zNlc`|cqz}9^{DsEP>3`RCI^#P%|@(&ZIEx2Sub3SPWH%CjQ-4<)vaI6B%LzT^XQ`* z@%j%3kF%W^TsC7#Xd*+uomok+!2$c$)mdBLN+W7zV_$DC3*YW_AzAq-_h09nkTA?m z>VOZv7GqLCaInnVxA7g_-Kj07d@i+NNYTO9C>t05UPdIDzRHIBv5ELLjl-U{z!nwZ zP!vv3mHAK_%pK(4p=}FB9yIiH-l?a~n*(^hwh4`Ee+It>NP*X+7M6aI-1}~OECynS zhxB?u+pBj039s>ZfOoAuk#I1h;H!oQ)Ah-w0i0w5l?T)MVCH^GebMn-f{w^te+_TR z=ZJ_bO!d7cCMKywMUQ%6c{BZSq?!I&_dWI=D;1vjE7VnOWz{&P)-zN_|Ay|zKt z8)mxL0|UwBIUg(Q$W6rhy!#lTHJTEPHa- z+)9b`YWf277okF+`ib+ty>jcwMPfZA%hwxk?HhcV?ihOm9ELK^_#__3X4B0^++x-v z#PtGl9TM|maNz@Y20#MK`y;+zb1r%cXZv<`>G|er?Q(t=X`DxQNSI`LMjeWN#U#G; zHdtf{lnk8(H0KQNlHU~MueER&=dR2TaB4r@}{S3oF8Jqo3;-$}WzvI)ug)R-8U% z3DEvqxECDbd&_H6M6wwqC*yM0UjwtUc;%u5g7%_o=<`1~cn`=nWh*Ki=pIEw85{ak z+^oRGEpb`&1Kw+q5Gwp!!UMF_eU~YXYD<=}Ocmcs;^^e?K89{uP7?(T^}HnK4)dNw@;D@Yv0JfCu#ZuafVE6}iTh zL4&_#)Ce6fRJU@(7ArIg>~2mfxH7%K{qsjr&7Ap%9bPpz_Gi(sM|Pnf?(($oi1E_B zCJrx16Nu$|hs^A@ZBW$n|Jt1WgnfOcFF7+c=){jEno+uGLA^xq(@FN9dC_CaM=%ht zLh4sWKOiZ5Zspk6p|36395)oWK~ywNd9Xk8g>8`6@f!{ecHY+fakL73pa?ps;68!$ znbJ(v+8H(Aflnomw!nMHiL{VQNw7fE&R#~ik=dHC2w z3K!eiOCt;Z-DHpVO?_lQ0xEEok&zKu_&^eG-7GN@v1;D^#?bfM)U}{vW1IZ3>(Qo@8au`qNW91G044dN zNbsjLG+yIc+u_V?kaycr=das=2@?{#(kKRtqshgw`rnHqfV_?S-=q zM1$GsDxsLusKRvbi%%Ldaw2(t(4j23%zM4$b>2BJm(hk0ZN_S+`~d&&X6`;Y8Rr}5 zx~4GwnoDIRmVEkG3E)SbC?qTxOpX=EsQGVXAzsiA@U)@8gyI&ZFZWf#7u6Vx$#NrY znetP}lx1T(sFr*CQrH5Ed->ih4y$i!*>z%y=tXvpxjEtZK7F8WMc{K{C0~AgnL&+) zh6aue+9650->(+#5h%=H7pOKN|B6o9mybiGWfJMpbQB{C_!k2(avw;A=8KhQnqa#0 z_@}~m2D9}}a{N)_B|1!DSPVx5yiBzhOJV%M3BvIPX>W=X?1buwnhOiS-R&YHlxB2p z|E*=B_IpGIn(2>b>C^xCS4Of*esI`Le695pOAzpen;macRT?E1aK z62w+pG|j_!wxEvyKgDh{r}>H9LM2Nen$C2W+iZlQ0?vL3YTS|c$VyD5;rU9{*34fI zwa`PE1+x<4vG26{uWyOz>uYm_D^J72qt4^BMWLssNA&m)7}?Y4`~xtH|6VyeU&$@X0yucuD(77^pKn^ORk{_N+|i6h7Q-s6I~4OKRNycM`y!D!hVm!%%9FnLq)maY{%!NC3q?#q$T z6mNVu1n;KmaKJNXHj`+sJgsPOhJc=vT z0Q`){ep7~PR3hder}d2L0N=5!iSq3Gzm*FwhTueC+|PL2{=GZCXod5{C|8JIE^t5H zGTw%Kfw4*%sC$#bDrUOds}FL<;)cDWKh_^t7+qu4n~rKVl*a?2*pC223?%yCb0E!* zi;YD}8%6s4Tm7T~_$k!nz+?0KUmiZEpYO})jEp@s|0;wP4i=W-pVK^Vavn{8?y0pH zXLJL--o7#Ud3Bx)_pNVjmhc(uOK;EasygZlDF9d)pb4{#2( zPtQmwapM`B=p?jD@WLf}&vEs3bda43xBAHV(k11dnkP7{`$v;LoT ziHrUf@X7LBEDpsBBvS*xzJ>ShfN&tGEhU}P09PrX5+*fWVB8BBj>(vsel23v(3U9Z z1#$2G>)3Z4q%XUh4MP4%+QLsD3Sh6HYjD};0Ex;@0YI3KKsJ`@&RV+U2(ObU|K|6) zEdzn6MlU-h`Ojr5gcvX22l~IC#p)j@a7(a9nk1OT{v{eVP4DvFWNHgZ=9F>( zo`o6M`yR6lBiS%$RG&1g1R`T&)ppsmBdJe<((IwY7;jp8o1(e?IhZK6{&GJUiN`BF z@ppLoQ-QZHoHL62uMZyI`WcN2d{llyuD~v*?Xib^qK`YDdDBc&*rhO<$G8s%0~$SA zS=`}Fn4e}JI^(vUZVX>Nz!*HP9AG(|9r*h7YuBj>=L+L~bbQWHZRMC6=UvBd`5vd> zNM1oBu9GhgD*@uC-c~!o^#>#yuXh4;7p(p2)-xUc=oR^6R7|L4vxeJYogXI z8i8WfvbLYRfxR%#=~Usxs=#tc!3pMw{E{wMBPAtubT(}hCdX6slADeWYQXY7OA)>>SHQlAP91;e-;h?0SL7GqgC5kPKMwt>G#S*<`_2{ zbi@1KDJA`IC(`!hPPo7K^FQB?pVR^6XF!~hlbfHPgq}Jgcht_#riQY=4ZIvIUQ5iGtZxGk znS_rRFY#pFtk?femf``J08VtHriyyT-&@RInnH}xTgA2V8azPDjPtaWIQ`00A!b&E zpwIQ<;-dZetjjeoB|yicq9Yib1eg82n^g)g-cY^yM5dhQxx6uUt<6>9 zw)rI~7ieV4y>Hzsj6EVP*1Z9*c?B?o6R6}qab1mS{l4FXR1gCR*LPc6|B3-x=EtE* zl{kD4T8XMmhd&@&0FYS$4g1p&ca=W-YP!v4Ospb>9&WIlUt%-eX&HO-Dm(8@m<5PT zk8wX)Z?zaJ)}q^;uHhVu>XWs)*3;1L9>;jYM+zPzbKSn0#(I$pWJv6mp5y(^fHvax zfOMjry6#NpT`Uh#;t_{^m?4fxer5d2$6}=uTPGIdjVax8{IR4tFLxzg^66|uH9HlnU&8^i4)`r2cy9z zFS9*nwGv)zBJHKRDVNGITT(?<0#uh05xQ4^zV7%a6! zCK;KKChhE4)-8q7tpM=v6=i|&cu={`{3f>&}>lth}@r=O! z|F=yRlBCp5Wi0xDw&1U#P1Hh&+68M6>6W$HZjfOpqs`btio$_v(dh*JrVAb2{2Rh} zh_|c`IBJzi0JGHe0Ew7^c42;J8Uw%tqZiwQp>b~nXcQF{*9fM$N@}cj$8L8Lf=w7B z7l}-^$BK@|%Y9Z-&E`p-EK(qthsho>UTFJoupC18$NpR6p_Kdh}Wk!aA>(SZ|F26}zv9_Q9<#Gz5u3bnU@ zqy+R9L@^;D2vHYL8@g_&JfAr2KY7YCX7KIzEP#eS`L5;=XMr5uHn6sh1#4=Vn;mwN2l#O#9!WpVHh2)lmM~!ho{;} zm}}TFuB`g z1w3EULtSR@b~P*#Vy3mG7B`s6X51GKdWdiFICxOTGG6wq`j;e1>B##{;2_ccphkQS z|FlNMBB-|?8ecdw8=IO$X*HEb?Xcbt8$7xSGS2`DXVJQyawt+r)SgG%;c<8ZwU|c! z#YS4o-ft|NO9}KtR$}b)=~{U%ZA~*`Sg^f6w-|2fKgs12D3 zr^a$jk;@Ug#y&A;3JO|QdG%^@nsHP@Dp;nv9z#1KUgttjK-|7GScx+1a@u#WwzIQ4TJT3jD&kVx z@tkEq*~>r1jlR_iF%b(b0Z0H%^y5@3n%E5QtIf8Z$@bv+P}i`c2f3Q+Jzq)yQX$j|hae$Yxv z$;q)>&D``CkE0$vIC{(RNoG(#C(?%9@cW%^JtBV*;PY%3BP`_#l+gX012oAnV1|n-KB8Wp#+Lwb zN%wc80}m;w+2=6~&&JoL@tJ!=X4EwT`eot(PSu`JQ2+l1LKY&udL=>zToJ#8=~N|6Tm8)@_u1_CmbjZMGQ7MD@Ndfe7|Mpp2^IGkW~< z?&uTEH;XJUp|z+wF0VAI-Ym5`HChCO)q*tZ>{^in~|^YM|2$q5zd7G<;D~0oF5DuE2;Xv5$-t@Rf;8pG5#$fA9W`{L;48d+pNQ6hY&9_5lOX8)zE!$;> z0|vI)K=mpfL`ME|8PLIz9dZ)rsUzO7g(oVUMRndgm&`zWb*jg7Fi%JH^_Hj$~W2n&Mu zM`8K`Ns}h@0ycG-MLQha+_)?+_F1Lu2(S~ki_@VXx@bXc#)0a_wJYE0W#GiZf&xO= z$`WfP&5PNQQSoP})ecJSWp#=D6Ikm*jMO;UR*YH`vpcG9g6L(V+iR0#QC3pFO}`o< z{=G}llKT19_~xFO5>pi()Y`RE;a+Z#uW4wNtouv5!qVNwUW5my;;bOW%Hdx;=VwJe za+~B^`4q=zi`|H;$%wZR)UzLUAKmOV7>qAd?zrPxAC6-eR%ta&)k4aP5PP~k{?I+@ ztGRS^DcjGv5wHKPk1U&q1L-RPqE3#Q23zwV0#cJQblsXAf#FA$eNd>M1&2O~QW*4pBeN)#1c+G5bNu{P|HO>RXro2<=TLFww5U|^ zEJ{=rCD|2@7Q!>W>&p)e*SV#=c9V(LCZfS8?4JuFdA6t>02>}OZnS9tqu zt+8(R(L#o4)n-Fa`3JxI9sNs*Al@vY8zi0gZ3Zq>$4K9tu6TR zg1NgP`=akZ-?Rk}0MsGn=|0R-l~wLPImB?(kCUL3eH`58KdIxsT}|7xu&aFnWIZNm zQb{}jiI&xP;0yd=%jsBs5;zb^W~vW68MKPp+uA8uS)b`yn@fp!X6Js{7t>E_i1ung zeci+CkY06w40-F^49EjPXxz_<1!iP@KqGjoax(c zZ&<_K9Ij{>k3DoXt1XMY&Z~Qm%>Tb{6iTMsaz*!t9CzCCtDUfU;Ui)vZ+s|EjbxyN zzkPBrisBd?4qV!~`+dy-!LWw!S%$wC@s3Y{@w(yCccwQ_P@7*rIT3tQUZJdao4o3T zJ6odm*7u|>`|0o9>tPKnREmd(gv4t%4S;C`#BsQ6&0?}U_tDWt6@W}MPsO3{j1nlx z_i`AyGsNoVgCI@@1sUh8V}<2RtrX}Q(hClxP`2D%g`MpC_(^zD&S?rC`# zb%wsX+~afowEVofb9@P{doOrhck^dig{EES>YBzTkmLUVII&IfQhVNQS1KmQUCyr3 zKeJ7cu)Y=(lLmae1@D^#&$~%%``xPXUKLfbprF?{5*7k3fk6RKgQ$qtN~x0}DO@Ue zoC0HfGVrkzs^!sj`(F7KXc#O#A>(n z`av!6#U)d_cFbFE&()Y=60Wl9cS=Y8NvIPvbQxGg;;)5CQFTVUsKlWwy>YqPO;go@ z*0AxdZGkN$S(j1=#gTpYDzoQ$1B4f;sG((cEcVv(VJpQAHr?%xqJqTKN#5IsS8 zJoo0@KNAy$-ywe+8Q#RwY&SVQjuzyz@gH?Osp#I{(b+_Lu>U_8W4q`<`}XP%)|ywO{uYn`XjR)&yOZ1T{b| zL-0HEMLz54w{GCY+$9OH>n!xw)4bk$mlO38Nkk~fqV!n)pPJcf=bV0pAW2xA|9yo& z|9Tbts7gYq6p>qL&U>9<(q;ZO%R24H)X>@#J+0AU#?c6r2?~ZG6(zVHmDl0Pu+7EXqbpTD9y?Ad9)QCLPU6I&VaB%G?6p-j44frt3>5)ed~JB?b& zdgY1dj3@_1ne5MYdkSvgMfDIHn2g~{L)u{m;a%jvY#+!t6ouo}rSl!{zx<_pmGEAR zwxGD)+?wQ7rTn|kBCIh1hQLJfT`=F{x{%7gcP7~Xd=5u8xJL4naQcQF62QM{SXq>y zk}`^_l@=Y@)5BAW)^tfq;@uygMa;^Yy8QM2P5gUpH>v6wa|2yv^4lww@7gP0$`{4) z9bZaX7XJRVLaF2mGaMw-p0z4^CghLgi2skSw~mXl-@ZTvhLRpZx(B37S~_P2X;4ra z6zN8~C8UO7NJ$AP1u5we1cneKq@=r~LHa(t=l7oTo^$X0%a5PWF!Ma$+luz{~F&3qn17wb3OS}MNWDh`TWn4(`&i6OD0auroFcWblEFm zO)hRYtlVXmjyC%dF87&54pS%rD!j>n57ljV1VtUrUpP{>; z3>sJNy9Q7G`Ml}MZFoH|b3cb!sG7Ne5h`-`FSZSD{__htbz}yvyh)1;DaYS$C;DF_ zD~Sb6%_A%iyDD{3CX6(A0nM1cwstPpgfP?Z*hsNnE3&^A*1tCRfB%m@B!~<_k69%$ z%z!sKIx1}VvDi!uKU$gQ@AKflKYlw}oVTOJS@As2A-D~2RjEl=7z{JPMDD+_arp6R z?B8?u&-eXn(11U61;qr}OFT)g>LKMo1sz%C!Q}2wDjB~1&pZCLg8y&HU?}E1XEg&^ zeaX5WX1D}^mqVQS9qA`ep1>hsv|1JIKgaHWz9IO#JTR8u+h?9RU;(|MHlkEbU)fYFZh+U=&av##mrO0`k39q#6$>l4qkt{2zNwSpp4h2k`f_Ip@pH zH(gV;PfCH_qQKVuuGn_tHR&x~kxcaOL1-ggm%$@v!;skhP_Lu=Q1yKRgZD$S*eJ5CD$}l;&#=x_0Om6FnL+V}z>$7+WyoHy{MIk$6xgaZLl49&Rc~UgHX%CEu@B3v|ba!|-4(|s3;uAef!@p*Y z;~D6(G1d+*klexgqve0b#0(E54xDGne?XpJeka~pV9zZqRI#rp|V^g#3k zJ3u1odNOI)5_fu%!4P`2t%uP$oq9snfcd}`$KM(@d!T4UBHBNk+PZfy_s zD{Qckp2JjrQx@D6N`I{-I0&O<`cK?atcmFkXAj}2idV$9==(Gu2U<({f-8?y z%%w$d*N@pgp0KhEUrSiQf1hzYoS5tw_4z%9^&0YRiMl}9*LG9}4K6X&jU89mU~Q`} z+&pf*xpJCx?jTxe$7Mv_@^xcB5obNSHpa$B6FbhP|Fu4IW=Qc`=B7T9l}`L)#4r@) z$OJHl8Nz@sSF7YLc4)nIYeWZ}{+^k}>tRpeY=+9PLYNhqn2X;w|4^YtE0Rb<04kW< z22r7suMt%0`~plL=P~`)DIo>Ad^C`K2;S-XuV2Vf2Y#YbeWAKHfEa`C0LG=BCZvB$ zpQaZ3O?bA#KR#yhcV+I%3g*2i5wk!upD;p1~T{k54u6F0r z7?4G9&G_~(NAv(nr0H7M(vOB9!c*WH1^v$>0uuua&rD9uTUu5Gg~JG_TS=uudiiY4 z1Zkb^YjS>6j1;u=L?&upSCxI4^-1T>)Q~?PfT{SPRkGgcwu_QX#A@?@q>`chJ=p`* zVS85Iv?pGFoeVozc5{M(AXZ%D$`EiE_>(G6dlN z_(tk@R9E66MX9!|?C}!=bL>g`s)2l+9z{YWU{*Z+`R)PPtGlO{bZW1~{LkIJ0pp65ym*;mZ=)AU`c|bMYjvL24va}r z%Jw!N^l~2net;XN(~?_dd4u2h1JC-{qpL*&E0DL)@bAW5nVsqR_RtqMSEnTG(=~qw zLw{dle0URa&BkUm@OLUfojQoHPKQX(YawuZ>)GMf^7lth-7X*OKYzRLIwX(#b#_hz zkeA&pd9vexS@|2_a2=uuAZ)O>qn&9nN^8o3h&$PF%9>Cr+i}i~Ic~^nBmc?_|MrhU z`#&GZX{s<08io&?msZMT4BzsVD%){7MxVQ>jh?EJP;9waGYJ66YdxUud}rSP=(k*f zW2Ft!HmhF9ufBY9eJXo47SK;~_wn z(7SaGlzVw_8T~3U08Nqie$yGiWk~`-1lO_f6~aGTcJ~6s^0mCl_o>nRn1 z+m8(KHq8IO?|NVlu&K)VaMqpRbZt8EgEHLTJ^glHzlMEdP#cEf3>G5U2=S~QpE804E^Hi^qe?;)jJ(nosFL|bS3bLFYVBLQDNQ}P`>4orghI(9!^ja-JvOOI_RwgxW?;gyVbz6KH+OvXJNBEBNPG_+d^F=;Fjf| z9(Z!uocYg?<~G%k`2w7UF5kZ-L|V&5AgiaCu%Q(7fW+S8T`g@6-IXD{xI zC2~Hqn)~6~_0yA?f?B!7ise?KDH{h9vY(KIgSMMbvnne*%@b#~=H{jm_Ck{^(R9J2 z^xxY~@{ovJpGd`I80HN!DgbF~z|^=~kxsZS_9Twsk@m~}b9{zM)&>{Ghc8v@kKXpJ zM0VWZ6~oB;^5-+ckEv)UlXYh^Bk#&SNe>kVR2psqIy4T;JqeX&?U-z=?{pIeC|&bh0xsqg|?6W^)F`bPj&ALcYq7*-2W7Co#_QWThIx)_e!i@}z$(|1 zXz_>IBR)qS6eLQe4D*uvRG8(s7)RoOM78I_sg)JD=GnYjK6491sK_VHB3lr^7B!Jl%1*5_0;?5l|oEDBrjj2!o!(ib_hjcKU#$>eC4)fn5M_QvGF+3=nHzii)Ag=fJM` zc?~)Y0GMnCLy9Ce#~1=@nCn-a`#K_*0K}?a8RIDc>#QB!ZXYyP zsGP5}dEl$nHlBU;wKzqpbhfWG$p+c_7 zrzRruGJtDAJrPm~3zu+ICJ|3ygvjBczr0R?gDubOvr7Z-lksid^1wd}xI5zLZ)P-X z{XhX!ij9;&wHDCM670Z{Z9IhSqD2;cl2lM0pDHlqCQj<0N9DvR&FO0xK796vXaNZj z3+*PA9i3kLeWQ5Vmj8{@6(|>9a9ma#7M7elHXr{yIBmV52XF4K40HT=4fyewo;&k_ zDIuJik9LI3A4L=Jep?PDkwF0V$SWm)CqQ8aKpODTBn+|btA9Kh4a`FyuFI**jt4t2 zAQ+unP+StwvdaNbIq z;<9Tm?L%kS7~W_wf(q{0B*tfza-MwwE~3@rC=hD_<`t(Zp*3TmOQcOjQA~*-)JX9sGrIZUT5it~H45_xTXE%~z#JWEd)78d%=PPQm^M z5Zh0rd|3d)iH(u-vv((%Y7uX5dCNH*ts0lI*%&W#UIZ?7CtsawY?r)S{`@UE-R@Iy z=X$E3W%XU8LnopeAcdP4IL!LnRiL>iPyaDC?@mY1$;{Czk z5t-l$uGX~P>^KFM+E%&iEn*d{7M1jS-kJv*nSgVSh&3;gF9$ zWhvg!_dbi!#ClXvQXQIM)7`qII3IeRQnKLqpB4(m{l35JRj-fB1B)B>8E^h{8#zSV zeGr+b_-ba{zGY$2YCFyrxLD(3C7l;00Ai;f+kG3g z_+Z=qnwpy7(x?2nBMD~LykCCl>~QGNq_AU#6H+6^^!v9CFCIPwEj4d?3S@e(bG{2M znQj*@Z=sFJJLeyBz1{Xrmog+#!#5YLH@f&5j9-A<&-Mz!10x<*b5nyb8osg-F!!Fr zHR0#0zE5jPx#eU-+w$0Ma8UX*26_h@5mcyHV^@P^? z;YsFw3e*TN@SL+0`*XMWE8jf`>sSc^*84=J6pkOY7v(2GxJRvM$*oUB{5hwVil=hs zjvFH%;`N?;pM}$RL34~^{8rcx{-W2j%(rPR;2?ei4nVx z42jRLWS5u9Un+>nvcfJOVe06a2JCZgqce%{^Tm6II($-sixhE({|aQ_Ww+A6w+{=5 zY#8?e3X>kbLJ7`D?Gg}de9C8d_~X+Y5F64C5M*111NjGE{G~bF^uf;A!zJpFQ}h|H^#<^pynk78%r;E7z;ObWG%-BIn};|J_f-wsWMMU+ZXId#dp@f%s(w(J*V8s}A!!$I2u+&k5$rLq5x# zxGz1aG7jbiI_^@5jCB%+!z^c{0zv^S zaie+B9CW4O#@>v;>t%Wo%QBv<#$*V`n6_ zln^?Y9L~rD&f43#*M#l@qf?hWyYz!vJ9DKYRWe8U#*6;4a#g=q^6;+sof9QFLw#bsKb@r9!?@D&;s$ zU+;4Fu*OSOPW+(!NomiTdOzl7%k-vXnU!s_=vtj6F_55I+k5+Sx2Hb7HMWo3+) zz4nq=&k02ZSrr1%pYj;cm-fQ-F^S1xR`3bFru4C1(rP2X5PXwWU3{P(1uZw(c3lnR zBVsQrE^b-=GXMKosCtDTX{g!du!*kFF+!18drj`rq+ubP7A40+r@8ki8eC|SIr~L3 ze%u7p6|kikp1Op{dJF7HEND~x;VXD*9}WoAOH+P-mGX4@FRafDuNwOn!L9w)Ru*TW z6cpx~Z2bM87fsH_JW{!GzhforUR(+pYq;7C##PPXhVahuj}DOnR!VHgqRT>i?XqPF zJr0O?=-GBdHEGUWnVmc~U9EZ?GIZ#>myWB{jBk`2gp(7(_b_dZ)i~~@FrAAy8;5<42 z`PSRv?GOw7Ie*t%PF?BkC&Nf7l^7}YXFfE^PkJ@ga`_heXjSGfrYjPUYtFtQ`P=O9EhsJ68#S zU2FQ9)>4E(&{MKHxb<_{`kkN2`c;F#5Vu&tYwGpwh!fe#xx#ZpgP*_uH;HAFXUd*5 zMAAq$JWg)iTz~noxmLc-$+1WFiT*Ka?&`OI_wLN=l{Yt1tiC(Vs&Rf+c94|2Xw@#= zhJ3)|@{!set-)%I))byIUte!uuH;*+k{pPnmliL|y6~It6Byl~j_^-Kg#@9fZwa{H zZRdrb6VLkItM^|_aMr?_&e0ktZpRot+L-H|_5IC8B8QAV{s3KU+Qg7xkKUci@nj zk~)UW0gCyAcUVZHqq?2Y!Ch&C!2NHOo6>3f5C%?(4SgqnlR&<*j&50i^|YCkZh7ir zQj@OXkm2yNFgu#9J*=dQ5W)nI#}yqCm(#=s0Mf-+Cu#8NLlDYPqnXF@93r z>J|u3>5Xr{y2U(JNmx}Gyz`OYs#PCT`~fs2e6_cUN!g6~42u2uxCMZ;TmhR2+o|$^ z<5D9(yMro$3pb$Gjj$x3y&(Dc4mc)lvXSjy=IFmmnqB<6K=xN^yeZqh zkZ9RboREcV5C^~0nTptUew2g!jWIN}oA&bxjq8QSgC28LW6rsLBRsGW=ON`a#JA(! zuIcr;b^ZKhG;`>?1b21?2^hg`;n4kDVM7=PKD|%B+_4*Q`p83}NZzdjGTq{-hcG3d9!H1yc)@A=s#wV!W=>_-x5I9L_}#}O(61SgQq>rF zPQI8jEg5rc+VA2@I0cFb=RCYJvVg~y5Fiyu^2tAYG@Bk3$*d+tP ztlsj#t1b4bk#P3zE;$zGgJm?l_TVh{qdGi20AMhmORIuU+ptLb$3~_u>q9*Mw;t#& zgjqZHdl`RSV<7Rd#eDtK@+?CS{w`tmd(_iwx5n%hB&A$4*b^u=A}~sl%6< zC-fD!keN5w(y}Wi;kjeI^4JSITU%7jd#h<6wI~D40+QLxlsPq#`*5;z{6qf*?_YH; z3N~su;1>{#($dng7N(^T53S>LWWqML`V*)7GQf$a7a1(<$hu?7Vh2V=a%&vUZ?dy=)nC< zcu{{v5mg9L}-%^9T<_Bha ze3FeC4}$y_V##rIb?5sP1TqFzWRYvd61t4i-AyXp^-;0_N90?9xF%{UXMMK5!Un90 zO}ryRy2n|ze#Zq{u3aRH>z+qx|#D@2S{SC^uD!2F%L(4_7*yq++~h#W#4q(Ghcg7QT2uIo>3UndCP?) zPmMj2Ze5kpCU7o3be+Gk?CaGzhOt!%63C-KJ^&gu_lG={Fe$GzO`RRvCAqrLt3Tt< z8{H>{nS6hAqw=Q=J8Jn;TxjgzKf>H#Hu<1uiU5(gkD`G69zC}xWkt)~w7Z^e>jr+> zEN$wXVuR|~@EC)21-#_|8np2;Q5>xj_=QcRB>Pu*lJ9U>HBQdC`rj*H6dF#op%SjOg8DA5v7VGr8#WYy#QyScLCxtET9Tz3%1q5BGQ8 z^y}eb5GkH&LJXuNAfEN%bJLwjxLhE6d;!Q6stNmi(O-<%>X=;W0OJ^26u+u(DB-n< z)1Exbw?`rS8!@a=2B|47GVvzleh8(N1x0gj#@0GFHG%yV*wM$@DckE>?LasD;OJzF z5%S+QO(FW5I%j5ljHJ#-$wZglVF;LI zUqJ7}h|cpWQXM1{%YsPevXyevV|*%~9~uv!@b3}VvNs>Bwi#7>=H>NWk8H%$1{Bt9 zL&GvocE&3wSKp!YVI&I2WW+S2>eC43iNyXKBdTHKjC3`MeB-w`FZ$1J!xkT4Dn&Wk z!rJFl{X>P9JvTXDn)~n&&sl>*A4VH<=`o&llil6#`k#IIFN9@)87ND;_1w;~97Rix zI^P@&-a=kN4iwQ-I53&6pp?Tl2@EAP+dbWc5XNFI)%V(1XgC51;Y8ED6yo&Y=x~So zDJO{0dvg7Pa8O>3GPO>5D^gcZy>*>uu-_e7o`vk*TAHVQVo~M^7J!h@}Qj9)8IQ!tyc137HyaRU0*#DHH z9d2uq(;EIZ#7z?TP?}YelEIb8;$gbN<8-{DT7Cz?a0n(?@LssEg{WjA+x=os^^gQ+ znpjSZVq)7OK(d>_Cv#VG>IL|1ZWhP3Z>~L_$Afu%-yMD5-g_h&4_Y5x-#r^FWegfp zqGyugubcM++PQ7G0xHE)e*ua*r6t1#-L0KCMs|#!0aY@d+Xj=s!xjJ?mNtXywL}`P zp4FzmQw-9HpZydoeKC-0wg2Cc7Qj!qtr@-$H~hpR9|TMR7$M({p*(E7)iunNW1r2+ z$hiYOk4MJa6e%gv!J@jU@RU(O_sCr!2um7>rV+VXMr_oa{Zz>OP913o z_Sp7HG7OFNI)l&h#wYLB$-Ev^BP0j(*?UC&iyZxli1)%7WxnQ|%oID<56Q-@hy;Nh zu|w4Stow+%8xhq{36AZr|Fhl&Kn-_pi?6}3Z4Jeo6dlR;oP_dgcrk-^0RNAFC!axu4cG7D1&N2L+Q9`2o!PBZ3o}(~aPdigM(*im zKK=?*|0!xEeE-dq=MxJg65&M$l@pT2P!%buQP=JfkRpB15m}me9-e=BJh4!@KgHb> ztZKwTpk>Mde#3QQKWWo#yb`|Ugpxj;!cx~wM-Dzcts<}iSpll(O2Pl#S-^Y`?c=$( z(z|zC+Vj?uVP*x{zXeeXztW0x7e4qLdxsxsyKclD8+w=(&LuKdLC?Gag@L0X51Os* zORQ3olJNBpyjSHPCGcn-H00*W4{|26auy%Itp1LD$bxV;QvY4IqE~DJ^v8Bov=u@k z>)qD+u3KkKfg+iOl=Uoat?oV_IJJ!Sf7adq0jqL9Sj@l(3B->nUXY7Frmc!ED^mA8yi!_W{C#N@`FDi3~r~kYh(;n%->S)pi{#>sv={b z5hD|ry>iXdNc(i30nKE8;L#%gs3vXmMqDZUZrmW3_)`?Ua-~^VT45=amYk@`z9WR5e;unRn15* zTEzA22g-50GO>>ea$^|_VeAU72@pn;r>G}kG_`q5W2n3*=rWVu1nY+S@DY313w*eT zUT9_gT1cEdl@@}b)^eYUD-wElbIgpFEwQJkB=iEEm^he{IM`(JyY9wt*+Xd!@Caf7 zO4?b!0Dl-AW8;rw?kOZUr(?!lc1!=}FaGnnU(w#O&}ivCCKJmAEq4R@?&<;smVBVL z4CfP+Q5Eu#%Px!ZRASm1NOw!`Eiv|`ML_bXH9fW;)9Az?Od$AZ@tR{i7D4r6+llDW zrk?J~XE>X`P(eyC3Nu1wOR&PM7U;!@HmV#eFb&~u{Mh1$P}-kUS#)n73F7d<;}E!L zpUU!W-xcjVPvCB?e;)22P)0A$@u?&#`@cDp|JhJAw@_nR>o@GuoZ!#m2luLMJU5B) z5Ky3Q@-i=1XYnH-F{7CyTh2=mh%L-fXL0`xWvQ(FmFI0JsbEBD`U@b=9^{R9!d)da6`W7=-+XrGO&8MLzh7iqRp^uViJIqQ~w6 z+87_eWKeFy^(;KZ<8z=901Z(~Wu*>fQ!IFjImG{!qxmfHfJY-&N6G4AFiGIK#w#-G zFY?U4IT46Bv&Th=Y4E0dU&&NyM1@B?+8;N=<=7L6xag_hSXuF?z`Cfmp*nD(urt<1 z{BF^Tnbcrm)*V@u#TVe%?j)tM@={gFZ4H$(pZr6b1SNlklR3LE9$7Cy@7P&tb>8m{ z_xWC)&7J2-#da&4yUp~B16o38NBLw8XmkF0En})+1!Vjb)?C2FM+Tr@U@_2-k@5hj zo^Fz~j(pHexvf8bcr*OWV4WN&tR^P{KAYN4OuS!62kb|iLOncc01|TLt$K>h+#585zH~uM?G%r@8VD*S0$|t)APB7D)^MSjgO+TvHlA5b z5t6#Kxq0L?rzWq$v_KW{!0s+z;d{;~CdR|zMh|RJo*%EE1*~boU<4tATAn@xqGU)K z?Ser3i1eM=0K6ZV#@^LPev!u@%_bv_Glwg870uEsH2*eEgv(1}eNBjJz!q{XJzien zyg_81GH^Qup4UJL89wL!mIf|q;EsN6wb&V@1Mpb=*Y7e0gl-OYYxos&6ZUoei=VHxQCt~X%eV?O=I{|u;X9WXKRNj0G?bj7hp2mz&=J?X<=Z;>CkE_M3A+_@!S zU5WgRPl(6t6NJ!m;+28BsZy>t*sjCWHwa(GYyL_txDe}YhgCnI@C~?!zQ)gFIU}N- z=3S91^D^={THOS_qCcYO$(5ue zGv%j5O~(wCb5%pD--T5Q$4V_uIXqk6qXEZ}Iun*g;UW;fQWx(ubHYYpm`GZEPgbl0 zLBen=8@X7x40o6ODJa^b;#@D4{a zntW;-Zi>{tW5y_}O47;)s&V^qWE@MF`A3&8L{&8F-A6mxESN@$tOzsBDL;rbsBLpr zdOPR7Fudc^!a(}!dP=$K&f$B$Rc6j^Uv>ACKVf>ztW>`Yr+;`h`#cd%@^_1x#LFxF$*yr>y#U3bMxuy_&8)#~?Qf2ONW z2f}>iJC%J!E(_QL-6D#;KptC?Z|SzXwz}vqo$0-L>LlO?7>eA=ux_PW<--ZADlv%L zuF;}XuUH4VK7(BL+!)F_KK%y`&N;kIbPm_re1?EfO-_`eNM(!~WJQJ2m3*j~)pTJ$ zX?7)&o1Bh>Kvou+%2?nB3Dj<29MpTuHZb)v#X&*FlrG2P%I~}xBSrj)@|hg`d*A!P zsAa6D;ZmppMZ(RG9~}@lULl`0wb_y={Dt|jU5Wegz6Dmpy1kHVRga|CYVgbID`l|vk=KC95~FB_)P!d8Lc5?F1L;Q_ z&iRo$I6@tGa@luk9S;>);+D`%#Qw?_EO(u<|ER|QN`R`|ABDUaoDoe4!1|t`7=PX9 zCsvB1OP*|4WsPMBt#xAr^e@~u2TC@7 zQMQ-awacTafP>$|La&hLh>b5+^7OXcg9N-(j550g+=~6zglWv~k0XdWAUw0;j}_eMP<}| zLm-|U^(h$pI1L1LHeg=}AsOp&j}eIuNsA5whf^4AHy^IUBmq-OUXXcn1SUL zm4F+b7sE`df~wl{eU)ouvmLZQWYK3m8FBfeF)fQ^8s*0?QM^h66VFZY2&Mz{?8Aa zj(#xdR_0WUv7csp1om(_ zSH&McZ7Malv>p-Zql~Kru$Y^H1`+T?(-R{X) z_1#$cv_))BJ|;DCTSSPWU0IZ)^pAomkbail>}(Qosa4np_oMSn5j>Bzrw~cd0J<`jnRTWnT zxWgn$C0fU6JMunYQKk*h8|J%&J%T#6Kgf`6@dixUo9(QzgZOMLO<|A%-b5_G#gJYJ|2QZrgUvyKoP#!2dkufl}O@rX1x zE=aE!-WfLP3E5DsjQHJSmD8a9LmJ8<2}W6;V0`|JhX)l84ThKz=H~`^LH1RSS0s-j z2reLc$oh&0-jNu1B8`S(Xjwd|kUCbPO=u&e0N+I*5KLv|obRk8M;I=T>?&@d$A&?V z9WJB01W)iFd=l)V-6tIN;BI+)0~P&Rd8y6&U=P(O{>=y9ZBT06nRi8_`Z*wwCB4JA zg*)xAUO^mJk%7;7#Bc|djRKrCJUn$qJsljkHc{xON{1GuhcDJ;1x#9=>M=BWWMp{G zI=KE2A$fJNjg>iKUprZN094p}0Ybq}DfiSv!Nc}M1Rbu}R_APK-Ij&iS}>Z%k0m4ge&{H)4UhO30L}5^9XOkl|3?51aa$qOjbF-qLOE7yL>cW~Cc0Y;>5vFIz?xAm*jhezHsMui6 z?I1!-9|>gZwt6a27cfys(#x_P8U*Um*pBF!;ugz8!V`(6;!5y!^;3N&=hvZx>?o>E zqWsIEw;%B#SI#T<7q^L?&&$6jQ)27ULxyMY@5uJ3I1Y(NKqN+Bag<>UJu1kwO@EqN z_B5PpQkPfQAQSSi7j$llVaTC3o;zkuC`^dfx>a0yHCLIv_(KIA*Fl~ofwo_(6j$bqX}oELwh|CIL1gDwL!s-@s};&pUhW5R zjqG7_B(|b}3g9O~M`A}mrV4AFmRvIlc?W1eO_?y}#a}j4o8ut!CZljYYJ=cj1 zz)~oP3<~_RZ{$VZ=M^$Xw7sOp-we5BxUp1Fj_<=S)Dx_ePXVUU?e}%1=7vri@PC%h*)RD=SR9V7|LOASSNNNsqpB#67&v- zDQ$SM-p40#X|MM1CwB``=hH$(5bu}~$;_mtK3&o^HTc5l&m2(k)nJCo6UEXWo)cM5 zVoHh_G~TK!le-K&6nkj6NH!cB7uNY;v?Q-6-ip3}%aVyfB7%bAMGw}P^@Lp5HX~Gd zB8w;DndoMLzmjB5u8;5*Q6hB3%cVQHr?0XPA}vq-l7!TV=>sd3Ds+ce=-zo)!yTRy zjP{6zGeT|UM_7v@>W|_pL}0&BC6l%(f@(rst3}Vdi&yB1OTnmDp&+X|;y8!*h;sD!N||S6S0> zO^&0>B$$}xQ5rXn;W57)pX+A>SMSx)*yH72 zTUiB(%xpHn$fKpKT|I{Fkze(0E2FxaNr9J3j6S;;mb=FBo$uY;Qg1u&2mw|X5&%(P z1*mQ(U0+?;F@G9-Ycoq3+xh8lXfF6uG$2Jae(e}-VHJ0D7kzmq;@Z<5fqwbUi5)1t z^5l;%PF`!X#73~X-XGs6%orMq^aCWFluyg(M^FF+mcZ3AAsF=O>no0xC}vI%MI6L9 zq>yy*9TgBuCb2R`iQH$^#y@};kQbY5OFh-KjUV=ayXRs`x)!I&YMzPHKp+43&DmI_x*GZyzvy`qyuEaK4z9op;8Co)ps(_sED6)v? z-S7AlObb!l*nXg{C7vw~J>CplW@|^+cgDaQ9D`$i*;05fC+jYMQ8i}H4mfPa3#W!D z-HL)zigiEq-g4QgIGvTx7sOskiPf|pZYWRrZzcbQSE;jT_3!ds3wS)pU$N;!oRmk` zm#c?7S4!xN^O^;GCU3jKNc^r_LXCa|+`ZqMJbU`@ss0@dO!bUq)*}}blN+iI+6S;7 zcoNy?_&;QOHqf~&GcE%(sW;M1HK-VO2;G>!@%2~YM5A=szyK5BJ}sgzn%Oem`}6@= z@82rD-+Ck=N-AP_@D>Iss{6yHt>P^&V8!I>g}?(X;Dy9I!6l2e>ohZx!|0?eQLg9c z5dvFt7U_uv3FMuwcu_+R<-*yR@uAaiP&zSp8p(V3+1j*lLy@s{`4QF-L7bh+Mo6O9 z?w;p6+Un>NKyQd<#a@bq!EbU+B~_VlCQXH-o2USMtt>R;t=_Q;Gt!lg^}OHZgFH{6 z+_OqvS5);2m=3}P->3U$OTv&MP48BnGrLRinU<3xmi^23pIrOJn$^U3!bTVoF==01ncd ziqqg>aUIhi|0?ijwX%ywaRnL8uZu4|rDV?sh^tG@Lc@B3g#QIBO14&hF%}%jwO<6`h!S4zSU45q!p8HB zJSy6W)Fq9DXIT(VU=>@jCKbsGzeE{<5^z6AMxEniERZ!}C~@|*HJrbhfVM9XLnV=k zD22!K>9!+8dyX?hcfe%%wp_}zNb#XlQ0hQBwutyDOnt!5>tb1(wWda-!nd9jiKuz@ zg?mtvDb`R;bJ95ui*rcaIXXCXxvH~8*EmCbzdzIk@-W@d?o|Wqq*3KFccpa(f-j>ZKUMJ|0>Bf=L0m8SkYDZ5Wzxzc%sCr}G`6 zN^(~ZEnBYI1A71UiB8+I0{HRxb*=@$|K&I{K=Iz{Qp4vKX9dEl{)BiHsoJa1Hjy?U zWn#aT2Q%1;;>=Co|9i&*YTzrfS6TZuH?_})FqPl?)w1lC>=tIeQw}PrCN#QKmUEQv z(rn2(Y0eNn0d0(xW^1t=6c=lT4!M*x^>0zmxvlnVV@A9D&UGdM(s7G~pnN~f3pL-c zO%KCCL?o*qwvFnCxGbHoZ@D%I<|7MbdjivhG$@p ziYmN=&rNilkRBztj7m-b{S%)3Qw%7ytiA&_yn^>-n-K{=3Rch^Cb}B-%n{wzi^xPV zVV@1z0cV$-45?dJ$Bi^nW9+kQQ_owZc%xm{gC9@naW_xgdKL-e_8{JCQ*NL25-e^w zF}{Z8n13jkV-n@UO~m^~Wb(J{ z?qmJZ3PEwr=w(~ax*{?Kkr_qFgEjC#3#m>S4Hj|`gpKzh84zDY%Cq~zC{DyEW9QWP z#1F;bPjtU!<{w8e25GP*V zO})B$O*MGEXSru{-STj7o1k@fL(unQ%}<>~j?76$yT25}w}qs2K0N0eqt0N^9pV*? z9u0BVg2+eq#(j!GR`6tx#iWuVWCa@hDAfSIr_3s?C;caGdN)y9E5b0KzTFkgmZDJU zVD3mJ1I(k`z~maHpkDiLDO!Z1y#_`4us_pSj!xMLoxF;K!uQNXrbVQdbz!fdg9LKV zO~5(fcaK5|RpPo%vC5n8WTp@--IBO6$x*X41moFy%_K}dL>S9(t&SV)M9igHD}mI6 z$%0>K5v?ZVHwb@+v!;29ZGZz(qq{j!-y+kv%UyXp(Bg(h3meb!ILskh0X_i zxs9Xb+=tVo5~U!_AM!KcEJE}k2D-LRix)l!gV=7^rzg;O2L0H$w{PJ|o@@*K9pkD= zw)&+i&Gyj|BmtLAr?iY+2?EP?;*PUbffN<{P>UZ44cm`kTHlGfGn-d`nKfyzDqeFy z=oFdQYy|GrOh?YuT7cRtGz|K%qa`)?mE(Y+H8sgiiJ{S8^X|Cc;OP@;}Mk z9Y_~>?n%`g3P@2!rmoE9M85uANNpg;bflkesVH^@rqj2S*D_$YZkMa|$>yc`)@$Z- z<>Bu)Lu;*1Lz^vI{qa^0$7Mb~9AtR@38U^M&>Dh&6gI$ky@z|HJyA|1Srz}Y_V4o8 zkUkkl04-v&hH#AHgTILSwcnxv+cQkNj8Bqc#xIRBN+HmXX>)^5j^|$D;_$KG|A>-s z3kX>_zW3r+T~!6gFAcyp@73AmA^%}?LXKiH77n470+;M(%Uv*HqUuDl#h^?sU+sh z@_$4p@_Dt{RPG^3=-m1%(+LBn^_RG(s8OqFo<2I~sWK2|R{Nrp0O!;wk(jNQ@qYQDIX>vKf`ZZjwRirPQdF4npR8^krb6783z z2V)MGtS@3L=MDVL(&pR!KDEYO780^9O{lI(L=MNSQ>|fuc)LSDG>x4I^TFZQ&n#zN z@_@=0qcO?caq(xB-ZPXe)kM0S@Z?pfNstVePdim)NQrFlNF0R)_C#cBMCfKw>HXYV ziQKLVnDt)cEgAkhlx?8Hyu5zz)~rY@p)}x9xBI|v4!5P_?TaC!N6yX4zTbep)gxO# zUC%^B>ks`S=Xp6l(*vOGOcf`=3J`dId*&E-3qEh6eSy5@0BGn%-skLkHFQjTJ{SP_ zb9x*AGhcF;4LApjrF8TCKTN%4LmbhzwcB_I?(PuWgS)%CySux)y9EjEE)4_^?vg-| zU;%Lce-{e74rhW=J%TzIclx^f_w<3lTDDV0ok*|tc8OLw`tDJ+;E z$B1aYKZDanhDC^zGQGTn+A?}OBv`+6bxI)~9Mb)}!DszteG^^{q4A&TfQ()vbVb{=uo~=-X|AC$ZpGq+*0Rxg~2Qcfe(t!V;D3Oi} z`Pvn1wMzCI5Do4EY1}21j`N;G0_AP5k55DADzvG+ibv@$@M8D__KWueR@!?w-8Qha9QHQ<-;Q1*bN3ky1GgnHBH`1!=k=W@+I99#4rn}* zBv|=22I1R~{O<@en5T)V_QmN^)go9dMH*!^ePo(01R)gKd}1J{$&Z#wQszU?3O=zX`l7I1+J$HUeAd+|7?w%fgd#) zKs`A6kepojgEf^@PR`riqt@QPEGqcP5n=qDNB~%69W?g7oO=eId%7DN`D+8RBmj}- znUe3hDg#v8ii7-~2@qj7?~L{3>I3)yY>KMJK0xfYVf8I70MhY+zZCL$HGm4OX7)zN zh;X41V^v?>Wut+?`PMVAz0d`0^BONAb3sw<8hn~b|M$+%N25W4Z04I)9#6;*PcZs< zc~S;`Ua8>VVkw8ay64sJ(a%!FN2gcUrz{P6o1rEhOqPxh#gtF24KolYRu`~T5+iNx z@GkphMua7JP#SJ-k>?2qYy%9-Xt%Q=4rTdrD2ES%BNjaMQAd-@Z*hwP6;PHGfj93* zv+CX{-euUU#|SnVhK;9|TZn+|KVMw<`HS{`c>mp=>_G1F5u2`@Z5wcDbkxWx2f_w? z8+L?a+}NeO9O~_~L=)apxT>-#a3jH<$^CD#j~2p$oO4g^=!TWs@ln<(%g}`Q-Pgt7 zk}9TQ|tn!ic#Wa%^fn;AJ;gm*PmY69bZ9sSk zXM9RbvBUlnP3kF2Ik-gq5dxb!WBkD+w>Iq`rOc1ySb5R!Y>S{nC1daLL%(s`8b;=Q z{cF+_C)FMS%6CMIeb>6D>#Ts+_>vydFJ66uxW7DWtbBNo29P0E1wNASA72w#2t9tP zu$g=hXJX|9sA5}va5NAdgUEc9JtBe37hP2XP<>pu%e^RomjJ68PYv>aFaSpY1uz}R z5kH;h>qk;`(A0)`XlZDSzZdb~PK_>|UH~N|>g&ZV5WAlQDo7pBjEn{;Tl)I$^AdDr z@3zhA3BaS;r2kE`w)OuWfdDibM@Tk$+6*%?ZY4_o&l{y7vA0cogeln&E8jhs1^*?5 zYs+D;P!16K{2i@Gg)lC*j!P~@KK}GCTu&$PVb33|$nBW;dS_7x@)Pf2l?Sda%uc9j=&BQ5@nrsn47+6##SD0 zqa%~P(K0a<&iL=;d!wtD?<;6_QwW$)xx|}N3UesQHryDeEMwxSZnT80J7e9vS(UI^ zzO&>^3DKn1Ps+4^|9(WP7DWzasYZczR<&o*{LL;jsk+DyajEbXC#%%ESwI#)^1uUM z3OY6U43zUFdMFHO#O_RJynVzWWQaGS1FhsKg##$70bXur?#-tq(mH1U|TxHRTl ze}95wI8bIvJ<$W4Bb+B-m*mFfVTry7?&!oTN6$)PhJXHQavNjiNtF;-M&?0FChb?a z0dqyLdl3N6YSYvaK_>BIEH$lkEr@gN|y$7tLge5}hXeeKo3YMJ(w$|QB!X`7B=Kd`We=+`38UH2 z6BKQk$bgK0h+2=}@i=BF!H=2wk2u}e1qz2!vYI3P&Z&)82rdP9-nZg7=bhe`7ePv| zCs%f+w_;CIflp99RonyY?5l*C$+ZwgAAV02;>ns3GS5HRhd;+8$y~6r zD{U8v-?AKsI`G_Hbiz?a&5OLz3a49u@M7;GQRz!t+mddL3eOkZdqAhY3)It8{4Crr zS%A_<26^$fR{(E>bDSMFLkiR%>LhQlCEqLT&9|#|`^CBRS~@zkQ(X(P^m`jTouYLe zq}vw&7l*xJ=)FJ6xs!?A2iz}E5~l=b7uPG4NZz?a*Xzk~`cp8IK>(ZKG0}pvx*VBA zP@ifpmrl}eQLS8Fg&@c%=%o!^Ag=_CLUK%!z~QGlTHJB*hx_x7y>~zb)bV|~7j6mb zJ=>c2;h8`HDCX@&QzRyPEa^z)UOT|ezVfwGJpR-t2n-N)bq5Chi#q@`qTw09t7l1( z1hfvaP%!axD}9D<0@NfEfNLbL1z|=1jdA1ug`2UH-Ycc82x7(L^qzn-57@gl@7=CV z0NdTxdo&$e6>=7*4W;Jk3x_>MT)iYoSwIoS8uOZJY)Er*3(K zkrt&_!z<;FsBhAxbUG8w-0JtZ79tp_YU;(w4+eS%%zPtHCsO2xBP1o_R<%=$F-qz+ zFSCs#k4YXO?g_3ZwZR?SsTm$x>gv`6#7aV%oI4FN>1+*JGI!=wS2VrSRvX5~1e6}M zGBUZDloELUYlVVsiqu%+f_(8gqX{c}R4Fn9nd#dwI|@xAWix$f~xQs;i= zJz1su^D7XZF?uI_*OgH1NndMeY1zG;n5pgBlpw>9e^M%_RaFv<-7#`#TMVx*mJ1`1 zAz5{!N2FAE1Iqbh00u`dJKZa2)uuv5&G1kraY03$#rf3r@vveNh|ks>wGDg@Qh-cV z)e!nsKkKx=AQimH2N0sufKInb=Rk*t$eCvq^Yb03566FtL!%aeV;tpuY*L~hIgkH- zZndc;Yj^q5PXh6JKPp7mIorC0>%G2|4SQT-bq1B#D?7f_)cOn;a-3-`NE*J*hU5lTt(GtqB8)c1cR1MV5V3 z6Rm_eGj{|lAr>Os3&m0!2q{fBi%gOizY_&FL5C&62e#VJVON`+WX-PfSd> z|1K~_N=)+MUt*Z-u8s1^{u-`eKy)gXO6l%aj2>g1YgSc#R77dTk9^~3Jied#px%~i zMTjU5)a7zQZswc?xoG&^_$f0Ul)3HmcP;V$W~dUS7ZmG#6y)6SsqqcDppQi;4KQ?4D@>dF2cW`tx--&ve63ne^J5v8wM1% z>&yOrcY4H8k>tDq%Vd>Y$8_RibrTlg+lj*X=_-`cN^auc`4)h?Qh}4D zY3d1BbB_ZN=+n5B&NzzxbI>Y!sjZ72>`U(qXTOyT@V&>BMP4Xc35I}jN9w;$UR z`wtyAs+4s{_JY1RjMNW-dLE^aPF0VS6GYQ_Y38B4qiL=+%sxk&;mVHrducJN@S@(3qTc%MP!cE4 z#hYo>gcuDuBMPCg*uob+I!Q~z(w~aX@jMOJtngABDb?1WB}hFg&27OXvf$#`lXeO$ z+LR+s37dS3YW=i(2CdMh;$l@9Wg;ki%?$t60?p`oMo&b6&r@P9Z$Np$9-BAx5P zixPug$NMsVB&`vo7GWI}t07dlyaENakDg6}+Mf**Cq;p8kMmYP)e(-s2-}6zSAYZ> z{=I)c#@tVB8>n5TAuxA0R+VB8GfsD9oPYfvL`idA&{rWG%b7e{CBX-CCW1Fdpo=Zk zW2F0h?`X~R?q*X6Y`=eQ{WaS38SB}1xI*Q-!$PUdtLAK;ShcSjhv1!~=*Mwggmoy0 zRStojc=l_atMj*8T%NB|g2&Gxai;>ns>5ChUbv5A-ep< zIdz!Po{l~@qtS)D6|j*K0Hvd4^E_GpefO~N)6U|5vy35Uk-{of#>~2TDP*JuAX8!H zhXDn|Swx-Gf%RppdGals_yJ_qRaRPhWMcB5#~=Ti0r0ilO>#yUUZcv+Z$1s}Pr&>t z{`a5!IAM|w)-s&o8RVPfOEvfo*kotQCgH-Wc3b|z0>YBgLS99Pkc<$q9Mo|sZafuB zq`|%DA0`VaG;y=?_?+uF-IkMLTFJUjkpJRBIqW*=WeT|=qTK)VAEAk~` z4z~F?#q?`VN*nFK)UC8oDouDE$r1U(hn2|_QzAw(;`E}W2F4PFjY8`5ilOHpmJ~IE zBP3QtP@@nF%DJLX_OiKy99+bd7&)-9sHX=N;wh4;pYubYi#>4;Ol!lL;hlcda=*xs zDM1~Jl9Z52AKFVD|EPk%rja7_*+v~CEWuKTX9%$hCGJ&085iHBa6ymD*m0g^7Vu@y zN4B~TH0w?s^wyl?_!-_?-J^D$D?D&!6YZv>g{K0wgy(W%RCzB|NZsi6B;k^91}n4TTZ`js?{Re*g;qq{jmU zUtj79vh-$nmcId$WRKpk7+{_>n8dM@VSKRO)$R|-0&I=WfEpl@r5e0YHA8*l_m4jR z26EpE`Z8+RLevJYK+L|{_j8#GpehZZlCJV4q=ck7eFuGU;p;U97y_=w9v|^dAWZ3o zYz>@0zk@^XS{Y^Z5`bnkyySkpQ{;4eW+bp={%cY8k%ubN#wj%fOj?CMYvyv5q7}2A zP6_$ycL)4Iw7TL3`eML@%E>=13Hto^0Xd zEV0HzA(a@4b}J;3U_l)*%7`x0-62sTiS6&4ww#WMBv6VyXqu!NO`EFBA0|g3P!NJ7 zR#w}LV2rNUij)&C0@;MPYX(KRabON>juBJg%uTz;khHKh;QVPHhR>bdY934R9m z5!RFq@q7|b`i<5F&PFo%Ys?sbOz?;4(jC%A;p$XWq%iHcUq#5=$|7%bwATB8xg2F4Ny)-0*=ha4#Yku*cvS zXtt~5$!E~E@L>|KqtAX$+2F9j$o%l-@4I$QZ0^U0QHG)OBBU}A7Pu!xle;7mXSP6&9mLAXYpun-%M(w7dAah7DY^Fr0}Gw$g}rZL+>t^;qe=_hNNqO^q0~*Gfw%mJ7d!*^r_>kPb#0TphYE?PK_>YHZhFujE_p3aCV58#vs3ZX)~XXlBwbHDlhsxrkQTG z53O;BBir5iY4HiFH++bqxT=XJc_n1a@z6eBsv1&|H1TNejDqs)!LPBT)FRE6mGwla zE<3N~;Qfzf_8-sZT@a`uLE}xLe2IVn!h-k#mv8|!SD;EN?f`pB=) z-1|N;$IkXW0^Jq2xNpW2$z)=o?fITWlykpLf1z0r9+QX0xZv7Bi{pm>TgV{&;HN3u zO3sv#9D9OMomNo9mS?sAx8S0oJjn>Bj)tl`UfoezEo_@{m+swxE~WbiixkptDfnQj zKSc(2A9dyel<>_4oeA3w!AWVN32>i<+Q(~(l6`~wFt?$hx>3`9eWpPLMQ^&$P%Lsf zK0NUx3pLhBIW~?dQ4t2^eHrPzgr*yd_$JbU6&UgXF4e6u_x+)s4MC%C?=7kkl4^GjSmhZQd zbjC{Pa95g|x8FyaaR`^MQ#c~8GyEF(bOO7MHAz3?eCs2&_XjSiifsroN&gTHKdL*O zl$fIxs%04$mYS%grVj8&5xPoWXcA%XNwi)~zdoHa16H(Yy9l~J(=dWv1C2lnX)ik6 z*k8{;tu5a+S8#6RlfWb#lm`8wz#5$F+K-1Hf4&1Zocye3;3Qzf$J~2wYS_K*t^j@C zGki{5{pTtQ1iR5LW!z(*bZc~Y9c{S!U|=c|K2!5fvux{HMcWL^L-^8L2#;j=)Y;Ve zU$wAuG#0Fra+juMWQoED3EuohZ^-6GIp9Scp_1>~plCvRB$+g0vMfII5%Z;R)F#z> z#b~0)R4(IyX0f6qD#vzHY>_VV1 zk2R0%xC&jfA@SFoZ*A) zTV}-Z(bWr(kB_dTU@lgccn8Wv$Zoj8cylD%VSXOjal^lShFT-djhrQ=znLO<_=leh zaKn6^ef~(TT;q`2Aqv01SH_6x&b_RjV~(PQ2s>>mQ%6yj$+_jSdYD3)W>im7k`uXn zxN(ezYmTzXtE!i`A&(-VvCS}b-Ysj0WAuhhvx4RIyig5N?@Ii1%x#*(9I)57DY?7z zg)Y7c=P&3g_+H+&_d1C=JwGyYTsQ}zY7W*0WFpg*mBV1jKtidwVsx8p`^%OY<20EY z1`vZ1GRWQ7PjN1`9{!9JH~X+qd)=r&tIew|JIG17tJk(kska`YN|RS~Dkri@Muvco z=MhFYjH{NMtiYiztAskoW#AiM+k0e;=Y=;$@N-%)`2d&G9_pQvW?quOxtmsTvnF*2 zP+sX8}+?gPO2+(7cr$pz$5lg(fQ-m+i!t4VwokF#jLPj5qmfl zfd<*_b!RfEusvpK3!kNbD;DtUgl@Fwd=)}vU{d~*plUrJJU+t+UKWiRd*@Sou8!vr z!~bnMt`7nAnE{MW#`lr-!G3n`{NB@+X~F%f4d~p z>d)svZ)&tZfg~y6=AgbotI?Le8e2X-GbP2#m(myA)-V5e{aKJO{zrebK$LaU9Y-n* z={l3g!;9Y+eI56BbabRhTt?yT?jUywj}w?b$-Y#&Oyj(b5DHHK%ce$)>Leg4G~Ob_ zz{Os z2_=A2`L$zGcLB!}xyU%)8`ZIuDBAzWe#LH}wL$%o5Y?pAejy=$1U12&Kg{Q-qD!Ra zqn2}u%cGMJ*D+4JVn^OWk)U}sbe+4tdAW_3KhzJE;CB1gjkgvrVvwi0#Z%B7_;e*T zTs;+u5<--wNDd=esgyQ4lm_rUt7BqfiaeuY?W&<6d^f^`hL%9XES1SJgoH><2GNFp zR^=SO?YVh-o;g|hy>2fmeb(G%qR8e2++-hTPV(Fed^YaZHxlvjG@h!+C~hsLi1ivr z&T{`XpK^Ck@i=V@@w5H@Vh4~INc4^-UBb36DG z%-t_k#a5&Aa7XNnUN|oVCx825nq+5)#a6$=X`nZs+JvJAZU?UPb&Kin&Ju=nMy0Ax zzZGcLf`$Y%ImAh8`c(-}L6}d%PI+piaM{)QpEqyljq!ZTKLu0TxUi(9YPph*#Xo+3 z8LdK|g%tjDs0LZBCbL-a3TX}7Pb+M>pm1t22mF@tz)7D~^?*Lmp1jFQ7j6yO1QkwNoxfk4+}r_g}RG~k~;Q*yZ2 z8UV(ZQ62?%O9KFq-pc6h@z?q$u?IhJR0KP3ixLRVJE_Ou#8s9~b8VPVd z^+DAsTj>zBUqGXcrn-&uvm4i;#$Y5?3&Zs0B47# zU2Yq<$*Cz5*fMpgwtKot($2xDMcpp9r@3;v{AWUwLzKqKP|-x6MnnQW=NNeD-xQUD zrdIFrLLI$>yH8aDk*y^X4nAjwRWI4Mg~ZWf-cJP95_yD zd{|PiU-5&9_4MfIu&oq>9ZG~ZId4jI^*R$sRBd*mG*>Q;@N2Nf))thVP9dS!7F;DL zK-?7j%=RmZ)A@1RUlw7xW%KKq_8{bkdP~BbU{uRt1i@`od(S27t7|`T#!6f@Oa30- zmen;CNt|SBF8(^3C?tGDOD_rZN>|{QSH7)h!b;azQOsmvxjCd+?43vyux~yQ4cr`w zPgcVq#E+rsGF^1#yX`PL1z6GOtpttE&!Q{vtj~BX=)s-YB;5(^&mCu@*;F**{dQO7 zu)#OajlKH~d{6&?i107IW|q_0hQ23OVd?^Kz}CyQ#=zknATilxUKxtPKuWqg$HvWa zMs5WJHNe@?%VHoMVK9>n;*8JsxzU_8XYOT%*_~PCCTg#@7X>b&-l;HiKV$%?Wd2$y zjF_L^?EETpE7@n9J6IYB1YZ2w3O20$v@K~ulp%|tMd8EIz56IpA(PLuN(X&8WgsgD zI5;>uy93cCiPxkah$XqIE+8$wU%7)YVfwXHjlaSTEJIb64GZsfXy{JR?+KSS2jnn1 z8Q8jIam9tu2rJow@fgjGhfnzflLh`Ip0Ip#g~3&g46e8LtKn$fwO{(;y5_VWqZ)-> zO?AG~8Lb_p`jQ#hy0@ziW9_uy*>?M9?UW9Rv~FO*Apw$@pta25;V6CDuBN$3Pm7-M zsJGh46AfdvuhTigVnfG%xQ=n@H&efyqDyV1M6TFEx+Wv0Su<@;qpyt-!lqjxc|UHU z8Ay=s>lqrON(~nE>?Y)bs;P|YdJ|>_HVeuUDRI%i86-WFNYcyeJNy*xCT>k~VPZtl zkmgg>EJamKV(-Hck#Tye!px^RrpAnY>aZW!ZKD~BKB%ok{mHKV+&iNDX7-Q|#ev7% zI4eJW2(3u8{$z75WQ~0??*#p2Tk#qCYbK5;2``*Gkxp2QS$n1K*To^T-d5MC;UFR* z(5MIR2jk%}<1&-x%t@otnN{3T52Uy}Lb`p`-IH$AC`Y-P;qbHcQC7QVUSEEluP|Xq z!WU}dmr3bc6+9sEz5WrK?du@zbs<{O5AFwe151t<(@)hlrIT*>?7}S zAFItqNqs}I3%{_U0uWuq$i(>1 zJMsOAgl&cv#X1S`zY_#GSg|G~utBEr38f6aswgNZ^d$?k(Kbw+PD2huFUUmbU_<1% z@XmekBrL>BQ#El=eaWE6a!=!zsjwHf1yAdD)H!hJgW)rns2fJZ^V=s@jn+nW)OJ*P z3T%`&IPDb1*Iet@H)hmza=SH@a1qgAf}^DDgINpt|9~o{1V5A8-dRSiHFLB$43YZG zYko=Z7KUo&Xlv8UA#99Kal`9e@pMR#Y}&+a;oF#5&R!;P9Sa>i$m0M5|A*9d(Hm;& zEmksuOxJJ+i#j=m)!&7@dog$~4iE_vM^@@DP!|)iMA@2wGjY8374VW6xKY(@x3&$* zY+gbTJCJ%As-DTy80QixA9hN=TuzWo6<*FM(sa#&tNDGMiwO-p9QK+mEJC-t5aD<-Yd`WzF8Oinh|pbsipS-5sr(pfQ1U1-m$bu0oV zS92pz_%}JfxfS~5N!>T~yJa$$r#r^YX7)ah{Pmm7L))(fVk@!Fqo?gFAy3TBeJ?Lg zianTkSibXn_yn)lvCzOV(0;yHBHzLb?v|H%muR5hYpq` z^4jKiBqU^WIT>b^0uB{}EH_1E4a0BlHdg!r!-jvJuo8Lx;*QFWPQjTxULW29%_tra zYadcBWb8uH`&McOd0hg>pf%B949CcS9zxUav`s5eWBVT{4Rmq?#6o|wPzhgLrHOhD zW{tO80n%TALcCn* z|FFglm#I=j@Spw|Y@a!LQa7TfQ6($_Vf@%YiYmL6y~O~Rj>cZB+KkuRGHt**DTx%T z*U4|w{%N(Yt!;fnx1ceWj89v~Cm}n@^a&ox?ILf&d%F#rugWzcLoe?1Gr!H-^BrJe z@eLVXrLWZ}Xp?J!>_NBSw15siw)GjWPdObAhx*fx8FB_XI`GnU6}cf)S~zS4DOS-? z8$XU?a6x$N^-GeuA__}mU|@8hdRXn^pwTNw7ub`3g2Jx+lRZ~b4!=e-;sM7j+xz7n zXOf`(qq8fhBd!ccdXtf=A1xw-us%rh>63>Ph2Ev-;V%+15)Z+6+|A#JgNhIw8`Nb< zFo{mu7L;{daVRY5PJgIMo_?Q~7u^_xY5jQfmxinRO(dr3M)d8L9T#9tOrY!q#Gl?6qfO_n=Urm{!9l%?e)ljSF|azbVp zZ;!PG|JL{HV6S4;mg` z`d)9CgAQ)f2mGu8Ac7s#a8r-zQ6fpezb?g;K;~XI#~4cd^8yVI558Bpq;MApiF{`V zwSVK;XPm*${zDsn=MDg$@vh?Brw_RP@#+N#J4UNUmTJ>Z_IM4&A8XO?f5d|F%R~7nryu z78-R`9h{Li`X&MT6{Sgn5p>lMpt#6Lxgecx}mDOYVwzm|v!1>LyGl9tlEUou*b?A&f)#@lO z??POeJ`*b6e4ehV5eP2(_^GVQ{yfjfG0jyoa&-GOWG~UIzm*S?UGZbk>Ke`BTCKda zKz5jJ^-UwC$0PPQJyz-_6b zdJBX;k@i~b#Mc7WpKUR4!5RXmXe)ox`AZ<_`#gUOa+cN(1zsNW)ydTA^S7Ag+HVF3 znsaTsrUj@g+CslnzXi9O9L%Cu*3=v?@DqZ!PW=Nm8X?|Zf#=A5yk(N9%bn-^G!6Kz zO=~+lJ{o6#$0MIHcfFLeAa!9j!czwqJb-oq|Lta3x@a3b%5reBzx2gG62dG0Zxlp$ z=S^?sO@J0PGXOst(VLY%K5`F=PN;&MV!i(c7g_qKMK7=%-Q&n_1`xXr|4uVuHkbWo zC!u*OA$h3`_=EBFLSv-?xtA&o`WPI;NkA91tbIA4bltvUNkFm~ zx%&GtFCm#nQavnS zImrAw(`*7-i)$wmq&0d=eNWk9rlr*CzmjT3@}y~GZp`KTrK8f9m%gi$wb2uMD$!~-|b)g!H*ZQ((A)!O0A(w+=LTR3D%S^`Z{By$zQ7Qg+mZTWH0nmM1g zPxHU(SLSU!m!~~($(5BX%3-u6D9SjG^I`qWXBeJ-AHX0F#8v2);tMXn-jA5`8Jmha z^xL&$2Nb(+aMb+tw9PSDL-^4B+PUsz}vLzd0^==VCklm~5%i>d&F+@5DkyONkU#AhJYc?i3&EC}d3?4~h)tx*U;&lfj2hZA>2?Y+ zmW?Rqnp9%?{ja)J*NMa*ojl?EMnQNMG1}a#YAdH6ygn>3HPR||uvV?1LsY=Yhpv-Lxs&H}{oM(KpvQJ-=ZSY<>9_r%_UqOkif#x8 zfQ;^urX9{de12bO8FjoR^5ex5TIF3R0#hS>LwB>BM`OD&;a(J=hx}1R`^YVK@Bw2 zv3@9worc5P2>Ct8@?Wz6WyqNbei1`aJabxi@I8Xu}4lhckonJh8( zGI-Tm>iUNd!D;rQnU%9YzC`NWBo}d(gXM`+AaKm%Rf4yE@8NYl-Kak4yQL%$?3&EQ zFUP8^x%g-FG}2hY#mVGgvb2dJ4uSu$a++MDhJ=UkveE4zK~`b+3H(5&v1yI|S?TbjCJPkl!~^@8g}5&wXe? zpw;q^|v!|Vpz!RMTZH)X!+D(8USGWqt7O zWP?_W5y-;uzDt3(@LbcQI1yXnXzrsyS!FbjyH=D_?L&Rb3aVuNdUdS@NV*h)KFEQCMo@dtF&#so_{{5Oe#vQZ z00n1drN&`tB2h}LuXzHabyag8GqK&KfF~D$hDxn(FqR%8Ss|B}x~a?!HMx%!^oWR| zymY0}n{)!BUAnc{;?D%#w1@8?^HWMo7+?u3asOu{-5E_&xl|{0mck!ege(;pLZuJ!-W1_%#0h>1e zKrnPPgR8xwMXD~ZV&X+&0@qpXBfF#Z_p^>e`=>{rUn>rG-KDKZUxm+v488KFbA@Id zyG}`7Msm`!WPoO7h#XVrP?a$l{IT`?gMaoz-`kT=(CQBHMSOP;){Ma2ZzSw#x7bw| zFG~t}1#JVt3&fI->sk;_%K{L|xgTQ%0VBf*xF}fvaubR`mca1X4<7pbHrfOdVqe~$ z`_IFtf;#1aESUS~9<6Re3@HN>nr`TOg7Aa@fQ`c^rSe*U{q57nV7F37!z(e)x5UQo z5bBT%9bE4_274EpklytE%+EL!SqQkJ6zgE>y)?Co_*dRDoY5?5p%H)J7LzN83<7bTdQaOPlk zIhb24*iOR6(b9OBhv=heM})$~WxzJ3CZk==lPjpUDSqU|RAZ(?RSp2|U8gCoDKXlS z+;Tj=u^<_Y`$~G0?w-|G_PPPh&zuLoRj2&TQ-VPks5MO3rPUnzl7$v2<}GU%_)nu9 z@SHb$JmAfA%a8^INPC!7n|ZInZkgK^DC)5mFMW?{1JPqwNPZV}b~lN%_1E9Bepf`@ z@i;5Vv2;&A1zFeBst@!`x=B(?`gv$u5I&Z&4-_M7nz2=JBFs(m2s3y5?dR1!3l`}g z5RO=FAyp|s2KDzVQW%rHP&)SsAh3b3Aefli1gF2 z(|L3HnMI1dyWsN$#Z2!qP%J#s)~ny%R_aRw#Vr9_uisVvy#OecU{R2tA1JByozHjO zNMg+~qRp=O!NU=I7ry+#>1z}Kb_n_Q@5RIQmJ{aWOu<_X?vuvB-RqiF<&s+nK9@0P zGpLz-5c}og=C3Rq4u@rB6I^cetp_V6$QG;?mb0G8LXG~deNGl)Ctwt}lVf_~-4Nsl zW4{1bPLrJsG^Q+*NXR+0J}}_o^(pZlQod843|t2MS)enxw7^gteQ$c_y(E<{@M}cx z00!si;awY41&^=+cvD_X)sMxite zecy&=!?qjf|8$`UhHl!A@@3i55I<^2$j!pfj)+SU}VL9GcWxs2LR?=}q? z_+6kVrm-`K23a9dTFM6PC9WoKU0*agO^!>En6UU%Y6r6W%W4Y+`oZ>trfU_pA?x~^ z)(z8kt?Q%X^Re}VIK5Hy}d+LS?To6A^AnJ0}35aWRUSqC>oVdBilWa$}wh9g9Z>N8e0?I`;nfoj)$ zgcCKsA1Xgf*l&O68MWh-3)w`e^V_Y(RKbxs-{$@E{1;1c`o|31E@F|I1qFim7i<5v z4LN40w7fB`P)$wkabCLK-ntaIq`4-z_OtpN(jy}kWbJ+YL++&EPN}WO?QSJ-9*eGM zS`!|+XLnI)Z9a<7xPqAN`#3{XT4CPL{!T3s&-O7WzUwrRVzRsr9R3XMa)hI6ympxQ z5kQ6I!g|LGvH~$caTZ?&dsf3ve9%rD5KT3^kqv$X4Nabk1vA>Z>~?6RO8-g z(g`kCg-A=4K!gCHv!uDV@>Kg`j3qu%S~^I2lCr|+q$ldeK@(wVSB*~Ht_8t$9X&oV zuFyz2NS$Xf8Q7xmUjSEr-tpcbAt0`IQX6k&J`|0Xzb`;^!sG_U+OlMhRc~+Q`HrceTz1A^rF0jhcW{OGW;_v4$>vWiBa; zwKt-_S(B{Qoy*7K`7PABsoveM+bBWSBu~quyvOh;u#wQ-Ry*_eK&RIY>2HtzLBAge zm4Kl7-9=5mk;E8LPtV{~2i=k7jq~m_%x~e`XbFFQ=wJPLeoE7axRDPyH|qip<&1ot zBEqZMY2Yv9?;ZM>UmfF)^p!HH3O^aiya)c=bFE20Oz)OLo64AzZzvf z2^Q4nv_Mem8AO*ZgYT2v1^AH-67OL@6qWH@T@p3jtW4r3b0-Pf69fI0VnKF^Di@RD zYU1L}?e)~6=jE$#fa#wYtq+e{`iP!W9 z07uT1)d~hCXLcMCO4zR}iVAY4F~dJj%COc}M9fMJ>6lkm64|Qhhd-(Mt?jmT=^yB* z+D};RYppd!Z5`%<5w6p@T#Ec|heFfW-+u0Ry6;hF>Ma63&S|$mQ zG{uylG@&?X)$m_KGcTJecwWa8V8SaS<;{aW9sLf8IZC%v>NkW@wrqm5&VGw`MUG>2 zHpk%a>SgE`T^IqmY7p8$ESa#OYdgbUil6d=xZ|Kx8!srC?`SVlkve1upw^N^fE`4} z6+zXK)FHrYl-DVTsNDOdXQadO zqFJjwKYqL8Zzh5~yP;#WLV)qU6t?;`QvuWe_On88Pl?O-&2aZF?d$Wxp5Os`sEO?;kIWc~E_`;#+`5VDJi=+dt(v{uO1S7QxL6Y*X=tvUD`I%eb z@BpPC3V*8>zeF2Rm5LS=8_f@o{DUDJPLXEGbuhlUU z;)TItN#2?H34*sEEtWNC$ZxlIy--W-m_U$oYFxv3K6EYH8>l7TgaE&UK3`UhN$IU3Y@6NRvzZ^esC zt#n4>o}^{yii_cwrrKG}TvgH0{mYAtXnN@z6P`qTd4IbY={n2R&nMkBz)j$Oa20J+ z^FW)Xs(v*kqiJNhL&~K?yZ<)uZ=NpHMG>OvS z5@L}cU}MrcmT9Fv4U#XN=T3tEA~AcTMD5sMGyxY6n~t~uYgk81U6Y%RW~)8aB0@A% zPcaH%EJM4y@8d<9k=Xf{kc8Gqm+nAixG2=HR8|E?$!gJyC`(*!Se6kC=+e--{;WRz zge{91C$^xoO7r?X?%2C$xd!myLwl8(_QJOV(m;q^XAE5lb%b+h%5kSXu%DO$hDqNh zjb8s0aBcpjNaQvpBAqqzYk%=eAt7a6i~K&44tKGfFS61j|EdYlGk%@TZ$E%CK(%e} zX5RdBsg0K&G|<2-?{V$Sor}}Yd3p<9mku9f4tEkMUUY7#Ujq97A5&);Rb{kx?Y&76 z>5`W2E@=d$rMo4hkq)U%gLJomboZvaLqNK_yF0$ean5AVF9!Dx166V(4Xve8Mmp-9XszH`i*`YgR?0}?+9(I;>>K^$K(fHzG_=` z-Gkla1r)5zrH2^qj0m|*q7%@Fjs1)1trguvL6e0Ev+wFKi#&C#(uzAGvmfM~-zx7V z(lWf;6kIb8TkhbW34uONaS ztmx7BSuA(4WlO}{F!W7s}d{G!x;qAcQuDU*dqWe3#DFV34~ zF7y6n;nZBiL$CZk28{Y5tHdkpS~n3z?aG`s*~+dFmv2Y7v3GMGzxIQ`g6M959d7}s z$nDj)pvsyQe!U-KP8EdR*1!EJB4iloP?6$zPGoq=|6lpUjRkY9we!*cc0h!bUvu=f zxza7vTsO50uFG^rbYQ?mEz27}J-A(`3GRn-d;Zvai+*=WA0#$#`1u586}ZYO5m3_4f*~Jpx?F0<|)c-vs>$0+}Jr()7*J3F@o)elKfg3LxU1V%s6#3 zZhb-OCN^8quw(U`1WTu?woic(-ws>{-v{o7BW2jox;M08Md=4WYf;nyo8uGjxKcIYelo9RZGM(E}fbqjZ_oG z4Iq%D8&~)C4(I#CP~MKd5*-cmAXnnZz;n1YCAA5m!|?_4M;K3W5?hSlwC}@CGH-lK zrSTFrOZIpoRTCiS*NRbJETED3j`1Yq$!z9Nb-$Z2W0|vgq_=+BPcz@2*8iU{#HZ0FgQN^jx3j zkU)qxTU*U_|C%Wp;dP8837hpXE}y{tR@_Ywmckt1Vbj?A-F@*;1?L8x^SfWy<`C!! zB>RsfLP!A~ab?pm%-Gv~2W!z5z1r`MBvL(a`YywgID>7y6PFqM+CLQsOVET0LeeQc zg`M0>Uq@*yt(6NGkC*qTay@ zJ3RJvRiFPoeasEj2BioPg>hJ@<>B+2%5+iB3?S8}7l`-v`G39NImoSJ^jwgb$t%^A z>#%l8o=PONNxPt;H}hrEQLzy#=}C6HA>ZUSbsCibx$tH0kLmv^RigXVRM;t_F7REf zUQHN|GM~LyTdr1HrnDy)QeOA~%lbZ`4vQ+;qmX#AfV}@s)l6!EYM`dZ8s%H{g-Hf& z)dZ$*O)t#2GF77O_d4}n97%YgZwr*Y+VhO6?w?@uW|-8jt#gb~L_;Fy2&x#Xq6f(l z9(gg`cM^Hb)pW>2Dm3waItfyZ*QwWb$rZYn8iUdRy zY=6>=bA<=S*up`Hw8-IyDIv{SVxuY1kzlP9k&EyjAO0%Pe+~S`e1Ne#y?wJ!T>_)8asi1z889kJpy~M)(FZSD zBA{+}-tY^tm4T2@L&rl$f^qh3SVF?WB+E!$4NKEtVyU&mSn{~^Y{lwxd&x0yX2%X8 zu%d#-K71PQKjVoP`7Q(6c>uTv7C?AB(PQ)$pkYN+d(EfWyd6fRTBBMMns7>=nw?z) zl4rKac+5_0_p_c4UzR;s|GwcFnki+Q7txu=$x&&8ym_0b4< zTeM}d{hX`a;WKB*<(kP|7DN3dd_PSr!> ziOj(w71Ac(EtqigV>}-an&a>H*x;er+U?J$B{fLq-|7D@fB$vmg#~=V<#T)gZs6?Y z_Vp1L${H`?69alDb%qA@eL2}%{Oc{~>U0@&e~nEbf%Xw;%_O^k)oD+$9&)_D@JNU! zP&BtZ3?t+lPsiFhVDXz6BP-ZO7{a_!Sv0USfjnYVmi@kdFT^TQh_QMuf0We9*mYT^ z1D{bc595P#2lFQUFX;q)*1x`{-xOL`O0U97l_C17P)sbOMzt7~#D!u@2JP07omm;ty{}?Y zOWa_0xX4lehyaL5$1h-yHbUSuJ{K7#b_^KcRoU*$}&x0ICOITW_N*)?@ zs~FW8EH(i^%GwcWgfAWy* zcr6DO7Z`4vkA4za?QnRoEBul+Z>f7%XMX~fua0XqEQKp)=LX|Iwb zv1v=i%XNiMqlfxH?+Q?4VtKpj(@yL-!bZ4S$+`_mfcUt~T?(zAlIqyP`Pg*0Fk8F* zQ=?DQ;M~5Sy{rjttP&rkXuPW(X8{lRQukE0wo-tT*_UBKDDMVdday-4b5ocw(tw8k zWPwYPHJb+!pah0s1o}FVsGkp99~hOct|QM}u6V&{FG7K_IwkB+$**(2+p1gd3T zRhk){l<{1)y6@Duhs4fU8PC;;F&+c%Lf(@fD_@RDCkT|ciT{j6#b#oTC_45(mVCYa z{y2S&RyaQ)nN;dH@6zpf3N#b%gdaK@>`U5JaLeD6Q>-ie$58;aLprnF67-&srkMwr zC?}E6aP850X6K6kq_TeCXEUu){^ym^b=KZmoCs8xrW@*MMoP>u@2Q};^5 zahTSmu-vuYs8)UEwsLQ-W6u0)Odp%tQ33_ZpO`EsjF^Y$v!`)b>XXd=p!1WNe?`U3 z#MQt*&O6^4T2t^j=u%76|hwT$|j8O#NsmF<^=kE zkbhW7dXMLPLkjyfnxvoq&!0aRTdjTCwTM!=W%$Q&v9eaOVH-N>Ilnk9rxuhyM#Q8? zr#P-mmb*RVTe-nY=GT%HaNDIh%@SQ=im;Q7S4*J=E-Wg~EG*^r>iD-5mgozTO)S*2 zcY6`oDavJB)$t_)Y8Q0f{(%yyZf)tRUYX~|7p~<&DhP7 zrlCsu^p7aQ&{p>ZpgdRt$?tlGCgHXye|=d;u^e>E>HK>UAaX4*D= zqUU%$8x`Y-UF=?tVZ$Ucsv~{rM>@kFLac>li$r!rjYivQh&l$>m)`Qmc^EDbcwE() z&XhLF)*NZksHD!m$=%|xGC=fUd3sUFe2DkD${}?g6U|<{0TA@OI?;j5Jd72uvROPU zOwaAJUy;QCkNBJ}lC|_{WHh+3Q9&%ZU4s&YUSmC9?L5@?Z8YnX!{HK(DC-y3QOzwo zN+z^!j3OK){K;BD#ZA*^m^jEwE8YcN?gq*dr}qoale>?BWMSa_>(QbeymUCa%QIk6Yh~qCNwgwKex1P9xuKDy;V+tM!!HsM~jKSg+%;wQ9s z#itA4Na~3f{ff6}3qFe&`L7AFVQRTy)1gELfL;{AlF#^c)@D^I4q)>u!euJrQi-W5 zaH2F?GP2zQbtP}!qhzC7eR<^c$LX|u>MGXkj$*Ve-);P)$!sF_0)-!u?9BS;P6c+V zxZBjG?J5Ubp}zrY0IP+8;Hk#VUG1!18r$^e$M%Ohj^m{ErvxiJSoQb+eE$D@e}>PP z9b%6Fs3lDwoaR{;jxqPj55&Nh-S&jv-XD53-)@StuI=$B_t8J^QRucF3CVkz*0naN zhW8g*qtUP@u5~kjs791{a2eVWJ~*f-m&ifHIs39beQ|?4Yv~%TDe#gOIU{tgtrF+5 zRZQdy#A|T>z~2qbkitfWRO$^Al`Hz*gElXK;P=zUDl>;^Gd;HNG8WLF;1`7VLGW#KYjvP!Z8fJLvS5J?(o)g(kM@@!$5A- zePW;6y&v~YGWI3rOui;2qbbNZC7GW&;6U08VYqR`s+x;Ru|m!zcSvK-g~4p@3mPi) zGAh$(x;HkIHp2o8sn)dUKT$O8mtPoT@^-ULUoNhFi+Oj~_cK1BS7TnC%O76!?Lgeo zc1fQyTf*Piy1t#-2a3aJM!&81i2M=qINHZ(9g`w92#>$bv ze-fr*Wx6VoIGAWE7SI5u`vG-rZK?fzVfQ?|^EGX|I5Czc(cj_-v;M^#xkLBC^$$|5 zVU)`1D!e`4{#ZaM6dDH-D`I$@`)#MV+;Q5sHe`zmu*xHXF z+{W;B>>vz%n$9#sGZTk<6|l9P|N7!f0X}j6?`Avu^v_}IJ$~YrdBc;uW-Eu4$f!lm z(q(kxj9f`-Wo6aedvk5kVdVc856doLI?*xiyTIqmJbq9OsLoDc1D7&Y0a4{zgu00m zL8L24qXNqNeYAdLB?r#rH{^H{KJMPs3RAtkbj5|Kq<-eWfk6R;@D_qa!AuS%>063R zP=h{>_qz0_C%6;kEm%rY17gnjb|$Q#4$7#||G65-Vtkx0b@e{1^e$RM`kOdc^2?PMH&` z<#=QX;ZEY}h2@u+a2kC029-9npel?0BN@Kwhz2I@g;QI`SFPcnAzEsO9KR9c*u*Vk z)HP;Hj*cz4==R&vbu&f$h!2S`)a6*GL|LQgAk#00MQ1Oh$zxAYv8NaA<;tby&so45 z9#^;DH*8)X#XIiGd>JIzvf$4*d&k8)g0Xm)K!tb7Ou7lD&ff?u6sEBlNDwCgQHn1^t5 za^ykJm$vP zmMd2`IjLwMtvxg2>0-5;+xFLGaCAIzNjmg@N_*&<-NfQeU2Ch=F<?cqm%k+nj!ZkWqWtIFEHkkS#d*^oMXp27k&q{HJMx_l;1lu z`^LORgXVZeV|GAd)6jyK(+X||qLl@?jw_``{QQs=6pjl`oEPH&eAmcm^x$QuyvthfC@NDhGO{;_$D6dZe(c#fPFb0>9qWQG|NGE4lsT9 z4(V#%BMYsU!)%nO86aCO5#0fI(z^1)-mI?xXs%We7>%lHXqe3zQF$KftXA(&7AyiA zz>6Q~NAeHQ**hIc;W*Auv#n+`?wiwSf0*{WjddLZJUIs4xJ(4WK(dkBenXreaO#w` z=$gb{!)?6+oxF2Er{&QT+fmbDITT=XYCAh$^YP-c=vxEa&kAt9=)@dANJ<|JT?R_@ zGHQj4t`DYf0H{MFUm}aaiO?vk#3d?fcOsQ9I%KK(#4Pi=Pa*x~VYYn%XveiCy&vcY zV%}{QD*0yX@2ue;mBdT5;!(6zXmA;#bDp zG_{78!OB;`vx5dE;FdDrK$P5|u&^9%IsJ4R^|2bAmnWJckCvbILWt!gvSnxb+z10M&y^sm@f3sZ&AdYUf#5iMiFOHOd-m#W}@=;2)#Cynu+#B z!KOW_0?aR^t%9fUkMn9ciOeKs`_;!LE7cP2>N1rrh^)6S3597r?5tjr}xF&+^+*1I=}UO#x0^)|MCl zNcfgUV=*I2UgeRJ0{?cbundv-38Q&E=+GuyK>x8_4CiQJKN+Gsw$IQ^T{c16{E3|(9jeOSJ*8F3!-`wX8J5fu{neXS1lvE!K0F_){~34K%Kt?&?6d_vTV5AeUv^@@HmyNmQ3u8@ z+DO~4CS=tO3{KNSzY>&=lf5<$2s4WdmR7VsZL=)4xL?lDodBCL;a_(W6xh|}jwp}4 zfHCKo@7%aQl56HAM>6W9<>sGtA`gCV1WovH9w=imxbu4k@S>wpF8v>WJ&%|P8J_~Y zmR+v*8v&Q2{9|qB5#OEqf)Qa2V8}p#nfPn_9+*Xn+Dfhk@H*wQ@bFkRj{-3%pT|-6 zRp|50;uw?wdcIO}Z!{sOC=|zeaCYsiFp0NY_;i5=dYeS|lvCEZmGC(N+nj4XXfTL? ziJLTgjV@HSTbF39Qtg9Is7RllF|v*3Jfl@KM!r$ip|bKJjtNcFER{O5%ktWU5d#in zhSJ4QAj8Q8m%|9D0}}9shKD6}N@HO>76uLW! z&A%VmXnXsxS7;v3CJG|U6J@Hcu`Mrz>8tyMbQ=d!w{3W-ZYT&Qc(;jlg?gaOi4S!P z<0LT$-^*3cOyiD~gw(_ubzzMT&Q2p(wPNk!OQiaQQ zhftJG%}`!ef76G%ZIk#;XG`}pqg35@@xb?iRaHjXmTcq*o2+ashlru31gk?o8Gfrz zQsSC*lk1RIa?amCakvE5PsC!j7%lj(ubga(P(n4dOuq%D*K^8X2$Xw#I5#7JC+N3U zZCv<qvr-7YA9MtJObB;ZlENnDy}POD!`wT#=o*0Q!)bPQf2QX@KWwkYD;UGl{7K$& zQOHC?vu!n6T;$G-8`Wn>TBOCw?HcIpDB~4 zHJZeMJ;@CK0bc)op|BOgh+GwXLl?gAo01hMcI&r<8*g6^B0T!%><8wI(3&V9LRbL| zinOu;3r{mMiTX+?%`fxHgEP6+SuhA~XAJfDG&@9O+l-E)jUzr{z=cU7-!)in=!)tXAZl$mNYY z1WB(zO&pL{K|w(o6~{*X*tkpjFdnSC+~zstxBqreR|Bt7AI$vSxj{p;;qcIfAN{3I_Zk7=mgmDayz%5?agqfsjum3@Z)W)XDX<*0IfeIQg}Q@;(0O9&5#b_coA`S6`UC zI4U*6QQJtL3j0itz6WO+D2Br;)ae^ap5krB50WygPz=L)KtfjDOG`kbug5T&KuJ7+ zR&x4&sSc$*Kf_aGWUUrIYM0~tD($N~UkGBsfG_M{^-msRV2RNAarPl>u*QWC=_8=u z4Cq{oZzMG7Th?)@sq1SoLqCNMrzxcwUAPoY2OaV4l;$^yU)!1!X(;=3CxC-hNsjsa z@jB+uNXP@uCnlZ8HE)X;>N9S-4?Jg(h?Xi9It26Ia_=P1dEvK`vc{$uz*768wu6cOop;R3F`95Xr6mSiWxd`e9c zb3VoKtog{tamnntA3He)5`?MP3ZoV^3kNQQN@}I&3YUnkdK66yY3(qy=KkE(m4M-N zjz;)ix}f@fvhMsqIAP4Y4?7;KkH1hz1l%Z;gQcOANLv;5&|L3U9fN;vy@FrJHRr$! zKN~i0fCKRLJ#Lb|?p1gD1*q+sIssTtSKPx*K8lCE51P$v6sN6iYb#8QIbHYS^bbOhreg*!O4aWbs@f-}1 zZ~f;UoTcDWHTz5^%ReXn`QE9tXFYg+#@H`OuB{YglE|d> z&V7o{5OdeJ4?_u+4z{qem68SPGM&8NB-UiA#LcRclN(GvVwxF}_+5OQTu7S@5#XH4 z&~*~Vqz`}T#^gGetPv=rXV3o}<%pfzwJiL(ppMo!MjV|@%)J)0;oZfKgT+DSY)%)3 zY%M4KMW3X_bW?e=CXS9#LsS&XH94V^Lj+k(AHr^1Yz%ojRpEaFL*yXe{u@T;oFf%0 zgf3~zWmu49ffsMtu!JCOnL|u#E=nB5?^BA=UHn8(|)DoT1k{4so>5%TAkG9tQ)`U!xP2xJO94C895BU#I}HWXBQIL<>*Lw zG_DsUMImO~Fqb56+6=k2kyk48vaOp|hYAsHr)hJ418ExmgB+!4izk1F$Ut0s5!v41 zd|gjleahGSv7dJX93u_KS^lW(s;*>KhFCa?j0Qr<)ta^DF78I8iOWyHE!6NiwT-n#F2dfD!U$XbNex;!=>`mqQo1B{FAxH1_%P0@p3qi?s^oWRP1MY(pR#K#vO~VhE zYE%JP6KN9XUdj7~tIrgMe(pYt!}x}- zAbsOx5P*8>32~Bjvz}3nkAVjw2hnTtn1`)}r3vnM3}p{}Ve2l|qa$?^uSKqqH_}#$(Tzv1dQz0GfBK64&*f^6>kD~6!$Mlknh_lQ%F&K79{zbb7d1aM1 zaJlqo^=#zdsNS~2A&w)dZtCwS@+5L3rFZm)-?$AjsuP1E>8`Ovm}Zn{oMRA4sBF4l zu*QjS3blO`z{y2@#lkSuac4C9nZSU$IsM%vB3MM_98ynwA#MIQUTo$^8a(^Ba}ss5 z0yV|sPnqH84t`#TkP_yb&z2x}x?wg9ca#)geu56Rq%xC+Z$)YABc+l2C zdqj%P)I452C;8*GO~-l{fLJ&di53+Ue$jgR^W7T@Cfdux<1zO}R8Z1u;_go=HUdd0 zw>8Ggo}{pYqj9o59MPXFzYG>q%|plCQRh^eV|{%b2mZYBWd=`P_}R&0FFSaqQLf!k zBxmN>|CGnW=cwX(h6Mi(^tW?1Y!V*^M1I5U)uIp<_Z}n#={=eCBxt{N?r^%Y0P_qg zbc_T>-MZ7RA|8O!QM)^mM1&DPv_eum-{hj_?VtFpTCED*E}}M^X>@xTNEt38abXpy zm0Tr=8_YEtFq`Aq)$+-6-Q$o@biBQywsc+gN`f|TuUmRBy_2s52>f3@Xq9krbMKSX zNP*^%4qzJAtuTD?;-g$KyzcyG55<4?6tRE)O8B-zY&Q8O`{D@J5YGz~4V&!88|p-q zqaYaqSNZcb7a8WBjv-o0z5_>&Z_1BYqQFh#mx!E6*G|Xht$ZK1IMp)CU=dCc*=LPJ zRFQI6sl(_BpMA5Q1OIc$M-CVoFt78@MI-fNei6|T$xhD|oOZ7M5q^F~F|P{>EVrRz zj<*_HYp96DT9Kj-2Po9~=U-n~Q}7LWRxR=I+m|`Lw@DI%x^~Y~F^5SvtW4nNJxYtY zB|$}1&_*#Sj0_#_IUjy?(wa1KcZ{XGc#Losr6Qd#wd1QUOzyg7-c;xFWWFrlq%dS6 zO95kfv*AHvt%(F_dn-BBc><%5!SLGVvtwN-n~;)%Nqz4?VyIs2qh5IZZ! z{P_n@ANLn8;eTrUzp?N`8r*vtxBd;KYb%4t)RkGQ)z(0324}@tfLyyn#0X~$YwUVD zRlg49kg9I-MvrbhW`S047EH^sSzDzn|z-^547A@L&Tm zJ5shdr%~SBxnCY9`%}?Mk3l#{(V;sSAIRj)tw}c+cmHv4j)9_)a`Pkd2N&lGJHNU=P^~2p?G#qvDWhkXmzQ&l zes+4gbG|QDEBVoKGP&_gq-FzSxwbq^(^kM|I1D2}QQ=zR&)&t#O34ZWNeRbHbm_(A zP|t_CJzw8zk4#>*CC{OR6D~fMO?lamOg(w5(HPy^FKfeaFtPNQ3P&f6TXF0*`fgy( z!=wnf+x_lRmal40`2tGDv|7ez38OeIu%nQK4+Bd zVL=aJiToW|HCZIEp!pHZ!bfG*lq)xSldV`&`mTqj_iX@`l$J~}I-@dZf{3<2>XRL( zY?{npgw4OP5J&nX=Gc@hFT@zuj~YS-zkGfbcK1#&PsdE-s*&}$yH}3qSl_r!P$H5P z!j2PogkvkP_*WB&6v7Z;Dc_T~2&>wPTYp}F<0ee_B57@D6c!hX;m~VKvG(B_LD3`{ zFJ&Dc`x0g}?8np+cqd*N}}6S|%K;g;SFXFHRXRd!6c*Y59k~ zisR5-gIVXIg0L`Ycp9&h8kfn;?=Ht#Oj{`bcj>p*glRF>S~602Cw7~TggWZAhjwapq)-rxZxwSNX908f%N?16ia?`=9S_qgX{ZLFR)|D>Ns>Qe&`~{M zF5Gp&I!dW}o^f&bbLu0U>mS+L)0>Zm0HMTDu2fV&Rvma)JXZ+YD=?-uu+kRM-n!bTrn-W+d&5qYo;-LdwBEw6;`E_iQE@2$KQS`a^Y z={AtgVS;)O`#TlTQ+~j4P+0Hq24RFf3;kleHtuYV`f_<|Zd^hs$itkR&fm{K%!)z3 zAR;lT@2!Pp%nMSY7vLLq$Yvl~BzW1LBBj1++okgjeMd5<(UbK<-B4A09K&YBAb@p{ z5*36Q9o^A*itNuq=sx$v<{?T=r>KOg8~yeMGeM*<@jyij{}?IPxwvPDG@i*$(H_!( zpKUGgmFn394+?yN7tscBz=TU5K$erOll0ms8|wqyv8BtL1(nETJ%an!2r2{>)Yh9 zBDoGp!{Myft!#a8w6e!o$ls8s&1%V%XyVb0joL412H$DYz4Kbxe2QS{m9!BlCAhX* z9LJC?H3Hkbn8}}z{wE|eV;VkP8N+R2x|HNAWS&fHMGfk)+jNCi_`9;xTQNEu9vm$3 zr?O>N_z@0r{krUou&1QKugxzwy30azNS-bq*XU1c&AAV8?ds2r6!q(8W4{RO_ zd>`e7Uzqa)6x;B`=e4}z>BaHn@fQEu zDZ}X%C>J{hn5jv_e$+5tHx^#^x+Y6k=gju~V|`OGnL+|5ub5|dV!}3babyTy!e@>o z*1j@%QKtoe(9)*;;hqF9;~de%Evxei<$yVkVLEstYh@9vs;uZ!_Xr_iE9FK!K{ABV zyeOV+k$UzEHrD@r^vt$<&!W45bj1Hj>Vgh6D~3g+X|Mdgg#d@|&=6$EdhY%#o7NhY zsn2qKCiKzaiR(s4A5ZV^3jvMpC0ToWx!g38 zEcy)Ph12~~){bN8vg4on&=%ez0kgWFZzEx~;s`>UxT_R>m1NVcWs04cTKpaZ3F?!G z@Aa?}(Ct+I*qJKhDu0TcI-H#B1?f&r%Y$NX-i)dW#!J3|OhEP_k|!ZkYd<%RaY^H$ z{G|HknXd~KTY;)K^lH2i^TxUIIShWFVMaHj9Q}D~c%nb>@qbdWCIfgSuEpbP=`s@s z%S%Qpckd2yBirXw%RbmX6-{n^_=<|vzuH||v1rx=6-Eyo(}}S)ynl*FQvaHKA2NV3 zZi-VVc;m+_v1>s}YD+O`?5TIwd zqnF#6HGhg0#xTB({j&L|qGkIL1Oc$Rr`A`)E0<;cjc|DGY&4K>A%$_2y%#vey>Y!G zv|}~r_Sf;Hy99~6k>?K|CLgprNr-gl59iws-OO_UzMkIlXMIR6+}5OujyVt6s%>uA-rc8bf&%LR zz_C7WL9vx2CPZ53|Imz>NpfxHvn2S%O{kI*c*05L6W*(!qA}-gf8`eTHbnB0wPpGh zc?r&UJ+_h;Nq))8Jz%&}`c)ML#bMCcGrf~Li~VbJGdbGS)a1%k&Vt#&-cj@hnW&u? zf80gy5=-^wzIr|R>S+FHt=n)nYB?;?b0NT58#OVHPg<*u*#N<-fas#~{)g9n?&UdS za#rW=Zl3-H`W_mTPF6-{D@1~RMMjo)8Fv3!B8_g6gIxOX@UlPsvGeEV3E`MR%)-tC zz2U5$#!i-6e6@OhZE(}P3ib5_;syHCN&!WrF}H;P1IP{wj^5HYPW8n}@+CxdpTog7 z;tPGGmsajIdrrAY^>Q5;$66ebUpYeKau604lQ0!5h6#yp(&LBcq*k0{p{ow_vCn*d zh(as$9;_%7_d&K%SJL_#CHRnB6DPX5N3>_J8McsR7K3U?@HQT8@uTxp05J-um*0 z2ma0`K#^UITKS6+!7`yg{#4AHcdoRy30tE+f0c(6VerXdHqs((=5}Quuqeq5sz*^H zRNNyI+mYL~GOU3Cqo?Z+b;FgUovOqdPogWAT%$~nHeheO&`(WaBLu7?kLAE=2?>O~~ zhjKT8LF0k(FupS|6pN;*4nPVZDf95&28#- z>^o&^s$;$|e3NDE{w9CF5h;}mhW0mRdZMe5NEWfn+~4`7kH@ttCU-82&Jk!T4P609 zSW9i~&u8Svo+-se#D9);ukL!$k8dnOFVheQ1VjcJ5%;D11tm5pS*r+i$&3~T=Ogqt zNTeu<-QAQNpe;~1*eNGUve6091`3MF*@`Z#0^n{Isg zYh~AXYzNP-t$hk_np_-@e-S<>-Vx^dj*qv1*&wK5vOe$-ZWWdE^gvzUcffimeH}8f zspHYXy7Y0#q!Tdx9Na9kZ%i)I10E!oxqYSO%f3tVRj}*gwX1+_ zW55HAx(xj?G_nT&;r;(PVCFs|v7-KVLAjGUJ3WdRZnZCZYW^pzJB6bHNkVvwHZRJ8+hR=MWLaEPhtbFGgeMtAl!`{9I|?F;qb>udgqi zYD4$@(JI`MC#Co-sm!Ml1eXHUU71Zs zEo1Wh$F(Gn8(u6U>AW@lhphET-N9(54#ceI|K!U~hrIBA{+r|G+kV*ec)*ho?hG+I zQhDIo0Q8imsZYOH-^u-xQlu?Y+^3uK5sJ>Ea=^Pv4C&93rG_uADagRym5ssSvfKnT)+a5XB@ zE#<|I@Tn$p*Cl-S@6#A@=VcJqyJzUyg)uONDnm+8qGT z7H^uDcd6GY)s-@8#Od*aLozcRwBJDID+^Powl3+w&)mpAm9qx0`BusfZ9&Id$`-w~ zI8@d*Kf}Ke#8kcIO+oG(kDTGi+skP?lLIGKuH78O1;)~a*;vo4H}bsGX@mQ5`8<`G zhj@r_LjewE1FAzp`1@MGi@-qg7~sirY91}avR^v*t04jamf*&SFGwq4mm9rdC<(Sc zZQ0dNOGG!h--m-HJaEirsy^0{-Fg0^j9F#zVG_<5R?Q-X%m4!5V>u^8XD;gAc}D}5 z;_*kBtlMlW&|sU`jvI`#e{4qrpzkwGJLCkPuO?A|3ILoljK&*PL^-v&ypJd_@c?y0 zIK!ZI8Ss~%w3L^RRw;SV=g0<~nTSYb87Nz6r|M7&q~^~DYHA8i-5BC^7$Dzz(fQW- ze_ErIve{>6i(e?3Dw$0Aw)l0z4Lp#vn9j31Cx-Ug4;W#hm{Eei9n)QZBC|p!;CHc3 zs(s!LNXlL$T6q&@Hn{DYgD2bIg;<C8NA-*l^y7*YV#C3voZ=S?`;Vu&A zQr-A4t-f%`Y3Ls-`t{m9zkY9rX_(z(^ph>r9y;F1BA^wo=XE`O;&r_FR&TaBX?BOG zfS1(9!8*uvGhSY~P|r%v(@>&S@YZESCS5wA&eHo--*z?c%~bLIhXOUo&g*d6$WFz~ zl0UVD{O^_hHg=Zy`Cs}C?W#3w;O})G3u&F)fDgfOAf7(0Q`J}ZXH^()rn66r#uXUf zh)(6vyvh6l&a#Yn&ftk{cJ;`Q@!`HzQJ>Kj*mxl6p9EWcQBfrXBwQt%Dv>WM9*xtx z-ELL@rt;R5*E846oE0E2zs}F2ZYaW2gFLILFLb=yo{VSS1T;GC@^!>pg)0GqU&>dC zzlfOykBw37JE>MjfW}b$4;-Mk0IM1HJOq@IG|IM&CAIgHjR52Q-3em*9*m3|?#sz7 z(#v0$mJ>@1Ek2GJ*K{Ag$;yUV&m=8o2a_CZ#5@A+-4-mv*^K%eQQ$XfE1xu0lmptguV8Tr zq|kjm^1iUpykv75sN>f7-wLX-jF2wqd%!~|SkOo>Xind6>miGje}VN{Y(MjAd#Pr@ zguuVY!61wjtTt3QgQTxMw*3GNXFev;?Yp@@_F`@4=KUb<1~nsCCWj8-^80_%13yMK zfflM$lljMGEeg9!n8U6?dki=1Mc_{@WmG{a3~oD6c`YAjja3JCPK z{djSP<~L5)AxX*x5Pom@`-Mn1P3^mx$MW}q)3aktKEXYA!m z(0O?Um;mRcX);Xm^77#6xft`?WwN5jVVB z+qP}nww=rbjT&3;^m+FF_Mh*#j${7M%zdqUt#h3KnUHVsI)jYEk?6$^)1U64VNpGD zKUZ3N4#6Y>nq(3wd5#E)Y0Mi_2E z*wSfM;L-KGPa+cYnbaWn?RM``e@bX1kzHP4gqL6I6^sp)Y2&PM@y}v??`cIPzVXC0 z$mwozocUl2CaXvAZcglPQqQ0)be4n!t}t4n6L@VY z;8ZoAK!3t)0b;q!yT<)HMNb-|=dV}lIT58_hYrS>RlxJ1#>gWWP?`kc(X~9+y{K!l z7=GQS8u5BqSsPF0zu9^omij<;(Pr&XjQP^cTj)uh)!rT2`qB0-%r~AE<+^#5UQyaD z$SR(Uqoz{crm)~b)bV0m1D>M36VA(cuAt^6FMgRzT6Wa- zde^g~to%Ff!2#h(vL$2>XW#wGQ#dK>O_eOS8;l`LG>)#2Jh?JXe)_=;_upe14}r^N z-ex?N#-fMNNe0etF==uPY8Mb;%a2#^8-W?Os_gQkHvHd2Str`Fqd18e=m(Py@8Dtk z76S3#aYEQw{de+LW9ITH0GxBlhlU0T;?@MmJIu&PUmHS##3>TD&Sk5*DBu>Uk@Yxr zT$d#U2*j;0TssLt*`fl{{uz+Ot&u*As(7V+Ae6w8yo=n6&ati@otw(>6O<-D1QJB< zfC+CjcX!j~{LS?`r7?xpJCO|z^mEpIl+y?T8)o2ff^fgsSa!sOyF&}J$aWRWao@0h znAc}&KR|;NhVx0XY8Zj4q;vWeaF2|phbdLcO-Rwgu$>A(N@A3*ekbxiuSa}fY>BB5 z>qr#Acao1NWZu>pAxL(Un>o#C+GmgDaNmG0=36#;%>gNeh$1l=SlzU6hO50mbPQlw zVayNM8n19dP6KZ{SY`i0FTK+DZfusJ?=)8nG37td16zAvw=cImtiqQ?YR-P15)_Hn z;8u%(JLJs=kX4RT<-Q60fjaAhe5_=O`hxQgwctTKS0YOTrfRz#ZICPIi|gH-ZrNBx zwOSZ!oZO0kWUQztt|OY#n29kj1zAH7<>mm+8))mLiM@SR8a}Eh3UboBXZukjtt94j zkdy*A$@Y^~5_(niYeBft(&hoT(QMir!P?Unn^Ta~#gO-$Soi5Jy`SY&I;*XmFdg&` zD4;^KoJ`NDeY;C^dR33wqY|0MX7H>0Q4q+G3Rr89Gt-4e=PtYZCV7v(Z7X2sc~^Dk zmaOIxYonD{JW7*6I){Dh*;lgwn;CAj-#xL(u1=^h_bWRWN zZv4bey?CP(mL~P(}RFCHu{)cd42#0jN>At2v=@n@UFY7%!0%KB`0jz_heU*iSWs7h{zLbY0^v3 z1HkV2Re33knC0+}Ir=s}?fM_%ZUp`?zh3MW^FqoGG~nUJ$l-m0@_9msVi!S`;@{qy z?4gQvy$&th?=V?Q-W^NdQRJ6D@a^IjlsjqVz~$Y1vMG!fyQ=goqcPMM2sxc&bh$V< zaoUEkVjC?NTk75oVwcP7;zDXXx(ag$oUasJ3^dunaf3D3wJPz^WP>p|r4&29;FRuH zHO}r0=+6@7wHWeyFD}oE8vd%&?hsIHL>w%k>)yUnI1{o~R$qsf3||!%dRHQ%ce@nu zZfbahFmq$F7n+}i2-Ka57*tFw-SN(HU+^PG5{czg=D^yf7cRAAVo=gDH8q~HP0?n= ztjo7civ3f4L)UdEjRBT!mfm&P9UxZxw|IA{WU?|AYviNZucPD>L+CwwV3S<|N1Lz~ zpHQoCXY=Yt3;P}7ZQQ7Xq1byVsF|~Bp(zu>;6mxc&<~1`=Q)&A=Rg|~%@F~Q_m2TH z_K_0cFGMu-j}Xs$VL62eUG{Q2(It)Yh9YXfh?Tq);Nlc=Bg?|noMsr=&j&^@{U&*Q zvFm$!@uYZZi|izi6!?Empj~Oe$Z6}2*Q8^-mD-a2OeT6z$g62C2&_(v&7kY8R^S>F zn<1B|MNd*&5!pDXrDgWh{MJ7T0pY^Gci>$vm-HQruovgrM$z(OhQi|y*X0?8m3`3b%G{#Oh6bTnOs>#7%wf%#_m}5D2g#g)Zd> z_+p1|EMzb;UXk6~$t`25+=c-z55dbD*(}kfuyd zMK3}K-U9%)3w%^RX`(hTlC4g^x2lza@c%sy`w(vdRd2#V%SK6nU^N*qlE67ARR{%? zUL?0Z1&=d}wIl_1GK^SE@SLcVO~6b=M>u9NsxUJQVWl=jsJ&8o4&zg^eunMB85HrU z6|JPFWV}uB5?##D)uzk#T4g4Ibz024OQnp0>7&WYhZ-ywqRu6MM}y*8=0c;de7nDW z?(*(o?#n^DUsQ61ZHNNLjrz_Unas9lfPC`R}SYD5U+A4JXm$RD;qVw?_CWdbLq>Z1A3ZI zCa{0G5adF%bo2Qs7$9c;g2;F!@2DD#17+FueAoXG)1{vg1Cd@707=XyGo8)J5Xe^1 z)e6qcJn3%xgnop1s1eqEJxZ;f^7;kYk`xDn8Ixe+xsxdY&2#Ai)^M_-1kbX@#L3~%I|=imW8}(ZEkd1)vKCmuzA{1sA({#qqCAdA?SO2rDZAz% zu54{mDY}|2UfS5kp^CcKogE^@#&aB0VgSytUXv_31c6QP#2*M z?GGHu;9_>pYL8veq#5@Y`z*s{(e~C+>%UbcMi{(PXSI#S*Qhkds{$wV-gei#BPTm zonTeFF=feEIaL(dm4o!KT8m&4xyVS-BxqsM;@!PSy@hBtjRlgG{(JSP1?dF=O={#O zKStffHh+1iIv+1IyU@6FY?^Bo#bu14rB-i@2U0##f($J*Z z%vyxVJ>=Yi76&g*WEQWYk^U5?Ed_771!IS%z#XB60B=siz@U;c6m(`eP1pC(RaYyL zT?I>?czp)Sm5f>j834Xu)SZxNk7GQ?Y`Fta%ywiGdDw`0(5*@x0Y1h!!wP>6Dd*zg zlA$C)ggoPt%C@gQGN)MxX7QD*k>x0FY6utF^5VtSZ5#b#Vvk){8GkWGX8EBR(YAqf zwKZETX{C-72hOE|e9|BEV8GwepI1!wc$MX?U10or-r}z@5=4vEs~q@xz=+O;id5Qb1FZ zuYhiI9-f(^Ys8EclAw?XwP?TyZDA9`JT@yAI3bwiju0CQY`_v!eur0I9+nYtX6v6M z;<^AKI8D?c^gV3W7pSjvXv9k8atGQNSfS$85|AfW>IPM6 zh7h0PO5k1{x{MOw@y=+IDUII|_R8w+d!c}^^c>@?0^nnYn|0z)Qpuqk$}=mom4(-= zC%C8%3$!xCtw=g;509~cd@5?*!$O(`;^F#sDST#QFtg=_Q(qOr8J_X*7?$adJvxo>fQ8puHFoXw(S1Mi5|In%-0K026M%UsqG@TFh1bS5 zABqX9$`Oc1Fg0g3xt9OVW6*5g!ZaLx>C2|SXLH3ZqPUh^QjZ@hzyL-PnCLY zhQ-@c(iw4{;_rcyPGb{B&y|9hY3$F;Sq5!q-F`V%xHd!HJo6HEq^P!&5;7Lj@#|ob z5Rug&tqsgV(V(m>|Mq2MUPi%ws(~-EA<-ufy1JK2*w?!zHKoCK^2$O!zM2+&U!)LNDL@rgy)aH`BU!7;zEEE9D;&G7}9a!}v28M;)Eh9>mp z<|Yc$5=3nV<~TAewoLg8uv2^d|l-d`^agU$o=KC&?BD;nWz6VdM>-ind%flkgl-9IB3>?QiO zHt4bOs|2IKY1*Ib_tIy{c1i`d(5l}s~W?=ZNnu{Z&w767z9{hSMYj)F>m2k1Z_sgIs!p``;%)*QS!G zT@%mkW=9i8sq^0@-hfsaLib_m*l?qo{sp%tcY<;eYMi4VK|jQ)gBZp`Vus$SaVa=L zWwTutbM`=pFY|@8p})fK?YYp6VL97|4M6< zp9g#>rJQ6Cs0U>*ptA+uZ_D zX3`eX|IRrVg#jbGAmkDLpGxw9qAs}}%K694pWR-ekJsJL0uU|vNav&ajQ=YB28?|G z6S$s2l!%q`ed82%wx4@nS;@5^2YpWIs-CRlckHQ2nJ#7O?VGMYtel+BpA?2<4%N(s z4vv)$QQy0}MWtD8u=0;55Uoh00xat+4a2I7@gl9+wb}WT2wHNTsKHuhtai<+^T zY?t}>xrmV#XgC?IVwY)o@bCWmOObLab`C@B;~eF|Jpnx-bnjh{OIb23wy(F`+^a%* z%&L(BuWTH~x)6Bj=vG!8Yd(X}_MF_}dEU2tv(UPU1cP}I1ef6yKF&*|)` zp0w>I$Y+)mv*F6QKR6%-DT~1t{=X^kqNH#4kd~*XHr%u9(2du+S2H2 z_WAxO<>%)o8Clpo@%DV1$v%@dAEj^d-)H6DCxbNjDENBNkh_ju4us3m)H-#5>*dz~ z46GnbQ}_B-l|Ib7wm$`tbw8FXI8{&=CFG=?K}6AwG2g8YYY@v-FMbj*x3jSU6dlS zV%cp%bc$uVgc^fx701GeEO~2NGIA`ebC2AnXNyKBZlGvAwW$rJd7o^!scnnl%0A0> z@j-SM9=Fq6I)n}eB%cIMr@w4gYdA1lyzft&$z+c0Q{nBq1WI4-{z}7jznxKF!3mybDw*D7#-k)VB)5Mk8Y8aKa(o9Op;;h z3PuI##1{x8ugzGwL1C5V97{Mw@fTLfk9t)BwnS|=Hzei{{qt`Ji%X}DFldDhNMgwV z`G?S>k9V+dU_+l{FO5VTMgafYPgMQuCmIu0DSDbQw7b1HR;qMNgKYNAsSXvhdGpK4 ztZWjk9~@h3PgX5vU8yF7CBupwShgvi@Tu~w)-aw$n^Mt_f1zd`ePJN5ZQ3h*JK#5- zN8fD8ij@`nVAl|fXRN$bnS~;Pwr9-&R1%#Y-%@}=pIByk-e%L99dRTEznZ8HWE_Dx z?hj)D_rEX_9In4)k}Plj_d*6fNP>f$3V04NWvqwd`q;!eEQc=T5y|KY~xjkAJ? zXEE}}&2}dsc$h`=oi_|dfA|{AFjplgBJHRijKMfGKDmk%t7xDFwQeb?*XS$`w656)G0j7f4zka* zF|2B?t4&qLmq$QYW?rF6A9x%=wZx{iFUWcaf??xefyxYIV*J~dj?q^o-EUWOVs&S7 z|C+D?bHf^CRLzLli@+LDRk#R-vLXc|{AfUbrT@@@6Z`<~T8;_h9a@yN!f8h%6WmE` zA6-e=pZuA|syTxc6c;(4t6VBGn3|x?u`gl&5wy?m^YARH|4`{&?>da@tgLz> zbc+!3=CQ~02pARW8JZk>bK5h;W!b7O3;>-zOwcXWH+{W3S-b|(Fo{5^_mi*zjqOn! zt*&P)h-xMBA|O;+eoixcQ70z}yqX*DT5yDiTCzJVcs~yv3{2mMOAmOYhX3vxX zz&-+aq->qmXcX(Zy{%)BWE?dn9rGjUV+ko9E}9pfZq0a%78b2sUVgv}zkWPhMFtse zZ0$Fc`ER)18&v7F&IDx2uDx73QZfc=mI}Z4mHz)Wx1MnHx=m#y0S5Z(h(Tb|Trym7 zmdEYoFeuR?IN%WnuF{t<8%?L#U{W?!A#^TcM7ezu!(4dmb^!946j65C87c619|we~ zIUy7aAA8%ksb6?_%9|;i>_cRzF+>T2^$skv4J58j(3+ZmL6a|620(`hV&OOiy%_lco*Lb9!jQcr8V!Y<9W-w;y9 z6mYl-H{#Iz%!J}#ak)yM$b7ecm({}RC0R8K4;f2mMFOJCREoQdC~9C>y9ds)`=nk6 zN>1!Ne8)(yq#4H@ld@tBt}4%nM%Ji|fF;Tv=D#z6ysl?Eh(M~S(JO(_Oy@FT+Qk3q zf?^=_q`>)RBM09>T&*F~SOJSZso|Atv(k>(0Hn>bCo*&HyJnwK!no`)ie}8byFfF{9|_-mG*p8P+k-6# zl!eL@aSMvLa$DK0i$cAY%2d9rY4+}@lsbqju7cQH*f0dHb1{@BfL3rgEBuAao=Id; z9UUAHWl#lV^)ez9?c1`wDXe0E`tQY|8wi0*)O49V9VAU2gpVu4Ku^yO4B2smItCky znTxn+LOMyT5|^)PBuaHX{Ug5aEVlOewkvVL9WM={-CX0HXqCE`}dsyKe!));F0o#+**Z`_A6)Ubxz)BUpl zz^#MN5UXQa5z?4?L(GUp%y8lo)(QyzN$j1le65@~%=*ur2Holunmi}93N6OAJ%}hG zp`ECUqrCB$Z9PSkOff6PKLhn3g2wL1)&5{BkDrSq3Zzj4tq7Wv^8*azQ$ZUh`tfQ) zBU7qlhWanqxrKb(W3m~i?}SY%-vEmHr?F@X2EOXe1C0{o5UBL}1cTt+?Sy+)fL*85Vwx|z ztFt?AXly(cXhyJp4;~qza24DX1@8opTb?|eOm)D}2=o8^c;~wLNyvu<%?;(UC{f6U zRt*>tdmmYRPZQ3{WPXo|WFrp^xw8u!C}BG20?#%LT_5`GQ6PS$(m|9iC1OZIDW4rX z>33~O|Lny8}T+{Ne&7BqpkKSH2 z_(||@*VXvEl9nYXY00a{urwUbX*Pz^bv=Uj#b>GUO>fxxnReCcE8bxjTJ*3=_8l;r zX(gXKWsudGvv6j=$Y_k5h3lQ2gvD7u>zOZn@$E9T31WB_UA?v7neU)hgrYiVwmRy2 zuWd7nb>Yt<)rgQExbdyS)D-2vd3vSDCoN$z5NTTvF?Gqtw17E|uTnGdCuxSqM#!eGuq zWW^`jj&^PFUklFYKFyBBtRBv>8eD_Uu5sS^68ybQi0QQxOhAom?5I|M`e-lDLFeUcUV&Kz;6ur~^iAJHKr%FDQrZ3Pd5~1Fm;{ zyquwcS>KL(d|~XjC17)h`qXPa_W!ArcL= z#ckLRVoLfYw0(>A*Y6LGvl=VxE*1Lnn%$f*|LyrAHit72nX}zcAC8f4qX6;?pWLp~ zz3abPW!WS^sLnQ&u*T3% z)L6Rw#j-5Qauw(7j=b98S~c2S?R}nh0Q|F>7-{qbNh#$sICG;c_t0!L;mWq5D78!L z$07`Esv1m7eJ^YNJ)C@8(CijgS#xdqgK)2lF5bB?8z3OUl* zMmWSnoTO_rqvaEB?5B^m+Ww}IIMK98ku$_4QXyMy5 z&Q75NowBHJFQ~M|vEVwrSS)8dZ`jm!v!++cRYFt82|nncsGez7n=V_j3-TQQ zcl=3%z@=jM`%{q%O>~$lSi>H(x{?ce39aZ^QBm)L?4>x%iUpwYxgGbueEj`RRT$8! z#unL#Au?*kF8epV3>=$6)=nvC2+9jigxJt1-3$0a zqP@`gE-m2Ilucb?(-$UdXKvpQd3L_u3dA zD_+JDG`1)#SDff_UDzPq9iC9W$*ZusoY<~W=16N~(UWdXqT!PVjBRIFo@_88 zxZR6CK=UWOgV%d31;oiPuJj{j%_=!v7-wyfqZW?s5WyKQMAbSSI(!BO8vLMi3p zq;iwlx9!J1U3|W;K(d$1E#N&RhjP<#Fz~dpsr8*9^RYqeZxcXsmIM&s-TT6N_<)R+ zqT|!=1|W%OR6nse`52<068!s8d~X;TJ% zw*vwSP;rfVzVDFD3ZgAQiyq545xUmMz=bJF57!s9fRO=MO!G#F=5R%*LY>{S_XL`U zKo=VnNUOgEB1==sJ+C{MNljiIWjX*rAldf3nf{xCYQR~SI6-O*>XjAV_YZ|2Uc6_n zyhVr@CO&}e=bC=*n7Yw=ymLnzgBbXQZV`}X>|G(NB0r(LtUloT-TJK}&_5^>-6$fH z_~JWv2@d6D3ekpc2(fj$)#x`YyD@n*pbxhEGWIwJ+g}^oV>8_oxjbT#W{Mu$k1={t z2UTi@?^6AuHki?m>EsTfNdBQR>Uo~s=*UiR`cn_Nsy@57~!Hzi$vfxe?Ywj#KnLHur zA)N6TGPloPF`SQ>>Hna~0mT8pAZ0zI9gjy=?LiqniFpo1BMZ@MiiWnlgQ7(Af#2bc zj^j*35<1BX5!iHvIy~#xua8oWAcq`0o8J?B@2(q3!|&_XG;r)|C>`5$OD+tXqqa6ZX*VmH9V~t#W%LW zJI@gCh`D0o87y8)W>=baQAD1x&$C%r)PTF31#FzA)Cg$YX{y0vw?gr{`xB^9scBwB zdiRq-UU+Th=w_X`US4YeoCu2n!WkHa{kmsx;dl0%Xqb{bDuk z|R`pts(Fi63w8K!Nf7dau`#rVOlRDv~szxF!$`y&bU>?4XdG>)ASaz)W7 z3HlQ#60)TAF{~0VrQ60ym~rS34_}|X9)4!pd%>;>v7!dYlMZqj%|UzYkMEjZ`Wdv- zsne=om`l?$FTNUP$~Qp^@NKm1fsJ9F^D|aP(-3EKE-x?Rb;o(wxoG#TKn#8$wO@Ti z-?$N0D+SIOnmU5{uNVjg{zSJWs;AP+5}B&1Rz69LejB{mioy#a+3oc$eEiv~64klu zVNB+KyiaXR!+ae-IaMMuOJK)heD(+QKFcf+Hf5gog9Q1@kl2HiU8d&}PKQiavpu`& zUVMPuoR$d==L2beklqWM(>5&~nC!j@K_r8f!X|?my&)b&E9moNtAfDROB$*{KJ}}C zAb(^AFSQ%ta9Jj4`56@z232O?&h}h4-`v{t)!fgo2X)X7r0v0b0mdW^)#%aD(h|>@ zfX6*}H+lY*eqpRZD8KC!6|ho(R>qQY%S#H72+LA-qpq%m@nMaUXlvPQ_s%&{RBa~t z+fA-i{Nsm;hD3MEJU?1UfG&O5f;PU}LEP+NjuZ@I9$a|~LJls$vZG2u$VguN+SG*?$ zHez1FZNuy=jsz#<5+yz&w}L}ZuCtma_h)r6h}O}XqROb>sBAo*K%oG#Bzb+103oq# z8Knk&)}}?dTQ)zl66g86vT)LNvIVm!1(pct78(#61-Q1!)g%_ z+R@__%1ol}@~U(V5CO?W@TmR5vLTse$GOHPSqZisr+;K{(NqtDR(ngb+K5b@M#|-` z`Xa2=3{sh9n%>lr(Wgb425caW!V+BMS%k0ci9DGVOxct3ZZ}ClggfWZv18IpYG^3o zm8B(iTXI`3fM1hlO!aPzezVNH5@jl@;ZVH>x$|e1zm7jORCU1-A=^qIasHp^Vtk+AmTEJB%`nc zx3;z@k=I+BOWdm~&YG+jm34Hi7j{-$^`8{fgqxzBeds8d1IgVciU&e$c#_9RR@FHQ z#&u8g$x<~avswrdDqmLj1 z2YGSui?hLm+IKlpy~sX8p4avHd*-nx&^Wjs@L=*+1N_2NcWuI48L3ZWc7mZ;Op9E? zKuGTOVPLlfX??hDn(M|QCZsKfCU1T>lhGKBkqdv>v6BM)rjrAxCv@6u(XnZTC5{1f1o+lBUPPZmQ*pwUp;tma7@^R3@zPW`72LPV{tf019Q{A$m7 z%X0be(hC=E%}ILReO(_BQ9Q3YiqZE3t$ukYv8^0dHykXGTB-}}q= zqp5Vhtd{qYq`4qy_&SSe+=GLIG*7Eg^q*fnOv4@^--yD_^bYWqW@sDB^TFe=-I`v; z%d2);7!*_1)wb|tlK3QugE<+}8gld41LJPsAaZ=9>UevJVS=GOcc}ZEi`M)FxPyqP z+xylk%X>rsWfL@+5d{T)I8K5XQ}DFhJdC=xs&2uI1OR0Xg;H-!ihDVx zFyidoWO_p8Q-DJRAywh3Z!-AC`Ky42X9^>cQV3xi5^D2DITlx>NnO1o0V#l&qO^R% zXxJ+`Su4>cnskCbHJ~J`3LgXG;1?~bh>Hk@+5?F+F2(aTj44JVBD4lAW_=1pSREl$ z9s7!Es1LCSL&SkF7GgRNa6}m$iA?YAJ8p9n4ha}FF136DppBo+WaGfF)QEF3TYkyJ zz#1bNBlU>ROp5f6d`764j|mZKu^JRSWR+Tkb;(%$@$OKMHalA%`fUXC*uK;YlsaRJ zPQr*X1WVu!haql0^I}Y4QCpU0qk#6f=t4g8>>1a&VbrYaKmq+^Z8u}Phntdi;yuaO zxIe2E*_S^0n8d@wWNkgeV0!0!_Y>6s;jjzILdLJSm-0`dBUcIB56dpJv~aGF_D*y>e}2*XCxs$p)Sf|SW6!$K%tyXS%i?zEIFWoiKh`py6_DD~>g@=bIG$Y-<$Z}-^=DjoZ=-=vGzHrf{rXc_{oD^&AE?{n+S9@Uo^L%U3vV`n@km9;EdJ01hI>}UaJ2uz*vrLzOFAMDo zs+nvxnP93YbtnAG-Fd{Vza#dH&>8lD3XQFF84|&6#>Y7scfy`;+`9pw(64TJ> zMMnBLBbPAJe20UUUeW|k$tevH`McuxlLyJ&efv|+FXZb0(evJz8kd|oxUoVaOQ*-R zbLaAQ^;=-9AIs7n$`yLdY3g;G=p&|dH;vI+SAFD$#pe!%-)nPyY=)|Az}1}j<{E2v zz-Ux3G+3@2J)V|F4TAXD;1xmpn?!2C%+mu4*;S)a_AkL_sJ*9)P^+)cjWn0QtVkje zI}xsw*gmTMe6|@L9RH8??^PU=a*k4k)!=o~Ux@lgzquR%4~Vux8k9+#!}&E(x%n)o zoZ1c>fY`!)RFDh2&9Q(UE}BZ-p6U{e?6bY8KAvZr*!8HPsi=`(opl z7_SJwQxht?1xRplYw;$HU6BBbVjJ-~9*zfS!z>?y2ks0pAo~Y+PJUIAqFZ-3jT`QW z#ck*Na9pP0w!Qqwa$B<0mU;+=I>FxOev0ko|7|m>D24<+$Q!gDO6W?Q^Kz^6^qxyN z2npPgFxNobWRCeu|Jc0x24)&Vq{z<`=_em~=LHOIb$S$=1+cY9APy%9fWp4cYrvzh z1yNS@-B}g+9bqH!%|SWx@?OwT8E9Zp!E347SVWgbet$W(Zs#(eZYrrOsGq5~E50C5 zavNcgn{D$Tk7hHY^>zVV&v!Ut!LsO$YN--`p1t4KE1|AR5Og|W21*6`%7Djrb)Kdo z?_JBV#ebV2Ly^w)fPD{f8(7=)ivrJv%{V#)%)ACOeq;SvibQd)F?MRAwiWKHt2<#Fn5s# zCX|R1ZuRq&|GZtUhtfA_y-B6duMeh#)?PEHKG1e5oeSN+?cGT}s|{h8!-v6Qb&I&; z;Us*Li5pid+l5`w>r5ld?c!_&oBfhU?P9e=SUDcAdwI!+OM^K;?2`|hKRN9PM;k?CI$9izYVvS$-TKp+cHS~`zX zhGTEr!#Vp8<-qP5pP2YT{R?psVckJ1;Q(;~Gel3sj=Wt4@I?Y&xG`nf_yx}1qNyB1 zDwNY=N<>f6AbS%D&e4fx+c5bcNLTIK;g>{xQ6GDFjO3?gq(vhT1pTF1Xj5e{x?pK# z#bhFhh8v_uoc38*dHIxt-U%0gnkybl{#F?dc)`2uCqPyxI1MHxB@`!seIXuq6HB0m z15a0lnACc=#r%u+iut$qo-~Np8)X-uJyZ#T9#NW-Yw#IvJLkRE1u?elgZ zlsgoR{Ac9Ab<`)C>}>bjiu#m}WE{QnczrF>DDp*=qc{xvL6n|m41DbiyrCD6?y0Rr z);yk5RjD7+$SDubt-PeCXCawo>%H&Q<7yY(>6jpOf8Y{dnwUD!H}o<*-#79KU}+O3 z4~@vR+xzj3KlA#bjBsgSoYz-30u%U)KH>DGm5*=)>vnQ~mdayF zD>43$DXgc>T&96^su*KNcZ<6pg}CVvUwz2~tX(Y|jLe|vRK!p|8Ycga7BVSH7BS1u zNQ>q#H?Mj32DSl_g@*bVJOp9!S5aJX$!( zAY%G=XHCo93cY=4yn(x3b0Grm@DU9ZB)_>gHVD{~NslGm)##=UH7a$*av7$F_(#3t zD1st61j!*+sI0dr#|L4FqK~$IGJ)@R?uZ5B#v2zX?V`SV2Jl*7O&bIneE|Hr?q@J` zA9tW9drJg2s#sIlV%)+}R_bGaP6I@K?MGO=eR&CEzL*469N%WGO*#gc8)Bti*MU}d zg|GIV@Ag~HX9{b+j{;7E_x{A#o^bbcS7t$pb(k`5yL%H86U20D(b=3&4Odj9<91S5 zTJAwh8i#RzS`QEEE^$-)1^&?txZ&7K`V4+Hm7d_MM86kXMJs*MH;C8;tO>AyRKp^MQ!}L^3uMR88v*!?f2$EHUomLnYhBV zxN?5ly%Eq1J`8E_s2}ABcmqJ3`M!U~DmlrTKvsLDmua+6fM&^-JiiPW$;|YYNyND? zdu!B+BK+8LKS2&>-$BJ(3YDGC68-SWTKErxbaBLXE6wCpV=iZZCt^Fdic@bDB5qKM zgtE4F7ytl>;v5_$@}HW1Fqfoq%6vy+)dfDJr-}a@rww&c`b5n6j1v|uWgMED7*9@C zP#mF;m{Z+KG&a!jWC#=w;*?ldSI`JgRBXqo6@2v0a-9>7K}MS{uBVN`auLi7L7!=Z ztTe&cKevq|l|@?3BjyXQl7?;O_^PfRzsMwyRCSIm(wE9&Go#=2G379yh+R~FRf!s! z6}L0CIF#`_F1>B>bgbETNX47@vD_Le47MP|xz6}Szl+bDWQN-rW%Rq!<<7*g&DC4c zp)esh?L6wF-MDPj-_32)hmy1ts@&;;fp0}(ZDGW*MA^5Ij$3;MDryt~ z^Rc_IK0f|m%~WK;imejS|Nh1o3Z!%XwxXWepwAB&r%YSq3D#ZMFVV{#-VuZOz7~Ko zQDNhF)cy)w#$j@*qTs@_Zn1a!`f)*gpHeA(i8VR3(s+!9z^p`wRcUhp!S9Lj=8tt#^oFB>zf)qdZ4wiJE z%GgqEGX}rF?knF{VoM~` z{J<}Xr-Ima(rv9F0mFt>?aCx})X*WQ>Dk}qKJOFxqt-Xb`%sEF!riE8;a%?_-NiG0 zQ)Q?VL}checDvuU$&q;>0@hN39jdkp^zD77><9)@Q;jM0L6lWca506G*=svX4TM=X z>K|-G$1ldYTWgQ-s$Zp=2q_lxUU!Cn-_PQCx_7{;pL%O?KAQ{Qvy0m`^rQfy#8J-D zzQZGM-3)7OM|O{VLU$h4;}rSM;NRYiv}R z>@kpKzO8<=0RH+ZL~gu^9*7$;c(xaSsG*PyRgZttg`uPU;C`+h`~ZXyZ_KvA!-)G! zsdQ);J?b(D_z?)$?5Ku-`?L6*`D4WcF*I)}V9cPyKpd zBJx6JA#|oeABSJBz^waiQ6)4@1Gmb zmtQ|QJ1fPBg=Ns`&e3t^I<`=)$8~qPyX&Za+9v@P*+w(0VU4)Wt~d%RWVTGu=Ma7m z=j$PZPB#bRA(689vERO-QQT(rxwf~ka{cJ}n2+@{b5+u%TQ!u~yxR35(3Y_mR9iaH zkeG@1S?c1Ghh4}n9^bZArHmihSEL`1$^18Ds{6H(0VB?Wbs=_1{-v?b$BqKvDO*jo} zsQXWZJP(S3ReT)>DwV`KGd;R0!J#=`Fu5~2kU~6_2~h1bpU>TCPa_K0>f*}TKuIU_ zZ;V|4!z$8JE#}NV)cVqazuAt@JfZ&&H9^Y0VBg(xL0k&81Sme5ybS*&;8t8qeTcy# zd^u|kZvV>*xaC)8kl~74lsX_Gbh9a^&n7^Qw3=E!y73_On8883Fq66`1vXLt?_+OH z$0>&o=C_vu@i2Tc;Z-bLL(%Y@T!JK?sILnE?Xf}b)^Upm7hm2%fM5s`pI)Ul4zsA3w z{2!K;gpnW@?((IjxZ$oB@%Nk0K_S%*$eQ=~w?4*yKU|0u+p3Ci0aZ-m(jT0JqxSBF ze6|gn52bADe?R>hUj2wVHM8hJ4#kzr7Gc7?6&SPc00Vw+FqCutlz!zTX(|iWWlO)p zg_r&fZ_TJdvVcIgbd+*VJ@fm=;*zuWA;Tqm8fg|Lh9q5}i5mWByapix;XDLLNi_f| zB<@J*icApb^To(nTvtU}@nFC&L%G5ZC`?ZP^Bczx!`UYeLYI6B`BTJy&cYJh`p6sj zx{P^~6FC)5qI78u-hF=#27hxX(MPHvp#QYVvvJ*hAF%Id(W9gahX z_dsrT7K7ICdtHV{9-oXw#a+lDTFvi(h2wXnI;ZMtjd;AzPeMwEK|6Mv9)a3arMxA^ zqQzff_N+Om6L?kn#edU2&EH5({3(`*OrqNc^t+* z@(>2^J{;Fye;rOd@pu#z7GUARh31sOSgzv4VmI>=zqX6F`b0B&(ZbwGg6&1=$k<039*eA(pzGgnmSAcNYHr#^;DpY}cS1{N%c)vAB|8NhpEUOPAr%=ceMu3&^~|A!5Sg6uX{R z0$)KV0!Z{oRp6S7562NBdn1bg34&otcU9rror(~zuEgJ7n9A`ckKacLUixqb#+-8u zM)u0*p$LHv8U_jJ+cA5%4e6KS_>?4A!;q*BcgJzx8jTmG|Cb;aLAb0!y!-Y$n03|B z7*W&}Rk3osGJYPDA*e;JN^y$$(1|gt$c-7rd!Nn38OQBG?o4tbE?b57J|)2Dm)Q@7 zMJ0|rcsP0$@*PzujM{%6OnkK$<}F%>ua>VxPHqJIk6>Ji>_*6Wr<4l`03LQ=9PfNI z55-Y(jFL_<8f00`y(anlkWKI>hhW`zj~IfFB$le}zLrQPz ziS0tJ?l{GYQ_(EyZuH@2=kJSyMhrwQ#kvCo?qYQXII>G$bnVQ3bKS>S9j2B|i6ygJ zJT~qPoPOL;bm1IC2$FVMIM1-n1=jh+-p9VusZ$(3Kld=~HKGqeX{rOE7;=yXWxC~6 zW9A3b@c4(T5umO_i4CV>l{oK$V{p##gJ|4^(L>!3FRVh>PJI!nt-{UYrlC^e#l9#$ z_;4v^%vptl_UKHm#t`<|e-vJRk~$BUtiy^m6+DO!Vy}^`M-C0oM7oocGK{VS*}i*l zF<$;;9XVx5X&Mts)uym~?mXj=sSFOSsH$Q?8W|bq9!#0X# zBNVQ|4^G*aV)>&{KFwVA*k{eV)2vU8JBxkB$4+LlZ#u%Io*bvBP zT?`n>d0U*LVHrxIahgN+>qQj=Bghq+M*x-ikqdagZryS5@_G2(-xnc~Fa41$8{2Qr zVsgEc!!k|)H%RpY|9Si!lt9Ck^7*W$OutWSj87jcur}SHJe^+6e&3_U9t*#y{SK8*aFvp4RP|?CrI? zq?cRl>q7fIQ6sw{N)MrX`3sB;P*=wM`SZyYc@7T&3vuKTNAsOV067g@{Nn4~@ZrNZ z*i2jhOk8a_?KKl=x-=XG90eQ&GC=_gyewb79Qu9n#TOeT8==KT`;*>D`;)-~0hQvi zlyQ#TcH7O|%L=PFFfHh@QG)dzTYA5#c+S7&DUjY)_Fe|vq!;d!Pd>q?pMFX)zC|c4 zEj6N_cD_?s8{Yc0eCfBGqsn&CMHd-ekKzippr|eTmQ!en5CR*$b?ExlsP4!WK@N%< zZuG>bF==)c)|AAN&kaMhFQ2O&@!mL>DGCU8N%4K56jYwCk10Xj=rPlRV`$#fk>Wsx$U0h0w#JjLB=c}# z7P1b&&RTLYcZ@_UwrVvyO{em*)|Kv zy+$OZQ#$28dD)x$>afgU}&k``SEY7)@oTpzEa>W_f~8Ey%G zYHEHvj1y-ci;{~n&VE`^R*jD*b3GrH&^Yx#^MJU=u6=RRk^AvG&PFc#k`5636suoT zL-2j{{un%920ot0`jbO-eVNkArp(&0Yc~KSyNl@;LCWkKXHIU~G3DEP(bXLMX<*o_ z(|1Fs$v7ac08WGzWl=o${EPIZ{svAA5=rnl3B0tVM@@snh6992CgXopF6SHt90eQ& zTAKoPywg?Vl6_7um;A-mrk^-qq{c$wEI^YUHvL}W-vV+3Om^u)YnxPaA?`A9R7wPF$f^6L^j4;)?e4dZ0-I{nt&0uQ-U1ZW?gAHO33t+@NrtmZ&(h_X z?ri^QDqs1vRX1|vNW=Ab$RUTA@1Uvjw~exUi<|l-PFj)t)agW#JMOZ+TpPvbG?qYS zBCjrz3AX31X))aG_ESKjaoUb@3regahNTrL^d?5*_3@2cXZv&7_L%k?JoeaQ%{ZOu z?@l^VZ@>NaZ7-OM(d-mZTgSwKzM>qp0{Q|K>;p6cLcMsm-7yY#+)Dk16oWMYAoV*+ z#2OU!M7T3Wox74bi@+FxjI}FQV_Er1^rBVa#VbnrUSl`Mmv98D$WivqQ-95cBZgtxQ!~k>MW88|hZhLmUH<*ynEvtSSW^)?%e}t z96c1DJ~EX6kigk&eDcwB{CCDeoJ*_Q^A<0`i{rl_jvFSrKrvg^`JlswVr0Ku2%if&{4)js@%0qZ2tUJCoZnpMZ5I_^Hp(7oi3~a2F1d+$Jv$!68LRU2(nQZvZSOzDD zZ)qKhOWBtK3@3n+XnmI+RKwJ_3xU!sWRu$$?5948xBIGNJa7oJeX{ZKEUL$0pX!LN z-2jjxzMafX?_onb*P0a2CfWNaHVZ=XL$~i6zIomRIY^}Vp?Yn~36kxZ;0Gz)j{^n_ zNNelntz)Jagw0!8m%5{Xqd-TcK;yBf@w2UWy1(wzpKX}NSDnzy;8#;dzZ6znIszJX zl{mK*@0O)u0h0nM1zd`|QedUHDlK>^{gvXvRM>5Cn=AMFxqe$xY#U*RYFiWMs`Yt}4UYFvq#GiMr3Mp?fVSB(JZEjgRN!lmDDDPBvx zw{+0e0_gYLa}Tb#;tE3}OGg{7rOLG}`83`ZXpO_>p_+Z_yCR3rggKQIe~Xa8h6?U! z`8r6$4rX(*Et$BmTc7~J3~su8{I-HzM=q@h;~=v=U~9Ay9a)m2CO4G8!UT=bcsl3^MsR!( z@M8eB_)2ox(N8+wsDG}qIE-3aI*t;!Owecrd;}p0&4%pl8eztFq9mFS=2RIOOe>d;}{bl&`5oG#QLKArUK+nJm9F& z==R!NtRbl8qq52QU(y)Orwj23IUuW;W{P61*^D!4cuz#ClX&NUlPTt%$Ff&q()4BM z=Ua;j)63z@Aq}Xb&zB#@smG5*F6)^^ab>gSAPD)Z8}G+oANUy6{;sT_fE?1Hfc2*6 zIuShZ8@%r>p4ZxOGc=~vza337bIBdXF73;Y#)EZ;n?eqFYwtS3TKCDI3`+x z2Os(r-+N#eyhF~?=@j)w76I5qE&-(kzIEiD<$O$E+iY>2 zhDo;wfhww2GC}%fvV_s-p1bRXyuxAT%#7!R|i2x}r-F z!Cx9l36hi0FIG}!7N^zdnEDM_{!%_#O=rEuElXk$Z&d$d0mPvw$Bvy;0qe-wD^QZ* zQAv^bRTbp^t3@b_??|>k-82pl{%bPIBc3H_4uS-d)xVhryC#)z5)>y493x;#Lqkc^ zu}OLLVLJ2un7j3VWZ1{Ya+vxO;15!-XgrHYQ4CyH6~H~THh(a6a1QNCy{r7@QUw14 zw2Z?NZM{>*0#@0s3C<;9u95TesV+evH`mDl0=9nA)<wo*&=5dYGS`T5M+lt4zm{q7+5ug=0w6v5+wNnp z9k5k8c$MOs3^_0dDON9w)EYFUuvku9Ioja1l(P%DmdelN(>^F5!wh4`jx`{QEKNG+ zD9{lpV8I=YgRxl5Y>stJ9~X76jq{eA#%+m)OTn0QhF@~W-5#=-j6i>0Q)ZCmoWA_&K$Ep_UqrB z_XPQfOocgSNHmr_VYI3%J$+R)mO+tN>i+A`gTF$8dr^)bSp=JqEMzDGT*TsfQN;F& zOTU3^f;~ZU8~Vtp6{J<;B*CT_xdGWdh=uW^Ah?sC8^j*N`!nr2>awF@ELqkSSjq79 zyd>)>;tgg<(3*BK8m6HcAG+_>6GswUeEQ?n^01jfGTxBcI{Gt zk%M}oFi=SA#a~jFCCf>+xlgAoKx*D#LM__^NJFf!VBzKWT4#^nfC5Vm|P&|9Lp?zpL#*ZRe zyMFM|mvP&;_h^HsH$hHzTE^*In1i9acSFCP*%;WnEBf?|pmNztT>a2=^BovYN{w;S zrMQt}y-l05ud@u%S|3L2-wlWF(G^d;JPlVYmcm-+*qIMx3DOi#`vuqzRWD!hdUn*HmUw&5|)wMYQ(sU0tD6wSIn1=8~ z!`0tn34X-&KvhR=koHqAa?Ds|>gJxcdIrZlqaoSjG-q7M$SBZrSsFaRNy%S(5fKvda(I>?9 zg2LMO%3Jl)VU_?*>*OcnK8mkSKWj^MYHwwc__ahoCE6O~W-(qzu~#bk?@vHOTSxJlv=-IV z`|`;rpN!jXyRD)B?+Bgs?bz`^0OW6e^Ba?HdVV{S{>~kj<14wagy{IFGKxKlw*(Ri zh9n6pgpK$lU#E2{jslb>Wf;SO7H3;{b61jFVZC}6pnyh^s%i>o^o8Qs1Q?Ti9zl>M zM72~jfz8C&Q<<)G$CYsY@CCb=1G%E2Fo8oFL=jgM$IgNMdx7$;EDp;>(bY9&tEg_E z0E0U9BA_8oKmi`)GGlqF>Jo?&K+K{Zyik5Nc40bMw5FXT7n;8|i9=635-(C*x~jaw z96s7MR~kWbcI9(^?Ljf-Y?KqwDnQrV0FF3#0N$83AGL`hes2N1^7`il$QYlx2Lse& zIe1uq3?ZPDqRzcz_YUFVcdFnchu73eGchBplw61cVI@+Uz;{m?K~BSL&c`_j1vz%o z;K+mH-lwJT-Xtw8SI1J=l@^-+^nc$*HyW0qpfCY0eeFTaol0&zec2LS7gsq!PKmd3 zFy_2YAdR4Ib})jvU=0pB_COr*`iIn0NuxX2G~N;~z#ndZ8YMFc_sVQI+c%I)Q24tC zp+^o4l~4~SCDd60a%OhQMZcmTW-ldIUXqM4fnt==68Y}^i_j@IpWvOiNu$J?B(AJB zE<-g9uY_3V!n_oEAQ7T&GD=$`$Lpq@7D{~V$tdv?B1=ARg597{>8D5 zni#RRrWR9Xt|AR6CNB0!a&7kL)E(WsWYG$Bl-l2sy=$eVjA>R5u{Y+bMCGQUqM0^-0a8{Qd|cuqxyfBxo%V{D_l=;8&-OVEJQM z#Xj`fI}1=v@YzQ$!m$s$g8dI1ii?gLLLk1HqT>?NCjid+O8Q&hus3(}zNuxEzHx>n zu}$CdU_$mejSne_QuDvwvz-J+68$x07JenMZS_$DMzU)bz$sc^!x~o(;!jrVl*kQ z$#u}6J@CUH{*cxzzsJqS9@O#lfDN+2RXWPF*=#9iH$yFzUt7p$!h{KU>#euU=3F3{ zxK7fYHiWm{daGH?eCIpg;XsM13UgbMwtNZ?LgXkK0oB5>XW3vH$-28z3Un z`KI@a^!rTYGkf-ITzv7xMvq(L^dy4#kAM6F!-fsp;FUzJ1O^M}uM++ArW7%m9s`IPq6 zp;pC(p8lbL0>hF`DJ95$qkW5mfdBmt;=+pg6%qGwi zAZ?-&$)#mr%32dRDZwEGdpeP`F2?wW9d`uAz5Oz+36nO|&00$f(tbaUa!^#c-{Af@ zV9%a3^uohHifu;;;H|EhjpDVGj?=*-%OXy>?3`Tm={*R$WU~$-mMJfQwPguB^vK(k zG9d65s_{6?2u=#1G8}G<8X$0$qKIq`4U^R772x#Kzkv^Lc!pe|g^UxxoT;-3d4jv;+}h-#C~^Qh8_hu1RhmM!rs|Y+d+L(uh~pV5#I%PpXimZhJ3;zJyF*G1T!Ix_3n zkpsRO1Za``r`JA$C*PirtlR?RkfvS8b^73)V=$r<`(beoR+JM1;QZ*LG(d`?|2d(q z)Mq&y1G=((X$&YUHw&vv*WkaCp7q8=0;>W&Aq(IHc*S|Dv0dMm;YCzhsz1kh0e(jx zODp3&^VzRb_|e(lz@oX2VDi@jSgY9W{J7?thcWWi>v3SOLJ(V}W19SVj_DYe_AS@@ zWa^?EQdAx(3H=jKI2=z*cnVRDC%(`+H4d)1{$J?w=PPmSK7AN6EG?G!^s}k>^&g)@ zX*s5tObdMG)T)FTN@WQUxh5it=KoN>xF64@Dq#DB#jY#-hdg-OEn6G~ItL}NgqdoT6!>JFgwboirJ#w)5 z27reY(p6VoWuO22=S#tsE@_myt$+E;UmW;|#1bsZzrC3q63KiLITk7 zzyl9-YMOw72OV^fv%z=kt+zTan1G7V`tp~*?An0z)s=>Q**!rXrQ?H$;8#T8fBTW`JPXj8|?AxQ_zqLY=( z0pI^AhIg>oHF1Dih4+e8jWp0f3NM_eyZ1Xxw-`;I*QfK>#nP_oaY(5mwas|NxCF2G zdEN~*{xAh~iwgk}8I8FWk}i3DL90FTw%Vn|uUkY9wMGrW`ho*F;T}B=B)^b^{NPhb zI!&w=u%iZPo>~rpjrA?J+|q8l?Kao%OHn7@9n3u7^*#b1OTp1R4M~^<>wQVq>3dNj zAn0#@y2nP{dW$w2Bp{)2%LRXQYgGXylCBbJC_8vfw%435+ATjl(vnM4cG#CTv#0<2 z0c(f0%6Nmkj6E!VNbcb#F^-u<4LfW&yk5_{}{XYBJ|`M^#+X*b(=ohkPIyC2z4 ze*Qaq=J}80EqRo+ERiIjq|v^z!)I*`IWhq#mEfVI)W%4<5?hqPcQHH`)2|W&5tCA< zO$vYlsLIx+Z0huhw$(S|)Eawzp2|`ME2F7bsU|z? zD@WRD@@^b&RasgO_dEn&mzX5~oTR6K&wC|py7Am|>^tAu)3%?zmc8@-TlPOcxy7D% zMv{sRV+D>2bZu|52{T69A^UG;)u|Tov|i3!Gzem|G2dl<9Vo$ld-ZJfP{8G!u%8SQ z+Un9oJm!GS?Sktcmr!E80O_Q?_|m8L`NRLmPWr~)w$o?Uv&Ek*vP*w?v;FOnS0w#7 zQqqu%C3PFOodkZ)oF$LwLi=I>k`wj5e9$CEG4HD$BjteRJv;NlYwhG?_OR9E%;m|u zpRvoYzs=r!OYcr~y`0$y^u*SwBp_R`Ng$9MRqTu;4S`96hKM#`za%`XWgm3H>Z@T! zQc{Ks?bL7XZ^xhWNBdO$A|~*B@kfj8xNlu)_x$d=Hjd2%0hQ1Ibme~mTXe6q0ngbn z0r+XDy>GJ7G&^kf>2~cs?+82=U*oOz-m9P3ZeRMYZS$FFHgj^Fz5m7n`{&cIO2QLU z00QVG6*^o)*#VGQq1x>d>0K6l4A@^^AJ|ZE@5^v~B15WOeqyJ$SPv!bROHi|2(4=; zo%n6rZ~y(|b#+RpMV*U{=bwKz6dw$>*!`L@V@4=`<)5yK3r2W+)KNz{@a_+P_=A&( zL)DhR;t)p&s5l~7=lO%$E~?uEALlLx`44qj8TAR%44;>xxd4KIz+eCR*E_&=>`Weg z^wD#uj`^ow)OImeyz2lehl4?Wc0dFLH__~C~g zFxhc4I*B;25;;)#-W9v{asJp{b$l8xh3Bt(lBc^g-0KOg7101EKqwNd^IIyDO7>E6NLfcfSv;qG5k2o3T$c8 zH!URzs$`ih7T8DxfGkDu?-ml`Y+fF6$RVX58_^I4T(^-OH+q#&4yUG>c2afNC8nSG z;MYL<1_=1Z4@X9J22pKIS%W17tl{-`>+LtOa~CYO?_cqRz`$xrH6eZ0V%OXt(D8=* z1+s{a%B!fHC>jDQ1g1@%Ho-3W;bAs5yTGd3COAp7rSd*~sDPV~8vkUsJ@Tn#Y9~ox zaIwIsckIMdZxFar=X{OCDw_npjFu3gfVS38Y_BhV#!lEEtaXG;lL+Lgt(1DU z)QUB16%D~S4#>z@E}Q+@K&ox1w_SIbYJa->WowkwVlKW!8!hcp!(L>wXK!sYC)Nq{ zlA{!XM&m|~wr#eaVNd?<6@gfa%d|_vPIduD)!7c4O|=oSGgw(EZ_|KZ0$>w~$y$qi z&K^7KPVo{)AUHj@cex^DCO6jMKo|@6s@=Fu9k0j~L#!n`@#NKA(NNgk~ zCE3|7z_7Zl*6O6reD?SEu`@2b#a?XjqopjW98k{GR2yVqG~y1o9&JND80AKPi)`)%;N z0Li6x9Iw}yrheH{MedYnsfH({azR&LY3y@Ri zO^9Yr{URwRKKt*xt-U=zX1~4bS^4NurrM>}D9QeF1nyblcPdagjllR=LUxy)(0Ty~pk_w;a{Q2(|cw>c@tVGC$#PsRYUEYEE z<0o+gRbIK2gQrozN7RANJ@;I9j@`psZn?!(@zhgK?Xam1K1{O3O#9&fQ_R2ZIp z_E~425LF;-uc2#n;x+iZntyShe756R3IUwqN+>SGrS`-AN4`|!|14;fAyu(d|G z@4ovw)RK4JdFKvr&ZjRt(#8iLe9+#0`)%h*7M1_qci(+Em1o~CIQsKKT7A97?xwfB z8K%Ae{`)%s61wlc`>wM;$vKjags*(%D^3mC=i$8q!~}qR>Zzw(o+(oT!2kU7&v$uz zS}yR!iG(rF2>SjWpeMWs7&z&qlRDzbgN-(%UUABUg9r3tdfs5^^xmqy_f9&o#JrbP6 zslJIw0yWAhLYtgv)ktzjUD2&^gH(h2cau#vaVCcN-j*uxUh(}$Q-Zly6iUDWIcY%x zE1T02S<+)!InPMQDN0I`kWTfp=;}Xbm6BAHLatOjWjRuyNm8IpU9CD`^Elga&#mop zc^0^b1DEE_oXsIF}@mt_^AEi@AIVMDgZF8dSNF{fK^W5Uq-)#+Av{k+P-|?E_U!?(>bw3_UL03|P2?2(iZ@Q6fH1h%b$175Smc7K7JYZ*H zb++p+Gp#|uVNw!v8F}Q!?&X$SZ)&6d_-|VzKu>N;RK*rsbFB?+{k6whLsFi8D+Syk ziI`NKYXRZ;qV-DHFcHeqKtI@sq2-U`E3icec$g!~IztonIVBCI($#(Q^ zv+Rmn9<5`)IR%}>2|^#t!1X=tf6X*yp2mDQh;4jxLpNc zA@oF7k2H(_(h(?JwB81z6@(Kb2IdBO(yp z(yYU(ZInEk@4Lt5_WusvN)Be^alAsR`{G}7zUH5y^Sdp8Gp2qxx_+cJuhu4s z-aT!`+E3dp|9Hk0ek}6@a;C)dsnmNurlHApQ(xV0zt7m!zxcJlbv6N9DV=}v#dbyv z%`kNSk z9Zm%RNTRUvIRLMbNC9ZXo+98PQgjTo>#n=5lX?r+f(b4L)LB%90Z63hus3+)jW>pq zyK|%}QQ^h$!-@j*v116(84jrJoqhJ%cKG3kyXea=zuY-)@oBJw=xrgg+ljPZSK%m0 z_W@WIhD$EF#2Il%t$Q#-yFBdq;O(HYPysL`Y`yi?{&vR^Cp10)%z6OQ#}yuVUIe5m zeSr4_)FT@j8hmuekum@veLXsEL?;mkA`Yyw9Prnfk(Ejq<}PvqA0K$B$zJp750ZOAs%9)L9A|?b91_M+lsRFB%H%2xM#|k9I8BRhVuOJcG>!ZC%$sWdJ!(n`Glr@gi_%BuSV-DZV z4%qjz0{a{74S8+;;NvCYfmGUsN3Jn-ta!eCAE$m$FPn}RZ}?T4|ItEw{-t;9{STYPw~Wo0KE>9O zhw@32>TQDZjv6~&^Lt6*D<7uNmdNY*Ub2C?)|Rui?p~ri2`3S{{=}rS_lUP{r%sRE zMV%((%%(~bo8vGSAP{$Nf!Eu~^Y=$;>%8|D*jw*?Y%SP^)N`LOuHM$1wVG@&s?DS2 zd`9Z#BPID-T`#qBF|i>h(7tV)?Y8HZw((|b+q}0wuz$ZX-xf5r3eZm4Iy2X>b@fcg z$stWlAnk-bwzLgDBfV=$q1H+uY1~*j`w?iJ$yHgazO~zZemA>mo%PfX*`L&NVx6@9 z)H*p)%IF!(^S7js$BdC3%hUw>=J9*me)AV-^8i}4HfHP?c~O^yur>_a^g4f8Ao1qg zZQ@LkvCbSjX0)v{LAG1ff8aUa`>nRy$gaP*!5W*Ex-b985hHEwbtdUk6G&0=-d56ga8&?(r2xuNWAzNBx?Y*kTC8G};y=(nMXhW|F11?4)zqnd>bsaZ5d5z+ z>a0UF3{e1bh;n-vReO!8YuLT_-D6v9u|=<2g(u&_z~W`~)mL{$x(n~E%xk}BTA5{( zD{XB3p;nFb;>jnU+_8W>_uO-xG+bA_3CCY{*<}uV#BL`v=nwPe&9e(HywK4FJS^te zB+L`MJ0r;l*oIRXfIy^Sk^Dpb7?ofq?MU!(5Br4Jsl@v%YQ^4z>JB^X(9wo4ea->i z03YdNICFs(ao1dPjguh61|q;JM&b)YxV?q#c_+RATsfo12nZC|D)5F-t@6fFw{gro!!EU0UclNy2Gq!%{p`pU%BCR(*5 zLtErAoAI$h{2x7{&henLZb851nlc+2)P8}4HS&NyqJE(OyrrtwBmrRoIH%IpYmxXD zz$O59q=2;%^7;+fn^Zr8PMtvI3LB?Bfuv)tO_Ue!&&*y=;2sWg)ZYa_SMyBOmnjP& zjLB14WX??zzj~&lMvbvvXP{r4)=Nu1V zS0BEQ;aRJnK&wIK14hX~k^~~vzG``=pQPtrZEdofNuPz*NP+#lzksyl88?2cXvR7O zrt0-xEYqxIJn;43fbS-psL;`iuLlAwh_3KgpV-|l$8PXC{~ZSqt$ z1*9RW{yMHi#`|MCV2AmmcwT|jL=o}cU4+WDcLdRg=!&(&sAjt}l#Go;dfx55C;oNi2b-7Y7`s%9<57B^({BWcK0J-O$d%B+|>g(pO{gDYE>gA|FdHURA;fzBTK74qS z(+Quun=9cD(uH^3b(f=zokr?Qxv0qdz$B?yU65vFBDiqj!lL(me(zj}_Iq29 z-17h=bc)fZTtWmuIyOXqA`V0x5C>;9H-x+r#rRmJ;|FmugrlrbV?D|4I^tLEr%WjedtSnolJqqot?Gu`2>K z`V%~qPKaS(D@ff~G&2WbeuVADQU*XxHdnEw9);d>z&{@k_5dI`31{^uf*;pbG^X*4 z0VDvQ0^l)N(|9nEc^31{);6h`N;)bd$y`)r0a+?#|E;E~&ME~oCZ!4+UJp?&KWHZ8 zpaPH%X|r|#C;)2wq))1v0*FY8O@LmtoVnnL1>li-t*Gvhrl%;EbRs)B+wq}&yPI5J{-B`K1X=pBCsuuEkQ}3!oj!zoP>ZQ2kNN|fMK2w zKcAnzPktZ#Hwe1Wq+IGm9^z<^&qKX^dY_*ov|X7>Pg?S~>)ExZ+XWEHNsRgj4tpv! z_B&py-K6*J^KA^%EIfyX?>F=h^0sSzO#cyF=L%nt_RbhM?C!S&nsLf@^UW@Ag2C^XY-cUX7Nq^Odmfa{M6Y5K1xoM z^66{UfQSIDPzt{NltX)<1#sKaE*f&kgLwl0;DmruBw?%cTmgS+AAQAbB<0&pJ!uE^ zg!imR{4@7_rX23WN6PZxFF1uyOB(L^BhQ|6@Wi*5vWVvz+VpY81L{N^d5MRP=bMiQ zRIk>(w9GJ|9g&bWM3vsVN~!ld!>sBn3E9?s{-x*b`L`!ax>P`?27q{#q#j34wQn4{ zwR>0Mk~&>1d$Ctt{TtbTY>@>B3B}07fDEZ>t-7|=N>WtX=5Sa)-u9szA^>veKD$A$ zIWHc;AA3?E22a#Eiv=8B40K??T9pGTK@7U=tP!yBSd1s(IDd}nHj`*}G?7H~@z6mE zhK~k=`>U_MYBOfcAi8My*T4Sd;xVGm;2);5^Ugav01_JEcu$D9V)6cd_=qDNLO4A; zhO~K}q&Bgkr?JXoV< zPr%_#_&NJB`a?fl)~a^yCn90qhtF3venjmZ+8kg!@ncF@%8`X6n?HN(v4`!rqwF$i z!;r~%IQV?Th0nujhTOR%TY`zc<~y4Fr)B49snpY!>f7_!>x-;8U8}{D7Dy;0EL2a5)s&56hoUx6~d@c%o;{eYG zkb!w9<6VEA4f6s&H=s70d+>sB724S}5_B^0pkD-1XS^? z=?@eK+exS1eigD&>NKsgobkDRxrk^C;sLH!M&i1J!gHhMUhHvF;wSK*#f~@LBjYJ{^6CILgJgqf4QW{!jkbuD?cMTex z;1=8^xVyW%yF+kqf+ca zp6swj4$JJ{_us?qDqoi}DNZ)vG#5WVQ$v%6o)!?Me;Rp&J0=@~j(1bW(?Z+20|&+= zdO>{W`7Xv*JoS`&RoS49#Bqv){n06*3~M^Jj{Xs5{#JZ_wMr|L;=$4oGf9(M*W-sE zeN!;(uNX%nfGbE4$maefNt#`KO`^8bint;1hit{&le064 zCwE^l=ugk-u%NfyXuhdUN6D`tZl?{ur6ii* zHR4ZohJiWxdA2s)sGfdutvHIc6H#jmKCpM!gi`MbPG0iVry}7{y3g1o(5mUop}u>b zWB>53TiD%u5I$GfqX$J2<3Eoe%GACP2mW&)w{Rg{X zKFG}a;52qJom4hNvsqsc6Mk%k(wT;l*f*Ra|!0H27|QK|YA^+9ZZ3B0oKm+MnUf z_D-f!tkvRcW4KejB4(QpS-5Z5$GnLgx^G0Y4CQc6=YIdZ)i%L|)%^=i=kaaG2{Wh^ z_ObhfSWS|4S#wKYFQd#3j;h$FrlM3%n zEz)N9xFl?nwkTXJx(2l7g<^$@x(3DH>r2^K4d6W~p6_!R)!)OPTR&a4ckm{!b?t9v zJ60H}3){m?$_9YPlx1g^b(uvTETCCJzhRO6&NE)+&8xD zs{#_39q7`Av49}tjim$W_T(Jjuk9u&IhU6}ZuFRhZ6^!+GpO8i3yFITeY6=#Bp8S8 zi;vwGUV$vrfG{Yf{uNmvbcCFddBjb^O-HU}^h+{WvU4I1(ucW7p|E3y`~{cK_45jRtB@?w>G-J4 znLk~FcAOV>4@5*digt@-w#+IsxPcpoAy${<{vX#vce+vpNgK&?)DIp_hg99Zij-Zz zyPWW-r*tupROj)}oc2dp87wrxMDpvFr5v}gYWS)uM;h-Ysz>Fz;e;0m7>p__y zjCCRp1?+v^cF-Pv3{Pld_-}K&RwP1zuAUuA>^WMd{M;V$xHsM9X1(A6(LlQ9G#<_# z&~%RN;53<>;%2*oEkn5Oszq1`20ukI6<&>!$2j}NP-i*E-;|>Qq*oxZ2wCawsT!%@ z9y(*~e5>oE!_VaUGkKg&A)nN%W*`PqpkAO&(*kRWj)Y6YS!aONbbkAolE7^cv-?kH znh|>f3rtD(qoS1L4#^jYw_$(Zsu$g_6T8ZM-<2yddF0qk#K;4A&FHq+Xfc^!5>iSu z|JZIbRd`7`*<^YLNeWu1A*i6&hTx&>ZgaQorkI#$Oay*}L-OrzX?}-Nq`JIbs@dWU zyW`Wtx$m!9Tl1eX!f+#R_EDz`PJe1Q744sWv@tv%!T%xEoJNav2Tklx6c`MM2l{u8 zUhehBS|#Clok0`fax|^D<3CD@eu4~*9ug4FWkcO8A@Sz(z}NTa_ajB$`ikoIaetZ_ zgS(BzH+u)>YaCK0xRkC6QZ6Z^?S~z@1HMVGmcZq`o}2qzGDRhyU=tRtjf{G zTzhIp8ka>5RoQHy(tE2dRP6hW%Ykjv2qvlaj@rK!+BR>4m#Bn?ml_wE=H2_J=x*t} zlawZSSASN1+|pvR3i$J_U|omY0P$f3(E-gyRz_C`7L=TvgV|)q-HYHi#EE>>-%A#@ zC4?1xuerprUlrk>VYm$SQZD&T+@HfCpw#$-s zG(j%iT+BABH;bRHRIG8qA4rZ-V;~yu=%(WcFC zE>}0vu~$7$s?OR^sv97_y1hI*{*r=#00D?X;2dl1`_T1sW5v@f6ZAHwknh(?N7?*-$TJQy0|R`hem@?Ph=(l zl|6{Gpu@Ih-PH~_n98SeVBiwwd@JfJ@KbB1r`Yg23JFqtke6aSgi`j~%65#U{&A5) zs^UO}?X^NIv4aa}C>_aAjZUE2JY|}7f)Br2d!E?miA%W3{bwLC^j+|_*gM$L!wu0w zl$pAh%8lj_CmCB`5{MT8yu3iT7*tghFyme`?Vf1r;rh7tX|e5v2lSqwV?^C9voSvM zQ&!gAs1gXXIOe6=(bOn?%|brU(B|p1+ZPA zdTz2VR=B#aPzUU`xKj;rH9YW4Bg8eieRMQaI2LFApO^uC{mk zkIlg~0}fKSFMnHln*Lc5PVwK!<@{PC%2vR|__yhB9mM4mzB`5l54(AZ=_5&h5NXY{ z7o=c^B8`(9ibIJ+hR!{1S~fVDsx#WX8DO*dBnUwY6-3ZEz5^v5o*6|C(GBsYQEB-7 zl#bCa!wXqSX`0cX=q#Kx*+up=j#PzwJ`o#5#Lx|sJ~8yv5@1Z5LV~=9;ybvraY1a& zavlh6@P)U_^b$}k;RhcKkAx@Av&jL8J&IYcJi#H;9hF+n1*Sm1cL5Lh!n_{2<%d8D z_FYOsL@7BFEfVRGPjD8_96r@wF6_HEqg!M=-t`j8Y7ySoE#z&ll?cDLG~#@;xRc1^ z=kZgGxhJH%%hG&>1sP|kE;Tm}B3F!}Dy(}fr``iV$z(wz`$8|<=tNFIDl^d*V*lQj zt*pxnxC_D_$gl-o6&<<7?%O1ZIEy^yXXgg>I0=X1p}Fm-Yot`xrMF{pif|IMr8V9Z z6DNq4SF$mY*8El}4{PJ_|3eH-9_Te7dd%{&Kn7s_6?N!UVS&qGE=s}MWXRW)@&5)HU_+K1kih*a@8V$YL+8w`W z6nZaK%_P7dpmtKz)1A;PY>Yg;xI%dAm&R0Z8Me27;d9TI@-~RA*vPT0H(zZ18MT$w z?OYEbJ(p9y6J6?;<3)AHx#Je4RRx6GBawoY2>1;sEN$LVgK`m7i-eN)&eiX>eH-n% zrhd>Ak%z6-@m`J79?YBc{g4P$gK%Hku(9%JE9Fllb z#1PVSq$}V9nY^4fpzrH5c$s&6e^ub=uz-L>QRL90klNEa~E!!Z>@!%Br~hdEMe&?GE;@v8-1uo(R+YPV---D<9vg~cx?CQs;rXH6eQN~du-gy|HTaPYNlRBT- z6PYRzd`H%FrqkJEDhL_SEoBA5VKxI~2ZJPB;ffYca8N2RL_?HR=^Fi>Yo(DpIRz>R zD1J4S&yO=6@HZWM#SUopJgK)}o^H;nsE2yMI8p!kpd7|sTkc58k88X!t+O95%ZNX7 zw_iT~T)IBQ~2=@%fs0J@YdP zFq-%HJ4CH2&G3o^Br^gdC>Tv{h%F@22y(R1vh-EDf;}ZSB&khpvG(IHM2brmLCtXX zQwpjL!daHOj3VTk^0_S_;UR^&oIohFN8`T)`L6C`f~7tgIM0d?p9_FK2tmh3`i1&s zZ2Kir0Vv`V43ePBMysLcK-_t4TLH+xLq|yZHs4V%#3bvtvLs?tO+-M8z|s6CT|WTc1EAJVjchI)5cx(FaB=x3(`m|~JW)`<74da1veo!D z9AWg@{{Xhv{c%5qkA~MB8J+XDy(r(?!!GLB!k0t@gw6YOxNa1{*mI1&3206;>Q}l&re;58)q@N!I(>K0(B+z#SPbMHQW3)?X9t> zqdsI>;FO1TT@&!|sda^FO^zojkm=V~=&5DW+=)UbFL6CHD$Eu&y3cz6-e2!7bsY$RvD?5XRp5>} zy48G}5Z1xyEG!@+B0ZXS6zGH?nP@c!+Rar){lQ|uazDWb@j1wtczR0s@Zit?#EW8@ z7O0Jri$#h9fQno(K0~M!?ZT~{D-l-D;0E;d^Gjiq;fIYgHj^Umj>KHpTPUS=YdzPA zhcL+aNR6|GOY}z$wIVH6!c$am+LwN!RrD!Ju7w0Ip2Fy z*l&A@C4FGeGodSwh#Q7RJ>oa zVSFNDLT3|~O0@+BJdkxyXAcA$Z5Fu^WHi31_QoX7vcWGzhx-uty}GrejXC%;9_ zy2)i*UuPsId zk(Oey3!Y2h(=buD7V~}ohc;YjgvbiCnEYfkL4=35pl)HJ5@L7yN+ZdDenQbVUI=RP zLJlNAHB<>ox8km4Ha1c}jQyPX%`69(ky+E#V;@9P8#AN72G#lyJpTyisQD;G(#)}> z&MVoNAtd#5d6UP-3y3qguIq5l#vv8fI!@pp^vGQ-+10A-DinvN(OY_dyLfL$L<`v; zXvQ08l<^RR0OOL3dZ8+Fp|}S9PG(8U<4+Qe8iEL3LYI;vEKK>q#11;_LJkZC9LcU(Z6d*uuZs=)Ha#Nk`{ZG@3R1s%pl-=!f_y- z_W$7bv%OztA3y>}B_@@#mDIwV8xT@{UV{gnc zS9=bF!9;+73=qD4QUHDzBJyi6NiU} zJ6dz;VAbZ5xHutC+hZjNLYmbSNbcunWEFunCk%g4; z-88YLe?JDH3QqI*sgcL#pGJ)Dx=7I8yg#kqPDV5(i)^*CJ?gP!B9IkB)o z&ifSKMI&T3SzOJyySc2k{<1`0dAM)P{f0&4GMI>u3u(luHpPM8*{ zW42t7_~v?_v@&VaH}ul7B1Vpw1|aF8cu*V9cFcAhoR6f0eec@UP4x6Y69epB^M@PD zj6%WF!Izt7dlY|B2WA^8TGs}U$RSj`l>YvAa{snu|9MQc+!(!)w)K!}Y#RI`(eRw3 zYixTJm;CV|?7*~_9-8K=TF#!6bY1(l1jy5SBfV$J)l6nY!uiMM^$MCER%dX(Ohk1~ z7~Kad1~LC=zJ!nPh&c6BasMR~N76Y}Af4aC5#h_x#3}mgm+yoAeSbg-oSq(`E=r?g zFSC!X=WRmv3W0H6uwI$$c0u~@kxn)@s3ls(+PQ_jZ(1t7rt}O=Hp7lJ0YrXpZ(Ua- zeRd{o$>_fM4uyI-Q#0k7_|UQX(8`aMMWM7IX%i1p_j zt=-)2V$Q{ZhY>J+Z;HR5Vo7}1H~;*4Y+v_YUMJ|i`koUQ9v6ZxISuothhO96aL!u|UJQ0kK1f5>&rhi-H7-6v4^(BUJ2!K=K!| zeLF29pK-D1aX}~vN>J1Bq6nE@1Fe)qFw+~=Xe>f=uq1+ zAAq<2N*rJ!cuqiV)+l#IBZ9n6uSRSkEoTF|(8G)|mgO%*E)eTA-Lu_yO+ByjD5>N1 zk&ILcs6t{o+VV!Cyj&p#4?c8$Xe}(?%RU4rE~IsPzq_Y@xj+?F%{p9V`MQu_KK$N5G-!yIjYq&Z9ZWSrmIl6Uyir7aOW%H_*6F=~Bp$-S zpk(}{PyhdwAVWi8Mo3lQ1+k=R=JzizWj8fao{qIR@TwY>i6v1s$TBdlpZrZ-_$%Tx z166ISrYFRWQ96DA3mS$K{8K4T`?o1cgc2iZYIkJqUz$h^4pUB3TiYsR z0ORF*y`4|#!5@N5oFc$W059niQ%(1{g5bWIZhPa9@rO23M-5GVOWfB>yyyOIJ`2e* z<@jkw(&8WZQCmkqG)q`^8ICpDdaMYe7xZo@(J;6`1NETZeEFZkz9<95&}IlARzqf< zFr!nx*d{aL#tVh;}Z3%uGeJQ6&wjqB=s?TR&+bd^OSjolmFj*BfkV5c)VW5~h?A)|fVN zil4+6%UDWZMcgd&zO1PatR6?EJrYz+7AG3D-~Osh3Ijjt$=eU^&b994dA7k)oRB%s zeTL*Rky^GQra2F%XROih)~4?3%)p&};f34^+)6$G)9wwU+;VgIaFrxF1dLTi6fZgE zZhhSf{B6>Z(i~K>n}U4u|1GQ#>Jq@g4=#VttZ^s85|egJ5=xnbUVasZ$*25=Akx~X zyok1?>5HrsDj_>7l4u+Zcc!##Kojpg<4Rt?AcR*mFKJ!IfZn$MF*Ohx4HC$DMF;2S z^?cTHwxs*L2_nv{%}gg+q}&0u07s!ckAwia!D`h9U609U4VwmkcYde*b_wQ;2avR^ z8QXT8k6)~%wzqOH7?52mU$negX9&}-rs`>tA&xcnj+vPkq*mF3Mr;|fjILt~5 z;U-ZD9{Q-Dd2CrLoc%h~Jv=U}HwI^g({+o)=g07KZASAy9yHr4H?YcNW&JIafV2Zj zNN9=6DXkwFA}kU=A%HnjcfxC!nQOm8a05oLVlUD>${>dsq@VwP6%z6-{R5l{U^m??5rlN9e z{I^6=?@;Dqu1i|wr-u*Bq3~4E)>vqU4EXF&_ez? zH?dx7LT%Pv|69rn(w?ciV%bvXJ$U}a)fkE%nF*Omo`g?_G#IfY!3zt6m1SbaAO6n^ zpj@KSiN-%3nw5^0X4F3g6tKWVg~0}~eKpe~v~2ubnns5!?F$;MJQn3Y`JNJDwMQW? z^Xg0zeUf}wrsYjtQL!j7Wohvd(w(QmU;?y_LnQX_W;(gsc&2?Wy6&?HbNLW9dkI$| zFf-fXDblj#3>~)mf0P^l*RNECaZAH%c)%{?3yS+5R|dtlkH& zXaU%5QuYkYMs(N!pFK9=c*{G?_rs`)P``lsG7DjL!NH|+8rC+kdnOg#$esrPk_H8F@0sKv+bG7!kBi z3c01oWTI=1;1@?fL;5nhr2QSUIu+-5=?&i~WiUUcj#WQpmB#TO2C$f=Ew;OkuDN=A zDl9uJKis3~Xm6t!JrrtEE=lKjIdO5b`FvwI60+Q)rGi46{X$Xxr^IaXWh6j64z^!K zeF{3`!1b)M+@QaKBPlfLkFnY>9@E@gf}{kPb?>QjAWgi>{H6`hlTQ-p4;*(tArI>R z&LxbSxs#_?grgu>s{$uCX41O31xLzJ+`2xK?L|w%*kRzA1x4xv`hzG4U>HCVg42?U zXwHoI!O}mfP|<_F5K1sL^m+|~nb<%Ogk(&ZPIYgo-&R)`>}Sb^sf zT&t8meFWUObGek~IJTSE4@;8wp43C*%u?la|ADPzi~K z-;D;Bat^@>mN&QWQ5#}>oGU`zP^4hVx-GI<`E$#*h>fVgfq0T^MF^taOH_23lzCz+ zaUE1g&%DXaXE>ebIg+l(P6Wotp7CumHZfZS?MPox2yqznPirMR1Cl?2rlv&gF<+y& zXM`XPzUlh|?!EyO!oQeq1kh7B1_=)Q4ny-wzc;ByY}a1PYvBZmVk^CUtm<_DS-`($ zAB7L?!C`&k75`z)(Oww+#?Ex-151d@Yp=4CYQOTZ5ZPZ{o~(TK8r zc5i2w+uP6A;|R7Y+PCl`O4L-2GX055G7w1!NnPm&ywoKs>5=HULCB(3Koutm+^I>@fcE{knv=1L?TiJP8hXTo8tWab*s2lf=Q56q3Vtf(r!l{& z({KK~ww5F*q*j;L_XSrib&~y*Pvay-ZB=Xf4&6VRSVc9uH&2Um1z3Ij?w z;*}r+j@#FRpWh(li0%+?!H|RcX`%Pdb;uatdRjN~H_afCWd~Ho;|D^DcfVB!=Kj9+ zxOkJX&nvZ*MouOmSawwA&;YqRp*ttgvfTO*CddmYrLH zTnSd+w->Vy4}D%EL~eRiK4xDZq=_X3k>qY4J{M0TL~cPzO?eCO#QdkAR-hrgXkp3` zH@Pq3^-ag%4?eTMwI173TUieJU;hC#;NX1s!Css+&djRJ^ezlO>Qd}Bsal1vn%?`> zTV?W)jqC}v=Gk5UYY5^KOf&-Nw==HB($mZe}#Z7 zUp%1RUpL=vo&Nlaa|%C>pO5|^0X)P;08CRngzoL2`#N`Lxt+)Sp2G&v7hHMFJ$QCp zp7JzLE1Zl4^{ZGXqXttDr+w0DK$KO*cqmE1H;jJ7pVErI#+&4gCf|hSmqEDU@VB-s zd^Nu2*WU-p9dgs^kU--=gIV0wO6~e2aNOej7N9V&?Gc4-$wu6@q_YK*L+vX&6V++t{URm{G!=!neu8r6Tf z1u&?^mI7?cLEXt!xe8jzl`^G%jDLv6Jl_S5?-&51u_Q2hXxES|2 z(x_1ckz$Oz)44rZiFPM|s(&c#+%@tk!}WUHLar>XSD+qQQ3z*GFL7bF{7U-5dxTaJ zxW>~ui-DH04Mr&N=fsPP8KR3AEtWk7UySfN_n);BKPi9|=dzfh87QVRNXDb#%GR{& zWEV;bCZlyhS?IXJt2Zt>Y=Y=DoLfof-(6_=$U{-a^5OOR*!m1?T@$w+6?hs(j@EG2 zyrvO(-hCD?f)#7d)K=Lf}a6ZKHaMG%c%KX6nUc8(#7LOOm9{zQeQSK!67psNW(I);~F znc}ezI^jNZC<7-G5U-3U2;5pVPGBHM9F;59+4YdXimkt2%C56Q{J^rTYO2kV%6qlW zb3ICaHcnU5$hF~KV0stGc2E#qG>;5gCa#vOt_-Pu)p-enf0r0SBb=eO))PA3bk%;L9ZKvU&V1NH zhrvEMQl&s%*7yV!QCG=1nOALVQS_ z<-h!4O#mQhqyP^jCuggzg+7l_s;Yv$qc1((MktCOU}%znmxcOk79_T4V4}t`bQ3_R zaF@8;WT+sN0k)op728=T8dmH%k5aoVdG;4U1}3hRVz~(kv+SS=l7A;B^Y7$n+IUPY z)klZ516@<=|8{I{SoOT!$#X(d-ud4Gz!r#E8$B6Y zK#G`>MiuRYg#)dlil(*6=hWJiO}qNG3oC~&Ft0iq+IlK+^kb}*utXTzOwN$MJ_Nj;nhVic3gq@!%#!`XgU%q^V~3mdLqZJ| z9LYh?QK+YNRIcBomktWCFn)^hF&rE$&ovD(b-O+7flWoY+OiTRjlBbfpt?pqqZXNT zo+BGv=+cBFAUSi~a-9fiM z7EoYh5lIcjZ$PD>b;2rO>T6;yj`465*d&#(@+~L(dpdD4Ah3WD3K)g)D}|Eu{0qvr zukF!bk0`KQplS)EnBu8Q=}4*Z^-x_<#>cU-1r8C|13PJW)`g`$*f)s4kY^7d`lY;( z3xUcHBCU4LB_Vo@#CRAp6j1rVZhCe!3Eu7Y*(id66&Ls+>~Q5fTJQGbmVvt*Cz23vf$-D{Pi@8Lt|HbF|c;A@_A*MoA(+rmgoO%40##WOLx=h}OsS=!bK zcJ!(BdO!P<=efu4VA+NcQ^FoS3IOs z8fiz&1(9V5Wfy1Ge3H)Z=YLs!0~{A_7KyJrteeJWN9T2^29OwcbV^HhFC`jeRyV{1 z=6IB5to>}8HiD2C!W`;zi+%toYSW9q?I>$R(?&FfANaeiiVB^3g_wMK&~A5ZzEvp|VXbddiUW_n@6VfS;ndj{4c{gmoxRfn zS58Y0)q`MeIeh*(ZkNatW0Qf=Dm_=_XG_qnK) zMXZ>_Oj#IYS{v;&;CG!5jXF~@mQGo2)fiIMXl09Mz7A&GzeX}sB^d5&^%Ig-vr953wvQr+j1%?ZYb;7x-Q$_wSH^y_GZdC)*= zMB+?J``><+oR@bF>m3uk+~OKkKx+?C$7h~=5meJO*#-WHadac^<=Uuz$=9cRgEbND z<-?4Cv}*AVe%U(3{#-)LC~H^O&I^gSv`9reeuUXbTH~OQaur=&@cG-Cx9c;JZ{2J` zTm=7WG|wMAX{l%j<30VwZHWD2v$4So=en~hwf-0>9*T{=@)ujLR(f=iYkw#;dzkt) zN;=y#%%*>pt$i1O%|pexPZSVtQHwp*hCqU^+P^EaT=fM{uS20VfbTVLKBrS(z2YN# zo-!@3{$d05)k2<=Q#mzHyP|3Yr^{E7i}Pe%Z%@tV>|$4BZOY_7sr!w+=`E$}=bpkh zqc%}RSoi`)egf;*hpCuSsk3}QdMN+3r+)Hli|yi`fMGEKBO2SxUFF6WfAIDtDWX)l zr&&{OVRn#vO`kH(UHX8fa2hs7*cgiiwd0wU)0L&r77d653XtS1g&Lu1MPlM|0e!M* zs9a4R>B!*f1ZY4zL>@n45y!cS=AyaJWF-jo@BzdFx+h{j6V!OXKY9=y;Z?BJzdml1 z1kip9DyDF8Yx1lDkHBW02>jtVAtQBem73fFfYn`a&LmM(C$}h|@ z_dHsXR%m5T245w9W%`Nr3QE9Tx3o0Fl@CLcX7M%*!>QF^JIWNiGXnUpVS)-7SG1fZ zqxyh>9_7P89=3vCiJj*2(KZCJN+yLM{y)Jh$_sr&j|5v?ycz1=g~xJPrA~n49S%Mk zNI=a4fDFz69*__I@{|Z=F;*iIW-Xx-U#6DPRHEZzbz zCnFhwjEK8D;#f3Rxod50D4}uKWxu9!fqQ%f!)h8yEL9b2`b{K;*j89jUf1 z*#pr%{VfrC)ea8`H@h$EXeVrhS<;yJ0ET1*S|?B`9@9FsTseJppMCq=^5b^{67ko~ zY}`(1>o{iD-&)V$ywJbf9mMqT=N zU=CF<@-rSLkjctGxkODWqO=>j2&bv=EE_jjCcj_#v(CYaUkLYy$B zjd#rn#wVrYRY#wh3XIDkX~Br>J*!In+mUIV>0-Oa;NvAa9tz2UjB}L;7yEA*Qjt*g6B?T+LBM>MWn@0Q_S9W@O1D zd+6P}+X#@fIR3eB&#!IG*1WQDJglJcHJ{|3zA;k4%%y+B=g;To!=wXP;#zjedgVxW z>F9P5k;2sZ=QlWslkT6-a#6>HRwl=7w z)BJ7Caf;^vZ!RLo>slI7_QRj!e+{wsRpi%32#d9;u#w#OKNWC`+z0|0wfMfCe081T zF<%qM)j#cJ8_o$O_Fe3Deh7{adMUQ;KGI3HRNY*DNCyQd3vIg~5sdI0Dxw?-&x)l6 zK~?GlbbiQYm~m{>t;Q)JDkTgS%m_+K2KGD;BZC|MHiPESGeW0)jG6H)`0YhQWMkAw zh17EAp@DIJgPdeX_~s8(&AJR5D}16E>l(V?}E z2)#jE6et!-nig?69xAj+i;DY5{2v{nN~~JO7a7!3>rm`*N#}&?XcN9S`(P2NPpaW8 z=R-vYd@Su|`S}aQHz~qtQgSiNX|7Cv-HTQ4N4^jy!qd1vD+1}=pSJTF{bR8%9Q%yD znrHCuFJG5|v7UMGjyP}%97EJ%DEuTVh$4+$`mRY3Y*59?JZ~EqO5B--j88U@9n|+6DGp9fa4_!Mih<|Rkl;R3@=?YJQ4RtrzG|Sfd!6&d zFr4MVl(%xWY){i^m5*K&9?RU4u5X|qOf34_>xJvFCG~v){KU7c_F)vhy{($t>op9o zj99(a)9VSy;0Cae#dh8BXn}m3VUoeMACcNBU{f!BJZyY4jw=W-njMRZ!_uh<5pt-T zPq$IGd8U7BS^s;;2Jo1d?`gKKrpZ!UUMQQlS=M)T08oIfZJ|jsiX{HtMvR%1ef^|JY)^5>B}J!Uo%g=+ zd*t+;@jV--%FoLiF&m+ewYk~#=VY2!0f$^_zPJD{Uq{cEd_NBVR%j;v zUf;BDA-7o?&M2ErU#6u}vgER!CG**yE7A}^;*0fzdP80yuZKyufCP6zKci!VoRr5V z^y^K-6a0QdJVhHnFLH$@P}Zo4*(dFQyuGt19GL30+00k(DKJ+X3$+0{MO|-G&}%mn z2dm<^UK4-UoSG}m=$EMCVT}s0fHBlWc%!_NP%-Vpf?U?ToF`!2rrAOhnH%VhGgzz; z^*-5i&MzE#$RSQgP&m?Rx|D0Zi$8av_h4yvioj7?PX@K;;;6c_(8MrCS*EN2Vw#+s z`{FYSddeTt>i}Sb!Zjw_*HUG+jWRuNNMLCozgJ8ts{I%B?d)##soyamjVuIf^>I`` zxn5Csjj^$(6nn5i_(!ST=4o9(7DhS(6R9RDoEfR zZVbN;nLo@>;^Gimp3F8V4JJ0r_FDrxrleyuZbqKJCM8nQHsA#X-n4hbtdB=X+IhgF zn;Z3oAaOSwUiWwFf{)j>_}_$_7cneJ>s4*@EK7(qBDw4FPsW70?RX+hGeil-gex?I z*%(u6!^da6ec?7NX8ymU2CRv!w`d?8875&KxrquBG`93L_nL8hz+6z10+w=Lv?J5u zUV?E#sJM2px@G?8j@&LOl`!zt@a2$4UH+jy$^)?~`v9rrHbHV?u^g>y4>gGQxH`+h z{IE+0d#>B}EvwOg)RmvEM|n|p&8{5M&Dz}Ep%TPA7C$%NWsdw@=C@|^m-n>m`iAZ; z83}+^mnzb&>aM!WzDc9wl-&rW+b-Im~ zlx9#$Wg5!Doz1>kOgh-C@Y<%o)JiwHFR$sd1Zmm!65bmi;yZO7>95z)q{hMOdaqk> zk>m-U#iJ=p){hwI+AuMdx5%tcTkT_(st(TU6w1J2NQ)=`kYXeg*HqOtVc`8k;lHx_ zuJM~UIf@?G@JT(NDM_%5t7SJg*Rk-)@B-YAEpMF}E}LId-oB)hV)1KMB!0`U!C=a5 z9a`5#^uwrt4-y9YAj@Lg!w*Gbh$B~rob?^eBQR2$KtNmjgn~xj%=3zx3TYK+LLF)4 z51pvTBXf}o-tVwSKgz?3{%D#nvzv3QUUiT3$!2G_-05?hoJ83!L5Iu8x@vmsuz=dy z_E-QVeg*}UL7^JozT6M3G$^^@`;%Bvv^t1+)D%z5k<}D9g;w~4$@ekx^(w~K+3Yr0 zB9VFr^v>Ojm))?d$lcex{*7?WC1$f3_kF8= z3tqvEPZ4_~gMeQ_8l*I1Uh-#R$10ozmgahVmfGHg%+%1A1StY?jabm>SXl7|gF(Z# zC013}@n?MxhrN=ENfkeLGGkEixTsmtEtlNBI}wNJ%cp;t2RrI$G%ag7uiL%P ztV1nGmxD6Tu!(hjdQCtXJWj=vsVoD^MJT>Ci3~>!RgR^i-%o%=G2G1j5Z}Iep6T@Gja8ZQ6amjJ|1JlcAH4_?t+`--A>{u-82-_E)q#>BMi317POo-1MSu5|`f zwi6Yabvk1!ZlJKE2)|LURmgg`6Gn>_P zcKj2Qc3Lh8bH%F=RVPU1n9|UBItP;mGqq4bfkDeYV}?V&gYRk0Nk{23$FX}~g9?c= zrdowHFCfd|sakat`+W=Rq6MsqdH4_xQiOTUP7f=gRjCP#&i~>fCP0b1tSVFJq$ukp zfy(Mml1r56pLkIJlD7xAH2o!4s(<~X+SQ0n<*~8Sy@KXj1}*+#|0B9LnHGx6Bnc(a zCFqqa;V2rSGAkb-=iJ2Jk^Pk0wH-nTmLRm<^9${^11FUWVrHpF!Z_TS_ZJ@@y!$+U z%3w2(X7g25t`n%(i3X>i8b)e?W5pu=+Vt8yW`VP*yhJtoN{ zJPO$RVhud?G7qSWt(%=J`J#33gw<;O9S6E*k*wO?!mv5eQB0oDjHSp8khP=K@r^ZU zE(8H&rLt9MN=Q^HMeLTt`teJQ^&f)`WUe~|&`-#U^bJ z$xv$sg^QATPQoG-AlQ5Oe{ipPzA-59zCnW*%)o)Sl~ZCF1@LnEGhXWD?NF{yFBHPs zyrPg11kUobm|3P!gt@`dwb?!uN-lf|llr$~7tMs3fR@9imanBz)o1~ycT43wUP;l< z#xBgYFHk9_ub98p5_UfkR7m%Cu+)U?9JwhBdP-z^)pI0THDB#=c$}N`dchHLYo94t zN4NdLtuv?aeob@xX0vdJsi8mb*3|J7;+etiz(F|c*Jwq3b}80meiuJ(qZ=uo(F}jH zt)$ibJ;;vUZJZsbK7>DSzE^~iEL$HCmivY_r9@P_%I@IzZs5d8ayLg{|)~%UwHznhlmh`(mtGr-X z!Ab$Sg45rYqr%pLoPrW7rpfvD#Sx;?*R3YrGeF0;v=V$4mAOs<%B}gbNcKX4BHHX` zOzaYA3h}#TGE7VPV{lv54qN5Jht$=ja?i!6g#b;sR=9GUH2t7Vc%0BhD}cBTGpfom z^O%HuHbX-C3hBovgCNjcVlX2hAK<}YPiIY7sWK<6&!5a#rYViYO`~hqL_WL{R%gxg zy$z#y%K!e@tikxc>f4?c0x#LTG%3-X41eZuF^;vuqLzC62}q~B(Pt14?n7^Qd=ds`1ow;++6?YUG?BIM!vM)?r_*!; zvaeU(hQ0q!f)?T*PpE4bz3=rI)jXo{@fEtA(z^sT)f9PICUjBVQXMJ^qrFIehnTzx<{Fb`eJC!y;4sXTtz?m~#0w-^8p-j(pqa$A&n~#D8Rjnh z2=&+*@?oEQOs;5qlw<$0AbaM{(kqMf44iwBme9FSit><}%*#QtxG_s z&9FiOT$XD8)w`TQphSeXdGY_Vvy{uA22neA&{3y!-!V>wDLr%u&=vA4(2ka&&>e91 zNKQx~g8EhvGr4y;ef7YaFC18+L;B_N;23Tls(iJ! zTrMGp6Du(bC6*gCcG}eV3rUrsUNa-iBUVO7BzGZFif!yWwGwTbhU8NN>1fJ1e~M&R zEJ2iV7Hr}EeE1qr$;q<~qrlWM^QB?T<|~qVyC`*oVul!Os{{#0k9+h2ce_+rY@+6D z<9!^La7QX3guMgWq!9xtwy|DsX^{0nktQ#w-t?@qH(P z?NnUwIhGt>7dq(R>hCv*$IM<|l%V-(e`A?th~R7??kWrq3Peji?{m#{-!vP&BL1!a z%!Xh{Mg-Of7-dYMIt9s-`*1aLjvGGCzZ(d#?S+pN>*uM|8K`<PG^VTnE8(+=zYg(EqIxC$jk4 z^6mf2V|F|mE^^+^qh(IrM-knzswTITQho@HFxW$lO+wy3= ztC~6#1CK!1=HRE6?bZiA*!Y{y>2qE^Pu-@h!c*xtPpP)5BdJdUhzgeRt?E+YL$K1b z_tD9)0;+Qwf43D$P8i)rxU;VQ@!{Z1F^mK%tnHn)4_$LI9DRnLf7ZDk3o*zeX+Zhug!uV%r|b6zG+Cc5 zXPi^o()3C41BF_jr6bc}TPYG9;&{%i0qh03ZoVe=5#@z1C8I}(fcZUl=((JEPhmyA zij)kjfz#Qf41k1n0bNRqrO+9FFQ_vrOkC9f;|_QNJf3E+A%n3W|oYWf$Xs z;`+a}TYB3pk6#Q8#M9}9x@(+#t1roGW5qir{c=*(aonzFRwwzAJ@#SA)b*OAV>da& zStyK8u{kY+_p?MRa^CrkTKEy^{OZ% zrIBr0@B60trc@i@TZH$0-3nNeI@7%Ev^HKg1--cB$v+gtj8p6L@Hu()hVP zBC^$?a-DWg=yjtyvj5OF^ZBE{_qE(OHA)#Z;;2-Y?+)A9gDd=4n8)1ti>k7m!TOKR zJJ&50iK=QH?JAlWDs8k%ep|H!SJ4O0v24TJoSBX1m~6e~%z;r&MeUNqM~7!EV)>#j z@eTP+XWy)^PS4W$UDmX+K3VJx7RlTJ8917Z!GZUvYr>T&jJd_}L zryD8zy)CZ8{kC8bMAa?v? z08pYIsFl1HSDdc`p#|3dht!OM;9O9v^L9)H9lQ2R>c$ z1A1C33!8;Pgd;@@CitDWG6b@(o-V%HqSO3kBB-g)}m}*$IvGl~*M2 zfedhqJ0&6xAm$|53C&QEGQ?O3kNTaT|AKW9xD9}hHFpXmlT4&269hM5@8vM&#m2VQ zOWEC_wVOjzA-U0na&MF6A(5B$OKOR%Od#8H@T?XV~`AibpQe6r-XwPGRsea>4(z|f0E8I67MFB!*KqhO|9p(;vBfEV1S+vgVZsg*?NblQh-o-@Q|8i#_M=uH0>%2kuG|O(z6v8(V>=7B1PfCv90`i?kjt zMaoVds>|JfuV4RqzadN?F-5*7Y&^8vq&S4rxfZ%geS<(V=vbx86_KjjbZzP%(%6mc z*EEIj!+ULjBoux)`dAqLP4sfZW$yw?cQK!yvDSiwmwX``Au*$r@hjb@;oJ&Wqc|^}lky zkam?Nh?ZF>uXy1O*3sePFQ9u^G9&hc2+xFnwszXacvBvVvp-Nw`SWU}r=a}A*4H8J zEMrKo4UjmJu?i< zJKJ!U8Y)F2!^k!8KvW)?%V%L_ArGdNvD4G>SHX=Jmn7JpPXPg)NOf#C`yE=79T#hk zT@RjH$SFsc;-a>IFeaT$6e_d55WHj&KzS?P zR%zP2MDch#MJUuz@(j1vMl7h01M8t@&3&IBz$jTR|6Bku0xH+QilHrt;k&qzW z#BEX+jrr-L6q&F((I-QOP!`HFDe4?$2}9aSY1aFK`--|b1vzcSvbl+}*lU${H?6)Y zWW*?Z)?L!5Jufgms+gekfL2L<585-CJ8OQzLiqrf(a2and_jwn35|X-*0iC)-+qi8 zPJs;*2v(E-1fM&S0TEq;RDfZ=S4CFAE$9h+o%Blm0%^Mc#*@iRMQ7(bu@VR<9kTfB zS@(X>Ia#P!5u-KwY0TsM?&US(Z0{#2#)(g+Cm1cO1ccz+!6%HzXAH0i)Ns`XvtWpGyx)x) zlu@Z?bmgfZ5eO16jI*wrSg=n0^L0;k_PmYA_zZ2Lk*!~wP|&B{!cd+6zi}=pxk(__ zT5ZbW=HuKC*G~Mb{jZWpu1VSW6FQW(6#TXgm#(Rh1(g~LG5^EiJG5Y;Y2JcJX{eGw zHo);m8akBIfSWxDf#3*xIB{3}nEU|e^m*BrSE25tWrXyfh&UwlS*?%sB#PJiG2FAP zs1+=+sk_NPlH%xCvA!P~pDKnfxXmx4mfGn0<{XB8?hmcBiISA)C@!0QqxqSQpiyS? ztQrp(W=G68#&fDQEW#D#u+W&~Q!sj}`9)zjLAkLdYCFZ$0C2+PWT8m6S6ycTtS-7Lj>$wUklcVNx(l6uar4Mh{|QbQ900 z^?;o)?;$X&-UAE+KMP?ubSIc2Hc}V$F%Jw&aR$WmvglHJTVBBY4{L;vf~FbHXr~UYg?dS1U^?(i&bCp zjq@=>lVUuTtONbTPgL&y-EGPJ9jVf;>`qUN;fNk0eh)CjF=17dd5K*0dKX=U zZuPD{EBzoew3s%zG#BMuev$00tJT4usrvrCq0#Pa@$7H;>#p>sm6VXQyrB0KC3+8S zza;e=ShB~F=fpp9oe#nl{*b%=czl1k@ZIVU3qxFi#1gvfUSB*&4ukL-v8B_kvjeAU z|01M#Z?fl#jCz2&{_=awrm6;MH161KY7@VZi2N;jQ#%Q{DAoQ6{`{%^`SR_^Wt-{U za6Uy1hOBvvI&JUhfWXX*h(AuWcy|{{=xo1wBRBPzkvPc$_zM+y>C2iqha}EMfohuf z$X?M(s3(el@NhtwX!FkUNdE?Dgw;PBvIT`jbNKg5ne-MIJ$4O^g#h`q%=^^|qL%Z6 zU8opZ^h$p3mIYE3M!@vrwzMr+qpNG-xZ+bpqp>*o&XHv9BGBMm5v%9edRvnWj^rP*}}e|CJJpOSzF2Rl1B%k$i#DBGu12hwME zuI_2Du^j^GD#ZvgR`v8I@_94>>USQ3V}NFCvA??pzCDZDQXrUnnVFd_F*LpQHE!5w zz04nV^00xcKYu@Uf{H@~`!a0}MzWz<(ursG}a4>wld@>);UU8N7g%l%0DevTVL z$|$i2Iq&4_iTGQ$W)<~U(te41yWMSYY`F2%0{>L7l#DyeSY;2eQ~T5qRNLyO6rCaP-&yjkkzYiIeB?9E2~mD>9jolZ+08cdHiGfh={im%vuZM< z=SE0fy#+gNpKwft1Ylq>U=4i!8kkAZ&Z~^7F2x6@D{<3cYM&*B-X=<3zkR_u-?}kdufa`?fkj0g1GqvQ?U|ZA8tF_0$T2ise(URm2K6oFW_tN^cO08mbA> zk4r%Um8xnq7+LDSKYMX4D8bJsevoq69R5tq97!hNq1wX*saw{SVRGWT!;#guEr5h8 z)Dz|sc!os_+O(}F<|OBx?`Axy90}*PBNcyAOteVn8*KIw#KDl%Om@@5jn3C zp)%-$JhU6}1d=MV#A1)o9;Qo~tK>bf(l<>|S|gTo;VE3D)DmbK(7jRol$(A;K-!xJ$M~17-DwI0AF@E{(8uBLC3DZde^%N+bUr%3r&@#n5 z8)GrR)YRVBFmS2f5vU@!pKHrRo)UUPib&4lR}yT@UZ(^NC6|LpFK@ zD+)r{uZ+hJwo1ugwhXp|7A`?d+CeB^S&gxUjgMcg7d#UYpY#@_ zfrKv?bF*?apLwIJ-ySwL_9xQEQe?D@q?0mT_xL&O2MO9vU&)sc#TP9@)%kimDqphP zjVSZcIR4boH(Wz7Y=5o0-tJFSs6WX5yZ;t+fHvGM=gCiMj~JH}IU_>v#CvpwMx!*a zkSUQE>ygv1cn4u)cFHh`gNwSnv2cObMGo2eF<=)A7MWuML{z22d}_3FrFI*k&PlT9 zg&asoWQc_+#X9v0{$JZ+^!^y&0!0u4l|Q9jjf)2Bb#G$m{~${BqelHgs2^p8fpy3CVCOpmqYe=^5#k)ZKPTbCsbY&74{HKF7raf+o)#N^ETLo3wod3dadvI+O*$V2la}jg z8>_PDy93aSLQT9LWYkN$pEa4(zbig7@>N87vDh2KKR#BAqHlQ@OLXlvY3x}CwKm;6 ze%ur4<1uS=SivM#8~{+#uU5yqDl}CO=GmB+3$U*eBRC$~0m?hSj>S(Z8h491o=M|XE5QK*2O+{UtnU2XdKJ8!QiT&he68)$LWN~p~1gC4Zc{Hf}ytB3> zot-}xYm|s|q$Fp^Qby&SvFw5_gPwRTSTpw@j>$V;aAv6-_y6Fmm+LcvmE^ zaaz&hxug}(x0xf{P0>a+kz<~*zIB<3j55p~+PrtP341{{pb>u~)K%KYvJ4Nf|FA(k127LjyyKB)2{ zZwQM##x?#HeO2OXOdGQ*5BXel5DtCJkizW=_qLeZDo2Ri+9r>GE}aq{LJa^O;+g#K z;{3Y*_%T#SsbfY<@SpJ|&F!-lvPXxXJwQ@eNv$^o$pO`$B;E+cJ4H zUu{qKq;pB-a&hv%1X`sOJvF$k86FYmIqA(^NC4ibD8m8qS;ELu$5~GN(o$#ierk=K zGUuv#0O#i!#8bGn?;GD0zq#zgZKw28pYp_3Xdu} z)Bwo6{D|?mPmwbp{@(!4fFQy01hM&Q6A>l``MfKPUV}u2KeqM3Qia8d~p-CV4^{R^Cx=l|!GV zxYSOYeHlwFK7&=7(M~~P${^`rB`R!g12;ayK`1wG4`oR=QMtmZxR&t?l>pj} zqEL$_k{EYLG(V|c?N0d;r|KNQ^#f_1gk^J1uwI!YfBaSZjWW9N9%(mLf#61VVj5`^ z$HJ}>i?AvUYWYZ~PcJl$4M+l)yR~*j&io>PPkbKt!!NW2F zWqMvgQB5O$dXOOp_duPl=WFLEnaBafRrWLbRIZZ|2%Y;K58Z1`g?Fj&c7T_{G0fW(kcHg)QM_$ z#%SDYyW0No{CaFM5S#mV1(pm<1O76#w5qF-M)f_O3xk7XjmDf|2m3(zf z1|?U&v4h{__nFUS3+H}hD$YohJ5R=}bG`rG|IJpNvIyoATacf6(!i!whcUdWMH`E$ zEdDjyG@4h)`*Q~7mPEm%;V%B=uk6yzq!w2wq-CopVq|v_76(Dox_us}sr^=W?sKECYcq0r;vi1Q*u8f9H63{ zwOt;ho>ar2i}U!bERpk;OB=_ss`>&vn-Pb z`W#{C0&5BA<~b1W$w^{y@xDH_u`0`j1i|olX}yTcTjWP@Dpq=Y-C^~&Z4e@r9p+qk zYjpd{T4q_`OM!Hki5qh)&vF8j-%{8D?07#?Xnba1D^xopF&@Mf-k;>tspp-numsh> z-cI!%^OPB^TAsGl^n#VDLmMa$I8=;Mu1=sDGe&YsDsAgwIizFl6IF(e;1T4)Woziw z44&NoDe35JIHUjF-5sPIB0!4eX%d`TeN-d73;VZHjX!W58C0&-gt6jUMF_e*|7m?o zv;yw*1X-)RfYzl9?{|O#BB-X6eAS><3EYExQu`rAjmf!(+dcWhrg3Q-3{L|VK;wF(|^b=Hzi$g9s zsP)778>CB!3Z>70F&*{~a#2E_cpjHb8nyjTS{nS2K48$n2TS-Sj?c3x1&NpV%q9#V z%F{ZJ{~BC&e~eGO5+TaEV$z%FlZoGul}O3yrLM<&UcGh(pZ{B9E>+rd)X1-RV2Y1> zVY2JgMfwX)^MJl^0r>p+fqS7V535U({yAlCAWW-9AA(nZZ{RelQI90Gl3@oI&#WxX zf5|X(pUj94E)WvR8<%}HFU`Ciqht8Y0LKdju&k(~W902aU4`^`L)BFEgYyDPcktqt z_nAo_igpmJTKpn_xvHLyy`C;7-c{f++sS$jq!X4%*r4r_WW5Zlz-Q-1==+tCD1Nsu zCmS8BP+q9?1Ns1QCF#Kq~F!6k!f3Tix7kkxo;E__4 zvmbxHWvuIXSelgM^Wwr^Xo@>6sZvUqn@o(skKChJBUI6L>us`nM-TNg-a z9mlhRs_iwPqh+c+Ydo_M3$emb3fR>#OZ0zhAh1Io9kaM-^p5jzY8HtcND)d8h(pWHV4)w;lIb3yxIm1VX-!KPAz`C zk-jW;7+o%E7N?_v*bV;jBc8Q}``GlgIyaJGZJMoTnVP*nS%m-o8V)E{%wy7he2G8% z)A9A@w&XgEXOE5dBH#q%qLjdb(ePSZuk*23S8it0xaRnwt&s_l+JtE~Ku*b4z$jLC%l1yJ`&_=h&(Ztt>}K@uxK9)i>!7g}7=zzV+)4e_vN`lFb6cZRAGT7$!~7B9 zc|pnjM*3$6YD2nB>qr#OF-=)%>9ZIfiQNUnAyQ|A3(-YdCU?21;jIEA6Ig|2+ud)L z87e!a6w{gn-ye-uAnB~kk!RxfOZbE2_cHC1>^gTzA(5btdpr|N!N=|>!L9F*wup!6 zU^~zGxW=wkovrA-wQ~AUiEq^cpZ?6eEURog(Gjio zW|f$HS2vR0r#?-XeK(eu%YY_Ds*_%F1@^-_gb#;Ea@7K3iU#-j?<)CUr+F8=!)@+& ztq)cf_`@}(48)|df1^w^4Z8IUeAJIR(C|*$Z0Rt`HAqKq^gLxs1H(*W&v+qO*qwE) zunj2}{63D9>O$+Sx|`Fcq6IBE>J(idu?ZYv`xUr?2@Fr%q~0uX0JU(tzR(Cij!0op zUh_$!*IbeA%DCwl)21htq~BmW2G1)!pq{@j`hc9Ep_|KjQKIXBvDqsDw&ZoyNt&R-a)XZh#AVk_)Y-d3S6*j z2$YV0u(=lc!#(rmyHj7L%TXi~Py!nx9X{I!;MoI&l$mIvh`o-~n{e*!n4PtjWz`{7 z@-0{LIoEU4DdcI;{4#9gE>2>ytS$&3{_#Glyoyg}X!T8!F?H&^`?BndX0sV-4G!3d6I$9VtMLKD}!$ ziu?HC{$G)Z<2S|}jg&QbsR=}b#zM!d&}GAHCJj?IqSB_e^DJ|-OxJ21mj$S#NO#W^ zKW2u~y73<2usY@?TLgnjnJ{Lb_-Twi=wHwm+m2N=(l+V(s%d6R6VA=b5?V{$7;O&^ zMN3KiZR!~}WWxf&)j1k8?Tm<=7*V8ongQm21ixXrJ#|F%b*A#vO`38Rf7F&+{S586 z{I}xrHem$1@&b=6-J%rE_GIvB9B3&iHFP{$)^$Ag!@G=L$k+O2d6Lu)P-I{2$uwEy z_kh|@vYEg~$$~Z$q&SP9Z|XQ_ql`I%+ni>SiEnQU$!C-B8+9ii7tHA#RU@kGigJIh z2E;@$=_S`1bmyE=&><@@@GypcEDa5R(33Bnk6b(qio_LxkB4QZcV~u1&rf0_R4`ty`(&(!`%pBILw0*BDkb^*WTqM;9seG2M z4`vk?WfU|%k;%LGpV^dGFF{S)KKO0>OP79~tWVTuR$6F+W3QUIPMf%~BAInP$|@QD zJ;ePg-?y?gNMi_Nz~g_0K(nQs4Yup&Z%4V)Eiosb|iGZcbx9+e7to^brTD3 zEM{#0&Qz!2p42py;#lV@w3;~Hc8OQ~FeJJskti;mhWdHUuIX2-yKc@#nhvyR(%{7s zPx8={dpz(2>Ziq!85(W4S&-&258)KZGSVAcvL~C?&^~WBB#js!JX{*KYzyiXyD z5BC?RlBP+q)~Zy~K=A!(z-3D5LcKWU(StTMRFQX#tOPzYMtOAHZr|-7#g~yZkftAfMM&8 ztk*ra=Xqu@vkVKJTpt!JIj>#UdlIIBA_K7!eJP~MA^U#FDjSA+v=L{zSQT6_(9+WQ z7UQsDkp6>?38pkbPpmsnLU-=n=_=D@P-P1J4f_Z{&)w}j@k9L}KdOgzVC4ui4UUF9 z&N|!swWQ+#fhvl-WuZyF^NhW`4&^)>g&7H)HrybDB!C4~w~;F-FYp4Vr5Vxwz$kc8^E~aOyWVWcu%nNVFG=*{Hr-HQyz9d}(J#KoPV8Eu7 z_dXcp)oJMFMiTSR+;eY|d3uTwc2^9w$!yZGeyVgS7Bib_eIf<_GOS;ekY(|p^04CU+ zH;2pEJtEfljrC>3;>!x zm4PEwdI-o9G4nf7o5@`-ZS$B{RJb^^Nj$9YCwTL49KID?nQ7aQITc?4$VdIv76rLS zM0$LCtDc{`VbGMpa5gOR^M6N448|~h3CB$+VMBqK4Tl0EXP=oa9N+AX2Lxo^_(j(Z zsyi5kjlaJuw}5AuYX=g2Gx2`8Z@8Hf+$e;U2LZ(2lAxYAMVzy|?=_MmuXPp+tk}ir zgd$(neQsyO@nNuZ7CjyhY`qY$uy$ASqXo8w4k*%lTk(H@<|g&DO+tu#e#@qFhLBrP z@qu2Ktr;oHeWH)rnsmY1nwyJ`vx$H)W5~Z$7et64-^Hzb` zq<{q^l|HRT3G7k5fWCs-+JQNO<3Z5Ur^9_AD`;q|MEBU6F!~yho!Oll)l#Iq*I=b@ zrD*T>d%ect$+sQ;g@=2#3UOhW--gpJ;L>pZ$L%83K4Wr0$7~yqD{Z5M>GJUbRLU_tTzZl)J+5m zdmf)wJex>e7H8wFZO8>)m^0-tdLD@%+Vw-MUFpjOg+#Kl6i3)Qhu>XJVBq}_C1jyi zRZ)xUy3|f%s&?&fGh*OYXap1iGLF{KK#jwBBdezV~-z!xw#ijPvn;xAXF$@ zRi~%t(8PcHpj1)IY^XSBsnqwY?K12IH24cxZ=9<@1pq^FM?cT#y1Zu93#&i_tU(dr zNUje3DtS#9TvSNhZROqNZpUSKxWf8^ffrLm{Pb719Zh4L=yzHDY-0hRKr+=e=9Ni- z1JkyXmVpQ(nzUwaa}$~K)(cLTD@k508=SLlL30XZ@C5(NkLgTPz+mENTGOZSp$mY&4HgHv18xzj2X6aejyKYqHbZtTG%g2$Izh zYpymAXzL{o*^nXj%9h%C8gx`vMK)Y!Dwox|aNxh;SWwk-vVC?KIb8Bs-2cFo=QDtS z>N41dCINoaZ3-p7uBhdO`le+gGBD4>vp1**c5SsVi#h3<|HhHO`&MGZ|RfEP#@$UP7f1~1aj=OAlyDpj% zKFkir3t`O8pr5w3z2Aj(@VX)trU5WXadnxiqXhTiUH&QdRXDngjskY1t_@XV;_G8y zkQ>=hPi=!oJmAy5(hq%&H(Tk5mH|F~t0n*%-V(1)JSziH4L!<3Js`ohsxCI@Y;6Q9 zpi}zWh#99n=l);jcI~;A1xqyFupT(C9k%q=>XFm|s$lcQ5#mLo z3voPmM%-kbK6rz+I>pa(CLg;-vs}zyxP9!_xk4(ywL;xRKfJNs6yeN`*ilQ}AZ&L9 zqrtlA)JmM7J~;8Q~gJTKWu2IEuKk> z)rO5rcd@{x&mDb032!ao!!7*%@!VfOUPD1c_D{3=K)^|UJPz;{P)mx>A};?OM0b)F zvIN3ax?K>xFY=AZuYt)TJrqy-Gw zeMprGEnTtx9{y?xHUBRmBnKkUH&i9V5b};Rne+u9r=B=39C@x>GVqkOB&o%iwX|q( z=J@8mU4scLnqx#Y=}1xon)~BjHfF1|9O=5*oL_o9y6-A_=Oy;y-SPdMzCSSedJf`n zG2iJMrVc9eM;zU7C%A8(Cst$qj93KHjndWr7(9vgX-*{UJOG3b`ok$zd-O%#?>|PL zw%9AlRNSx7I1WtU2f52)+oCmXXCl?}{v8_aZBWUJG+`ep4W zXkO}ancH{TG-Pcn3Ok^xoMkKeSU%o+LCpo*r?PK*T-GQW7u4syJEC5DuPf;qb%4c> zqF^=LDEoCx&L9gH#C z3u+I8LxF>h4pR+-)*El|OVJO6`q)eENodVknS?z~ox_v77Op3%rH8u?ltOwE_yDiO zuF=Nt50#J#REW3^l0l$oxxgcN`t2qVm91?RpG>_}yD68@h4SAszz<`Sww#(~%9H;x zrEiHnt)qP&1J8<2oNI{Uk|{q>nrj2%_d0`McN+tMuWoGee?GU=INK+d)$*`1ecWV! zGy|A_{zk5mW^CyqJz4gBj6*}DAn&?4u^P=xb-iPBr&!8~mzS8ofKUnF z;^N-2ImICku~$gzg`sWdUD8?SQ03~|dfK4%+jfAk&kYCB>#k%@1NK@i0|!?H1^*-K zsKkKph62Vk@+stLb3*SA!Hllz{?`qB!iwfW_#LvBUWtY%mX$C+XuKoGlEHyHMVoz0 zA+Y$H!h9f|R_vAc7j);Q=3zLe3tR7(y9V7icy*I#1J&i0qO+P={S(c?0Ya*Bnw{(U zM=+SH0)d%aWHV=SjmH3I6-6j=L?Vnwe>Qwapntb<1WKwZGTo3vWDa$QoLM&Y=L<%} zPbnP=5Cam$_JY<3&6 zo)ePwV8#Ha_aw%{Gl9_EO-nceQC&vye1OhEk^%`JThoo<#VHIDgaL#*AUsRVpCGi( zK-X%?dwuQw9q9d){?z13T|OMgxk*>2P2o%x907>v;qi>~BLwEu=5yopT&&v*f@eH> z5rZcsb^X#%q))GXJESHzLw{-F*;_^m@-O*}1@S@MR2(Gjxy(iNbqhi#!MmwNYTS&a z%)uGl7+cuDZyxbh&p9}Liol?2FgGwm!ZB*h)H9rEpH!Xs8{tD=FNW*u?-c0$-M*HA z1U&+}Y_7ZkDS)`k(y-@W*5@-n{$we3pwC_HTGKhIkQ%7N^Pz_E?L}RbxO=V=8g!7m zR&JZ@z@-bUSLrhyq^1MSAbO!+!%A4sw_d4qlFX(whL(T>H1^^&vRCLXCWhE??-@wS zW~u_4j!k&27sosjUGl2nG^c#tD#SOkR3}p^iVq_hryMCTYplXI%ZHgd+LL%#QguA%i|pOgRHw09!J3J|Mi2 ziJ4@W0^V3Vqri^UDo*E?9UiD8zbxfXX4=XURby;7d>S9@26dGf_(R&@oQr9O=kn(f zwvn*!(H=3tn;7T-e=FszDq(zHUTaJoxGR6vfv94y*r;JQUrk~K~am(eOBsKT!RaJt&@4tO=DCP9^ zj%TnmQ-?nF`=eV?MV=eWkVLLiSSf95YxZ<4sapH%_4gso$w8@N*Q$4yskH}ZuzF0~ z>lwfNtHATQgx`GJe|u~W1SjS3!ASfAtWP?r+?B3R-jGs9-^Y2@+bK<1VA`jp3OFGN z3n)0`JOqpgg9!xpB7j>d&iqQ)z;(FzC6dg~c;@=ndxplfZ><|u8y3WD*1oyS(I zo(rRM#8>OP${{>lUkB-AXd3M9IjbO96(S)V>e8UVBkzeC zOrVXkqShwwgC@-CK&k_K*OK?GbNOLGJ~$^yfl6VZ;$>Q%*E7kfO^vf5GkH!gOx)y4tF*p zb5cjDJWq+TyoYRz;g3OOxVs>ID_lS>eUwX`@Z)@{1dQXCI2^wQM1YICbG$Q?K0UKd z;#4WZJ$ZO8PU>QxMg~{af-1f3HeWzJ#E!!^2KR6bN;Ju=sHZn|Z$|qhcBOH^5+LF0%VSi-f&NHMSlm!L03++KL-$c2qDxll8Lr~OP`4c> zr~0RBlzFBIHtt}*UNhqGUxRaaMQ{$C@L)DlOrWF}PT^FXI1U$n(wN`hTUc+*O-~#F zJgsYU{5KeCEd7r4{qZ!b=+2t%NPGY00gvojD1kyo+>)1tenJxG z@*W8B7nWLK^mgZ#2!Q_6!Rm(ITf*tO_{2o#+EcIB&fkadoInRd4pr&PVA4z}n)p|3 zo!tv|;;yRCWQNc+;pa#HQw==$4omX8Jg~wkGbm_MdkB1PX0h+jWpFKG3C@vT5s?xO zvaVNoLETc18s1fuIYl~g)P-60lGagI$Q46XciYbiiJL{O*n1@7(27(26D-cg@HUWw zKskBAtsqPY6`aV?PpeS&YX|?0w^4_yu}CShD3t)DNK7XuZSv6NzjkbLhGAD@suG*j z=OZ1G+<%W(J8VVGjmDD}g3VFHs#Plxvx|l6hIiANT_4JQncmyzUJ^I;&)VVkDkH`B zqm4qCbHoUi+eP7q+=GR79SJ#U- zqkd7ar*O(2>8%%T|BJNVlAeD%p?TatQ(GFjKsb;G&nta;XM(kLBRnTYwy^q~cmaY8KU1sx=rdklvk z70`?s^7w4Q(lM0?u`r;Zk2qzHOWZ|G^_Ksl1B}xStg?Q~K_AqJ2<7ArR};>4h8rJ6 z9a?>|5M{!76!t;PBCXq|kr{l~0$Hrw|NcsOPdb$LhvaqDlX%5=JaQwG|4RN24hM#px_iKId2w%yp91P0Yq+0Mr%Ia}$F{U-P?_OTGdvLrxZe$0_3hHB zuxh7^P7kzlE7*tGuM$iYS5~Y#@9nRpfg4*}O>v*b7#)EVeLEW#b ztO3KNxQRDvWnw7*H{4ulyn#D$^dRF$RCuVW{^#-Dz7n3r-y+gPv4i|35+vE9|2C@9 z2}n+Y{>F;EQECB(w%ZNI#z-yMdK}2W!{V3Xslf=27K}BSjz^B@tqC&KlxBHa@K=~e z<9#L5UyemzOlk-WYm((e431|61I7SfexxYlBX^toWMSjrXeyTX8%FrkkYv1y1|wu8 zAd%O@Y;qy{Wr>MZUX+ybLDwtT(7ki-RDT5Bj$-?dbWxEQ)0a&n+Ed2_FL~m;49$;enejVWxl1qyp(6YmA}zN03A3Nu z=Nx|+36^|$5MvXPi_zx>=gx9zhy)E`wP7=Vxj8F;tu`@8A`AsKnl=DHrdo3L5&w^- zbMTIXi?;a8#BS0wR%5eqgQl_7*ftw$V%tu`rm=0?wr%^(_uhK{z^pZQ=H7eGJ$vup z;9`U}yDH`Fzry#yR!tfu_KWn7h2+kKByfsps_&Ns;$Qm}u3RHJPo?XWomz56du-57 zoc2;TmAb~QK4;T!$esvBkQ&)?3|BPfr#qvhOZ7Hbf@dA@jx+uMs5aF>o|Q=i{(hFpu}|qu;{+ znhz3>Y(2uz@Eds=IVT;c#UZ@%_8lV3$v>^^L90>KB{W@Yc`$3)s3Pz3n&|oPN+FSa z!;SZGvBbS=d-gJntg}@@)K#fBl+OE*EJ_S7Be5JgnlXWhgf8?2KAxDYr-UX@{C2lD zuyrXVJ{p+f!4u$D)}zM`uOFbaS6#QgFX_zs-LxG?UzK%q&YjuV^mb{f9(CUvpymDC z_T#@7EP8=Dw*Z+RO= zzi2$!2%sjRsja|GuirzY6}=r@Ne;9Ke1d8jt;g z2l^?BjqNhw^&s^m5H((#ln>ok(B*v!Q3p4nqpVtByz z?}EEd_~ES%o3u^&NGol6f}gyF7puomxuTfzy8@cujNGbhzCVVY6Mc$P;+sXow=-%a zU~n_E={0m5!ghy(RV6gsUI{ad{O|3mmnD|Gpl&MwHCc)@j*2l4!ep<9A(BE#Uy2dw z*g!yirDfnA>E*s)REUut%aV%9x*65^${1s_CG8tYq2`}9_ANe-%^@KVsL#9k2}b=s z0IZ2WFUXGG6pniG21dw&NRvr$kMSaI;286#bfC=l>)s#E5aym*W1#bnBO81S71_QC z)}A?O_(H=l9Qm7MmWXy(nHEm}Vq7LCiX z)E>213B0$i)Gf2sYhXjtjIMcqrkxG5Wxq7K_0MP43fmq>)nXL49i3Qc>UreD$R)1` ze$r<|>7T%ThI%7zYl>?ZE)W~WC$&@Q#MIo1TxMHMK=BElCAVmBzLABsibmLw55_#{ z4z0AXy}aWxsXz$BttDnBRuoc>8+cRd`sp(XwM>9y@ZJul$-m^kpA)fGu{xPdiS`H3 z`vad9-=u+2gw!S$O#QDCa2G}{0$k%JD*D^eCw>~QxmiAEKRLGV9ZNp}X3?3SjN9VQ zz53BTP-YX|JCp8Soz2}!S;pT+7S%Q5&<0hWCHZ-rCPKI~x8EZcR932=L-s(|@M97! zW-BRXJ&yq+<~7NOxH%qCIxey#G%}JDakqLob%}@nsgZ~pPP>RPiL-Wte%G;r4;g%RSKfhrM^ll_3 z08gOvwY;D9C`ET64gZ;RHfJKoKN}D$1h%&&UH2bfShY?zlZRV3$w2D7e#Iswu>Cc1 zR?{hVwNN_M0OI;cj!za;7#rB&B(YG!CBttf(x@2z@?U(a-bdz3%8YaEB;rr-UmXQo z)3;}>mznJHS~#M{?5c(mC>nOECWPT%qBqm~>8ysH#z-plVvHrbEq5t~-T_j@SR5Zy zXt6TlJRI)F9q(>MYYro0&TCE!D-}LoqQM^B3_3%Keh%Flscj#SD;|%$(qXo2OY9?t z$u|mP5D*R-jOY*aoMody*xC)@OWvIym9iM{V16!R9GF27=)FG|ojC0tUFxkaFvjTO zo8o4zriO(}6}(_vY2JrTs?CwnXn}?Ye#rIhSMFNMZHu1lw}jm#{irRiW;zbhu=3c^ z(tJdgaTt_jG51lUZ&LZW{S*9?DQ0Ep#Vf`z2kHzE**7H~uU^S=!(WX9&{e7qyC*G1 z{q#^n2Py}3z0>ve@Q5Lfw!+G z#-=Nos&B(KO|RrFd(~uT#K||?Z`rB@h96B^${vTrMd}T#$AX`s`%786mKA5usu|ZV zbqBctrKfL>GJ#_mD1Wi6>$KD|1@)5P%+lbl=z^N&=sjf_b*6;LrKMdErepEPeQ88* zf2I7!A<^_^+?2ED@O7-O`@?6jTSP(zHj%62GyqXP*_@cJQJ#GV)|p+{C$JyvAyJio)55l zl7PwSv;K)S5n_yVu*_C*r5Rzi``u%@Sq>NWSmwda`az>m@x6t~*C`S3P;uVZzn?J2 z2D_1}ZF@11(4okI@9J$@B|%PEGtl<9?W()5{d(htP^tg|5fkQiW{e`3snnB>XN-8B z;qVb=wOO`$vvE^r^4&~peH91>%|m7Y#0!3-wi}|3%EWEt7g5=4P70N{slpeKHbISP zx2N^lE&WS`i}rqNNIaEVC{`D*{C{uLkHMHNBWQTHK|H#U(+&WzHr6|!Ae+W5N&Kn!JH zQ*_@AuJP4A3-O={({&M!&zVI+Nmy~xqgp3~ca=WO46c~B+YoKW{oB=?LB7ARc z6QXJTGk$KKvqcrhW$I z0W7sN2mYbg!q-nJ5Shy_Mep%Y<0K&3HxOOv*Z`y$q&P|bfldhT(UR&;`<8q4FJVpe zzE1LWc~8%Tpg)2W+BG3D-B7z3Yq>M)X}&>~=pvBgFIwZFSA1kBiiaw4*Zk$|H2rM%jOO13)mMrgiH)rWx2rCWefq4CAq(6*Ir zgR${cf%hfu;I#LKsLm_8wV%k-D{c=I$NfF@aMO*Nw#hAUzQ9xtzfDQ^RV0>44?F3Y z!@~wDF3)OovS-kWSS_io1xwSLextfkWwier>oCpE`l9itQUSj@YA$%nv1}O~qltFj zxn^V{$;mH%Wyr_IiEr*8{`zG%)iw*C)=}yUi`h?dhINIfESn~!6`1UJTbq^#sHg^`wk67+5gIU*L7FvUxj(kCl84 zK{D)Sxt4eEI}%O5y+?i-VPFFE2kB8MGG6ex|E^Y8ajyBaKRqNq8FYJQ^9E%9JS%~` z%)E2q8$7T?7msbnL9chP6Ekd={rzdQ#Q9@~c(Jzc2mS}Y*X1oasNkThHUJIrMcFri z;L-P~np_BOC8o?ny@S6`MNJ-ZyVk@Lvgb}KGCMeRi0V16KSUp#UQBp~+yXA!xwur( zhd$o7BdjJ%I7%S9-!CGDeaYI?9Za_G`gsfQK%HQ;BiTh3j(Y+Mf^A$YUc z6fC{AGo}pH+1hr|UhNU{(;Z*M+Jx^d+ByeOmtKgy5Ui*X^!EDmaKXe2sJ2~EK6^^9 zB^WWt<8>_!PCh5?(=9k->Z|eI*A$go6fsx6rAKnlVW27KsS?+F7E#T*mwQ5K*0O}+ z8;AhmVwGCL7MrAshUy5*;pNsE1_52I&h^TG_aMVjOW0OqTPLr*h6ZV>Vg;L=q_p${ z>%Op?i!di^b zsq~kss-qVEm2P2abLoGsx(w*=l4F$Q$THu?KLmq$3Q|Z6mo8)VGF&A-7YYpWhM47f zjh-eQ{+SgDFiN%mE$!ZUM4+(r0C`1?5_rm9AOW(J7!hSac}xNcDt~|~Tf3Qe_PrmQ z&bY3>3lbYO}L+RVG@qOs=;-JftKt*8lklyEr6vZnLoV-b#UVrJACx z_X|lgm4LA_mKUu$Gx(tzhh!=ELaxqKH_K*Z`&ULhiaf9~(W>?{DzVK9D&=r_CpozM z6Tl!sd@?dc?xOmkUgi4qcL^y*y@3U^z6Ov+9Ybu)!=|pT4}KCI>bCSR@=}O*o7Hs0 z127|O2%AlFQO$ldM=B)C^D?T9WhLkcRHKMqU@v3tn`>}_HByBo*sS7=1;u>z-6ZSW z?iH;&CcIjS=8|O&ARYiunxatz;GiHyM{EM&pcGwuhHkdlRrotstMaGlBOTYJM5=jN z_cA{Btlh7odRa$n7efiXZbn9*7F=cP6KNkk`9-L%Bzc_c3A}BYsTl$SD;>Wj2W|e? zHz~MO5Z45{WxJaP{rF@wCB4_<1TbH!+#hvU#$5SI_M%CIp3-9g!7nH<07#yZ>NmcM zof{jj>*y)Lcl#kp9%otmw7j!;ob-j(Ukr9Vnj^04q8%*WOtc%`#W9`55O)lRk@D^} zzLhe!WWB-*{ha(F!Z~jnmQ$)mQwFwTRgI_$Pw$^q6N@3Zz@xX>yll6SECOJ&{~i3< z<>5Dk(fPe|iZVmqhiBq`^+M~V>+sC_#2ZFMcfl$;!fm2Z+FwCRVC1{1uOlqlv4zK3 zK*z`@%5e)S%DMAm0<+wsYyBl@86!yyBSAdK&R<@BIV!$B*XF@Bran69I%yB8rGd2?3r(SmmT1`hJm5(%OHjU%+3l6 zp>5UqPoAYzIBQ#{y6|FiB34X8RWB+%+$Z32pdQY{@$A?%Or*-1nr+dmkz6{*3%Z97 zUYBjS|r6lIz;_+g_^G^;A&aIxM~94VZVeC@^3 z1tl)u$db%!76X&Dom1B!itY_%_W7m^+w@QKeokl=-C$n)n?Y7m{84C;Ft8^8wk zRQ&)JB9jnAaDA^VXbRt~-0yw%9}=mM<~b>4JA2%Ts*ZP-XBfWVCnaKq6~tN@^(Y0W(wgtjqG>HV0+_q03X+-2)y zO5BqZwMndlB_F4cBQyj-uoz5qF!y^uh1a-dX+=nbsd&2WerZ@u*O5flzUHgp<#yv{i(D# z#B;yP%-cKCjQENHXlPjAVctnvR9IdDoLLY`0j_F%zF)b%sHs$wVg~82_5m3k0pW4r z;8>jZ?P`b9$sT9WqggdCk=M+zCN$~xKrD5Sp-!5SVU~Ni^dP+5XvnjbucCZh{$4-c z>7k)>6)|yr<`=!VQWACprDC)iyoz)CAZ>ApreSwA^e(cUHI{MV z42+GCZrhm+y+ZQ0_xH4&1f*xuO_|jEA%Q+ zqyGTlBvNWeC~shCp>_cr0=|Mu;Pyea%1D_QP)GL|H1Y`oI-8P!Cdr|ce=I?u?IWcnqs zV(8X6HVpQQW!(2SO82!;_c+ib_|@P0Wk3>Cc{24E>u=T)V|Fc1?=;LINGw;Tr#<(s z&wDOsM^vH93~s>*N{4c>=gxU;SFiAqT$e2^A0^pz$8l1i8L zZ;X5j+H-_s=Veqboh!lS$_BlHN7i0Ohw-sBPMWypKALv&lR5Z z;QtaNihWSv#B(pz)gO$no!#v5E^0?_SFp>bFDZ+&U>%IA8`YSUM8|M$noYD9)XOB3 zdc4-59p(yAVSgP00yneRG`^hwuhas#wd_91I!p+TH)>bxtisAtwe?c8B%UxPaEz}0 z=CH#swjT?3`41@UZF_?R2s{LQ6YbCS{CGpY;s<`|Gj|eDouXj1 zlnEbkD|a|rx-`Zk)puh^i~$5aXnEfS7hhUmzK#Wx+`=xzdPnK>1)o*vVU&&W#>-fV zw&nMLbkswu2gs9~>xF>soGm6wVuM4~q;RtwW-bct?I}<)c2v z-tUmrjRUKcrz;OjN1Z(cln{mi!r8Z|bf$w7{RJFneKxo-=K!>QI!ov&p^sG=swdDU<owYxld;j!U2~LpG^%NQE+oVFR%m%wl6vs(;F~;9!@uF5y>3a3Yu}`+_ z=AjLmhqwEedAOAuL!I_A+ge8|FU437m*tXMIAu@3>V|`2!pzl8g5UI*c|$920SDdS zV55t;PD_f&JSKcz1el4O)%heV%W_@c?~SNnQKS`N0^(?4#-t%T*@!hhK>3;rMES(m zvXmDcU4z{(SG7zjh>erE=%ADaU|d!ZtG%#V3=Kx9Bu3ZEx24hNmj8wcqeY`cJja5+ zSx>RNgeqXA>Io56P|#sP^@DKOnd;7=nis#mpusMP{0Z$Mj}O`@FOs#WA!R+_T$INt zRDIuq_Sg;$y@#fsUFMEgRX3wCf13;|XD@^!1rMysjt^(M|WZCql*I|9CwoBr8vrT^|Q2Jf|njF6A zcwP}sKC(jLpti=BgqdL%B^MtMGBPd;B*(bIcZ|u-oZN8UC|f1MV;fq}fKc5|aMGEL z2)XEUJ}23wv1rRD)W7*u)}1w6M9o(yjSg4Or2I78M+MX0*nJZNEXz7i9+=w-p;d3!1I1!`zVbkYe^~fL11eGnts3eU^7a-ahXnYF;E&196 z9ow`WVc-QbCVn~=^FHQS<_6x09-9FMT7e4kAU$b4_U9vBbww+&3xUCUd^HO+e)hh8 zxinjpvE5X_>6W^ZDEXzoC|ZNR7)rgpp^m*nEM-iDe6Wh(B__RDJOYo`=6`1(HPCl$ zo9Q^ou`6b|a{$^~d;p{NBz}q6Dm8i+bRSXGvL!B6c-$Mi6E4y4io> z6QU4iWP#W7>7uj#yX>FJ1SYHt3R_9aL zR^6=LY8JTW_230v#<2elL>w1yXal`gRrr@eC|EGfM=EMG+k3MmupC=XrbH%`Idybshf;x_8h}=W;$- zp5uS|&D!z>3~xhHvBhZC(fv{R2QpYBG7!je7^cx>j#lNi?Rew(cD9B8Z}8$bKLY8j z%EH`IHMgTx_imGlwm%a$Y2*=*p~I8tMSezm;A)IvSXB<~e$=d*`R%Wsscmn}k0jlE z@%BiShTJ|2tcAtu<36?KIdv!Nys=bOTQ=-+@SngAA#n8RsSy5TL8tpIZCx0|<_`Ud zp6<-5uORbsCnfSiY|%nmRuYuDhoS#;y~p8m?&%S|)-j9NN(71^mxP+{Q1w|UR1Mrq z+*v?p+kD=qEzx)`ZsRRj-)Hy-V)pfmcC(RCckv8KP>-&bWyGlWa{;I~v9=#)b9Jgf zS*P%sCPA#qzP~uX@fZsV&Vswztj)3&!Ihr*IF-%KSenhAj0$1c8f5RR*q`UlZ(yXX z?_V{%p=SMnN$HfsC2AO(tAbf_t=Oi*wd zWbq}NzK#~Wi!;z&&{RJ+sRK=VY|-boG)rh4>O%y5DZ*W%yK`#^A&A`5dSlczeF|>F z3woN$Bee+R2JeFZ-e5D<3@IHfwNe1I0rP9ja2wUOoF_r%qAY?oZf>Cvr4jMSeyTL@ z3E+4i(yv^2R(Dz)r_qPuYUbyR2H7kv!QP$zY_GJO@=4QQpI7;{l>2WlVyR#r(f>E@ zRD&tKRRH0#9{ZyJN;d}MXtY|zdBHsX=aXyFCm@U`eOc{xoZ^AwH$V+LU@>;{dD&vG zi%XYa(8)v?5Sy&JD2$nA?CgIY%R&zIpCrBJ7%1Y?+6$D(V=5vEh%Cz;(V z*Gz^??ty-}LLZBg7~PURJ<@ecaod%4TPhHxxo1IX6^H&v(r5z=64v7FL`f+^Hjje* z*mkuL9TmyAiWi-JCC6f|dbl<1b(tmQBMSYb-!urHwU()xI#3}^7JQ1@a`Kt5p>tEl2eI@Zg9Vc_LV_a+zekVbUr%<{DJ(|#lQ zQBXaCTLMmCX31{;;H-a8(bo6CKxjjW`1tow?32X=Z0Opdq*rSx`_8NGG0WD_c5{U2 zVM&B+4R&~PMW)mbV=JaPjBj8*;yQS8xTUxplOpM>@w~-i!JiLAp~||uMk&=ZMfAS+ z!p#KDmp32NVk4+#C$gqjrQU&g4?iF$wlt>Q<#srevn6?Ixih($xHIn46RD;EL|>e_ zOTA<=Pt9gJ9#H(~#|J4HD_{GY>cTi=dm6X&i=exR)IFMkgVd8SeI>Vh6@g3LO-g?WpbdJtaxO9H^=etYCM`oti zeX2@#f8%j!ek0Q%L4h*s(E6e=4jC~DMlZi4dC7JiYRxU*Gts2#-z ztaf73ADFdA#>VTabHBq|Fo2<(q!R+M7$wyrHmbu&!Jp{pK_`q2`Mo09ST_pZJKc}) z5k^#iAZ9)i5^;4K8bP!Lj3F+1;}$69zY;p$@yT2SR?e zfH)EO;oMFvg;Av&2YC2tk76eV7)*+ksFdU<81$1kCDccR9N*mes))q0*K0XMatyyc zH7#ZMm(n3TJmv`zSs3UJ8iu)XqEi7-hgxOq^|z&aa3oIMmtX8y{lU5t5~(Qoe>0`k z^irzu6r$@aQ^i)Uk-`TX7O(ZDhZd|vn}%k^9|Yl>Ob$d!8wKT=`VXfI1~S zrDW;p>oIKJ=Yu<#S(!~koIc7(+?r0yIqMN$?Za$$9P-^%Rg=uH8o=~rjYu127f(MI zLQX_LHJM6yMQTu*`*m^M^!S~yqAh36LT`-!h1 z9Yh;cS35RZQH)05=oDv(Sbk-#(|)&t5BsB&o2@AYFYHeT&ai6qlc8>f5Hc7L?OKeFVks=PPI{OsC${C+7(Xe26C*4w<(S&ry=;TrLiDC6kRY)r6 zwGg3u@qQf?Lny{ek4}W}B~>2mg&)O~i@i&=zK;5~etq4o)>Z0&w4bQ$h@Dt9xpBMv)DCoJwu_ zNOd}Pb=vK#3zyQA7%yxcHDK?=Cm(!vlt$!min*dpDjVEJn3aFx)_&u@>yWyhxTL7m zr-<21ZLw2dtuKcLWBRY9OStK-7Vq7=+~#_zciw!p5)Se%cr9gDM5$P2);JDkm>*M9;2IVf*F$N zB@>2EL%*AM_~K4VBSFNQ5g>>} z-<7}eMMxdJxiKieC-q3kEMURceG9wI8l7-N$AGt1- z)$VW9Pdyn?P;oVUWgN^T)(8*>6cFAmuKaDAo#O0te@}l~0@rOR#ZyTasHp(R)Joj| znFJ6F_Onoa=;^0A!3|o_z%=G+1HnZ&l+8^5ZUt~$44VMt?AGFKm6Z`T<84KtmBfL~fhk5cu^z~F;?)ngV^ME^X^7=x z&Gwc6uIQe4`(4|N48?u)xnO?DTpZUoI^qD3NM1_VL8s6tR-+W5|7{tPH2G%}-(HGL z01b*-QQ3#J_-Jx21V%ZcI;MH%fsA?uIeB+0&2_QtjUpeLE zbIJ*=tAu0g=R2s@pfTLJ#y=B=+<;gR5l~Y#ZN|_-_6`oK&DPkGVU=+W)v zmA)}_tQzc3-|5ss1SEm$DD%*lI0Jk?Sj#mk^B6us#N>D|Mu`{1I@j8GSm79{G|h_A z`^5eXo8Fg1De*fN0So3A|`i#UR;m+fqH@k2PG* zS+Y#x+VVzV2zDaNJ#%o;g#){@J}s+5Ea8KY4pqsZMSbcG28SsPq8{RB2fK$Pd0*|z z8mKZK)u(1;bZb5vm-Uaghkk#Ev|(h9=|4Qq_??`(P>Ou{ z-WT~0eCa?+NCZ?Zq(K|FhmgHnu7~N?wz&Z6i&A&OErLC}%bB1*GJ*9$6b`~`J~!zb zi|MxQOAL1KB}!1LBfVjG*g(5cxf_RDE7aCHj%j^*do_<=_#hN>=Yn1Wtg;&XYJW%) zyKd#wNx7{Ukz1p-`%yvteww8-%vljS`FhmmbL(~(-Rac;@q;HQ6aF)B=T^xKz>s2I z7qzf#J0rvCXnB4jF>Nw?IK@M)`|E||jH19Mw6cseCArHBagzCZ4G`Js3Z-cCF#elQEqCoYjQ}+<<^&!}U2oJsp zOs3GqOFyDh!N3=9koZPG<+DweZPI#OZ;BCkOILp-T8J@`d%8yb8RYPY4$sVyMrw$Y)*q*x`kj45%aARzGi>b zMlzc2PBbDh4T+eM@81j&(soGWUao65ybMBq4Yw z@4X%4V@CW(c5M1%X_3Tc>W9JxDO$IvQ{-_Y$XaeAm21oEyR?K>BvfDB3Vn~rSL7|B zOa%OGV`zR(G>j0MO1@c|0E+KdyeqwDG>m&cI~r@W?{13dH^`lbVb$f52T$^%+Zmyx znZ!=y0c5w0i2Bl@NWZ=>F|zZT?bQ<2Z&2NlpR8J(K(-At6JkiRLd9JDTr!Y&F85Z| zOE4JTimy;o_sVNRw&rU4lPuDr`Fs~hv}SSjDEeJ=L=ItYj4pjwTgaC}6d1J14I&;0 zr}LTH@;8bRjl;G(WURuNRS_MfBP)16ZoL_=vGsXb8Q%*2hPf#$yL~*$*ZBDQOOsvA zp&)byK*s*s{?K-@v}Brnb^^D5CRjnC`tNxR!Ci=n{1VWy zjT$zR5@^vAgi@oBC%V*+Z%e;vt<>-wA*||;ns6{`gHFw{_WrW5V4Sn(hO38X8P6Zb zc+D|pls1#VSEEj!o+S#LZ#u2Z=Tw>IBoiyQ1bB>%#q}Fxl|&Hm^+i&&0UBnb-P>Qz zTmExtEkSa5FDCw+U)>Mz2^<3QJ~`t}-ZT#od4#x;Y)hYJQ8+RiM+mP<#OvBYFzo)$ z-B-Ht-UDd8zdKzA>DO0U%Q!U*ZCbB_ocB|UR#c<;bE~~kk0=%bK=S`>xj)YGd|iP+ zx@9NDsYktKkG>wTXoz7Hx9D~P13yk592cxpZw2mV^Yszm*scsVOgCx3$#xFmMg`tC zgbhY%+O6eZ|JE;r+@RoRJj7*mhw)<&#XNT1^skQ@&SFGcbpkT6-$Fij&&d9Kbj^q< z@5q=S?!NXX^2I{>oV|-cJdAmWIpM5x6zI~6wgKJY>a}e?cEX=P7H~v^@@n@r+U_E& z?G?dk$4Sn-Kdcf1U$q*AvY9yoFSoQCVL$BpvWe|?jNvbuf*Q4U zoFaomH$I!_m@|muecd>&hVdx}G{E3mSR@0}C%kO%U(94n-k#4t)I3VKn4K2?Oe4lF z_$lzHzm*{BIp>LOBi64D-)34gn?!5eE8uzHyk< zsn|9qUilsCreFUveK3bt!nzvm-Qj?APsV8LW2CKTPy72_#fqkF+g@(Jz{}Ev*7p|T z8coVLgYtbB2w$N&(f$zn5sKkTPU`{_{#z~tD!*iGvkNDhQu+SXL`^ABx%;NP<@|WH zsO79ay;Mg^wW-lH)?Hm5!V&7I9%1U}UdMeX=OR^yOEPT!t#R5CN{6R9-B|gAmA)jQ zD=>8*x0N`jO1yP4?ojI826)W&d4H-FdaD`E`cC_k+DO%zPP`BM?Y0vN?ROpz6h+@> z7a$${@9>Jd9NzF=h;9bL{&)a-JjQl}*SLfo`u-yZmVD8uoKO;M6r>mv)HrN~vlSFF zZCG=uGK_xtcdkAo7J*#6_ZvBKhQH||R}duVJe4bZk&D6$HORfezoGMSVd<^dbf=;j zHbRT{TMyK&*5fzsflQ8kPhIQvpB9m^D;jPc$nTJgne_&_NG37WFv8KV)i9ovRoAJi zEhfCZbtc^dLzC$C5I4>_wUM!zHNJ7y|@*8_E}iq@(RVC zNPdYCZB*&V-f-02xl6F|DHM6;D+s>&C+!G<+X$Do^`LI}P_3A++@0ylMb>flOVg4+SG)2FHyema79HPfMptLn>n@0vl9KT#Qh#>5iETNzR|GAjwyen2w=e{F@5h+kun%XVF>Wy%AIBZjkFbH2$>1 zrZ%QK(6zKCNo;_Jt&|%b`+c^E-x!X-4(xdS$B?bHr10!oyu>y04-y0#J4AJ6sr!;v z@@~);rJGTxk0PhpYr($ig(DHTV*5jDut=nzUKhe-e;L^MsKvK^4QxajpyuIOAhS18 zerUXTN1GJ$0XRb${q!p)vELs%%kf8xQ2qs6zso}s{2HVa4awBIF!UwzrQ8bpcs{AH zg^**a9mVf^H$R1ms%eGbFYh$kU%2VMAIaIqFy7H1el6yZi2LKwzODSxy6>T?K+ZUm zi`wC+I2Nd5`u>A(`r}Bh;&X#>{M#m+K#cCDd|7_nDmkY7iKJGh63OwUGU(GagrSFS z_Lvj#qtr7pe!y zdS`-awJG~~FIs0rSnC%JkZd>fS61{0bCoH?vv=(52Zt|XYkP*% zo+amFvyBTfgmu~BD!cmihxjQ{?@DjwQH4!UV-k(EJyY-vE%0(G)!-zwgnZrP0c(-p z;^Vjot}!&NlcQFPHqs5{BF&TGo%3!-Bne~<7VX3hcBxN9`SxS=u4(@WqR5jlF=ndR z2l+79t*H<&*0I^W>NPUjuTcZIK!dVQ7oDPJ#Ti9c%;YdFIL&EV7Fhw zKuiZ8qB(iUPNItO+QINoLM^Y?7;GEjwF0_Z4^BwC1H?XBfpqb$Pe%D3W9$p!y3dHt zQzF#G|qI?21MtIY~5v znx?E7d>-}Lq}6&sBS37*4Gl&g#rgoyO&;K6x)vo?XMz&HISf1y+hbiem1mWykY_bk zC%P2EzEJ&Z0Y@K#*s&vlvh8-qAHO6P@?#aLtz84 zLu*Ex?FGVr>8KQ)ZWF{MF98s*o$V#TYyiY0#y!IjZVS0Mg66h2w_mC@8(Ovhb6r8+P0qA-c_zuU zpcp1~Lv9II>pNcem@;>m{w^a}(*|U|;EfqQ5kY-!`;-Gzm(Z2RncLOka6 zc0}v_vgH{>-cXW2{LxE+2?o`T0VRkZvL@%2@+SHn>vV4mZG9{Wf-`LkNHy#X{QXhz zs-MiGY;4+}RDfXu4Rv)x-*3`Q7a=~Iy&{aM9MLs0cZ<>6AKMV(RYOTdd-DJg^AeU1 zAKCB9x1UY+ogDM;SHu8`bmwQt`S)_Pp2A{i#c=08>D*Hn6qboe@keljI)_CdQlB_; zn==&Oda^U4EFVUXvEd&vEsMzvl^wk-aBGR{+7O-i^*PB6!%{sTycu}?&+iv#-yoMA z)^8z``%iQqs-?AAb+Ar~g&}3ArSQYG@}`-2s_YP`jn~?wmpiU808}Rp)G#Yd!Jb{W z`fTd7I69t-Vx5pRlZzZX_rjsig5F-ljwv_|(T3P=yzX;acLyMhzXkujhkPZCB~@rJ zIe<32*p)q*{>~dxmz>6Dzvg@G(dpWwaz+%;PoR#>AJS*AiHY9qnth(6sbxqp;D0-k z<2`Kb$FuxR_6vSytY!et-DOzAcxDrlZZhW;|NM=oIgcGZ$Vjq4Rw5Sp%gi{9^D4ps zgj8>{X^gN3G}}r4N-Fy#v{HclpY}uwRtI8mN_2Qoi+FO4n}@_H9yHTuLmFpEjmLOm z)p>h0jUqYVE5kpf>iWI`&Y5*@?3V!nqIiCL;c_VsgWhB3?W=>uAHf8NqQ-+%x!B(f z1taF6c+VU2w%>YyyYnhsqAjbl#Y&lsIAgdxzs(lHcWs)A1T&?Je}6w3z8G!#QhI+c zdomeq$v=_P_0s-v-15ba6`$cgJ>7V$c9=zvWst)ty^oS#fhxgt@vjrV2^^7Kh%5uq zlpdCE6fy^%T&C2ur7rIjj_~$pz)-F(h@uhF3CS~I>Q(pSea+$CB(vtRhg6Qnh?Dz3 z>?%-bpBR=Gwc){lXfO=j16_Gz?g@im2>`%q2g5W{D{)+Jhbi84?OIj^&1Dhz$(pkk z>twdMM9EvpNOS+Zhzg=x?>kB%%}$Jo?7_3;02;PrDV znoUku{8TCj=svf3#Gy3%hlr0j|9-XrT#d%AA-n}hvjZT$(!}JHx6Hkn_^6K?3>~qr zcYK7{tiGtz3C#3`4n+GbcwhFE&~B2s!BnC%Zv1z?V9jz~F?#TS60*rbAeIk!l4+=+}RJ-G!vzm$Z@h@)uxTeb= z?-$W@xQd(v_{y@y^7$G6x0@+@D)j^j-Dg;XR{&n@SSIF+f8+)!c>#Q z%qcUhYSR|Q#=GWTvB~tk7syL5{ju5tg%{T|^8QXgQz+vo7}o|voBfIR>@)!n?yY-0 z&mw$zL*#Gj?dIjnk(`eO@yp@>Z4TDAocFmL*)dFabR^KvkuR!RTN`Qa4)DY5U<-h~ z&+|;S)!-*W8-{Abj#YLRnY7zjzN-o1vu*DdjnC&^3l&fs`|k8-e6lE96utkG z9jwEt8*;v9LbA8VIQPL~w9l)d4<+oor(6V6+uQw$_aR~T4Zr;eER2rp7L0&2LY=-3 z%7BNh?3qx>poVj)t38NRY1%R+(FR12g7c=ZHt+OlEOlnNY{WGu@DVcUghN7aKFBfL zAZidd4sp54a{POb!qWZgXF&vF{@ux3lSl=%r_tQMu61|IQbLD8bUcEfC6j8ahl!71 z9Sqo1W)hKN;CJsMDc$Q}qstJpxYsg1MCi*{nC`D|#8%Og4%C#z_@iOm2Sj_`c99{3SlWXUbWFfIB{L5HLwvS;`s1ko90uQnueu|6i}mV3tL3!zI=L(-n@}ez{|A%He@FREjv@1Odio>*N$^k#Ry)pX@v&McL2z*p& zJFoY34JeCx2}Rh1;eov;Ma|3q*i=qMQ8yZil%_nhRNLQjI&VpDJY+ z9wya%_oBgd#xc)_34xZ#s3K z?>jVQoOlS6bJqIW1)_#%_1w8`hf=xEnZv!E3AJqFO?huQY@42l?5Q!$&%jy9?C-$Sb-L;S~A>-EjM%f7XQ1 zT9ecJ1anjz%HR+y!PFLUQMcW%$EpoWkhn7|+ekMl`YtF>WxcqCD?i%2Y!}}>Lj_GV zT_zgC|F#pmAka5h`$J7E#PNqfYGRe_QMZ)2XXd10wZM1wk$%|)pn2Z!ltc%2Iw(;v zbg`e4QMKexGHce>`A#^Qut{u0z#l25#66|4|Doxe|LT7KKYp@pd)cixNW|A6z$IoG+aC+?5O!)9rgv%2WPmZVWf^C;?Sz3LI;@(I@N!h zV)!4n@eFnWxb6F1p~v@0YKqR6X0wP5@LDawj;(vxONT`0@Q)$;MSe&(uzR4iJrT0` zAbRAh|yq*p;?M`#=E}i!J8+=MKupy$wo!x`ECzOL9$?_8v$NbOx_dy z+P1-lMTR32Uq6E}LKgZ|G*%9D-d4`JdcUwY+A}irKWfvtt{jzDS`}w|#{Yd;g*ln1 zJx@8rw7nl=-AgE=#+0FnS0>E|!SEb-?_RKeeQXEG=s-H))I6-MR-(6^HSiXJu{j~# zsG`oN0gvMtK2&}q*e1Vke5qYQ%%f9^0=_}b0)As%*qGLs)ne}p1;Pmbx;4a%*HEQIhAWc#U@GvE-RzBjR(Ls zr|iSK`|tK*UtfxzgEcVoYXrQ%-;Xr)Tg2ZVrviRMJvcBYgzqJQH+F>G{1IfN*C1-D za}9ktkmlA_t5?1~I8Z5;qyjuK^7R}HlX{MVFLx?Q7w;uycLa4j=#N~BnXOrjC$a^H z+$c$M*xlW5F=MP%5d*4`bBf>pIl;84&U-i63T#~kMq2&yP zI>t2Gfn>79JyDe3`m*siua3&A-AQ^wYxJ!txYs>R1>_9=p8r0sasi9?b%{=4e7FR6Vm>vT2=`^Q2eL9l8{rNMYzjP(-3M)dO39Aq~2(o>|#e zcBCW?yvYU=lkXaA;k|q`=p?u*bQvF&okS3e3VV?7%XHst+?9sUdoYT=IfxMcP<^uV zvhnpazaC{Ktaaj3qc!!`T9+N+G7Du!nC?@ytPVOn@HPI%gmsc5)8cq-jt#T$x$VIA z5z~*e_lhi#8){l6tITD^(U|)qHu)Xg5yqQW#R@7GK(Rgy85qZLL>ny~uDY zVV4fRWLlSS@LnBP`#sgjzx5r%5S%uwkyeM3n|l@Th1kqA2FAY~E_|`r(_F3x({i%g zTRz~WbYRCXVUGAPBs&W|s58v|mk9gdG0#h5uRx1_hFx8(l(SwrT!I!D{tp64G zdP-GEUD=-eZra{{ADptw4}AE+aws za!AdwqLpIqWFv1mt60WDmz6mSz}JMl-$~G;FCF+g@o;)Hq3;HeOa*JT{YWb z9DsjAT0O4Mxf8XYEtLHj5vgGGwk1c#b3Cx}e$=8(8~)D=ry(`DuJXMLC{X$0FiBFy zc443H3gUQm*V+QGmni)4Vo-SXEO$rU=aeRa)E)gXKFf(8G9h;Lqm;HnoOAG?xF-@k z8Dn74`M+v9g#^CF_j@u}rD(kl^d1Yp~H=Q9D-M#NA4NQe|^`3;7{N)tgK- z1f&Lx$wF33ry41UrQ&>Wgq+0(Q~%=JXVfnaue;6($$SfbIpTm(WQSVl5{`iPYatSe z&>A!n{=9A2Jd#!%sa|z*`Vhi_L>6%EFjX#`-#Ov|Ng4Ma_Rv|bv$EN8xl;lO6(d@p zFsH__-vbDbz+~#t)D!2(6JV28-k$^Brw%b*TI$}zh<#3K!;5j&2j(hnpOycCLAc7$ z8Wa1aIm3V=%XnPr)0tps$i2^z7>`-*y&WyfO{8LVVCb&M)Ha z1`kfXI;Izl`)_zTq2VUa!R zAgu2^-L{HVq_`#6@Syi&tVr)Ob>{Qtd9czM9_0e4sJJDn%89-#E+9MK7V5NU0|DRsNgn`dj zax}_`m}!YqD|#e*_WjCurlZGB^|iT;lIGSbiRNdO$|e(2&$^(o-X}0|;-0S#plk1P zaibS;p)LGkaTydWb(x5sQ0Q=q%$Pvh>)9ckS%jtd#Vg+;gTF3Qf|G|@3NQy=fITXI z_gI^EF~Q=vxL|K~sAYu^OhDHR3CO*L#QCyDV2IIhiC^JhEbncek>^O`+zr7^wkk?0 zC>??nr;=|>?W8qTsCn%Q!C9zkTf*45AkjrZUYM9#Ih@$LBslIeaexJs&w?GLr)@0{ z+$6fWAOz(Vy1*?e9HTEm6n+P-04xx=a2kbDL7Pq53<7e4suqwOn64fT$}jJZH(zEi>Lo zAkJ$5<(!-}H8|!QQi`Xf)CMK*1me6bu$)c7ggR)=!_nHu^LD$*F4nhPR~>LKt+Z-N zEyg^(bsvsuJL28qo)E5`TmdJQ(&Y;Boy?F3h4*R*4 z?_3Vsc6z2abc>&$;$vn}Xf=m_=RxcHhLiZWm>fVMcL8|-Gyi$_SZgCBdjbO(s;$|@ z;(W+J3W+NJK@t_4o7MBWF{UPfAz20HE1Ei8AstFBUqRV2-=J)mUa%a5B;w1vAU5x{ zx}G!+aToDB#?5LjN|zK7j{dWZIG-{W*j=$usn(xEoZ-`o>vXmR^M)%cGDf=b~I!p zqMqk{)cS=gMzPpYT)5NNA9&iXq;j^1Gp}>8^+GkpC|9S#F~7n|ViFuk58*Cqzji^= z#~)!Z*YRsUMmJ6`J$URdn(b zQZe!*ymM0Xa%kuNX;;zkrLK(CiuaP)$#ArO0!qCaPg-SSly(X0-MSts zd3?#zpQzFWEy#o8GOO&43bk$KhTW8d4-h^&}9*;ly;f7ENhm@RbRL(b3599g~v@1PjN9zyvC!=SjI34=y}pKR%) zEE?Uv<5cvr-?Ggd<;z1aG;+vyi*5~B{Ps!PfH*LBbNLzMdfKuR`xadO!+UD%LXt*Y zh60QPf(rZP$kt-^{e9J$+fyFap1>Z}u)n}E|sz4-`m zZ)1EzWZX76^k`TT>2mmSbhGt=Q`hbSbksF#@la~y{#VH$v(Q#V|1*}7zO&aNX1@_) zuU#~fgB=Wx1q-&1j7++G+%Zzx1iA$xs9A853IE%%)svEH;!3v;5iYz8+C72_S-#Xs zLHhvy*W;XK>qOy(*c2&xPWtvh*-sArQOlns65F<2BaW%n8jz$=8Uh4eV_xRCOb0oR zPpn*KN}=sX59tqRNA~y_SL2i6!4c;RF@Mdi@UQGicOvO3gFToRojc|B9_Xwk+gB20 zTdG})9KzzG26>v)RwdL>1rf}7+#=hIe*49o0EPNM7Sye2P+M49gxf|i1j|kv=}tQp zJ&S2W7YlM`D$Uesmdi+x@dm8XG^b|TSc=YC{#=|nm>nafb8S(1v=r$ z`3_-*Wv*LpvkYn$B`&OfLPS z7vP{lHR>L^KA#XK{`J)9eLeD={Zh8WSZOImVT_{hi?Cl1Gx)t-Wata>e4&||o8NZh z&$|uTEKNH?J1S?-3oLWvvj7EodyWPxYC%VvvlZC-Q9yF4JAH?9_Q;oC{d z8YIn5;M04@>Croax1dQ>_dSHMMt_`$Dxb@?jn^s{IN(S8F-a8ZjKq_Y5@Kq9(~qIV z;G{VpPNJWcgeE^9sMmJ(yWEB6%TJyb)D+t_DE$7{gy&8bQpHuE80lUIj_D{N{sH1X zfjvFXc8Et$^?DVF|3e-@5}X^HtMP>5dyk5Apj<`Jju`G)ZOL2flwXxaOFZpde#?d6 z``dljR5Bum4xq_QSx#fq0z;2W|DcB!=l2hMOnL(clNH~94s!)4aJ;$_=o0xMAcW7* z+QP6h2Vk9hb7$_+DOoY#ZvenUcEw)LCo1df=m@au=~B-KDNrGd*4>RGT(|0a82Qt* zqe)R|K1x}C7wrbG&%oKBt*Ia1?Z=CmS<7k}Q%WQ*`(^o0!YnGiat2S(!bPR2MbuuQ zT0#pb#@c?`1)%>>Hy5X;54wrWdw3L7x>OBcixPzjkoXDQ>`&&bT|dKLV9NYV%^peO zfruiyVcesK;Wk;}#lDT7@!89ZkP`=)$&!Ky<+gW2=H{M>$zz?cY+N94(ARR1=)@BP z2fzb!83I%LYfEv{8=DoGidYn#N}SeLvVC7mwY-v-RTo?H3Eir_Uv3+IxYs672MD&f8z3E#ThY@H&>i;%iz#ZzFrXf7S$+a4Fo?%}n z)mF(%dF(=K;34{Ce_qP`#+~PDTiKXmi9N_iynXNF($fKG&VU&<4F5?@@M+ik+vGTE z_b{rEe&2EoGg1Zd2kmhzc)E*GPH+Lueel6TI@+qSwFO7xiULE>~ z_-JG9x!-Yy7Pa`Ct2&DR9M_E!iBwf2uy7{Rg~+fLX|-aVnH_AwcK6CR}n#yKe4gRXYhPAuhf(#L7+5Uz~M=qSKK=5Nw zDwjJlvm33%*YoO$Mxg~J6ryF9BmRdAF`dmiFCr9I**d6#>8;}V+h~GVKoJjLlrtg7IQjwL#pFx^AaXLRldQwr0Ov76`JP zxgZ&nb`ud^F<_#lf^YW4If48h@;V^`y2Y}=;3FYehU4yEHgm~NL8#l(x?8-RUMHn% z@~h0#CBkE1+Hirbqjcph4(95aAaww=9c%(Rzvq8ud&yev#)(b{%xC))-|xMUsd;=x z4yVN_!d!G;jyp01`3+Ag|C&vxUZiQfOOEmtK}3H;R^{M3$Y8CS4&Z$_XjQnSR!C?- zho5JMl1o>LI^stHe{kVb_r1!}T;1QHUnP|luMsM78{!$~qc71*H}d*PAoQ>afwR+;}2u^U|0~ttM%u6>alK6_JKVir%jSxp_IqRs3EeoWgsoU zJN^Bi*3hosyBY{Yps3j?>tqru_;gSZyu{|>_joPhi`$ewXprPZe!8Gn6+Q9ux zbdiAsRM)`p36r2dXjqe<;x*2iHV_AbYz=Ob3byLkFeqFn$bkX0Ovr)20I5%pNvWBY zY9vRReYf_FG`UKm5sC>pX_%eht0x?oK1;*)n&fxcbX<#wCwx4qZpwA|Dj>1;08P3` zgrL`a%S@eR_7mg2Iwa}5AKKn6Ji!2v(xa+sQN1l!sPEjLm4+Rti_TI)&TE`5hmbih z_{5|Zm^Ce)L3Y!Q#lH$g2`(Zfff+gZB;v8Xc>c|+8jR@ z1R2ZCB4BCu$X7(tTLk?2@yfX#@GN~ekOExO8*IEj9=a=o{>v5_aho6!mkwn3pF|6N zV*x%&w$|-%J1m632uItd_@+<5c!U~<0t$B*wD+(R*GyqX=>+5+Bcz*EZ*8WV3akMa zsDU?viVbDsFhXu(Etd388u>H~Zv_^wT6G!_>Cg(r*@J})G)otwe5@O`3;%QIbXSY& z#+3hEz2U;NgNg^XzJOih|U$ z)_uZ9P{HPNa&k3mQDy=>a-L`6{4v`*62peR)E#Q>9 zSD7&4Ng2Ca=&L(tnFQ{|oKLI|nPMgTv$b%On&_E%7Gs5cQN|{$XUwQr6ruuNu|~sq zSb-2Rvi0#^b)4Uj_B!u-+7)zuU|vv+$g{Ne4Yy*dW9g_^q;rQ;pkOGl_?7Bsa`4)d zZaC~Gs68tCH;Mbe#N83G;C2D=0O-C;7I4@ZJPlMaknuqvQFk^Efx&+IHaW6^M5gXi zJ4Av-mRzpr{m*axR8UE(IH6azy4?(i5pffY{vNxluE|w$U_bBzrDh@K)mM@P8N0~} zVpRJ(N+*8QS+WMc$w>^&Ai;4{8CRzMF@eK|-i|{j%8WH<0Tlc0LCqq+0txgfq<=mv zX+re9|9sZ5~e1o8YWC@vL zaU$3r0#D`XuhxJObl%eS+n954^nVyKc+hkfKHKrq=+aBuKXNV0!QrTU_|n$QQ#f&t zxRJzl0Wf__XDvI(alPb3S;{5Ke|)bevJz)e#Pg9yXoKgOo#M$1;;u5*(wkFRAq8RkX_bsZ_&QbrudC(uiGmKH(?8aBla$K*QYiwj8m>Tt@LmZUC#@ z6JZG%k999g{>?xLLSv8}Jd;pL7+Z+P)~LxcfWmHySfE}bpO;k^ssR5>7q`q^uMw5N zR)z@5A(xNc;Hy*2T@8aT^HE^-*nYOpWI3MWzS9$+;L1)us_ztM#Ah<}Sp3O<+Mq_I z|6(vuujtV0K_u+op7;L4Iru4*?^3Ahyv}Z3wc)vgv^3S* zP4XhX9G0FsXb$e_-2dIj`56v!&YOtv z%=Eaz%wzp)Rb}&?F-|MARZ=<^<1s~U^c{WX#A+ji$z%*{3$%yUJTr*B5drmK*n+GK zFVUnp`ghH8vLE&>nENL9ZXtxKyzV|W#8`+eB93dzOaS3B!sZuV$60FOjeei#lIYCs z9n@B6r$W*LmFPghv)9Jdu0SCvu!z{8va@+4G{CO0XcX_(@>XlWd8eU$4vCbun{JDK z@48cQ1&t+LWqqDg0WV2J&YVi18|E>exSnja@Bx0`RTWH~=qf}rFg}O?ov+6LkN1dB z|7Xiq?PS$F=gYQaxD+THcL9jnMbHi+J>xW*eX5~;N@z6<0QN?z zu&JrG`$w0Pnvw(`{~`L=)`4V83uU5|d;`-7E%9$m2eW|UPKIWh1QRv7T4*SYHn=26 zy)UW3;wMMBnNq;A$$Py+B4@)GY9`OE>Ufranil^i1tzQu!X{~#q~JLGCir3gITAAS zja2VuAZwbMBJY6PDq}<%7vYw6DYA=!uR!5RWH}0aO{YYhrMCExd%l=KS z5Hal482rqN>$6Sto21-Ytjl`wMTmLqWZ`h}h`qsBpc_mGnt}Ym#ay4~q8q}t5ni@6 z1^nZAr$z0k)?qUam4virk=+3Pe0PJfz-HT(@9d^=$U(-4sX2)!r>nu()eRx+r;uuf9BcL=cXxY@Pxkj?}*^^Fo zMPt8UtK6i*IZoLPH};*^y2Dv%L3xhy-za!%Q#-43CrgQfp<^wJt}uZT z_&CctA)q4?#hq#7MWw!iDEbD$U(g&BW+mGzN^AR^kw%fTju%u&j=IkQ7N8b@RhP1T zuVi6x!O*~n;UHkh^~3$#(6WBRYP=H8QZeh_a)zM1U9u39J=Tva=ROf!pE}#0^0s|w zGcC7~`L1gEPUl^i8(!f1PD-_kS78#1nlaF9o%N<8w;J5523ZKb;74*ku)n8Z@Xyz@ zr2;?nL;p!mq?V9d<60@jjQxqgTCu-2(J2*=XM_0XF;Q?3T`^F_<9T5WBgk{0jX8u* ze%9+dU_!|E@6iMox+CU8P2?gy*n_lgEB?=?S|-M%Ae*l|^MeDcJbd|D25uVn)%U{lQGGyc$5kqFlV-qv zq9WhOF@AMG#}Y5?d%nuYJr(0GFTjfSJc_f*Ae{$O8|8WIV?^P1RK%Ef*7U0 zM~#}`q>?H+&#MdSvzAG_(ErJR7Qh4%qe2LEV|lgEk?H+wKXkxKUnIC)2U}&9+zeJ5Q z?qXiFiaV%kS|vBX!XLt$PXVj8+jy19jZ?9iunrpW9Qw^^={b`gR?_Aw(Z~x5wTICdOUG(?Au0FY@Hnh?^@kw&y zKt|JYHI!mirY3_BJ32pFxK$e|EQEtP3Im7Lpuo!$7g!_{0+{BdF0ry6VlTH}l{b-F zO=Z(V-$Z1PU)zrtm0#0#(%$1wx&z1a!Q&S+%A<8^abzF>UN?Z%wKt1a@eCO6_bLiK znrXp=BFjo>>|D~AZXczBi-vwy;)GpX^6}P+^X~!-8SGD%Ydf=}n@#3_od9Y_tbi2` zm_L^+d7UK$X*r`os7)!=^FKBK`J*Gi+@;}g&Zn}5i=*5OY$phvnaR9GfX^uMl1UmU zle%8zyua)ZTBC28Zfbtl3PeUh;K~0J7>5WcTO6lG(`uxO37d#|8iygmx*`4)rv}4Pn*-^CWNvJw~$%igRDVc z^}#T~wq822Te&QXq*Wrw&AVsWU%?Ro?1Xn@-fq*G zG1Ia9X9t@U4VyStTGh95qaAjtpyP#`o%TWDNg_Ty%jNR`-=@EBS&4Qc$Liq(QQM^F zpONO5fAvK@ou-fdgZXUJ7_BT4p2fD3o0Ud^=)N64i-w#K67@!mY z5`|PTC_?hnS>oCfCKPVV!P*O8oDQJR543;^5qBAP6AT3;Hhur__uPLe2(LF(l%@Z_ zEes@-*lOXcNl|L(K5!;1;gI0%=DacAg6z2o%(?x~dGuT)MlFDhr6>x7clm+>x_uDu2Z?pdaan+JoagJrTbEQ~;)~ zen?tH3c_A27t*K^98@XBXaSB%xx$A2 z*HuhHG?!8#!C`PejRI5n1E(P{!5Ad#$vn0 zF3dNzBI+DM)5!0ZD#c65h2cnH8e`}jfR`G#`oj6ODEYR5!N8cqmr@f!smC2R?Jrm| zY`Vtq7nMFw>lHuyf}X*tHBG@vwX6bIR7pc|vr7riRal*tO~NNMzTWK%@*>|KFAQ|C zyYc`i!3p5?#t{%=m;i zDdZf{+<;Eg{>9I?yP~IzN>Ue@Mnup2M=L;iKZi`XFj25Dq&EF+TJ80Jzn-%b@h@xK zg*=H2uFa#AJnP(w?GOFRhF|cHF&_Cf0?jxDBRq&8bSC5+!$&fcFHjauX1T;SoysE9 zVU&lZdJ}v$sTssQ`#JfRVAeyO!I}FD8lUd2lzsqivB@<_5iof3=`U*}14~uQ4-Dsd zqP(0L!49QDF)v%v&8A`aLod02Lc#v_`TI(|au-92bA#xJj4ypZ^()KIVi1*|IB+=i zb8yGO7$q|K&O5ioHSQ}@8|p#yF12EJ{=I1Jmhgpn3R8LG?OY9IIfmMQRI%mG&=$8Q zfpgDN$HyWN(U*0a>c8PBl_(f!5HU0U$o>5D#Ge9ysu1Kd7=ixBF~v<(dF^XdRADa>+!Cf{BicrPsN1xD zBqcGYI9R8pQmiA4hnXP%;(Y}XfR4Mj0b9!slF%n*VgH6d0Cj0s)x`IuA2tr~N}$&d z20%kjSJB0Sg2@vN|Cb#SEvs)vPBQ)H=lb@{5QQxcC6>MZxgl|q=5$lDazoJz2fj@h^xqFk;O#j zb{j22kJK!`tL$z3@jsifQuG`(qzkv#4^)*B4v&C=OigKGYHletN*;ZEn2Z??ndO20=v zkrKcKO0+<1NzG4*&P4FDmP^7TVD?|Ck~%LX*`5bv zy97e212(2?`f-Nb&PwnG(}G`SvcREN)d!JHBEgk4xSKmmU+R#J;e9C${z@N%T?Mg3 z#Qvz8)vS}8K@;JgF3v-HjgNVf9JJEra0lGDPB^vQ7gfuvbXjj-m%84}J=UDV=MwKQ zS1b%PC~57)f^eZWDc=vWa884Aj7*-hE(M8BIF1=Jv2QzOqBK}r6=;;NF==f4M-D`0 z3eQ{F`TGsimo0+vEmtN<2y9}~`PFp(8CGiW;F_J8Z{PAZSk_oLYx0cyG?F6YjrMYO zT8hSP0z2)kE(}GUp1U;{rB%~7LH+7=O+EVs`?J^~y-Zj6Swj|hr--<%Jewgt^x8dL zu+H+aX40vO!ws)}B0wxUh9oY3=`PQ&4=jaF0M(H@Rq1r+B`6T_*&|zgO{d<1*Wd^% zuuw5hcAp~b3LHYJgy0r3S`Y}WXi)%wjaHg?P`t|zvqMjoz)OT+%t6!5GFhYviq!bzi% zuY-~xy6G(FP@t}j5JU}+2^8UxD1j7cqK|3_6b5l)f6m5vJQNf$O(O9_5J9an?UoKo z-*(MC4>bzkM#UDH+lj!K&iNHx}XD9q1G10>&;HQ!xezzXD zih>HerA21N48JU|%p3QI3CITjE;3t&8T-4twS5SRFZ|@htw8)+tCmPRT0*p6_9u?< zA^9I(W|$pW#Y1|$!#iuOwI^_rj^3whK%<%5b3PpI_`#~W$%8qoc(52+6MA26ZTtya zJ+UKMy`@i?P1_`DbD&Sb6vz|lP!ZY8M~2`Sd1|-)Ddpp^Mrb>Qb;_PmZC5nuepq0^ z*qturrwJJ0VlY2?hjHSOqD3QAxM-8qeA1b%@S1P*&j&J$Mj$KH2&G zPw1{TE_sOy&Qc@OLjIaKn64wpn#A`a2q)&8aAj+j;kfr7lK3ys|_` zlvzXOi=<9ZD<&2M4`sDuTiwwl_%v+lesoy8V&A;>3-0^fit)SWHsk86%l^tev*5V< zUx%c|NxMY1ey~LzW#L1WQJXE~v*cq5Et6Qc&WbPGEl`r(e6#DAb;A8$0wZEi~nH{f4&ST z6lc%CNeMItKLzEK<+PAR(ZS@;h0M)YyN;4t{HfzwMd+SYoGBok&R5AdL4ud}1gVQG zl|+M+6>+eEi#`g?m!l2JI+waX)F+hD!$=PR0@$Onaaoh&4Dg$Gz|rSfU`nJ!pHJ6v zh5i10kZakSnw}Fy?cFGocj?|kRxU?5H-NUgV$vk9g}`m;0Q*oa#TM6YN{K;7&-wdl z?Z_yX`n8K@nd)qUGN=j@@lV%)_VBzE;B@PaGxJBYqgi{nFh%B~rurv~$+y42sNxME z8IoM2&j6E{CLlxVS;#69^V3M77JLnJXj{tpK)S#galni7QXFol`HO+zTKxvJ@^PsH z(8?y4|ID9Uxa~tpmMW3zW3h{vO74V#*+P>hR6(IU(3DzS_&~!tfSc)zUTz zF>VgNsL}%;>HDhmaeTfhkh+dLK`D37{Fw3kR>Jv2T1J$`&9m(b2*Bz-ROm|SV!D?s zWOiSHE0!J;_SEGfzQ_G|qIsoB&+*t>LB5Uw4)t*|q}2T)Qn*%rlCL}VO8T zYXqK)bGmmuePCvp6wO8_06Q=ox5=W(LHGsqB8RR4tt`&K$6ScQYIV1JLoQK?=JIR9 zvpIo!6W=STLG| zT->jyP;ug*C>nqFZVfM2c&l-65%_qhWuzS?I{HgiyiM9x2f4p=8PO2=Wfa||f$~^W z>Gk$yDmN(JAvri@Vej2ke885OnT!L;)B*{ImsU4MEq5HIQfRZ_yIlEOSr?dQuH(fx zXUl`%#qn{nzYgX>j|q5w&UxoUL<|A<;NrTghKsc_o6>*K?{#sY$7jB1AlMROuQRw) zO1<*pz;O&6BU#bF|6g~U6JOI@-1AjdA=Y|k1;oVCuRlx#l?++&Y|6#$__gr+&ION| zk2Jb*5-w`m^aBXQ0VMxUH>F!@sv@cxwW&i|9akEx9g5rmcINJ^?fkdsm~my=O@vl? ztoPk6kd|%sGdH{kqJXJ33t-oKQ81)?~ZF%%d2wYDin*@up9&WS10b~2p;2xKM zvx01&eV{?ULn*#Ha?| zc>@+At3aaUF}2l4EeCldTln~`+~2Xf<1){{<#CIPhVgQHQFQT-e$Alh_E{ocvQ#8Y zs+lM&&y#f8P5ZkQJ96{^D5sli5Tl!GBE+AB@ugtd4v#X1A>0^KiNUqtFN~jJS`L2> z&mVRk8l1g-X#E#K3#Vt{h|bo(!pv^WX-fKwcuDsA zys1PFb>Rx~x(_g#ZW zVzZi@%;qnSVKe;qRc~bCymm6cq)2;HB?8fK`bfXqNR3 z_+9>Hni@#<2q>0+2YI$%^dblzP8(?_&N+T~rnCV9sP@k5V`-zuQ7uB!;+#Pu81UO( zDB0Jo^j}6nMm0?qzP%(cNI;>)>?0U#)Lu2>Clq2I7Ow@Nh$Il^)+&DSF{e9-MI zrU>hybCsxKzyuJ}099$$V8TgC)1exjMbX7C}SE5*u(@QJBbR-^_;8}-ZyqfEQ>)oTZrPEGN&_&I+ zt+u;!SbsWHpFxrBN@cTEy$pU;my%qy%R|Ek=MHuZQ-%AFcrj2ea!eKPbL|%Z)HdaXcs9Fk5=`|RKq}g}OPM#a_ zM-EPYj*CJ9K$qDm=LV|qxcw-ZlDFyhsZx)bb{xGX3{PC&^V6Ts)JFfR?LHnd(+d8I zc!)SL^_zl981_aer}?fzy(y|4 zRzRZR2VtM`@N}N|ewn7gn?5r}TxdQBJC0T8st1NdeLIxP9RL&fK{_ZmzoG-9aEyGN z8zz~SKFx=^Q4zKT{td}8$^s331je>)g%QxXZiTUeoXtVk$y$c3t8D|9EL~qG>8F5? z&D;Z(*`2QW8te_}`iJ=984#Ro5f1Mr0+sD`{)ZBR@yn_O#NWSI1G7ZVHA$&Ye~p%= z)o>$d(1{XB&fcESJ?IxclzT56?CZScJE+9Mu2L_%)WXiWVNeoIWE1Pz!2ur+c@$}K9sojv@WW6mj|0MFVrMzv1U{p~@<9IrwI2#%aC83w- zc$oLsI4J8tjtc&^ExgB~(fqN_4C6e~`9QIHDty_q2f1!FHE23t-Np4R(%oAQ*~dU1;r#mOu|Ym)v{GtW#jC{_WzNj*GOQA zFy^-^1EHI1mG_5I{+$7i5yEPSe_gy&FW2?g_>3w{xy4d5g<<(7C zODHdkzY~Xew3QY6VA1bZ`fnc?>>$)TT;Qg%NbF`BE7o8X@o2 z-&DI(6}T4uJPb*k*939AgGW&wct+fp@+-{)gT5 zqSy^4JfsLYM;<}wT#8QTg|xQ#8&jbXZeQ74xqmD*!FK=a(Pd|`H_JOH#h7Ooz@=TK zQkZ?W5Wb})N;!SvNOZ+sd(oy4gd?5?@%wNmegHU#PE{Zzo)+<-@0N5v1A z(W$t)Y`_yK%wed;9q#xi>Oa8V;oS~!8ox~l_qZ+}1U5#8#uT}xYl48^@7;%HBUb3? zpv9wWJ^ZUnQG1@@R%`LN7-8?a$A;gB#SOnD{bgSps$+4MdmUi%S=h@Ul?L3AX*eIZ zZFI`jHQiVHE(8cP0s|gGG`J4~g`;h>Bwzn5^c|doBoT>ZIP{_IAS0Po!9-yIYzKp9 ziQGy%Xil&R!sv3(cbiPJM$)~R%3QD>%J%B$c)as>AH4KIus^QJ?3U&!R7*#V93vM3 zpUxLb7}##$korwL$cFldcHjcOqLL4ToFJNI)T(yNg>qWNwOU=ELLg#W_)HXkxLTVF zS#5SV9eh~bw^vfMx1R}>13?5gh{@z~Dw!i~ypK8XJ8{mi=orNRL&R%KZgtg z2&)1QurntX!2n@vf8)tc8P%EoM=fCbBhjZ@QfBk^t8T=&`3?G+G)TtPdV3E>eDAk6 zWwqPsd(gkkVG=<7`4Mll-M)t_gNPNKpT=t#IF8|8GswMTTH7w4qp-J!E}^0R{07KeM5!Fd9eJDYer#tCuf zlT!APse&k<`Bu%(6_pz9^=vy5g$(o4EGXL?!M}3$>E53O&HNuDa=V4PTS%ntp&$7pMDsAlh-tyTY_iloBS-o`XOtF#&aOUyaN)-3H} z+A#Ppnb-*sm55ltk@%@u|*cWDxs1pRd9choO&eA zAh7^$F#3`(ux|!0Wi4(1P+J*D7N|)shKKFkfbFL^a9oX6pxt3C(Sop#~%Myx6S_Q=7Wq&toJlLalq1(TPyrdc_9UTM1H(riL!<-I^yz6~Ut zC%K1T4}SmHb67z-iw=!<3baPsHi_Vzup*0}@@O;;oLomA{AgIeU?S>%xJ_if3O@{0 zlNsKA3kCy4Edt`W?8>I}T}4wS*M~H%uNlh5KXXNVw}rGpGuY@GB3;9P-^}4HJ?5PI zpZ9fh=FY38zZZRpW*t8Vyb3BhdS7W45YZiv;<2orl9{0)^|w*Um^epzU3{YUbfJ2a z3t?2H)FD}68wiXgBaLgpB3Q&`qe0+9>x9~7JK)r$)eW#S0au$j;qwT07=eCv0Zz2e ziWkhq6T)e-i4vKtfjfkekjAE>_`0wKBnjF~+Z7GujTn1slB!@Lh1&4DZYn|sftHZ% zUxHR!X&_OLqzLiZ;tSk32r~l1ocP^sD#Sdfn6KpeDh-Z1q9dfu^8^fK%?m@5*zNZq zKlcjJ23(1(5xkdd!~fzyI2aZCA+%+)7J7+~tcM&1w8n}?5|8(;P*wmNx4#9BhZUO~{ZQ4^qh3aRJ|O6fRaAXEzqlTgUFrOPsi*KV05 z4sZwb0zvO&4*Sv0p-1iPGR(zrF~Sh{+_6(t6(`j5mRBGAd{b53P}U0TT6F)UY6>uOXb=AHqB8kPIPPB5$8{wC2a1^>gHO6M-}`d;rq3ts{i*# zY3r0eA7m9gx&Z{Z@x2+W;;6+L4>B$P!>>XHDzs+10!FvNOeEVSZe>OnrL8EpKr#g{ zxxqYH%27~P*R7APYm%Z?=GRY(i4o8tGS;!hp;yc~U=>SQqtlxWXfWh&(H><|x-PMp zQ8eZ{$(qPns^YUVKd~c9Y>ycxMzR+FaIIP>=GfH#3NT|YRz$Vp`3uiZtv6I*y~yU1 z9voFU*I!D*ROr;A!t`gmHA1Qa>$hhDm78+18tzhgd*YCPA!y_Oh~!p;V>_pw_d92t-!(>RXVl*JUTe*{u9?MsB`Nrph>v(S zR+3yYi2?HuV+E1msR)_5eQxx+^WnWctv{Y zoyq?-I+l=k!xw&i>k-53axFRf!u$oLVfrYtD!ayHOfRMQ+!s zN2&bDWc!hx3}5#;pPZb?Eo!30(SoJX@)`;DW%bf(nyF+(Sok{0%(oT`z?e)A*LiFb zuf$0mopF5~bY6VM0D%CJ9oz;Qv^6aZoViSFs?a1^PWFz7A0Q?Mn^>`)pyjmjr0-_6 z(4{2xBBRc`CbrhrzW`&P2prGm0k8^^mb()6Y6y37XFd4&^UIt+D{X?shEar{U&OpCD7M@)D!y}6kQ}5XK99-86Ow=iKwe>~T~!b7L)Z6$tRdn% zFQjPJbiIJx0cGg=n%0fU8Nu(5iXQsV!LcdPr`r?9**2pFxLs%}Kr}Dc7gqz45lR2< z?m%$vzl2bh&YBxCdgF{>k6C`J8*tad`e=7OX@6yXYPQuEf{u!_CkLNL-fM4EpTe?# zaZhwEN^eyHv~yA(Nx?X{vABrmvWqTO-VPEI2Kh@?2Nu9|p1f#QiFts6%|7Y*X3fme z7vf9M6g$WI&GKqvBH3!|3gJ_$U5aq$lC|oN|8%W@F;i$#@0y+@yR+`X??pwM9!zOf(n^qr?d{IinKq)nzy&%3u)Gulbh)N8~l zs9;9f?(y>nkp$x$rb!f3OpEgzNs&prbsTjYBJwFaRf&kYkWpS2funAsDCg{|>8osS zv__^r=uqxmIi+93VT+R7QE)MR2`0BnivKI&y;P#K@MplvR3Kh_yKST=nKl0((P7g# z$052bwhu?SUdJcT{5fBRd%S!7L~z!l#8thZf0n39)K+1@5@aNiLv`2s3%RE6>uu)J<7F@Wogj*Mr}yug{%mUXK;w{9{dMnqCx%gX z{`}4i*8#%+2C*}bHK#G&0y64v%%1grmzLMArku$94-sO$#3`X?uskJ}>4>2{7r+Ot z;duWCt#;TC_ycG?zf&JEzN|-7JMt?K$nTqQ!3S+0zB!QG5@0lKTCU&QnLQwiPlS8! zy%VS{;sY4$THVKBBwhzU7BN|qBS)XV`5v3kzZ3XxucuwbeFQ zo;V{lka>DQ1f5dQ37c_t0yAk(>&FDI3TEAV?+FcMMeBgowU!o8j6MWYiW&GVszKRc z@Cc+k{{7F!yt>+Ngi4Uh_5}|Px7vPS7BNkVP7s*Jt+J8HRiWd+j}a-Yjz#4tCO8!VqBn@z#YKa&!@>~`0zFPlbm7qqWH}2 zDcW$yTGe6}L#SL{vru?XD_|50=hk~xIhi2`un_}ExB6h#FG--wUcJpzFwS>%y_WVH zfhW}bV6-G>9`OL|5p3Lb6zACKt;?{P#ihQ%3=s^8bz^Br{mcPY6u^Csyc==f%>L>U z%U1zk@Y_|x$|Zv9hg&&4MPOMb0!WFVI8F>lcuFka+~+ut>_nF;qrorz2g7X1$)e$k zN88NRTmiezs{(wIqe=1I))oB%>^BMR!~Zx1wZxS=#Ir#w;5rBGVZ^RSd2~CubO8V% zBM>Ou`wn30(~sOHlz@a01`yJyNl?^1Mzh*eU_Wp!y)N?iK!EFG5URSozI$wB=axW` z&TqCWf#|vA%yLe-r)Z_>`Z!mNbQ#QS;T*zBtQ7NS>uC6G)8fS3b5axL>5Y9D!*Pt{gbB6xtI3w#r%{Jwp9dL=!L|H zcV3^GeU7D$kv5R-#RmGA!<7)Nt8;6>9*2d8^x!};7DuAP=j1%^ti@LY6p=hP)z8|F1t%JIZYu!T7v(nvdH&sE%ZjlK5k}qXX0(C z>B$oM2F|=@xZi-0h}V$A@x(DK!DneShmk%+EyWUODn361wUwV@?dp&sy0*Z!-tm_9ab z9;C01E{|*`dvyj7ZJ0=5#~1_sW{&mfqPYX1&+}}r?(+eU*#FjmONWTRaoR;+hWYpF zeMF626LN8Pl^b!nU%5l1O3KmC z&I^rc4+)y(4-?0IcIcQGdETu)&xz|f>I$js0a+jZs|M2xw9fnmGNdoDB$Z>nuKmCN za<2)#oszABHou)$@mfZlvH&-!03am&B!a^Udr}Al;g0Bo4KV4(?X1v_#D2zwxRdqm zwabq+ev~`glW55JeaPmq?~g#B(#is+5ERaqlW-t~XL~vgAZKPHN6zjCK3m7)s80%T z-fd+AtiYJ&$ZAHsi@6#X7Vb4@2OZK<*P2K1Px$`TIEWX(2*D8egNT(ZQ==paB%=$Z zJ4mfp+Qcetm7jZ| ztk}M?LYv^xkvSh>6?rwtl`Yu5auvWbrx&a)0bW5oXb3-VMM*<#)O7qT$xU9>X}FYR z^#YS$`Ergnc4-WeW_RD{q<1Q+x|F>CM0U-(;lpF(Q_Sz#%AB*4|KyYO62DJs%p@ze zo#S0(oq$8z65S{hCkRa`l%FNEV=GNp3n*A%ihB2pd+?h_QAQT|8!FoX`1a8rqj@Er zRMbMMcdYdjwHq9eq3xSvEF#Mf=moj_h!YrKh%+;l=3T+}Mlz=5L7%$b7w$gu7NRJ1 zJ#)!Jf7}KCCuoNy*el=^C{ifDpN0q*(n0N`+CIkBKl-BQQ-?VSgkRTQ>fA7_Xj>3+ zGI|2Z1-wE~pF^BryBk2q$HjkQl*dO$!`mwGxQo=bT0og*L~F5c8R=p z9+9R1#+HssdxEX*QCrpgGPwOm_&m-?WI5rLDEIud$GUmCdUg5O6!VVA7?|3aC^ilB zQiLm88uW%EB*IAlv~f7$v0g+qlT)EB$vW~ju>(-^DF3`1fHt>0GtXvsiW=oS&XIG+ zqXs)LRKAz%1<92Q-yv&h;~8e;`sO3P-;;qv34Ld2PcWp$|I$k71FCQ%(mV^n>Z^3a z^8fc(^MC-(I6kjWwWyP!)pGbe8(lbxy!U|dB9HICRgE>ToC}jjcuiLS)^;&lvYdgk zJ5LUs!98*oMe^Y&$4aiDyf5Ftb;^ zh^DCDH*D(c=;K}=mlKitUN%vVqdl?$HTZj?!)34D6Tz&jKxiFFk3-b@&tSwjbk~MM z(z<&%ONX{G(+`%o7q+rQ*!6RQf+(|dMB(gvrObFwaxg&f!BmFDwXVQiFq^@usS!08 zPa78thI4&N1_QmFoPS6|SQp3J{X8)6RJn#h4;1Ls7Lq()BL6s2ILP@bYAh5DV`Z*o zvm1owI3AHa`n&Z5QKZ^Gg2ODh+OywCHhygr3K^GnPM`Fn^KJ^Rz!pP^+h`Xs&wR9p zm&J_3K5mnu0560NO?0iY@sR2oU#y1H0ptt~Zvb@jqpoGyTr(`!k_hup-K(v#}G~A7Xi#7itoUf6A(kt#5^$C($l(dseQ`*!}PBw;BF(WizNR2{|qXL)7oV#cwr%yop8} za>5&_O;%CRQS>)LS|6o4=W&v7kF9+qQG?u8xKE8#F9xWUg*VM@Wvb%HH*7w>Y|90w&oIQ>3WK2@k!F&FyjK;WC+@aHy zSkpVo%zGE%um(#-WT7bV>VVtRtzt6s?9~tQb&E3j{Js8;2EtuweYvRLGcBMUb|HiY zBP;X^MNG&efNqlV6df`MhO_{NI;sy4q^#@_1);1Y<{Kd(o=+VebWOvjv`zx>e&TPM zec1kf&edJkUtCOv#DiKrKl;D#LIB-9xsssr{9XfM%x*X-if^n^#q>} z?rOn*rEzUHb%+t>h?kIj!gx|iWe>9^aGlQzWsUJ$@X<@*W#JzIV*o-i{&Jifyg(GZUP)^7YW%VAD>VOXAcN3KJFPAVq%?(#PHBM=fcucRdu1*| z#>0cEg3N;rk{IF%PC*FIr9mS}Pi~pr0A4~l=Ps5E)9=|qzi$m7~WPU4#;{;u=v(KYVi7qLG{ zk?vCMACBXwjr!5a&nSMQw76E#ab>jYP{xU<>$7yMb)@j|Z#@t;h>R~dcbJ&8{(7`i zP;=3=hsT5HJ}25jw%zcb!JG%C3p_2(Yns@8!mRyn)uDy@ErmM%DpuO865=`}v3wjw zTh;u)W-@ejor(o@BArq42UHENf$@M=)qENNPM1;U)j_C&=g?|f5u8U5Ao>DG(RLRd zJ2Ly?dWavQ+4Mshva2_o(IeBmG)v7{t0FLJ8}&uuG1N~cbohh`$*1x0Pp01gl-f^p z5v{z3S}?hoF7q05_#C(OWk4{j0;cll)j>||=>*1sT5Z_Qov=rNVxYouJhfIfw|HfJd*cWq`E@ufzc zeLB!LA|e&(hl(>=Qin`jPpt>)q7vuo#!!OM1NC`2AxR?WC4Pi%;ZMMoL-~HyR_D40 zzNX*T1OG(D6jHw|SOB+E=LYGEaPH;?uGt*E*OdQRjW)jY(qIH*OAFBo2FA)4IOykC z!G8!bxCJsm&gFC9oPS6fIgClCar*0Qq4fOh0Z5Mt(t5HPH2q36t48`WE4c0Y4}KsP zr{rMOcO!HSsL(FutpQP3wBCck4k#JDJc^DptziKq^~Nwtv6sLst|eHA%hx##SgQ0X z&E~1h6Fnxww?EKF)$v5M^I&Sz3vLM^0d_-Nm-wCUyjt##vhNgXJ-eSa#s{c#(z46x zi?K}0G9FE2D2q(*IVeVju&G7o1!`mw(lT7f!hAoY9pyq{#bUIXovtUa%+xypb#;sr z3r`Ab0rEpwWJ|zBH=7NSq7;1dzbn{-G&y>kZ_Wq;#Nzm}^(5M2J?pk|zc#IyJc`4C z)~mvG9q^mNhy2hQ%)s60)|S@U4RaVAYe|+@Ves4ahSqK8;q1+HyLJ=LL+SyqLhPk+ftGiJZ5dYXKJb)0Q*C(*l^DkHlgbZdI%`L{Dn1wPXV>M<{Q zQKq18%{0!vgNX{oIOL~8Eah|%I-El6UG z#gxt9D=7uM^iL;QhT(G|dl{u6|oEs)vt7&p@Woc%16?!XuPW zqX91I-QaCI!CpczsPxX}7dIr(hG5qgurWkCpT*j}F@Yx*Lel}Q%2Yp>;Rb;fdGF`^ zmtiVb+a@B;r@elpRvPMg!qBXiIS2$wCeb*T8HbPVbz7ugGwA_z+Ld$Mzm>zu)R&}% zI(hVnrX%u!t)hM{&~KZ`=jn_aznf!+7$_gwuOT9&(dqKQBKh0BG=JMK{Nv)JZ4ZK& z9hD2gLruC*X438YHq1a1#=i61HKzO$I_hE32_bS6$S+hcQw#@n=OU`W41yM}H_y89 ztKq}4fWZM9k_7k&5&{=s&b8y2F5ZoNGC5{n+)u8*Xqo!DwT|_@<1RXE;3-+_l{Ijr z1TUVyP(7|XuDgF_us8#}2O;Qty=H6&Xv zLu%(%Np_|TlQ}|#gvz2Nfi(+A@`jFsMoLaf713h|V_tzxMv~aehJbD43QKxEEJ9C(5um-xy$0Gw3wIXDIrGDO$IJ6Q(avt>S>WPl zb0~N94FlF=Nu_uz>Dj`pg8Lu&#}mdnm3~d~}_0*1Ssu?;D)!B4@014o+pW??-ZQ-heGsBkRdYGAf}KjEv=f zS`)R)4vmH<_Z>v8-8IHjuz3IPw0=e1m30C}$~XgEi<2iz@7+Fx9Hu5pEsRDBcQ5zR zM_a_bGWH!;BHT~)>lwCdgMRmhs8s_fYpyWup)fgv{dvg>0W9ieB_@If@BB)I2Cb}g zvKrN?kTxz0`W49{80Xr6$NiT(L*fbA4(tKa;t)tlqLbaQs3|0r*qhVpCWmL`2 zaRIbkzK!G{_e*NE5wfI2S8|3fV!xn2Z&P)LBV)vyt{^(nz{@p)i9v&C*Z40Y>nMBY zqYN(8k?>eR?Dn9sk*2t$+#$~XCf7hyvplbEmj77~n6D)pLR4s_5ozKj-d%oXiIxvF zwb};p6#Im*idj*_K(S%}GzM`DU$FX+pB5dTLBNQJh$sT9Rm`vkNiGxq!-FK55fa-U z^01O)fMhYta4pT$E8g44jwhr75>)Z4+; zL>NeLzHClTiv5pvgqL0#xIQ{6(c-3*%j83l5G$-Zcw)PQ!VJ+$54QL2c(r<5nR2IX zkw=lMpX+ggWhO7FpuqFb#`%n!YV!O2YXSCbMX_)wm`tYE)NZBtLjhv+5oo8ij=5OT*3$_ja87JyuPNt z0kZ`FwI@Bfo18-zdJl;X!smvN+m!X%5F@1Eq#I%hLPt1W9Ta~(L~=c_`1A9UVwFTR z9=>XiQ1^Tb5oy|GyW<`s1?=kUpmWRMD`4lL*0KeNvkLy9jbicF4jR;;Z`aEO(eHkm z^8n9~r0@H4%Ndx@_q$k&N2&181mfBWIZl(hXZ)Ex_m9)86@row?6ptINgvBr{TSlm zqy@c%;Gd4f8@{JC(<2~4Q&qTFI+-#R6n<21uIw(7(~@cv2~KBD;4r=K!@ThMAJFzA zM&z*z+5t5GE?9tGKsp{yambl*al#VXvA2+to}U0vZ>IA!kz4%L~EBfm<{%J~$?Wpl{? zoXPopzUay<%wpnY-C_hh;EJ&WlNI=+f6ipk{09S_d&QtCe+crPe)gl8<@-*`@t?6$ zI&l=R-|GH|%`k~K_^7c66AA#qh<4LVAItf3r!k~h|3WFP)o(}?4dEF1W(HvB2Om?}a>Q%uROGoyr(l6qKSI0UvgUT&9~^;6CkO_Ymhj(;z3-(Vzi^u058~CG zm`G|>15n24IRe9n9i`YWejQFUezV0-4E6Pby5OHUhKtd^<1~BAw#=Wi01E~AaFE{O z_G}^>tY|#6+Out7c0=Xx!P0M4%qSuFSQ|kyDcWLF_KVw2 z#T+i_|0t^ec0OM3kAS~i>3>Vq%94%1&M@)o3!ypll!QmS7o0ihk=RP2oF+1Z`cEzS z0boUEm!T7zgCzSXP1hgrpB}vtL~by^1z-OcYZM(;ZDZze2iGE}P~NcVXDq#TqZ%-i zQ?YWU*KyuttxExFYYf-Eip2oF#h}BiM#`F!BZF@KGP^tgMt(&a0)CJ?uZ6 zEvma^k(2ZPNE|5FaeLHkD5!SK4!+um#gZ6#LJYLS4%`)(HDhJ9m?2QtEXZv~Bj6Wu zQq9W7+g+k1-SXu>HIpve3;lCKaM`WH{NL{p3PRObzgH4sh!JPv81l>=Ici1(wRCGx zzEmtEOPh?j8LzF~T&8QFN4Kz^oXjq;bmEjmy9hQBZc87`Hy$|q(P*ef1gei3^P+{hR4YW{3Lx#InO+1zFUn9fm9OVzP;L&1JT(azp_6 zw!5T+>x3qb@gd(eLgm$oA>e_+J!oMKFFo8F!JttX@4RqJeU+4VcFo||wo~H;L}84y zYMIR9niH$tJ5A$I$)#G<`M5g)#TGw5b>OT<+Wlx|O$X3Ct^OlD$xyEtvU24D{ls(G zhHq4NtrZofZX&pY&s%IEbB6SFwYL=TI+ir#dOX%7Nwr83-ieW*{AjHu=WUiSALUY{ z42&*hgb_qfY`(ZUP12sj({1|Iq7wh%!LGF2CGnSov@+|31XbiDkNERc@(8$2gl=7{ z%?v>RW*-wauhn6a>a!PZ7?OTU94HmMi~6+`0&-R3Q%IbZ$imgyp~Kkw!bY2-_Dd&x zUZ4MI@F*_rGynU9=@8%WyOZy630-N*9wsqCe0P!V{j#gi=l$Vf~If3-WeO|QlK#aH$DAXY@o0Il-a(cSv<9Op0b%bPfmvH^>H^9#> zJ(vnkYcnJ|%CriMPFCSAavKL^|s+VZ5xR!lj6 zByVy;9+EdYN1ecSj9iRJn#e`qwXGiC%q+A@H|#cWGFgdc>K*;Ax7?G{4ZQ|_I4K2B zG3=P}rkEh8RWh~jf^`5ztYsFM9kPLs%V{AjJ60h{J7G}q__kg_jt8jzm%e-Kz9gVL z0sV7h0q3fhf;;9DW>kZ56+R#NT?qaBmnHY529Zs%jU4x#(lj?nHUPqx?|JjyNbz0* zrTLL(2X2PV3N#CI=VR2(`IaJIf_-^aTI6mh7*f>e5C#X7+xddN{QqjrAnA+2RjkQy z#rJx?hdI%V5+S5O2SZyc&2hDQ$%&Cx`w*0ZNz}CBnYrD7R3?5Am(X(_fG86DjzNW7+p}m^Ll>Zm2Yz8&Ga)sTIwnWdzAiv6 z!RU~fY9x;_PybRFvDdj!C8~C*atDS_;QTHtwbAh9k?L=00g1YH>$Iq=Tpa>7DC+Nc zZ1ZUw#VO+NdkxRyFWqKYJ+t4N7>rRo<;K-K70Np4&`1Bu%Gtxb5sv82kuKd+NKy1G zR(p28_E9CZrcq|l_&BX8^(4tD-osFX%)lkj-&mo{!}0JihO4=17I^(wpSV5PPv428 zrRJ=1xlmJ%uPAba8iaWW5Dydrhk*s8v=r$|Fu=C#!FUmeU{$uVMZOzqI5rnBFV@2z zk4rZJg%TT^paPMowK@k8uk9#;8GcWb5YLhkSHwdODAuFSOq5H5EDz^svc z9uEFH5d01jIA@uyf=K>HNKr|sqjpfnX^cgb0{*w_Wq)sPouyEKN_DJl9Mgi3O7Ux_ zrvln4af$n!3=bbgB)$CO>$VBn4$-kpy5>LB+&PNb-QfhjQY3}13(4+i(?7N={kVTd z%p{G)J)(>s4-h=d;rMbYSZT*UC(TIN|EEvU@MiP8Bb3S8>s`v)vDsfeXsb6E=*$7M+Na zpj(Qb#fc(Xweer=?gSAeJ^8fQmi`}l<*oGLzm={hT0X_?(JrfLPKZhrfOI%&+_zpm zT&b~|hD5O=(z#3)cx6vUVOo7cym29ZU=3hKKl%mO-L;A5Obz)6qk2|oy=d3no9;C5MzmmbOiPlwW|jt9QHbz-4QdFGbbepp^FiB(D(Rl<{Sg9>Yorw;(P_ zE7qE8@_POlM#tVVRgAXo!Wy-oiluo5nN{;yDvZp)qr~zU(*WCu1#YL1o6H+P{ZbD0 zms@B+18ZKhd9GH{fP&57l}Szi`MDY5g@c((nW!nVM_ie*Q0J3f#?7sRiQ z+{*I1(I7#MmE`f!ElM0`RT(1A%^Y8-pj&PYYQtKd9RfI}GFpRyFqCuXJfq|WGVTsH zU1meQpoUvTNTkrC8udku{z(A3R}k7#lkktiE#(0a+M#Fiu`x2`S{QhC1n;G8AHL62**F$(8S`@x$@4b z6&=1Ppa7n>$pAkmIWaV8D_ndjlE$VFd|?=K_|aeq&}3Y;vZ>PiE;R+7TQgi{ZJ0T1Es%kh05`Krh zg1eEJSZwJ}V1Jmc3eXLHa`&*9K7q~HrAOrTg1T;Xd{qzbS##0(m$83ttNl&DW3j-D za7zcJetB@knWCETzk!c5DvbYnHk(D<1u&Pu83=tx0+7T8Y?dVG8tZ}u8iit4MlX&h zF+m+(4(%i-v;v-~QtT4vyVW4( zbG$K~4Ea`rs=&5eMY?5RhePEyN_VqlT0TsA^U_O-~!Z0 z=n6i6B&8Z45L2}ytHeVTV!NP)vkZGjFnPMELFVBcVtMjO51h$hn3=#9Eyn`T4q*B6RT8wscq&nn-pHI3BZtAVhKNS*x!3sr z{5CToIuB1dJa$PSEQD)>mm!gfv5stCt!TWs!dz994{rVwwoq@*_a1HHSa-IlI0Z&h zG+zRkM;d`3h7lRDEUP(`j8tjn3=S7{9(1)+7pjOWiQMbZ5VD>t`~!JoEwAeQv8$`t$BiT;hP~f`F0%+CauNLV=}EcLR*0iqC0b z_$06;R!6L;t5d|skTcp|ThYD@>%T!Q*e42OgOHYDc7kq3qmU`^I^2{t1w|N>RSMIf z>73~$SW5OP?SbdOk_T|5_6)=aFqfihqZdG=f6$~^5Jz)nk=v3mHKdky&W{IGb6a?bkNB9C$Nb<0Q)TY8V? zeZvivN{k|dJ#+RfCCGDPq?*0$80}mN5i<%;9U)~#mRIK*OnTM#+P~bGRpaY>guG

Q?7sF&=ll4^Jv9iL6)VhVGzMT?x zGs*^eaNT~e%^*qaTjJ{KYC?a!w`m1NB=~|;1n&3u@-nQ&M?ZHYIdYcjTf5WvNXJ^# zXpt0!6!3bt*Nu`S`Rbs=1#p*gz%AIMs?0x|;t%2%5I&MMmAxNf(WHOQmZqyJWDGqT& zpgH2m=~ixkAvlCwQPk@<2)>0>)^lHpYJbu+e1z0RQA`1q{Xb6icO$_e(SUJO*)X`g zE3Wu|Sl~2h10K}7Ss0Fp>N>Iv(jF?64r#Cs+(Km+-Vp>J4O8UFGt&0cRSUolvs$lL zOM}r*zm(j&tBZWKSMBaoe_?T%WZgCY;mK7>0KO|J0gWz@%hB1ic02YP(F=o-28S-< z;B3yAYq|a@F@JMbsl`@qeyGx4EAnGSxRVJ@3UKq^;jZU$udHLwVWX^=NM{4P zC}Y@gaRRJQtq!&yh*d6Dijnw?mR4hl!;tq!yK?}|z{V+grnK7>424mX)kJ@nQm;*B$>L|y)mf4Wah$MBt#+3Lt4+ELsLD_N zty}=TcS&EL=G(iMo9$0F-=x`M=a^N2;SOY;gbZ>0S3QZw%xW}*y}cn8CdabkYVo;= zMBDjCwD;ma;%=b*a3@Li&*cRyHE|ki!$qAA^)I9aT$(#V*~Sm7NJ+@kHkK7*#NA=m zL$~wRgJu*@85wASHI8KiLR54#TsM{>Vt|P@>hU2QTl7kH))LU2w_ss@69%i6JzY{<&bUU-lr9C zf7B~0sHu}KSB7KNBFWTFvQu}W?L`b!J}ightP1ZM5WTFzv5aR`ZH?nm5wdWvaG#myq;gkmYoP@0*z1iB9F}eO=RX_W2#&hCq2>Z6w6Af zodosqJ6D&B!{u>ruz0rl2^F*pcSImhCG~yDA|wm z-&|h{(#qBb#+C*`q$++F63aHYO~3w#d<0oo&CymDsD%TE!NA+!M$Cx(ewJj%iEAJf z?TuTiHFO3@CEblz0}FMtbpHd+E4&c?kEaC>$~j@ggLH9S=vE7H3{89t~1dm);R z4fgDhSbcsl23bzO(QdO!)mbuuU@IsUzsj=bRR1r(u}u>BIbjTYm0mlnaI z?p7TJzIo0s2nJONaO=T(^YYTj0kB zGveI=iXiHI(9Q{O#cD_s3Wcs!$EC?sX%VcR)kphYd&C2?uL?$v2R7<2;_Qoqt$9~u zQ}w|+ke_i;`>d60@7;` zSyuhA>qAaGyXPoV2DfnIB{6^rA!d<$=}LE0K1toTZhs35L`yBUpG2u2K6KsDed@`( zM-++YHJSBajbt!E*bpn%OLW@8jZltwF051&hZGavb?xc+lY$g`rNpp#A_`2C_IQySWz7-#EvY;K6Il$YV@B zklKHj8Kx>I0;yz8&uHwG1=b#6b=v#90nbW=YhjxW|XREMl~v2X@)ODT1|U&gVe%cnO}As_}3+q@JLf%3CVZA zN97C(R=8|1-cRTT9?=2kP1ZW&Xh7hKENK;d@LJC9+ z_N!8+&R6u|P+m~hEjzk@-8-ce0H^MlY@}6Cx`~;Op8AI!f@k-vcq?~9Ko5adAl&Ml z<@n0zI|ntEreVHI0=F_|jpHSDPa~aFsi8zPFSw^uUE{){egyG)dkJ{}XSeUt(m9Bh z&hmrRnnzRgQM)pH6|Q^Kt42%Htqf&B*kGg1_54vdMg)xqxSq7JOZrG#MBH8$Jo((z zF`z;dOi}Srx}6HXPY0d)W!XTW+CKB~qE5&BBjpCORYK}Aj+j?fgFz?a!ABFaIPI~s z)kXH?XNo~?_uoM01#ZpBIOvb;hlhRs)XTA+M9@O%Ahb^rEI&tC%&z7y6$l(ao|q>r zxit}XQ%|`ekJpWc*}D>B9rV9iS;~?Q0VccOLCqXLWOQw0vW%htn9l$wTu_#YFNBL^ z8sD z*&`%n1TcT|z@iOHvks!uQ;gr}lu9n+ES0)7KxtQq&_JdNN(w1$#9%;3qt*7oIU)^_ z{Yv?qq5~adRC&Z}@LEt5o|l3UjJ*0gdnyrNMn==rj{qVKUU}{O(XKp@IOGJD6r^ON z3*(b*6Y|wAR)FY{Ck9W(^%blH7abicm3-$L5h6Fk=NDN)wFWQqy8&?-HOE}dP2mJ& zI2V?n9^wo<$Vx~61H}iYz>M{pW?v09xOeOTqrMP>I_Zc7_g4vVkyBqIzj6-D#t6Ic z_!~X+EGlw(m>B%II5#8BY&)+mET!ArKC>w|-&lV)%dVk49cvRIxi)p8#>BvqCfGl#AY=!?p zD|v1sa3ZR&QSK_+z5Juxf6InN4FBb>(Zu(SL7wG#S-DFN_2K;u9hWZK>(TLN(~jd0 z{VtE{Anub`Q-Yt|u6Do1JsD1$PiuQ82}#ti8%%_AWx-12x768UkHBBznR(}@9y*2c z1emTIVi%D}kgTRsQ*<-EU5TOSFnq`FIe`Z{vn&dxn@q?b{ISc#Df<0d3(p+_*mUK# zv;XhA82}cXSIAW}>-pj3!3~|a3Vp2ejS8{91)g`-f09$G@z53ruItFM?6)Hc@SrO;Rv zNDl{E>3|~Blxos5p)EDFLRm)kq-I6NIGvPD;lI+X6=nzovAZ=@=eg99e*@cG3P|yS zDXH7OpIlA0$cR*mO4Hh| zZqt%ycFq1=fWkho*u%u-dG5Cz7}R7#&~{YM3k?4!DAFN{sZVIwF^SWp)#Jia`wSI9 zCJ7lp-|sgkOo)ziU=VYNY*!0e!jY{W3RaS)lp)~_5SGHbtrvl+|B=e4)`y^T6}Ve4 zo9e7YGjykHIo6VN7zwk> zlHwYk58T6lzSkPTyhO+(@j=rB^9*yAWYnABSxp~~rZSI=;N4gxH6(f)xuOlptMZoX zT$HofmYDcySULT|@CX66%!}Xk^CwT+Nm9d>un{ZK{E%xAF#4sogMx#6MJqn-Pgs#$ z>h1xf&WK0{6ackktUpc!R^hYbXG0vjN$@0S=nIh7KqgaDfMbRCb2#n^@tte0v2zDU z@a1%96IC@Uo_q65M;tlA^o%}>VA=7$9>f=}9%-60X7VLw#mtWqt1+*?%MORa20ti- zmZ3e*nXWwe&SrJ6L1)YzuayPmLiN|?x_KzO6+*+GX^w^HN5AlH`Qw?-ECSbEzxr>u zdt%QRqfJ#@j6sf(8&n2F3tpMpe}n^6;488H@dwm#GB2|5g2dY*ensAUKQLmGtF7! zA^)#j4J<@ax}^2(-uIlcpnLkq+$U|46skR_w7!CmY=fV3cG%IvAWdN8^ybXe@vqHyUw9|4(^e{TJ7^^NqV}@c{;RE$%V{6nFRH zUW&VvV#DCYwNRWQ#ob%1P^?&Scej_L_qpeu|KOcp#y)H9y^`##B;O>f>riUCJE9B_ zYwmcxhSZf1|FZ{dtrbEKQ8f?C$!=SX&H-Oke9L-+tX&G#`q`Yh_q9_H=6gb+OPBL{ zkfDR*_{&0_e8LJ#ifd|dO%|OmC=B7Gaiwil=!ysMd+W*v9viya<8nuY~atROOE6}3SVryv(f~XA1io*9@FQ^MJbOloDmg2wHLBT;Kc*UL0=}4>>hi&n6!AP#T zigu#l_?Rn%LR%T}V4yS0?XRnYzMuKKiC`cOXGknD14rd|GeM-jH-!>xb`tv59>Qdy zL3SaB5}2V49LBb0Wo3*WlhwvDNp(N|F*HQQz_`I{Any4?>Q50?3z5L(pZS9Di^^DD zRjXeSmu2_G)SwOBD|oPMW&sfUS_Wj-*~3soOkJ7~{y8S#o%Q+aRV^WdNk{S7J~6NL z{YXpd{OarX(vD<&os<>?M_mLmiMz*3Yx!TF56GH5rOhnBfJ4Q?q4(puef5IqC+J8+ zu18^%xC$x;|E|#G$L_E+=C8wBsW+D&cG4LcV-`%sTXlFW1Z!DKwVx%bXKy5TC(^vd z5PIqywB@oleyWCD=2ne`j!;;2?mJ8DKe(su)V^RgF!Bv$Mgu$mHv58_e3>dZt6&}& zZx>H^3mBxTv{xmXQgZ@r0}sW2nkF%mb0d6v_6ZH~@wwxnulU?n1BT(L+9CzIWQFF# zXa$K5w&dY|UL~;q^a9)^e#u#b;2=fu9}6LDK+DHMYr93!;JA%#QqLE+M0b?fFddQlq8@}l7Q z&uhel?r-tE5Vy@I+V4wrTj4rN#r}3vrEhb&u#jvvPuzri2BbbfFay|BPT=ARV z53#1Vg7sJ~I0L-ABQhK$UP+&~6xU@h#{@f;CH2>QJrUykvUW^J;njZoF8RxQ1;D8t zqQY#`UBp`ytZO=nGl}+ChI`M5vrl0(@3<7K2qom8FQNy~Plvx_4{dzx=*XNpgPtC3 zEdh`2uH}ow;iV?|I{eyerK1!Qv~81!v+v{lR`GK#RVI`|8IGQ=r%zYU#F%VFSQt@J zoAGy~ue^$K)f!U=do&R^l?kBRWJGvgPIPYmwLV>bJN;)+b(c~-D#{pJkFC?o@#z57B1r|v_pUV}pS`6KgTEQ5#7^qfn{!@gN?RzJaefJi zC6T;v27HkApdk>o42%%L9TsuXd4+`$L)xFv@`;^#pq+|yduAF=9&%e(97i0~L zhhi)Dnj%h{Q1Y?h-lh&4?TbkMYtq4EwU#x+*Am=>OP^^H0w78NnD5c+5ggf!932gY z8YVtl_T1h-fKkOanT17_K5?;+qAJ3k-y3*@Xx|>g1_qE+Gko%Cgl5MM!0iZ9*P7?v2 zzN}fR!nysLTHLtj@Hg;5%Px%O1WUkw@^f|zVgi2+kWe5|?;-lr)L3FgF||hMPH+|! zx-0k<-TrvKIM6oU>H<%#hYVXfZH5JV;Owt*q9sGzU8I{)9Xze)_Q!_tEDV+? zb43T0VjR)9kwzPfTI zZw$A@^!v^;jJOyN4vV+zcr{|q=yQzdR|aHSk0duTxrV*Bo^>r^HN1>$$`PDo9zM}B zQ%+Y0c0v(o9ecs3U`UJ6Yi(-b zrSbzUsV*ePi$eS-G)VK!0i$Cjv@-wWD$>x_t<^#P$8{C)7U|J1+vdqD>b3YU1>5$m zB{e6s)d-k-Elk-~x0dfhSbZE(GrN1~um?CpunAlD(&yn}6IrE((Qn?X3jesHx|sYD z(!7L2 zh*}N?xc5HSSZFzq=S4*VkX^jo6#cyx9qzT?@ZRSH^}@7|-;wBViz?Kk)YZKoFF2+P zR8W`g=*7o^{K9!HEm#30dB3obUy=w^Fm>sv5J5|s3`sZXy%k%hyRi4nguyFjX|8H z=bs@ai4;uC0!ioal`UP$KuMQLkMkXu~+t^5%%42p`Rn0Gv z=t;O|IxRP7iL|uIGTBXRvhOdp+5%OqNqv$1HF#TWxZy!#E?7v+{g$}j@u*Htw z-5(jf95Fr;QO270CEgjRAc^d?Aez)u!wUr5LrcS2Z)cA-u-`tC4rG57+FoRIFA}*p ze#(1^nB(ULg?i5tX~th{6HSbU_^|{V#;!^xe7xoQkPM?IYipOEJrEh81WQ?_s*bQz z(*BA`RH%3IOiA%nMJp40ZmH%3XU!_vpT|?UZikrG>S0N{TUaQGaGA0~s;FhP^R6$n z*F3JlHX%JRu-O3|s#zhQLp>Qq8ch1`CyK*Tzv)Z@t68v@gqEm^!6ASmF+5-eVQiJN zVBJhiMQ{SeaV_6yqYO=IIP~M1O?JJs78zD^8iU$b(?jegb%Iq-2KyEM<;cB6hBHJzF;eUNEZ*;pYD}v4U?a

!zVFf zDhJQb!wV0-X8Mssui7i2_3?HOda#$sScov7lF5$Wux!+?l*U+U3CCOpsVU&4DwWkd z+S~*jOSo9w{Qw0HxGAklsu$CP_R{F91>@A&Ucw7A(}G-KaGaW~suUx-$tgUQNCG7M^R;fS+Cu%#>3N7!u}Hw^9#|*rt2iXBZDcQ z)`x*Ocu7<^eB+Ucbnd32H@n!!CXZp3lLA3N`+Q8t2n2dmiAs;{a}?epf@U2B=K(34 zch$yoUlOP48$kX9qv6e|BfD1U&u4QR%NhvL1vmE>9F~5+O6ou855}oT1OiRbYmA3N zAQhoaSZUcw+sO9Ad^kV>h$K8aQ+wI3u$kHP_c!L60FXrWtec(;{J^o}|;Z&U1!AR{w z_UH9O)*>SNNOF`y44ErvQTY@dsntzcU}8qqO-$?Yz8{V?WCdPLen?O~k`DA$7GO5Z z>zUvB^p#^|f*}WvNeM4ZQ_|DJ77M`|4bO5+^qS{pDcMAICzxV6AlT5m=K>G>+;zhE z3!NraoCIGpndOSsYf3tnnM?3mZ_oN|%OT_PUZ}S$ zgH62sXzcXL_bACE;ApSb?gkB#dVG)h1FzdVcU1is^^>QDXM*6<5q)~o%+jymun`R{ z3d%;Bk?fQaWl{ZGFq#ym5ZsVBqv^=in7CY&=HPW+dJ-tS`7IaqQTCbEO{d@%1SzQ* zq)+*H@OJ(3$WPkmyQVdv zN$F}!t@=Vv93M|bZi6i{Kt{R4uM(Is2_1>mQCY?{O_U^6 zc-sK<-IzlTWNI`HjD1e!P(o{pQHamS!%WJE=?x;eo%kstizRgF=e;bOlY}wo{K?zk zcO~*W;u*Y3Yl^UbTvMC$CrI$;+jGj4x-e{;M$A>PA^zM`TMkr|(o5pGhqTqr8g>Vb zv*12wx~MPSzI1<{>Q6TRwvqM9g{@$Mk&)iT_*4t=M_eXPwlK{l)1jVRbX=TBHPAVq zl>gP(lXv(}mjk|)0Y+-Q5QGigxqw?Ga1m)?7*e@mgK7$g5u*`{aVk}yW1PsvcBtDD z;c|+XQGvQ$5+{OeshwhWYWQ9T)FTM>4fAxNj8T*1Vi!N0s|wV!)Lb7`0h@W2HEMYJ zeEXHHssgN(w81Y#97_P5MXh1G$K~oN+B&u&Q5`&x+Dr%6Ep|dz%KG5WbExRf>ID5MslH7RC)GQ>eNVWsDVzCc z;nF)eAVuD=h}k58)`Hbm$!_+@Iq2<6kT@X6&M6TUf1$9bi3EYI5N@Kq-6Mz9>_W22P1}2?hZ^D$+);>6AuvPFsUKgBr8m;;raYcg!Q+`LqHcR>tw2`p z5m1qbyYY z<;FMA`<<5^kSjxvN(H-GJ-aGR_l5Ys;2=|!a_r|cx|v8w)^ol4Zw~#RQZ$>7qWU2Y z;e|AU91J?3UBBVbS=>`BmH%bd|c`2Du*FrsUS%1lw8yr8<(aUb`~wF6FKnFD*dWrPnDRJs!xCY;kBP} zobXv9wA@+!7aLOjuUnf`k>>|@xZb2ycRrOPnSt^;{ObW|B-Oc1nnrKjE+Gb(`^zvS z$&4Nv24$ysJ6?mO37tS5q89`_^{mYNCF5?ePX z-(55NS)b_Z5mXfW0g~y`rDM5SexOzVA{~;iR(rrPthLo4Z|t{8xU=V{7Vy+_G+e&d z5$oAq143FiIdgLBYV`&FXj5%}({EOL*@p;0IbZLsx|hQG`9?&uTJm}Wzq$kEJ#L|q zxFcN%q`;_z7iF@U$vNRWN2{Et*u8*lh8TK-09Z*q8=rX!a6g-D)23lMJdOAPgb_X-_n|^W&#Bwr_>j&OF}HG{_T) z`=*LqN8SOoXMm!Ll#raIYxq}z*E_FAvRn3{O$Ti(XRif-29cx>F zvRtLCl0^K`4oT&v6+8jj;7}|O?&jSc5S}cSVy8rDdCTAJ+qaGc5*|;4hoqELs;BV# z8IC~A9U%c(SUOo`Hrd%ArS3{|)@?}yPqc|Rv?8Hurt@B<*HlfW+F0@o=U9|uGfYK9 zp}gj}Ktl|E5^yiHxWH&gG2r~2pX-u})mFN&0&cIl2|xW}dWgrxN3&4Z;!OWO9kZ^9 z@Q+mOIw_Tif|2*KII)NVswcNX5M%_Z;qNf^XC$*PzZSYf_r58Zv|~#JJxpeW_R<#N zCd8=9N%SB3UV~4aUmMdbsARxSJ0&GVteXdFzxQvO#3cXhB9RzXKdfi+SV`_W7*GPQ z<1p>#eVD8RpaV0hy;TE^s`vdS83dB1I)&Q|b{fvpAcK&%M*>Aa+*~mG9R;6!`_;$5 zp{Olm`jdVl!<@QvY5!(oEQfjD=-MY=F%~MXCt=8k2)etC^hm0Y4UG!g^pbeQ78j@2 zIgf+CR6hBv2x!h}0H{TAV$;p5&N~q#dcxY)HB6q8{Wem(@l<-4;^zaW z_Af2|Fj;=X<9cKOX}cIaO>{i}rBI$LNdRz=%7RustaW3idHUDJUg^A2viuo4Nl#5{ zEw!E(cukInuO(UuEq}#Dj2iKzvmgT{Ldr}`CA*^~0HTkTX!j{d!AsT=UYF}1#4u(d@p&jh)!N##hi1)^;hh49k#YzZ*IkUHk zGbgUSIOoEK?xZ%z;=ClhQs5Yb-p%BnptEaU3a>-lqOw?ss44dOrD#(4X;xc6Zs1Sm zEyt(JPs~k+o+yxz%-AA;E9yr#0L#+__RX%h zyy9JlaguJU`4Hr zFTNG395ktLk?|SiVdm9@eC+A*(6A77VCe2S|B!06Q=447hvitE1%f)EBb0c3e(e!} zuXeRi`2d+iK$k!I3BzK{5T!{=`WY!uGl71U_+HKEgIU%#02>JFPk6~n-U3OYCDFy^ z+p=lUc)T1i8MFwzX={DlEt^EofHYwgzFe&k&KQx5ovV*Jx9C;u<_9(a59`bybJ;#Q z9q4!e(2PXce>*u8k5p2GELo(V@NEkmY7?l~O{!iJ>$u^C?XCDFNY*lU*8>)se)wpY;-BCYkkmERre~5)nY&;sLobY^O1TYz2Ma_ii2x6 z(rerY_-u0GzhY*;1wp+~FrtIj<<-&u!<*k()R`g=1NG1KDG9(B=zC6ROnMl-j@b8o zdKz3C>tJNb3Cym`P)hfYA@}V**-dUj7^(+Oz5cA~U#x$mny32}q%#0L-D!y80nnv| zD!BBPGNm$f{dBd&UznJh$KV)&4DRCz2nM6M2?Otng>8G>%*g6K=gANi!AY(LcWPu~ zGtXmaPXB-z;7Ym-#g%_s-m#58ue{TSvai5h!tBu$Ps+D~46dJ1O+s4T92}4<=@@%D zt6J~3ZwHjkluw^i0+BNMW01{WD$`sDkIXh46xP_5^YZZx<;y=BY<9GdCzmY(Pf+-w z7oUu;#%CgTHyvOd-%RSM2nHdLGpqV$Koezg`jTN5QUUQyH)+T&I}Y(mY5wJgHwRQh zZ`?ZoqAaQ4rw=n56L&XP8sY|;4H?x1F&SJ2SYoF}wKIA0Jq1^qZ{Dq|mL@s*{)e>H z0SM3id)*>dtbt@gboznyDcyfrJbxNKy5evNG@547s1U31GQ=897)jk!GM10V9!;$t zOFN&OF#2o+A5ZOz^2FHNNQ5MJ@UK%6j7uJy=Nt}vl7irC`cZ2VtICkUh&hTBZ-T;ydU;qy$17PJ*MH2`vxeSofH{VU-s1;AwA|6)d>sBxv_vrCIl}J(4 zO?_)+DtOV0PT8x>P6h68bcFT&I!#ak*UT~u}kDu~;9zTD|Y>s&S^wU`~k3{Tz%oF(jE!v@e47hpkc zEc>L^UMWwm6vkwID3zSR%vkHeT9qEg1*yMY^3S4$i!BDe3#jhax@Gf6C2hldHP z6c`?juRDBUwqM+=ysm_gb7|K zDux!NfMfNa8td;j2O)%?7>P1^3F?4v7Gg%48>UQ^KxWWC7~ zxj8nmnrY0TM*f;joo;-aZH?-p2M1*;Wu5>|N1)V%@y2GLe2SuGkJi37nw-E6atmD} zi?!6NzWI1&UWa;-3ecLH#@gcDsZ+3=>`*GNNA)8d1eY-AC>qI8w?(F;J~8c-B9QM{ zR!KnRBpFXt;lbjN%3PV`-6?Ocr1_Z=@|h&Z zDufwwb4Q z=6N(NSpN>7&dTAg>@^p1*n0x*iz&S$Bj^EKQLe!z;{O5v{_;qXU<0lx?LK9M7+Mg8 zsjIZUTJrv32wIjz6rxIeTr!^Bl4dU<7KV=1zbSF^YIsqVdhl^9#d5!KGKXV$B=9by zPCBc(h_X=c!w+;^8j=#Lo?kSBO*Yg>L&E`j$3K?~%g8SBvM?Q62B(HBfCj_40iSMY z*an*=ZkpbDHx^Q-r!muasX@I8%IRK+DA4?xlZWvFo3(IgJaZqL<-9S*x?^>*hy#M(Zq569Zt|fRlJbs3? z#YxzUE2}E@Nw~H_O~LEMfuZ^Ka^UF$9>>HIa2WXp)tW$t;i)=WC=$bP(WOYOV3jXl zst?0oE0l*2ZD9;4HyRfbp{o=ekVMdG1P{wgI77P#-vR*$OX?RxFQA#tpX-zsWiQ2; z**{7&yDwQ$rF1-Q9Ca2MP&Pjq3$Bkh!uh2T+CdMVEBgP~_6x9JTer{qnr)4}LQw`+ ziYWSH@o57p)>E|tV%H6WKau^Ped&)lLIO?hsn2ax7TvYGQkHwfR{HGLJ^quxLs1yn zI=Q`uj%d-Pj~kJjySU{i}^wYRcT1?MHqjGXx37HX9*p zp&y);J`B7{_7W|gbNTSudd{TK;>Iprh>1F#7j*zZvsjdlI58@$u6KST{U#pd9IpYF zN;Ami$pDq=sOj-;Tz<-ZjfF|+>J(S^9%Gw#Un8B2EOv_@g%U-jHpQVpXiKu6abK67 zjPxFeXlqidYPoEy{?)VWQp5OzsxdzKt);4QR_|JNuX*K^d8xdQ4t(N}i*lm$mZZq0 z#HM6F-bS*e5;JpCcHc2)JGTv7zW1wfh6b|0R_H1}5~|S?BgM{b-117&!Y>E{E7#J0#^o(31VI%J+&zN2C~yBYct;_6Ti4$MAw@55m6!FnBkN$pA}d0V>lH=QJ>OYxL!H|=mh7|FQ) zvtJvemZvdBR{M2KlP6VH&>cO1c$RNb=G8`3eyf~EGBn z3AC&+EC2fQO~d`#(9Ph=bESBT)aBe6|D00`DhPIG)coVR8zeGD$_{TbZH+V|x6v?2H?iGdGnbzx(r@KwINq$?ncdPkRdFC8BsUBB&H;Wuj2{}*4Ezq4HAVaGuaZp8r zUKL#>>^ti^9M@}9BRZ|NANGY=s#=b1PWvi?UusrPwJX37_AmXCZgFtf{y67dXU%j= znaNa-1Ky{*wb0C)bmy+Si|2glM*I69a(2mK!WXzYG0;odv7xoVyU+7=mfpzZcd${R zFGknM7yg30o}2#pqkL%!8)X`AD%t8dD&gZ=@ozN~z3MRIPGsTqiv5)5*gnQ3czoRc zmasVri{a(HuH&C@+26MR3nnGeV=zA99?ZV~x30e{IkJq$>+ zxq?had33`?$3qyyMDpjQEbY@MlSsF!0a2euPF2MmY1FZ*#4}RgX8CXdpCb?TEMmy& z<qZrTG)*J}ykR>kBP_E#L3AJ(<<66a^~y zGJv$OE9>Wu1uTUX>*R)-1ROc@i6!O7hhMk`&+|XcQYnwZM@c9MGS8J1wNR;g+AvTY zj(?&%qXXuEhN+K)ln-0BD0dFGQ$}YVS#yM4RY;ckwahIwSAQ0_v>0Fs-*5|V#PAfM zkR>u?y4QBKftv;=it+B z`zkxyBo7&rOiWN6EHM*~8)M_-Q88Y^HV=6Bn9ouu4vR=S-&GZc2v`$kAXu#gWTW@x z>ZbuD?G+KKmy{X%Dzyi6)f}%Z(yu+A;$(C=YoNdSEyIHI`vTLL_+1#Q&yDxa&Y_H& z>&+nD%RvKdahyx>mT`JRGGqL|U5ide>7clS=Q`Q=%FB*AtF2^OIgeb+gv4hv?rR(BEKl7L|*8ntD^a5C^{bI^+v36h^~dcKL}nrofGT7q6Oe z7)jmN>}RMB*h5pDi_7D{t{Rj0u=;(IERv1L6mDdlEvnUP z^jF+wx5jQ4-#St554ETVi!7Wmb$#BXVC&cjWh1|0z+D1(Ue z5k7`FG{fMK>J7f={46@0S~Z_jSo-r%6!FCq42F9mC`Ml8#ScTxpqKk^=v}k-aD*19 zU8896+O>k0x-<+suO~?hY1YV9$kBcLO}A>s+3y0jd20JxWQp4ELp(e^2KUCQI+w+f zl86u|jFx%jE(Nwl-G;+cM=I~yw7AcMVrxKTA42V^Ad6Uk?I*#G*s$$(Cx_?9U2!7R z;&${Wp^f$H$4(oDBW>|7TkR9fQ3D>1wO+=;XAAQqz zax~jCAFG$@fI#XXP1%rfSew>G$Pi|TAd&(EHSmV$a|wm*=!N6!fqNp%@+$S9V1ai` z#cCYl4bnb%(8P0uZ}&;#p$${23 z>FU>dkqx<3Y^bFL#IJdo(H}X{S|BHe@s@5Qx%5jkTmqgaAI7P^E|$hA@2IfjXzJsn zZ9*8Z@`9zFXqbWrzXtz|=8r{2MdrK0qu9;O0?>mOxq;)GUZpzoI_%KYoE(nDEc;ai zWN7BvTgZ^`D73#uBLRhu%?-mar2uG=R_;Fx)yr6|PSto`(9a$$QTbT{a0VGRi*M!L&}kf@c5ruy*;o z-jT{Ab8Hb;Y3@3l4Ej<{N4VN+})*4f&E1$;Etg#n!$YEI{LR28axpW zvsC5P<{HX_9}I~GfO0$H)0;^Uin1=Lyn*N<@4DHZZpq#+gtDFj&s8U)5175 zQ!26WzmQAuOi#mV7j@)XElVdQE{I>gB7;o-EwO(_tAovGCBjKZ*}yQ9NI<9g^=06G_C?yiD+6;vbVp2hdWNrUiwWAb6ia zJ^|;79Ag+(aIAdSl_iClLOt!|hmv<>veubO`A$D;&aivu>X0?SXFI526c!1q1j99S zm+}dp60*TkUQ7zOz7{mSTXa>!J0~u<#F-m~3SH%q5)sjf!0voEqy!pSC|rtJ`hwEb zi3n$KcTQbEi5$E^2w^%d3IgEsePA05d>hdP_p}+ ze&O$9L{Tzi!N!YCa$*D0g9{PypyybXl)a^-`~qH`6*9IHmMpruNx^llUL053H7Hg) zd~i3zKHS$)y<|YaVoB@z1Hk7id08yg179pwccPhAnaKnT+*w?BXyeb*u|JaypKF-r zaa=Z4?u}RdNxD)MA6?~wX`gx{oFg{EBHokLvGoj>e9Pr`mowgqXqqF3@$}>N zrF}r|wSDspDUr=xp0+}GIZAt7_AiTw)(}CD!N3uzT@Jz>`LaCExMf3DSZ=(Xx&U+O zA!Tgl9l$Xs^;<@Wh-}U6+AWwwnU0K_?*%L_BW_7`K{s9@*W63ZVy|s(xa*+9vo+g2 zyh4U|Kh&|*OOrr!)bDv6kPjqmJ3j#6$o0g-@!p4Lt{=;jll-dN+qRlO0_o=;#>}9Y z6Yee-0W%wO0|jzU#^neUMwGb>dE)W1I$5YfwNwP|sdv)g4ane!zzb*0rJ$o#*BI0~ z7G**wx+J5lRg+?5i}%^Ts0I}pG8^di6etT>GfMd@yaa<#@48P^;pWn{+(_pVLV`Om zZG;oyFdlDbUTo~>j`NT@i~pt3J8dL_j#QBBWcM;*ou%8cZ@LH*;SW#F-$|thm9tBs z%O}KaiNy8NGU!uI^Kmj&&m6ovZup1&AqEHR1N|^-D3!r?L3aDkxeJcu`tDyY=J=Xl@!z8<7 z-IW$(kyEN^jF;%rPzutb?uCqphHy?MrWJ&e%d6K?0BPWNM{xD_5zj*RLwR#`!YX=D zfMk+#*161-v7UK`pCUEp@tM@*6D&z|#Ta!9L?9{UxRwU6UTW&Wl2!tenjx=4rvRGC zMU>O4FqVKQ;ncy^t@%D}_tM}S(LwoNCiw~isL~*oeC)*c9=^!%CLHa=AK@%E9xSLC1gA?y{BgZ2k9q)YmP2>CA|AC$V$Z+9CfTLjqB*KNf zJNrJ|o>9?E8j*bo#R!?orFT!X)_E`9IL%X7%b78~OO9HMZ}v^&75#)9b!neItnEoo zA3_sI%{AN5w!Tb<;rlxZf-1o|(xkPnV!YF>ykVt~8WboN0U7h#Ej?tzMjHzdQ8T|Q zHO{_0mraa4W>bHOM69SnX-r3~sc7M#}9OdtXp&eY!o;2VsJxkc{6fx<`_}JRVpT;T)yVs>Q(;FJXe2c>oOm4a{_I zO9W9Z9mj3Tn<+CM2gLRJo^*Z2I?`(AxDi_y_UY*vcV1A{E5SY^Y2Q3iX)JMhR~47% z&|v=``0dXpj4Vdt-TwSat7JqhlZC}8(nVyWq<0s;pVLZ!6K!q6J?4}(uS2n_g}FsfH44Zs#p}L{sv{AKNx`(%RD;=Y|JM`zHsb@Y15n+vo?~Yh(_q%jL~McsbtNN3!i7vDsvdkm%ALNWuv6uj z1=XE&r%vW)DZzu7lH01JTa)-x560T5e@(Y7Hg05L&~7-` zMmMfCpCTyO67|ZAHXq@MgI_FZX8Zi_^BzAfv}F8jh~>oS#ItS8aDaYCFj^05k{Z>p zB=$(vD3lF$nt%VWM56A-iX36pSd{h}?*URAvEH*7?QD&L1CR*nR6yX~_bEXe`~k() zX7noIL|sx+J2*-KVYjYvVi6MUxWXg z&akaB$!36+e~bfk>S_Xs$@^f3E+$k_&W8 z$VGdVuF;$ci&FU*MhE45QY;%z>o)%wGa%J?(n?ru+L%6(d>~It9IHMndgA}y|6ePb zjgZLjsFCVig*YcaOwaC3NjK>C5#bpJ0QX5D`(ZW>*itk%+*9yBCwM;X5*@BIpd6>#*by@g4RIjv5=iVP_rgmX z);oup;f4L=z*qQme5=O+V6JFHYhaz@zmi4WbeJFpOqwXLIW1mnRg;G9yjy%*>iHgj zz$4(TN)``tY_iyoTb?&I6#?I|Z3n#nl_a-_#Z1$2T6Y2uMmheXY3m7X%-mh;RtL(6 zmMSlg#$eN(@FkY&@CF?y>|hUpkklOBHk*HwyK-s3UYq6Y8_ed)*{X(5Ag(IvoHtRT zg01`dM+lI%P>n>@%n*J%!LAp8z zUrf#t3!q^I!>iGkjY`k=Z#-(C9$)M9sd{>5voz*FrM9X1LkIMj0f4Wd&pnA``@3#q)u+BW-Y4GRSN?|;m_PZvPS3D6OV3KgGAV* z64`n7eJbBNtXdoenyhvG>+SOc$LWL0?`**q-JPVE4{(idi6pWwytiR3(P<4ZH&=Dv zdwZ5s{F^u!7IkWdR)0QM($@}}Ym}T@`}~RO`^*~bI@e}-6P1R~-02`)k`giLKQ!R) zi`U_RydTg%6`HV6e6nkqrlrU6lOw;jfoW0_X@a2-YxV2Bnv7QYH*)^~x^x^LYo?|- zr!qhWn&@UcK39hSo1{6Spa2?A$QKd+_xizFXea=k8(l+!fBEnK?{PmxJhghpd4{P1 zUwGaPU|qibHy%{#n|`PY=pcLh@wl2Hw6U>KrM*#uYWaGn%A|ci;PKk^YT+pGtNc2i zOv3U??Q`kbKPTzbLRU(DxHvzmZlQ==R3)3E9B{q5Ioo1bUdV!}MUHmwTB|8A5%Zsa zIKMn_T_FDF_}^!gG5z4vW+`@c7a2`7wi)Div8(mnARq?%zn6Rd1sk5km). It includes both the linear oGWD like that of McFarlane (1987) and nonlinear oGWD like low-level wave breaking (LLWB). The LLWB downstream often results in downslope windstorm that can enhance the drag by several times that of linear oGWD. The incorporation of the nonlinear drag is by adding an "enhancement factor" that is a function of the higher moments of the orography, e.g. orographic asymmetry (OA), orographic convexity (OC), effective orographic length (OL). + +### FBD scheme + +The Xie et al.,(2020) FBD scheme parameterizes the drag by flow blocked on the mountain flanks or flowing around the mountain under upstream stable conditions (>5km). It occurs when the mean flow does not have enough kinetic energy to traverse an obstacle and either stops upstream or diverges around the obstacle. This provides drag near the surface where the blocking occurs in addition to the oGWD. + +### TOFD scheme + +The TOFD scheme (Beljaars et al.,2004) parameterizes the drag generated by the shear stresses in the boundary layer when the flow encounters smaller obstacles (<5km). As airflow encounters an obstacle, it is disrupted, leading to the formation of eddies and vortices. These turbulent structures enhance mixing, allowing different layers of air to interact over a short distance. The intensity of the mixing is typically higher close to the obstacle, with rapid changes in velocity and direction of the airflow and can exhibit large control over the surface wind. It is an alternative scheme to the current TMS in E3SMv3. An important difference between the TOFD and TMS is that TOFD explicitly calculate the stress profile while TMS uses an enhanced effective roughtness length approach. + +### sGWD scheme + +The Tsiringakis et al.,(2017) sGWD scheme parameterizes the small-scale orographic gravity wave drag (sGWD) within the relatively shallow stable boundary layer. Models applying the form drag such as TOFD schemes usually lack sufficient cyclonic filling and do not accurately represent the development of cyclones over land (Louis, 1979; Holtslag, 2006). This caused significant temperature bias that occurs due to runaway cooling at the surface. To bridge the gap of this missing drag in the boundary layer, studies have hypothesized that the missing drag can be generated by sGWD. sGWD occurs under the relative stable boundary layer with low winds where the turbulence is significantly reduced. + +## Namelist parameters + +[orodrag Namelist Parameters](../user-guide/namelist_parameters.md#orographic-drag-schemes) diff --git a/components/eam/docs/user-guide/namelist_parameters.md b/components/eam/docs/user-guide/namelist_parameters.md index b09e8c44ffd..9b7972e0ebf 100644 --- a/components/eam/docs/user-guide/namelist_parameters.md +++ b/components/eam/docs/user-guide/namelist_parameters.md @@ -156,3 +156,22 @@ | Parameter | Description | Default value | | ------------------------- | ----------------------------------------------------------------- | ---------------------- | | `cosp_lite` | This namelist sets cosp_ncolumns=10 and cosp_nradsteps=3 (appropriate for COSP statistics derived from seasonal averages), and runs MISR, ISCCP, MODIS, and CALIPSO lidar simulators (cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true., cosp_lmodis_sim=.true.,cosp_llidar_sim=.true.). | `false` | +## Orographic drag schemes + +| Parameter | Description | Default value | +| ------------------------- | ----------------------------------------------------------------- | ---------------------- | +| `use_gw_oro` | This namelist controls the default linear orographic gravity wave drag (oGWD) for E3SM, if used, the default oGWD is turned on. | `true` | +| `do_tms` | This namelist controls the default TMS for E3SM, if used, the default TMS is turned on. | `false` | +| `effgw_oro` | Efficiency associated with orographic gravity waves. | `0.375` | +| `tms_orocnst` | Turbulent mountain stress parameter used when turbulent mountain stress calculation +is turned on | `true` | +| `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ]. | `true` | +| `use_od_ls` | This namelist controls the new nonlinear oGWD, if used, the nonlinear oGWD is turned on. use_od_ls should not be used at the same time with use_gw_oro. | `true` | +| `use_od_bl` | This namelist controls the FBD scheme, if used, the FBD scheme is turned on. | `true` | +| `use_od_ss` | This namelist controls the sGWD scheme, if used, the sGWD scheme is turned on. | `true` | +| `use_od_fd` | This namelist controls the TOFD scheme, if used, the TOFD scheme is turned on. | `true` | +| `od_ls_ncleff` | Tuning parameter of nonlinear oGWD. Stands for effective resolution of the grid for oGWD. Scales the magnitude of nonlinear oGWD. | `3` | +| `od_bl_ncd` | Tuning parameter of flow-blocking drag (FBD). Stands for bulk drag coefficient. Scales the magnitude of FBD. | `3` | +| `od_ss_sncleff` | Tuning parameter of small-scale GWD (sGWD). Stands for effective resolution of the grid for sGWD.Scales the magnitude of sGWD. | `1` | + + From 635809d8779806140bc1ef03211bda2deaf792aa Mon Sep 17 00:00:00 2001 From: xie7 Date: Tue, 19 Nov 2024 12:40:02 -0800 Subject: [PATCH 295/529] Minor modification on doc. --- components/eam/docs/user-guide/namelist_parameters.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eam/docs/user-guide/namelist_parameters.md b/components/eam/docs/user-guide/namelist_parameters.md index 9b7972e0ebf..0a0f81eb4ec 100644 --- a/components/eam/docs/user-guide/namelist_parameters.md +++ b/components/eam/docs/user-guide/namelist_parameters.md @@ -164,8 +164,8 @@ | `do_tms` | This namelist controls the default TMS for E3SM, if used, the default TMS is turned on. | `false` | | `effgw_oro` | Efficiency associated with orographic gravity waves. | `0.375` | | `tms_orocnst` | Turbulent mountain stress parameter used when turbulent mountain stress calculation -is turned on | `true` | -| `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ]. | `true` | +is turned on | `` | +| `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ]. | `` | | `use_od_ls` | This namelist controls the new nonlinear oGWD, if used, the nonlinear oGWD is turned on. use_od_ls should not be used at the same time with use_gw_oro. | `true` | | `use_od_bl` | This namelist controls the FBD scheme, if used, the FBD scheme is turned on. | `true` | | `use_od_ss` | This namelist controls the sGWD scheme, if used, the sGWD scheme is turned on. | `true` | From cf8101cb6708af6f9fd91715a0c47c446709b3fe Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 19 Nov 2024 15:14:02 -0600 Subject: [PATCH 296/529] Fix up orodrag documentation Make sure figure is displayed. Add to top level menu. Fix linting errors. --- components/eam/docs/tech-guide/index.md | 2 ++ components/eam/docs/tech-guide/orodrag.md | 19 +++++++++++-------- .../docs/user-guide/namelist_parameters.md | 8 +++----- components/eam/mkdocs.yml | 1 + 4 files changed, 17 insertions(+), 13 deletions(-) diff --git a/components/eam/docs/tech-guide/index.md b/components/eam/docs/tech-guide/index.md index f93b7715570..10e66936799 100644 --- a/components/eam/docs/tech-guide/index.md +++ b/components/eam/docs/tech-guide/index.md @@ -16,6 +16,8 @@ This Technical Guide describes the physics of version 3 of the E3SM Atmospheric - [RRTMG](rrtmg.md): Parameterization of radiation. +- [ORODRAG](orodrag.md): Parameterization of orographic drag + - [MAM](mam.md): Primary parameterization schemes used to represent aerosols. - [VBS](vbs.md): Parameterization of secondary organic aerosols. diff --git a/components/eam/docs/tech-guide/orodrag.md b/components/eam/docs/tech-guide/orodrag.md index eec7e04828a..4373d91619d 100644 --- a/components/eam/docs/tech-guide/orodrag.md +++ b/components/eam/docs/tech-guide/orodrag.md @@ -2,21 +2,24 @@ ## Overview -The orographic drag schemes includes a suite of new orographic drag parameterization schemes into E3SM. It includes 4 components all combined in one module (i.e. subroutine gwdo2d). The schemes include orographic gravity wave drag (oGWD, Xie et al.,2020), flow-blocking drag (FBD, Xie et al.,2020), small-scale GWD (sGWD, Tsiringakis et al.,2017), and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004). The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987) and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010) module in the E3SMv3, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. In the following section, we'll first introduce the default oGWD and TMS scheme, then describe the newly added orographic drag schemes. +The orographic drag schemes includes two main options: the default Gravity Wave Drag schemeof McFarlane (1987) and a +new suite of orographic drag parameterization schemes. The new suite includes 4 components all +combined in one module (i.e. subroutine gwdo2d). The schemes include +orographic gravity wave drag (oGWD, Xie et al.,2020), flow-blocking drag (FBD, Xie et al.,2020), small-scale GWD (sGWD, Tsiringakis et al.,2017), and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004). The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987) and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010) module in EAM, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. The conceptual location of each scheme is illustrate below. -[orodrag figure](../figures/orodrag.png) +![orodrag figure](../figures/orodrag.png) -### default oGWD scheme +### Default oGWD scheme The current default oGWD scheme in E3SMv3 is from McFarlane (1987). It is a linear orographic gravity wave drag scheme that parameterizes the subgrid process of vertical propagation of gravity wave originated from orographic source. The output from this scheme is a vertical profile of drag (or deceleration terms) when gravity wave breaks at higher levels and deposit momemtum flux to that level. This scheme is shown to have impact on excessive westerly wind in the extratropics and the wind bias in the polar region. -### default TMS scheme +### Default TMS scheme -The turbulent mountain stress (TMS) scheme parameterizes is documented on Richter et al.,(2010). It parameterizes the turbulent scale form drag (TOFD) through adding enhanced effective roughness length to the model. This method is justified by the observation that area-averaged wind sufficiently far above hilly terrain behave logarithmically. It leads to significant decrease of overspeed surface wind in the model. It is currently turned off in E3SMv3 and used as an option. +The turbulent mountain stress (TMS) scheme parameterizes is documented on Richter et al.,(2010). It parameterizes the turbulent scale form drag (TOFD) through adding enhanced effective roughness length to the model. This method is justified by the observation that area-averaged wind sufficiently far above hilly terrain behave logarithmically. It leads to significant decrease of overspeed surface wind in the model. It is turned OFF in E3SMv3.0. -### new oGWD scheme +### New oGWD scheme -The Xie et al.,(2020) oGWD scheme is an nonlinear orographic gravity wave drag scheme that parameterizes the subgrid oGWD (>5km). It includes both the linear oGWD like that of McFarlane (1987) and nonlinear oGWD like low-level wave breaking (LLWB). The LLWB downstream often results in downslope windstorm that can enhance the drag by several times that of linear oGWD. The incorporation of the nonlinear drag is by adding an "enhancement factor" that is a function of the higher moments of the orography, e.g. orographic asymmetry (OA), orographic convexity (OC), effective orographic length (OL). +The Xie et al.,(2020) oGWD scheme is a nonlinear orographic gravity wave drag scheme that parameterizes the subgrid oGWD (>5km). It includes both the linear oGWD like that of McFarlane (1987) and nonlinear oGWD like low-level wave breaking (LLWB). The LLWB downstream often results in downslope windstorm that can enhance the drag by several times that of linear oGWD. The incorporation of the nonlinear drag is by adding an "enhancement factor" that is a function of the higher moments of the orography, e.g. orographic asymmetry (OA), orographic convexity (OC), effective orographic length (OL). ### FBD scheme @@ -28,7 +31,7 @@ The TOFD scheme (Beljaars et al.,2004) parameterizes the drag generated by the s ### sGWD scheme -The Tsiringakis et al.,(2017) sGWD scheme parameterizes the small-scale orographic gravity wave drag (sGWD) within the relatively shallow stable boundary layer. Models applying the form drag such as TOFD schemes usually lack sufficient cyclonic filling and do not accurately represent the development of cyclones over land (Louis, 1979; Holtslag, 2006). This caused significant temperature bias that occurs due to runaway cooling at the surface. To bridge the gap of this missing drag in the boundary layer, studies have hypothesized that the missing drag can be generated by sGWD. sGWD occurs under the relative stable boundary layer with low winds where the turbulence is significantly reduced. +The Tsiringakis et al.,(2017) sGWD scheme parameterizes the small-scale orographic gravity wave drag (sGWD) within the relatively shallow stable boundary layer. Models applying the form drag such as TOFD schemes usually lack sufficient cyclonic filling and do not accurately represent the development of cyclones over land (Louis, 1979; Holtslag, 2006). This caused significant temperature bias that occurs due to runaway cooling at the surface. To bridge the gap of this missing drag in the boundary layer, studies have hypothesized that the missing drag can be generated by sGWD. sGWD occurs under the relative stable boundary layer with low winds where the turbulence is significantly reduced. ## Namelist parameters diff --git a/components/eam/docs/user-guide/namelist_parameters.md b/components/eam/docs/user-guide/namelist_parameters.md index 0a0f81eb4ec..4b856c6c5fd 100644 --- a/components/eam/docs/user-guide/namelist_parameters.md +++ b/components/eam/docs/user-guide/namelist_parameters.md @@ -156,6 +156,7 @@ | Parameter | Description | Default value | | ------------------------- | ----------------------------------------------------------------- | ---------------------- | | `cosp_lite` | This namelist sets cosp_ncolumns=10 and cosp_nradsteps=3 (appropriate for COSP statistics derived from seasonal averages), and runs MISR, ISCCP, MODIS, and CALIPSO lidar simulators (cosp_lmisr_sim=.true.,cosp_lisccp_sim=.true., cosp_lmodis_sim=.true.,cosp_llidar_sim=.true.). | `false` | + ## Orographic drag schemes | Parameter | Description | Default value | @@ -163,9 +164,8 @@ | `use_gw_oro` | This namelist controls the default linear orographic gravity wave drag (oGWD) for E3SM, if used, the default oGWD is turned on. | `true` | | `do_tms` | This namelist controls the default TMS for E3SM, if used, the default TMS is turned on. | `false` | | `effgw_oro` | Efficiency associated with orographic gravity waves. | `0.375` | -| `tms_orocnst` | Turbulent mountain stress parameter used when turbulent mountain stress calculation -is turned on | `` | -| `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ]. | `` | +| `tms_orocnst` | Turbulent mountain stress parameter used when turbulent mountain stress calculation is turned on | `1.0` | +| `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ]. | `0.75` | | `use_od_ls` | This namelist controls the new nonlinear oGWD, if used, the nonlinear oGWD is turned on. use_od_ls should not be used at the same time with use_gw_oro. | `true` | | `use_od_bl` | This namelist controls the FBD scheme, if used, the FBD scheme is turned on. | `true` | | `use_od_ss` | This namelist controls the sGWD scheme, if used, the sGWD scheme is turned on. | `true` | @@ -173,5 +173,3 @@ is turned on | `` | | `od_ls_ncleff` | Tuning parameter of nonlinear oGWD. Stands for effective resolution of the grid for oGWD. Scales the magnitude of nonlinear oGWD. | `3` | | `od_bl_ncd` | Tuning parameter of flow-blocking drag (FBD). Stands for bulk drag coefficient. Scales the magnitude of FBD. | `3` | | `od_ss_sncleff` | Tuning parameter of small-scale GWD (sGWD). Stands for effective resolution of the grid for sGWD.Scales the magnitude of sGWD. | `1` | - - diff --git a/components/eam/mkdocs.yml b/components/eam/mkdocs.yml index e41cb614387..d0e23a6e7e8 100644 --- a/components/eam/mkdocs.yml +++ b/components/eam/mkdocs.yml @@ -16,6 +16,7 @@ nav: - tech-guide/clubb.md - tech-guide/zm.md - RRTMG: tech-guide/rrtmg.md + - tech-guide/orodrag.md - tech-guide/mam.md - tech-guide/vbs.md - tech-guide/dust.md From 84d49343f938e033f1ccdfaf134d2c505e119932 Mon Sep 17 00:00:00 2001 From: xie7 Date: Tue, 19 Nov 2024 14:22:29 -0800 Subject: [PATCH 297/529] Added ref to the eam docs. modified: components/eam/docs/tech-guide/orodrag.md modified: components/eam/docs/user-guide/namelist_parameters.md modified: docs/refs/eam.bib [BFB] --- components/eam/docs/tech-guide/orodrag.md | 17 ++--- .../docs/user-guide/namelist_parameters.md | 16 ++--- docs/refs/eam.bib | 66 +++++++++++++++++++ 3 files changed, 81 insertions(+), 18 deletions(-) diff --git a/components/eam/docs/tech-guide/orodrag.md b/components/eam/docs/tech-guide/orodrag.md index 4373d91619d..8c6df04eae2 100644 --- a/components/eam/docs/tech-guide/orodrag.md +++ b/components/eam/docs/tech-guide/orodrag.md @@ -2,36 +2,33 @@ ## Overview -The orographic drag schemes includes two main options: the default Gravity Wave Drag schemeof McFarlane (1987) and a -new suite of orographic drag parameterization schemes. The new suite includes 4 components all -combined in one module (i.e. subroutine gwdo2d). The schemes include -orographic gravity wave drag (oGWD, Xie et al.,2020), flow-blocking drag (FBD, Xie et al.,2020), small-scale GWD (sGWD, Tsiringakis et al.,2017), and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004). The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987) and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010) module in EAM, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. The conceptual location of each scheme is illustrate below. +The orographic drag schemes includes two main options: the default Gravity Wave Drag schemeof McFarlane (1987)[@mcfarlane_the_1987] and a new suite of orographic drag parameterization schemes. The new suite includes 4 components all combined in one module (i.e. subroutine gwdo2d). The schemes include orographic gravity wave drag (oGWD, Xie et al.,2020)[@xie_an_2020], flow-blocking drag (FBD, Xie et al.,2020)[@xie_an_2020], small-scale GWD (sGWD, Tsiringakis et al.,2017)[@tsiringakis_small_2020], and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004)[@beljaars_a_2020]. The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987)[@mcfarlane_the_1987] and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010)[@richter_the_2010] module in EAM, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. The conceptual location of each scheme is illustrate below. ![orodrag figure](../figures/orodrag.png) ### Default oGWD scheme -The current default oGWD scheme in E3SMv3 is from McFarlane (1987). It is a linear orographic gravity wave drag scheme that parameterizes the subgrid process of vertical propagation of gravity wave originated from orographic source. The output from this scheme is a vertical profile of drag (or deceleration terms) when gravity wave breaks at higher levels and deposit momemtum flux to that level. This scheme is shown to have impact on excessive westerly wind in the extratropics and the wind bias in the polar region. +The current default oGWD scheme in E3SMv3 is from McFarlane (1987)[@mcfarlane_the_1987]. It is a linear orographic gravity wave drag scheme that parameterizes the subgrid process of vertical propagation of gravity wave originated from orographic source. The output from this scheme is a vertical profile of drag (or deceleration terms) when gravity wave breaks at higher levels and deposit momemtum flux to that level. This scheme is shown to have impact on excessive westerly wind in the extratropics and the wind bias in the polar region. ### Default TMS scheme -The turbulent mountain stress (TMS) scheme parameterizes is documented on Richter et al.,(2010). It parameterizes the turbulent scale form drag (TOFD) through adding enhanced effective roughness length to the model. This method is justified by the observation that area-averaged wind sufficiently far above hilly terrain behave logarithmically. It leads to significant decrease of overspeed surface wind in the model. It is turned OFF in E3SMv3.0. +The turbulent mountain stress (TMS) scheme parameterizes is documented on Richter et al.,(2010)[@richter_the_2010]. It parameterizes the turbulent scale form drag (TOFD) through adding enhanced effective roughness length to the model. This method is justified by the observation that area-averaged wind sufficiently far above hilly terrain behave logarithmically. It leads to significant decrease of overspeed surface wind in the model. It is turned OFF in E3SMv3.0. ### New oGWD scheme -The Xie et al.,(2020) oGWD scheme is a nonlinear orographic gravity wave drag scheme that parameterizes the subgrid oGWD (>5km). It includes both the linear oGWD like that of McFarlane (1987) and nonlinear oGWD like low-level wave breaking (LLWB). The LLWB downstream often results in downslope windstorm that can enhance the drag by several times that of linear oGWD. The incorporation of the nonlinear drag is by adding an "enhancement factor" that is a function of the higher moments of the orography, e.g. orographic asymmetry (OA), orographic convexity (OC), effective orographic length (OL). +The Xie et al.(2020)[@xie_an_2020] oGWD scheme is a nonlinear orographic gravity wave drag scheme that parameterizes the subgrid oGWD (>5km). It includes both the linear oGWD like that of McFarlane (1987)[@mcfarlane_the_1987] and nonlinear oGWD like low-level wave breaking (LLWB). The LLWB downstream often results in downslope windstorm that can enhance the drag by several times that of linear oGWD. The incorporation of the nonlinear drag is by adding an "enhancement factor" that is a function of the higher moments of the orography, e.g. orographic asymmetry (OA), orographic convexity (OC), effective orographic length (OL). ### FBD scheme -The Xie et al.,(2020) FBD scheme parameterizes the drag by flow blocked on the mountain flanks or flowing around the mountain under upstream stable conditions (>5km). It occurs when the mean flow does not have enough kinetic energy to traverse an obstacle and either stops upstream or diverges around the obstacle. This provides drag near the surface where the blocking occurs in addition to the oGWD. +The Xie et al.(2020)[@xie_an_2020] FBD scheme parameterizes the drag by flow blocked on the mountain flanks or flowing around the mountain under upstream stable conditions (>5km). It occurs when the mean flow does not have enough kinetic energy to traverse an obstacle and either stops upstream or diverges around the obstacle. This provides drag near the surface where the blocking occurs in addition to the oGWD. ### TOFD scheme -The TOFD scheme (Beljaars et al.,2004) parameterizes the drag generated by the shear stresses in the boundary layer when the flow encounters smaller obstacles (<5km). As airflow encounters an obstacle, it is disrupted, leading to the formation of eddies and vortices. These turbulent structures enhance mixing, allowing different layers of air to interact over a short distance. The intensity of the mixing is typically higher close to the obstacle, with rapid changes in velocity and direction of the airflow and can exhibit large control over the surface wind. It is an alternative scheme to the current TMS in E3SMv3. An important difference between the TOFD and TMS is that TOFD explicitly calculate the stress profile while TMS uses an enhanced effective roughtness length approach. +The TOFD scheme (Beljaars et al.,2004)[@beljaars_a_2020] parameterizes the drag generated by the shear stresses in the boundary layer when the flow encounters smaller obstacles (<5km). As airflow encounters an obstacle, it is disrupted, leading to the formation of eddies and vortices. These turbulent structures enhance mixing, allowing different layers of air to interact over a short distance. The intensity of the mixing is typically higher close to the obstacle, with rapid changes in velocity and direction of the airflow and can exhibit large control over the surface wind. It is an alternative scheme to the current TMS in E3SMv3. An important difference between the TOFD and TMS is that TOFD explicitly calculate the stress profile while TMS uses an enhanced effective roughtness length approach. ### sGWD scheme -The Tsiringakis et al.,(2017) sGWD scheme parameterizes the small-scale orographic gravity wave drag (sGWD) within the relatively shallow stable boundary layer. Models applying the form drag such as TOFD schemes usually lack sufficient cyclonic filling and do not accurately represent the development of cyclones over land (Louis, 1979; Holtslag, 2006). This caused significant temperature bias that occurs due to runaway cooling at the surface. To bridge the gap of this missing drag in the boundary layer, studies have hypothesized that the missing drag can be generated by sGWD. sGWD occurs under the relative stable boundary layer with low winds where the turbulence is significantly reduced. +The Tsiringakis et al.(2017)[@tsiringakis_small_2020] sGWD scheme parameterizes the small-scale orographic gravity wave drag (sGWD) within the relatively shallow stable boundary layer. Models applying the form drag such as TOFD schemes usually lack sufficient cyclonic filling and do not accurately represent the development of cyclones over land (Holstag 2006)[@holtslag_preface_2006]. This caused significant temperature bias that occurs due to runaway cooling at the surface. To bridge the gap of this missing drag in the boundary layer, studies have hypothesized that the missing drag can be generated by sGWD. sGWD occurs under the relative stable boundary layer with low winds where the turbulence is significantly reduced. ## Namelist parameters diff --git a/components/eam/docs/user-guide/namelist_parameters.md b/components/eam/docs/user-guide/namelist_parameters.md index 4b856c6c5fd..73d3c262fff 100644 --- a/components/eam/docs/user-guide/namelist_parameters.md +++ b/components/eam/docs/user-guide/namelist_parameters.md @@ -162,14 +162,14 @@ | Parameter | Description | Default value | | ------------------------- | ----------------------------------------------------------------- | ---------------------- | | `use_gw_oro` | This namelist controls the default linear orographic gravity wave drag (oGWD) for E3SM, if used, the default oGWD is turned on. | `true` | -| `do_tms` | This namelist controls the default TMS for E3SM, if used, the default TMS is turned on. | `false` | +| `do_tms` | This namelist controls the default Turbulent Mountain Stress (TMS) for E3SM, if used, the default TMS is turned on. | `false` | | `effgw_oro` | Efficiency associated with orographic gravity waves. | `0.375` | -| `tms_orocnst` | Turbulent mountain stress parameter used when turbulent mountain stress calculation is turned on | `1.0` | -| `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ]. | `0.75` | +| `tms_orocnst` | Turbulent mountain stress parameter used when TMS calculation is turned on | `1.0` | +| `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ] for TMS. | `0.75` | | `use_od_ls` | This namelist controls the new nonlinear oGWD, if used, the nonlinear oGWD is turned on. use_od_ls should not be used at the same time with use_gw_oro. | `true` | -| `use_od_bl` | This namelist controls the FBD scheme, if used, the FBD scheme is turned on. | `true` | -| `use_od_ss` | This namelist controls the sGWD scheme, if used, the sGWD scheme is turned on. | `true` | -| `use_od_fd` | This namelist controls the TOFD scheme, if used, the TOFD scheme is turned on. | `true` | +| `use_od_bl` | This namelist controls the Flow-blocking drag (FBD) scheme, if used, the FBD scheme is turned on. | `true` | +| `use_od_ss` | This namelist controls the small-scale GWD (sGWD) scheme, if used, the sGWD scheme is turned on. | `true` | +| `use_od_fd` | This namelist controls the Turbulent orographic form drag (TOFD) scheme, if used, the TOFD scheme is turned on. | `true` | | `od_ls_ncleff` | Tuning parameter of nonlinear oGWD. Stands for effective resolution of the grid for oGWD. Scales the magnitude of nonlinear oGWD. | `3` | -| `od_bl_ncd` | Tuning parameter of flow-blocking drag (FBD). Stands for bulk drag coefficient. Scales the magnitude of FBD. | `3` | -| `od_ss_sncleff` | Tuning parameter of small-scale GWD (sGWD). Stands for effective resolution of the grid for sGWD.Scales the magnitude of sGWD. | `1` | +| `od_bl_ncd` | Tuning parameter of FBD. Stands for bulk drag coefficient. Scales the magnitude of FBD. | `3` | +| `od_ss_sncleff` | Tuning parameter of sGWD. Stands for effective resolution of the grid for sGWD.Scales the magnitude of sGWD. | `1` | diff --git a/docs/refs/eam.bib b/docs/refs/eam.bib index ff4415a519b..c8b8ffded40 100644 --- a/docs/refs/eam.bib +++ b/docs/refs/eam.bib @@ -1035,3 +1035,69 @@ @article{neale_description_2012 journal = {UNKNOWN}, year = {2012}, } + +@article{xie_an_2020, + title = {An Orographic-Drag Parametrization Scheme Including Orographic Anisotropy for All Flow Directions}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/full/10.1029/2019MS001921/}, + doi = {10.1029/2019MS001921}, + language = {en}, + urldate = {2024-11-19}, + author = {J., Xie and M.,Zhang and Z., Xie and H., Liu and Z., Chai and J., He and H. Zhang}, + journal = {Journal of Advances in Modeling Earth Systems}, + year = {2020}, +} + +@article{beljaars_a_2020, + title = {A new parametrization of turbulent orographic form drag}, + url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1256/qj.03.73/}, + doi = {10.1256/qj.03.73}, + language = {en}, + urldate = {2024-11-19}, + author = {A. Beljaars, A. Brown, N. Wood}, + journal = {Quarterly Journal of the Royal Meterological Society}, + year = {2004}, +} + +@article{tsiringakis_small_2020, + title = {Small-scale orographic gravity wave drag in stable boundary layers and its impact on synoptic systems and near-surface meteorology}, + url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.3021}, + doi = {10.1002/qj.3021}, + language = {en}, + urldate = {2024-11-19}, + author = {A. Tsiringakis, G.J. Steeneveld, A.A.M. Holtslag}, + journal = {Quarterly Journal of the Royal Meterological Society}, + year = {2017}, +} + +@article{mcfarlane_the_1987, + title = {The Effect of Orographically Excited Gravity Wave Drag on the General Circulation of the Lower Stratosphere and Troposphere}, + url = {https://journals.ametsoc.org/view/journals/atsc/44/14/1520-0469_1987_044_1775_teooeg_2_0_co_2.xml}, + doi = {10.1175/1520-0469(1987)044<1775:TEOOEG>2.0.CO;2}, + language = {en}, + urldate = {2024-11-19}, + author = {N.A. McFarlane}, + journal = {Journal of the Atmospheric Sciences}, + year = {1987}, +} + +@article{richter_the_2010, + title = {The Effect of Orographically Excited Gravity Wave Drag on the General Circulation of the Lower Stratosphere and Troposphere}, + url = {https://journals.ametsoc.org/view/journals/atsc/67/1/2009jas3112.1.xml?tab_body=pdf}, + doi = {10.1175/2009JAS3112.1}, + language = {en}, + urldate = {2024-11-19}, + author = {J.H. Richter, F. Sassi, R.R. Garcia}, + journal = {Journal of the Atmospheric Sciences}, + year = {2010}, +} + +@article{holtslag_preface_2006, + title = {Preface:GEWEXatmospheric boundary-layer study (GABLS) on stable boundary layers}, + url = {https://link.springer.com/article/10.1007/s10546-005-9008-6}, + doi = {10.1007/s10546-005-9008-6}, + language = {en}, + urldate = {2024-11-19}, + author = {A.A Holtslag}, + journal = {Boundary-Layer Meterology}, + year = {2006}, +} From 59f4fb077e5d94ac3527a22c1e546c75232fc1ef Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 20 Nov 2024 13:47:00 -0700 Subject: [PATCH 298/529] progress --- .../eamxx/src/physics/shoc/CMakeLists.txt | 2 - .../eamxx/src/physics/shoc/shoc_iso_c.f90 | 71 ------------------ .../src/physics/shoc/tests/CMakeLists.txt | 4 +- .../physics/shoc/tests/infra/shoc_data.cpp | 22 ------ .../physics/shoc/tests/infra/shoc_data.hpp | 4 - .../shoc/tests/infra/shoc_main_wrap.cpp | 1 - .../shoc/tests/infra/shoc_test_data.cpp | 75 +------------------ .../shoc/tests/infra/shoc_test_data.hpp | 1 - .../tests/infra/shoc_unit_tests_common.hpp | 34 +++------ .../physics/shoc/tests/shoc_run_and_cmp.cpp | 55 ++++++++------ .../src/physics/shoc/tests/shoc_tests.cpp | 25 ------- 11 files changed, 51 insertions(+), 243 deletions(-) delete mode 100644 components/eamxx/src/physics/shoc/shoc_iso_c.f90 diff --git a/components/eamxx/src/physics/shoc/CMakeLists.txt b/components/eamxx/src/physics/shoc/CMakeLists.txt index 92041141589..3686c3cce7f 100644 --- a/components/eamxx/src/physics/shoc/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/CMakeLists.txt @@ -1,6 +1,4 @@ set(SHOC_SRCS - shoc_iso_c.f90 - ${SCREAM_BASE_DIR}/../eam/src/physics/cam/shoc.F90 eamxx_shoc_process_interface.cpp ) diff --git a/components/eamxx/src/physics/shoc/shoc_iso_c.f90 b/components/eamxx/src/physics/shoc/shoc_iso_c.f90 deleted file mode 100644 index 608974ea9cf..00000000000 --- a/components/eamxx/src/physics/shoc/shoc_iso_c.f90 +++ /dev/null @@ -1,71 +0,0 @@ -module shoc_iso_c - use iso_c_binding - implicit none - -#include "scream_config.f" -#ifdef SCREAM_DOUBLE_PRECISION -# define c_real c_double -#else -# define c_real c_float -#endif - -! -! This file contains bridges from scream c++ to shoc fortran. -! - -contains - - subroutine shoc_init_c(nlev, gravit, rair, rh2o, cpair, & - zvir, latvap, latice, karman, p0) bind(c) - use shoc, only: shoc_init, npbl - - integer(kind=c_int), value, intent(in) :: nlev ! number of levels - - real(kind=c_real), value, intent(in) :: gravit ! gravity - real(kind=c_real), value, intent(in) :: rair ! dry air gas constant - real(kind=c_real), value, intent(in) :: rh2o ! water vapor gas constant - real(kind=c_real), value, intent(in) :: cpair ! specific heat of dry air - real(kind=c_real), value, intent(in) :: zvir ! rh2o/rair - 1 - real(kind=c_real), value, intent(in) :: latvap ! latent heat of vaporization - real(kind=c_real), value, intent(in) :: latice ! latent heat of fusion - real(kind=c_real), value, intent(in) :: karman ! Von Karman's constant - real(kind=c_real), value, intent(in) :: p0 ! Reference pressure - - real(kind=c_real) :: pref_mid(nlev) ! unused values - - pref_mid = 0 - call shoc_init(nlev, gravit, rair, rh2o, cpair, & - zvir, latvap, latice, karman, p0, & - pref_mid, nlev, 1) - npbl = nlev ! set pbl layer explicitly so we don't need pref_mid. - end subroutine shoc_init_c - - ! shoc_init for shoc_main_bfb testing - subroutine shoc_init_for_main_bfb_c(nlev, gravit, rair, rh2o, cpair, & - zvir, latvap, latice, karman, p0, & - pref_mid, nbot_shoc, ntop_shoc) bind(c) - use shoc, only: shoc_init - - integer(kind=c_int), value, intent(in) :: nlev ! number of levels - integer(kind=c_int), value, intent(in) :: nbot_shoc ! Bottom level to which SHOC is applied - integer(kind=c_int), value, intent(in) :: ntop_shoc ! Top level to which SHOC is applied - - real(kind=c_real), value, intent(in) :: gravit ! gravity - real(kind=c_real), value, intent(in) :: rair ! dry air gas constant - real(kind=c_real), value, intent(in) :: rh2o ! water vapor gas constant - real(kind=c_real), value, intent(in) :: cpair ! specific heat of dry air - real(kind=c_real), value, intent(in) :: zvir ! rh2o/rair - 1 - real(kind=c_real), value, intent(in) :: latvap ! latent heat of vaporization - real(kind=c_real), value, intent(in) :: latice ! latent heat of fusion - real(kind=c_real), value, intent(in) :: karman ! Von Karman's constant - real(kind=c_real), value, intent(in) :: p0 ! Reference pressure - - real(kind=c_real), intent(in), dimension(nlev) :: pref_mid ! reference pressures at midpoints - call shoc_init(nlev, gravit, rair, rh2o, cpair, & - zvir, latvap, latice, karman, p0, & - pref_mid, nbot_shoc, ntop_shoc) - end subroutine shoc_init_for_main_bfb_c - - -end module shoc_iso_c - diff --git a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt index a5bd7d65796..321e8df1a68 100644 --- a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt @@ -75,7 +75,8 @@ endif() CreateUnitTest(shoc_tests "${SHOC_TESTS_SRCS}" LIBS shoc shoc_test_infra THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} - EXE_ARGS "--flags=\\'${BASELINE_FILE_ARG}\\'" + EXE_ARGS "--args ${BASELINE_FILE_ARG}" + LABELS "shoc;physics" ) if (NOT SCREAM_SHOC_SMALL_KERNELS) @@ -83,6 +84,7 @@ if (NOT SCREAM_SHOC_SMALL_KERNELS) LIBS shoc_sk shoc_test_infra THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} EXE_ARGS shoc_main_bfb "--flags=\\'${BASELINE_FILE_ARG}\\'" + LABELS "shoc;physics") ) endif() diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp index 2e92a8a0551..553a88f121b 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.cpp @@ -6,10 +6,6 @@ using scream::Real; using scream::Int; -extern "C" { - void shoc_init_c(int nlev, Real gravit, Real rair, Real rh2o, Real cpair, - Real zvir, Real latvap, Real latice, Real karman, Real p0); -} namespace scream { namespace shoc { @@ -111,18 +107,6 @@ FortranDataIterator::getfield (Int i) const { return fields_[i]; } -void shoc_init(Int nlev, bool force_reinit) { - static bool is_init = false; - if (!is_init || force_reinit) { - using Scalar = Real; - using C = scream::physics::Constants; - - shoc_init_c((int)nlev, C::gravit, C::Rair, C::RH2O, C::Cpair, C::ZVIR, - C::LatVap, C::LatIce, C::Karman, C::P0); - is_init = true; - } -} - int test_FortranData () { Int shcol = 1; Int nlev = 128, num_tracers = 1; @@ -130,11 +114,5 @@ int test_FortranData () { return 0; } -int test_shoc_init () { - Int nz = 160; - shoc_init(nz); - return 0; -} - } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp index 7e4aee2f8dc..5cc390aeebc 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp @@ -67,9 +67,6 @@ struct FortranDataIterator { void init(const FortranData::Ptr& d); }; -// Initialize SHOC with the given number of levels. -void shoc_init(Int nlev, bool force_reinit=false); - // We will likely want to remove these checks in the future, as we're not tied // to the exact implementation or arithmetic in SHOC. For now, these checks are // here to establish that the initial regression-testing code gives results that @@ -77,7 +74,6 @@ void shoc_init(Int nlev, bool force_reinit=false); Int check_against_python(const FortranData& d); int test_FortranData(); -int test_shoc_init(); } // namespace shoc } // namespace scream diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp index 4dd055abb4d..5445a44dded 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp @@ -220,7 +220,6 @@ void gen_plot_script(const std::vector >& data, int test_shoc_ic (bool gen_plot_scripts) { Int nz = 160; - shoc_init(nz); // Here we: // 1. Initialize a standard case with settings identical to // scream-doc/ѕhoc_port/shocintr.py's example_run_case method diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index dc341fb9515..e33a12882b7 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -20,271 +20,226 @@ namespace shoc { // // Glue functions to call from host with the Data struct // -// In all of these functions you should see shoc_init(nlev, true). // We are provisionally following P3 here in case SHOC uses global data. // void shoc_grid(ShocGridData& d) { - shoc_init(d.nlev); shoc_grid_host(d.shcol, d.nlev, d.nlevi, d.zt_grid, d.zi_grid, d.pdel, d.dz_zt, d.dz_zi, d.rho_zt); } void shoc_diag_obklen(ShocDiagObklenData& d) { - shoc_init(1); // single level function shoc_diag_obklen_host(d.shcol, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, d.thl_sfc, d.cldliq_sfc, d.qv_sfc, d.ustar, d.kbfs, d.obklen); } void update_host_dse(UpdateHostDseData& d) { - shoc_init(d.nlev); update_host_dse_host(d.shcol, d.nlev, d.thlm, d.shoc_ql, d.inv_exner, d.zt_grid, d.phis, d.host_dse); } void shoc_energy_fixer(ShocEnergyFixerData& d) { - shoc_init(d.nlev); shoc_energy_fixer_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, d.zt_grid, d.zi_grid, d.se_b, d.ke_b, d.wv_b, d.wl_b, d.se_a, d.ke_a, d.wv_a, d.wl_a, d.wthl_sfc, d.wqw_sfc, d.rho_zt, d.tke, d.pint, d.host_dse); } void shoc_energy_integrals(ShocEnergyIntegralsData& d) { - shoc_init(d.nlev); shoc_energy_integrals_host(d.shcol, d.nlev, d.host_dse, d.pdel, d.rtm, d.rcm, d.u_wind, d.v_wind, d.se_int, d.ke_int, d.wv_int, d.wl_int); } void calc_shoc_vertflux(CalcShocVertfluxData& d) { - shoc_init(d.nlev); calc_shoc_vertflux_host(d.shcol, d.nlev, d.nlevi, d.tkh_zi, d.dz_zi, d.invar, d.vertflux); } void calc_shoc_varorcovar(CalcShocVarorcovarData& d) { - shoc_init(d.nlev); calc_shoc_varorcovar_host(d.shcol, d.nlev, d.nlevi, d.tunefac, d.isotropy_zi, d.tkh_zi, d.dz_zi, d.invar1, d.invar2, d.varorcovar); } void compute_tmpi(ComputeTmpiData& d) { - shoc_init(d.nlevi - 1); // nlev = nlevi - 1 compute_tmpi_host(d.nlevi, d.shcol, d.dtime, d.rho_zi, d.dz_zi, d.tmpi); } void dp_inverse(DpInverseData& d) { - shoc_init(d.nlev); dp_inverse_host(d.nlev, d.shcol, d.rho_zt, d.dz_zt, d.rdp_zt); } void integ_column_stability(IntegColumnStabilityData& d) { - shoc_init(d.nlev); integ_column_stability_host(d.nlev, d.shcol, d.dz_zt, d.pres, d.brunt, d.brunt_int); } void check_tke(CheckTkeData& d) { - shoc_init(d.nlev); check_tke_host(d.shcol, d.nlev, d.tke); } void shoc_tke(ShocTkeData& d) { - shoc_init(d.nlev); shoc_tke_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.wthv_sec, d.shoc_mix, d.dz_zi, d.dz_zt, d.pres, d.tabs, d.u_wind, d.v_wind, d.brunt, d.zt_grid, d.zi_grid, d.pblh, d.tke, d.tk, d.tkh, d.isotropy); } void compute_shr_prod(ComputeShrProdData& d) { - shoc_init(d.nlev); compute_shr_prod_host(d.nlevi, d.nlev, d.shcol, d.dz_zi, d.u_wind, d.v_wind, d.sterm); } void isotropic_ts(IsotropicTsData& d) { - shoc_init(d.nlev); isotropic_ts_host(d.nlev, d.shcol, d.brunt_int, d.tke, d.a_diss, d.brunt, d.isotropy); } void adv_sgs_tke(AdvSgsTkeData& d) { - shoc_init(d.nlev); adv_sgs_tke_host(d.nlev, d.shcol, d.dtime, d.shoc_mix, d.wthv_sec, d.sterm_zt, d.tk, d.tke, d.a_diss); } void eddy_diffusivities(EddyDiffusivitiesData& d) { - shoc_init(d.nlev); eddy_diffusivities_host(d.nlev, d.shcol, d.pblh, d.zt_grid, d.tabs, d.shoc_mix, d.sterm_zt, d.isotropy, d.tke, d.tkh, d.tk); } void shoc_length(ShocLengthData& d) { - shoc_init(d.nlev); shoc_length_host(d.shcol, d.nlev, d.nlevi, d.host_dx, d.host_dy, d.zt_grid, d.zi_grid, d.dz_zt, d.tke, d.thv, d.brunt, d.shoc_mix); } void compute_brunt_shoc_length(ComputeBruntShocLengthData& d) { - shoc_init(d.nlev); compute_brunt_shoc_length_host(d.nlev, d.nlevi, d.shcol, d.dz_zt, d.thv, d.thv_zi, d.brunt); } void compute_l_inf_shoc_length(ComputeLInfShocLengthData& d) { - shoc_init(d.nlev); compute_l_inf_shoc_length_host(d.nlev, d.shcol, d.zt_grid, d.dz_zt, d.tke, d.l_inf); } void compute_shoc_mix_shoc_length(ComputeShocMixShocLengthData& d) { - shoc_init(d.nlev); compute_shoc_mix_shoc_length_host(d.nlev, d.shcol, d.tke, d.brunt, d.zt_grid, d.l_inf, d.shoc_mix); } void check_length_scale_shoc_length(CheckLengthScaleShocLengthData& d) { - shoc_init(d.nlev); check_length_scale_shoc_length_host(d.nlev, d.shcol, d.host_dx, d.host_dy, d.shoc_mix); } void clipping_diag_third_shoc_moments(ClippingDiagThirdShocMomentsData& d) { - shoc_init(d.nlevi - 1); // nlev = nlevi - 1 clipping_diag_third_shoc_moments_host(d.nlevi, d.shcol, d.w_sec_zi, d.w3); } void diag_second_moments_srf(DiagSecondMomentsSrfData& d) { - shoc_init(1); // single level function shoc_diag_second_moments_srf_host(d.shcol, d.wthl_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar); } void linear_interp(LinearInterpData& d) { - shoc_init(d.km1); linear_interp_host(d.x1, d.x2, d.y1, d.y2, d.km1, d.km2, d.ncol, d.minthresh); } void diag_third_shoc_moments(DiagThirdShocMomentsData& d) { - shoc_init(d.nlev); diag_third_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.isotropy, d.brunt, d.thetal, d.tke, d.dz_zt, d.dz_zi, d.zt_grid, d.zi_grid, d.w3); } void compute_diag_third_shoc_moment(ComputeDiagThirdShocMomentData& d) { - shoc_init(d.nlev); compute_diag_third_shoc_moment_host(d.shcol, d.nlev, d.nlevi, d.w_sec, d.thl_sec, d.wthl_sec, d.tke, d.dz_zt, d.dz_zi, d.isotropy_zi, d.brunt_zi, d.w_sec_zi, d.thetal_zi, d.w3); } void shoc_assumed_pdf(ShocAssumedPdfData& d) { - shoc_init(d.nlev); shoc_assumed_pdf_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.w_field, d.thl_sec, d.qw_sec, d.wthl_sec, d.w_sec, d.wqw_sec, d.qwthl_sec, d.w3, d.pres, d.zt_grid, d.zi_grid, d.shoc_cldfrac, d.shoc_ql, d.wqls, d.wthv_sec, d.shoc_ql2); } void shoc_assumed_pdf_tilde_to_real(ShocAssumedPdfTildeToRealData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_tilde_to_real_host(d.w_first, d.sqrtw2, &d.w1); } void shoc_assumed_pdf_vv_parameters(ShocAssumedPdfVvParametersData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_vv_parameters_host(d.w_first, d.w_sec, d.w3var, d.w_tol_sqd, &d.skew_w, &d.w1_1, &d.w1_2, &d.w2_1, &d.w2_2, &d.a); } void shoc_assumed_pdf_thl_parameters(ShocAssumedPdfThlParametersData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_thl_parameters_host(d.wthlsec, d.sqrtw2, d.sqrtthl, d.thlsec, d.thl_first, d.w1_1, d.w1_2, d.skew_w, d.a, d.thl_tol, d.w_thresh, &d.thl1_1, &d.thl1_2, &d.thl2_1, &d.thl2_2, &d.sqrtthl2_1, &d.sqrtthl2_2); } void shoc_assumed_pdf_qw_parameters(ShocAssumedPdfQwParametersData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_qw_parameters_host(d.wqwsec, d.sqrtw2, d.skew_w, d.sqrtqt, d.qwsec, d.w1_2, d.w1_1, d.qw_first, d.a, d.rt_tol, d.w_thresh, &d.qw1_1, &d.qw1_2, &d.qw2_1, &d.qw2_2, &d.sqrtqw2_1, &d.sqrtqw2_2); } void shoc_assumed_pdf_inplume_correlations(ShocAssumedPdfInplumeCorrelationsData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_inplume_correlations_host(d.sqrtqw2_1, d.sqrtthl2_1, d.a, d.sqrtqw2_2, d.sqrtthl2_2, d.qwthlsec, d.qw1_1, d.qw_first, d.thl1_1, d.thl_first, d.qw1_2, d.thl1_2, &d.r_qwthl_1); } void shoc_assumed_pdf_compute_temperature(ShocAssumedPdfComputeTemperatureData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_compute_temperature_host(d.thl1, d.pval, &d.tl1); } void shoc_assumed_pdf_compute_qs(ShocAssumedPdfComputeQsData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_compute_qs_host(d.tl1_1, d.tl1_2, d.pval, &d.qs1, &d.beta1, &d.qs2, &d.beta2); } void shoc_assumed_pdf_compute_s(ShocAssumedPdfComputeSData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_compute_s_host(d.qw1, d.qs1, d.beta, d.pval, d.thl2, d.qw2, d.sqrtthl2, d.sqrtqw2, d.r_qwthl, &d.s, &d.std_s, &d.qn, &d.c); } void shoc_assumed_pdf_compute_sgs_liquid(ShocAssumedPdfComputeSgsLiquidData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_compute_sgs_liquid_host(d.a, d.ql1, d.ql2, &d.shoc_ql); } void shoc_assumed_pdf_compute_cloud_liquid_variance(ShocAssumedPdfComputeCloudLiquidVarianceData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_compute_cloud_liquid_variance_host(d.a, d.s1, d.ql1, d.c1, d.std_s1, d.s2, d.ql2, d.c2, d.std_s2, d.shoc_ql, &d.shoc_ql2); } void shoc_assumed_pdf_compute_liquid_water_flux(ShocAssumedPdfComputeLiquidWaterFluxData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_compute_liquid_water_flux_host(d.a, d.w1_1, d.w_first, d.ql1, d.w1_2, d.ql2, &d.wqls); } void shoc_assumed_pdf_compute_buoyancy_flux(ShocAssumedPdfComputeBuoyancyFluxData& d) { - shoc_init(1); // single level function shoc_assumed_pdf_compute_buoyancy_flux_host(d.wthlsec, d.wqwsec, d.pval, d.wqls, &d.wthv_sec); } void diag_second_moments_ubycond(DiagSecondMomentsUbycondData& d) { - shoc_init(1); // single level function shoc_diag_second_moments_ubycond_host(d.shcol, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec); } void pblintd_init_pot(PblintdInitPotData& d) { - shoc_init(d.nlev, true); shoc_pblintd_init_pot_host(d.shcol, d.nlev, d.thl, d.ql, d.q, d.thv); } void pblintd_cldcheck(PblintdCldcheckData& d) { - shoc_init(d.nlev, true); shoc_pblintd_cldcheck_host(d.shcol, d.nlev, d.nlevi, d.zi, d.cldn, d.pblh); } void diag_second_moments_lbycond(DiagSecondMomentsLbycondData& d) { - shoc_init(1); // single level function diag_second_moments_lbycond_host(d.shcol, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.ustar2, d.wstar, d.wthl_sec, d.wqw_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.thl_sec, d.qw_sec, d.qwthl_sec); } void diag_second_moments(DiagSecondMomentsData& d) { - shoc_init(d.nlev); diag_second_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); @@ -292,7 +247,6 @@ void diag_second_moments(DiagSecondMomentsData& d) void diag_second_shoc_moments(DiagSecondShocMomentsData& d) { - shoc_init(d.nlev); diag_second_shoc_moments_host(d.shcol, d.nlev, d.nlevi, d.thetal, d.qw, d.u_wind, d.v_wind, d.tke, d.isotropy, d.tkh, d.tk, d.dz_zi, d.zt_grid, d.zi_grid, d.shoc_mix, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.thl_sec, d.qw_sec, d.wthl_sec, d.wqw_sec, d.qwthl_sec, d.uw_sec, d.vw_sec, d.wtke_sec, d.w_sec); @@ -300,13 +254,11 @@ void diag_second_shoc_moments(DiagSecondShocMomentsData& d) void compute_shoc_vapor(ComputeShocVaporData& d) { - shoc_init(d.nlev); compute_shoc_vapor_host(d.shcol, d.nlev, d.qw, d.ql, d.qv); } void update_prognostics_implicit(UpdatePrognosticsImplicitData& d) { - shoc_init(d.nlev); update_prognostics_implicit_host(d.shcol, d.nlev, d.nlevi, d.num_tracer, d.dtime, d.dz_zt, d.dz_zi, d.rho_zt, d.zt_grid, d.zi_grid, d.tk, d.tkh, d.uw_sfc, d.vw_sfc, d.wthl_sfc, d.wqw_sfc, @@ -315,8 +267,8 @@ void update_prognostics_implicit(UpdatePrognosticsImplicitData& d) void shoc_main(ShocMainData& d) { - shoc_init(d.nlev, true); - d.elapsed_s = shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, 1/*d.npbl*/, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, + const int npbl = shoc_init_host(d.nlev, d.pref_mid, d.nbot_shoc, d.ntop_shoc); + d.elapsed_s = shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, npbl, d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, d.pres, d.presi, d.pdel, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.wtracer_sfc, d.num_qtracers, d.w_field, d.inv_exner, d.phis, d.host_dse, d.tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.qtracers, d.wthv_sec, d.tkh, d.tk, d.shoc_ql, d.shoc_cldfrac, d.pblh, @@ -324,30 +276,13 @@ void shoc_main(ShocMainData& d) d.wtke_sec, d.uw_sec, d.vw_sec, d.w3, d.wqls_sec, d.brunt, d.shoc_ql2); } -void shoc_main_with_init(ShocMainData& d) -{ - using C = scream::physics::Constants; - - // shoc_init_for_main_bfb_host(d.nlev, C::gravit, C::Rair, C::RH2O, C::Cpair, C::ZVIR, C::LatVap, C::LatIce, C::Karman, C::P0, - // d.pref_mid, d.nbot_shoc, d.ntop_shoc+1); - - d.elapsed_s = shoc_main_host(d.shcol, d.nlev, d.nlevi, d.dtime, d.nadv, 1/*d.npbl*/,d.host_dx, d.host_dy, d.thv, d.zt_grid, d.zi_grid, - d.pres, d.presi, d.pdel, d.wthl_sfc, d.wqw_sfc, d.uw_sfc, d.vw_sfc, d.wtracer_sfc, d.num_qtracers, - d.w_field, d.inv_exner, d.phis, d.host_dse, d.tke, d.thetal, d.qw, d.u_wind, d.v_wind, d.qtracers, - d.wthv_sec, d.tkh, d.tk, d.shoc_ql, d.shoc_cldfrac, d.pblh, d.shoc_mix, d.isotropy, d.w_sec, - d.thl_sec, d.qw_sec, d.qwthl_sec, d.wthl_sec, d.wqw_sec, d.wtke_sec, d.uw_sec, d.vw_sec, d.w3, - d.wqls_sec, d.brunt, d.shoc_ql2); -} - void pblintd_height(PblintdHeightData& d) { - shoc_init(d.nlev, true); pblintd_height_host(d.shcol, d.nlev, d.npbl, d.z, d.u, d.v, d.ustar, d.thv, d.thv_ref, d.pblh, d.rino, d.check); } void vd_shoc_decomp_and_solve(VdShocDecompandSolveData& d) { - shoc_init(d.nlev); // Call decomp subroutine // vd_shoc_decomp_host(d.shcol, d.nlev, d.nlevi, d.kv_term, d.tmpi, d.rdp_zt, d.dtime, d.flux, d.du, d.dl, d.d); // // Call solver for each problem. The `var` array represents 3d @@ -369,25 +304,21 @@ void vd_shoc_decomp_and_solve(VdShocDecompandSolveData& d) void pblintd_surf_temp(PblintdSurfTempData& d) { - shoc_init(d.nlev, true); pblintd_surf_temp_host(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.obklen, d.kbfs, d.thv, d.tlv, d.pblh, d.check, d.rino); } void pblintd_check_pblh(PblintdCheckPblhData& d) { - shoc_init(d.nlev, true); - pblintd_check_pblh_host(d.shcol, d.nlev, d.nlevi, d.z, d.ustar, d.check, d.pblh); + pblintd_check_pblh_host(d.shcol, d.nlev, d.nlevi, d.nlev/*npbl*/, d.z, d.ustar, d.check, d.pblh); } void pblintd(PblintdData& d) { - shoc_init(d.nlev, true); pblintd_host(d.shcol, d.nlev, d.nlevi, d.npbl, d.z, d.zi, d.thl, d.ql, d.q, d.u, d.v, d.ustar, d.obklen, d.kbfs, d.cldn, d.pblh); } void compute_shoc_temperature(ComputeShocTempData& d) { - shoc_init(d.nlev, true); compute_shoc_temperature_host(d.shcol, d.nlev, d.thetal, d.ql, d.inv_exner, d.tabs); } diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index 48cdccc690b..ad159059589 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -982,7 +982,6 @@ void diag_second_shoc_moments (DiagSecondShocMomentsData& void compute_shoc_vapor (ComputeShocVaporData& d); void update_prognostics_implicit (UpdatePrognosticsImplicitData& d); void shoc_main (ShocMainData& d); -void shoc_main_with_init (ShocMainData& d); void pblintd_height (PblintdHeightData& d); void vd_shoc_decomp_and_solve (VdShocDecompandSolveData& d); void pblintd_surf_temp(PblintdSurfTempData& d); diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp index d392c9e905e..f7326c06df9 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_unit_tests_common.hpp @@ -69,30 +69,20 @@ struct UnitWrap { m_baseline_action(NONE), m_fid() { - //Functions::shoc_init(); // many tests will need fortran table data + //Functions::shoc_init(); // just in case there is ever global shoc data auto& ts = ekat::TestSession::get(); - auto raw_flags = ts.flags.begin()->first; - std::stringstream ss(raw_flags); - std::string flag; - bool next_token_is_path = false; - while (ss >> flag) { - if (flag == "-c") { - m_baseline_action = COMPARE; - } - else if (flag == "-g") { - m_baseline_action = GENERATE; - } - else if (flag == "-n") { - m_baseline_action = NONE; - } - else if (flag == "-b") { - next_token_is_path = true; - } - else if (next_token_is_path) { - m_baseline_path = flag; - next_token_is_path = false; - } + if (ts.flags["c"]) { + m_baseline_action = COMPARE; } + else if (ts.flags["g"]) { + m_baseline_action = GENERATE; + } + else if (ts.flags["n"]) { + m_baseline_action = NONE; + } + m_baseline_path = ts.params["b"]; + + EKAT_REQUIRE_MSG( !(m_baseline_action != NONE && m_baseline_path == ""), "SHOC unit test flags problem: baseline actions were requested but no baseline path was provided"); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp index ca9b519eec0..529d352dea4 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp @@ -74,7 +74,6 @@ struct Baseline { // Run reference shoc on this set of parameters. const auto d = ic::Factory::create(ps.ic, ps.ncol, ps.nlev, ps.num_qtracers); set_params(ps, *d); - shoc_init(ps.nlev); if (ps.repeat > 0 && r == -1) { std::cout << "Running SHOC with ni=" << d->shcol << ", nk=" << d->nlev @@ -105,30 +104,39 @@ struct Baseline { return nerr; } - Int run_and_cmp (const std::string& filename, const double& tol) { + Int run_and_cmp (const std::string& filename, const double& tol, bool no_baseline) { auto fid = ekat::FILEPtr(fopen(filename.c_str(), "r")); EKAT_REQUIRE_MSG( fid, "generate_baseline can't read " << filename); Int nerr = 0, ne; int case_num = 0; for (auto ps : params_) { case_num++; - // Read the reference impl's data from the baseline file. - const auto d_ref = ic::Factory::create(ps.ic, ps.ncol, ps.nlev, ps.num_qtracers); - set_params(ps, *d_ref); - // Now run a sequence of other impls. This includes the reference - // implementation b/c it's likely we'll want to change it as we go. - { + if (no_baseline) { const auto d = ic::Factory::create(ps.ic, ps.ncol, ps.nlev, ps.num_qtracers); set_params(ps, *d); - shoc_init(ps.nlev); - for (int it = 0; it < ps.nsteps; it++) { - std::cout << "--- checking case # " << case_num << ", timestep # = " << (it+1)*ps.nadv - << " ---\n" << std::flush; - read(fid, d_ref); + for (int it=0; it Path to directory containing baselines.\n" " -t Tolerance for relative error.\n" " -s Number of timesteps. Default=10.\n" " -dt Length of timestep. Default=150.\n" @@ -207,7 +217,7 @@ int main (int argc, char** argv) { return 1; } - bool generate = false; + bool generate = false, no_baseline = false; scream::Real tol = SCREAM_BFB_TESTING ? 0 : std::numeric_limits::infinity(); Int nsteps = 10; Int dt = 150; @@ -219,7 +229,8 @@ int main (int argc, char** argv) { std::string baseline_fn; std::string device; for (int i = 1; i < argc-1; ++i) { - if (ekat::argv_matches(argv[i], "-g", "--generate")) generate = true; + if (ekat::argv_matches(argv[i], "-g", "--generate")) { generate = true; no_baseline = false; } + if (ekat::argv_matches(argv[i], "-c", "--compare")) { no_baseline = false; } if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) { expect_another_arg(i, argc); ++i; @@ -274,8 +285,8 @@ int main (int argc, char** argv) { } } - // Decorate baseline name with precision. - baseline_fn += std::to_string(sizeof(scream::Real)); + // Compute full baseline file name with precision. + baseline_fn += "/shoc_run_and_cmp.baseline" + std::to_string(sizeof(scream::Real)); scream::initialize_scream_session(argc, argv); { @@ -285,7 +296,7 @@ int main (int argc, char** argv) { nerr += bln.generate_baseline(baseline_fn); } else { printf("Comparing with %s at tol %1.1e\n", baseline_fn.c_str(), tol); - nerr += bln.run_and_cmp(baseline_fn, tol); + nerr += bln.run_and_cmp(baseline_fn, tol, no_baseline); } } scream::finalize_scream_session(); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp index a44f2100056..1884c0e3458 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tests.cpp @@ -26,31 +26,6 @@ TEST_CASE("FortranDataIterator", "shoc") { REQUIRE(static_cast(f.size) == d->shcol); } -// This helper returns true if we've been asked to generate Python -// plotting scripts, false otherwise. -bool generating_plot_scripts() { - bool gen_plot_scripts = false; - auto& ts = ekat::TestSession::get(); - auto iter = ts.params.find("gen_plot_scripts"); - if (iter != ts.params.end()) { - // Here's val, passed as gen_plot_scripts=val - std::string val = iter->second; - // Low-case the thing. Isn't C++ a friendly language?? - std::transform(val.begin(), val.end(), val.begin(), - [](unsigned char c){ return std::tolower(c); }); - - // Now decide if the value is true or not. Use CMake sensibilities. - gen_plot_scripts = ((val == "1") or (val == "true") or - (val == "yes") or (val == "on")); - } - return gen_plot_scripts; -} - -TEST_CASE("shoc_init_c", "shoc") { - int nerr = scream::shoc::test_shoc_init(); - REQUIRE(nerr == 0); -} - TEST_CASE("shoc_ic_c", "shoc") { int nerr = scream::shoc::test_shoc_ic(); REQUIRE(nerr == 0); From bee699d1f67fc22e43c2d0845d79b4ed1533baa5 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 20 Nov 2024 14:03:10 -0700 Subject: [PATCH 299/529] builds --- .../eamxx/src/physics/p3/tests/CMakeLists.txt | 2 +- .../src/physics/shoc/tests/CMakeLists.txt | 30 +++++++++---------- .../physics/shoc/tests/shoc_main_tests.cpp | 3 -- 3 files changed, 16 insertions(+), 19 deletions(-) diff --git a/components/eamxx/src/physics/p3/tests/CMakeLists.txt b/components/eamxx/src/physics/p3/tests/CMakeLists.txt index d705b30cc4e..9c1f41120e6 100644 --- a/components/eamxx/src/physics/p3/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/p3/tests/CMakeLists.txt @@ -89,7 +89,7 @@ if (NOT SCREAM_P3_SMALL_KERNELS AND NOT SCREAM_ONLY_GENERATE_BASELINES) CreateUnitTest(p3_sk_tests "p3_main_unit_tests.cpp" LIBS p3_sk p3_test_infra EXE_ARGS "--args ${BASELINE_FILE_ARG}" - THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} + THREADS ${P3_THREADS} LABELS "p3_sk;physics;baseline_cmp") endif() diff --git a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt index 321e8df1a68..b51fa76fb76 100644 --- a/components/eamxx/src/physics/shoc/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/shoc/tests/CMakeLists.txt @@ -65,26 +65,33 @@ set(SHOC_TESTS_SRCS if (SCREAM_ENABLE_BASELINE_TESTS) if (SCREAM_ONLY_GENERATE_BASELINES) set(BASELINE_FILE_ARG "-g -b ${SCREAM_BASELINES_DIR}/data") + # We don't want to do thread spreads when generating. That + # could cause race conditions in the file system. + set(SHOC_THREADS "${SCREAM_TEST_MAX_THREADS}") else() set(BASELINE_FILE_ARG "-c -b ${SCREAM_BASELINES_DIR}/data") + set(SHOC_THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC}) endif() else() set(BASELINE_FILE_ARG "-n") # no baselines + set(SHOC_THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC}) endif() CreateUnitTest(shoc_tests "${SHOC_TESTS_SRCS}" LIBS shoc shoc_test_infra - THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} + THREADS ${SHOC_THREADS} EXE_ARGS "--args ${BASELINE_FILE_ARG}" - LABELS "shoc;physics" + LABELS "shoc;physics;baseline_gen;baseline_cmp" ) -if (NOT SCREAM_SHOC_SMALL_KERNELS) - CreateUnitTest(shoc_sk_tests "${SHOC_TESTS_SRCS}" +# If small kernels are ON, we don't need a separate executable to test them. +# Also, we never want to generate baselines with this separate executable +if (NOT SCREAM_SHOC_SMALL_KERNELS AND NOT SCREAM_ONLY_GENERATE_BASELINES) + CreateUnitTest(shoc_sk_tests "shoc_main_tests.cpp" LIBS shoc_sk shoc_test_infra - THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} - EXE_ARGS shoc_main_bfb "--flags=\\'${BASELINE_FILE_ARG}\\'" - LABELS "shoc;physics") + THREADS ${SHOC_THREADS} + EXE_ARGS "--args ${BASELINE_FILE_ARG}" + LABELS "shoc;physics;baseline_cmp" ) endif() @@ -93,11 +100,4 @@ CreateUnitTest(shoc_run_and_cmp "shoc_run_and_cmp.cpp" EXCLUDE_MAIN_CPP THREADS ${SCREAM_TEST_MAX_THREADS} EXE_ARGS "${BASELINE_FILE_ARG}" - LABELS "shoc;physics") - -if (SCREAM_TEST_MAX_THREADS GREATER 1) - # ECUT only adds _ompX if we have more than one value of X, or if X>1 - set (TEST_SUFFIX _omp${SCREAM_TEST_MAX_THREADS}) -endif() - -set_tests_properties (shoc_run_and_cmp${TEST_SUFFIX} PROPERTIES LABELS "baseline_gen;baseline_cmp") + LABELS "shoc;physics;baseline_gen;baseline_cmp") diff --git a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp index 5eb6335ea25..0c7cbff6bdc 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp @@ -259,7 +259,6 @@ struct UnitWrap::UnitTest::TestShocMain : public UnitWrap::UnitTest::Base } // Call the C++ implementation - const int npbl = shoc_init_host(SDS.nlev, SDS.pref_mid, SDS.nbot_shoc, SDS.ntop_shoc); shoc_main(SDS); // Make sure output falls within reasonable bounds @@ -382,8 +381,6 @@ struct UnitWrap::UnitTest::TestShocMain : public UnitWrap::UnitTest::Base // Get data from cxx for (auto& d : cxx_data) { - const int npbl = shoc_init_host(d.nlev, d.pref_mid, d.nbot_shoc, d.ntop_shoc); - shoc_main(d); } From 444bc1f8b82e14ee26f05f341b5fe3c7be7b555e Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 20 Nov 2024 14:32:59 -0700 Subject: [PATCH 300/529] Fix baseline read --- .../eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_brunt_length_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_check_length_tests.cpp | 6 ++++-- .../eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp | 6 ++++-- .../physics/shoc/tests/shoc_compute_diag_third_tests.cpp | 6 ++++-- .../shoc/tests/shoc_compute_shoc_temperature_tests.cpp | 6 ++++-- .../physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp | 6 ++++-- .../eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp | 6 ++++-- .../shoc/tests/shoc_diag_second_mom_ubycond_test.cpp | 6 ++++-- .../shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp | 6 ++++-- .../physics/shoc/tests/shoc_diag_second_moments_tests.cpp | 6 ++++-- .../shoc/tests/shoc_diag_second_shoc_moments_tests.cpp | 6 ++++-- .../eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp | 6 ++++-- .../physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_energy_fixer_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_energy_integral_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp | 6 ++++-- components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_l_inf_length_tests.cpp | 6 ++++-- .../eamxx/src/physics/shoc/tests/shoc_length_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_linear_interp_tests.cpp | 6 ++++-- components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp | 6 ++++-- .../eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp | 6 ++++-- .../physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_pblintd_height_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp | 6 ++++-- .../eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp | 6 ++++-- .../src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp | 6 ++++-- components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp | 6 ++++-- .../shoc/tests/shoc_update_prognostics_implicit_tests.cpp | 6 ++++-- .../eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp | 6 ++++-- .../shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp | 5 ++++- .../eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp | 6 ++++-- 41 files changed, 164 insertions(+), 81 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp index 3175f908af4..93926020d82 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_assumed_pdf_tests.cpp @@ -425,8 +425,10 @@ struct UnitWrap::UnitTest::TestShocAssumedPdf : public UnitWrap::UnitTest: // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp index 3e39bb245e9..21112e0d0a2 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_brunt_length_tests.cpp @@ -152,8 +152,10 @@ struct UnitWrap::UnitTest::TestCompBruntShocLength : public UnitWrap::UnitTes // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp index 6a51a339e52..404176bfe3a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_length_tests.cpp @@ -122,8 +122,10 @@ struct UnitWrap::UnitTest::TestCheckShocLength : public UnitWrap::UnitTest // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp index 2d58e6f16db..5aa189cfb5d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_check_tke_tests.cpp @@ -104,8 +104,10 @@ struct UnitWrap::UnitTest::TestShocCheckTke : public UnitWrap::UnitTest::B // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp index c1d8496b744..4f254e65cc5 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_clip_third_moms_tests.cpp @@ -131,8 +131,10 @@ struct UnitWrap::UnitTest::TestClipThirdMoms : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp index b5c0581bebf..fc52c64550b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_diag_third_tests.cpp @@ -217,8 +217,10 @@ struct UnitWrap::UnitTest::TestShocCompDiagThird : public UnitWrap::UnitTest< // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp index f596a44b2b0..0566d12d932 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_temperature_tests.cpp @@ -225,8 +225,10 @@ struct UnitWrap::UnitTest::TestComputeShocTemp : public UnitWrap::UnitTest // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp index 86fba68496e..1e0d4134204 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_compute_shoc_vapor_tests.cpp @@ -115,8 +115,10 @@ struct UnitWrap::UnitTest::TestComputeShocVapor : public UnitWrap::UnitTestm_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp index cd48afea56f..47e4f72ed99 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_obklen_tests.cpp @@ -193,8 +193,10 @@ struct UnitWrap::UnitTest::TestShocDiagObklen : public UnitWrap::UnitTest: // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp index d931992be11..06f8ccdd45a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_mom_ubycond_test.cpp @@ -88,8 +88,10 @@ struct UnitWrap::UnitTest::TestSecondMomUbycond : public UnitWrap::UnitTestm_baseline_action == COMPARE) { + for (auto& d : uby_fortran) { + d.read(Base::m_fid); + } } for (auto& d : uby_cxx) { diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp index 406bab30d90..9680984a446 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_lbycond_tests.cpp @@ -143,8 +143,10 @@ struct UnitWrap::UnitTest::TestDiagSecondMomentsLbycond : public UnitWrap::Un // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp index 01a0c04f2de..bd5dc1a77b1 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_moments_tests.cpp @@ -277,8 +277,10 @@ struct UnitWrap::UnitTest::TestDiagSecondMoments : public UnitWrap::UnitTest< // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp index 82eeb528d1d..45964c6b1d5 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_second_shoc_moments_tests.cpp @@ -290,8 +290,10 @@ struct UnitWrap::UnitTest::TestDiagSecondShocMoments : public UnitWrap::UnitT // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp index 08b3dc6ab4d..3f1bfd557f0 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_diag_third_tests.cpp @@ -233,8 +233,10 @@ struct UnitWrap::UnitTest::TestShocDiagThird : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp index 20c6638eb3d..3d33d55640c 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_eddy_diffusivities_tests.cpp @@ -283,8 +283,10 @@ struct UnitWrap::UnitTest::TestShocEddyDiff : public UnitWrap::UnitTest::B // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp index d5ed68e3550..89deaf7ad4b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_fixer_tests.cpp @@ -292,8 +292,10 @@ struct UnitWrap::UnitTest::TestShocEnergyFixer : public UnitWrap::UnitTest // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp index eb950dcf37a..e26ec03139f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_integral_tests.cpp @@ -158,8 +158,10 @@ struct UnitWrap::UnitTest::TestShocEnergyInt : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp index ac59a33a8b7..639d48fc70d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_energy_update_dse_tests.cpp @@ -167,8 +167,10 @@ struct UnitWrap::UnitTest::TestShocUpdateDse : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp index f89d3eabea0..f9bd348dc47 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_grid_tests.cpp @@ -158,8 +158,10 @@ struct UnitWrap::UnitTest::TestShocGrid : public UnitWrap::UnitTest::Base // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp index 2ee4cd44fd7..1616bff130d 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_comp_tmpi_tests.cpp @@ -147,8 +147,10 @@ struct UnitWrap::UnitTest::TestImpCompTmpi : public UnitWrap::UnitTest::Ba // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp index 22acf6d6860..b5feb285f55 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_impli_dp_inverse_tests.cpp @@ -127,8 +127,10 @@ struct UnitWrap::UnitTest::TestImpDpInverse : public UnitWrap::UnitTest::B // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp index 9a9d091e31f..db769d17010 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_l_inf_length_tests.cpp @@ -136,8 +136,10 @@ struct UnitWrap::UnitTest::TestLInfShocLength : public UnitWrap::UnitTest: // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp index 0c9690c833a..b492f6a8e4b 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_length_tests.cpp @@ -217,8 +217,10 @@ struct UnitWrap::UnitTest::TestShocLength : public UnitWrap::UnitTest::Bas // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp index bd09f7ad94b..6be406bda09 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_linear_interp_tests.cpp @@ -367,8 +367,10 @@ struct UnitWrap::UnitTest::TestShocLinearInt : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp index 0c7cbff6bdc..b007da41322 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_main_tests.cpp @@ -375,8 +375,10 @@ struct UnitWrap::UnitTest::TestShocMain : public UnitWrap::UnitTest::Base // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp index 7277d33b67c..88336e52ea4 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_mix_length_tests.cpp @@ -145,8 +145,10 @@ struct UnitWrap::UnitTest::TestCompShocMixLength : public UnitWrap::UnitTest< // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp index 999525b1d99..02489c97fd3 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_check_pblh_tests.cpp @@ -107,8 +107,10 @@ struct UnitWrap::UnitTest::TestPblintdCheckPblh : public UnitWrap::UnitTestm_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp index 73b96f8e4bf..a0beea7e4ea 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_cldcheck_tests.cpp @@ -117,8 +117,10 @@ struct UnitWrap::UnitTest::TestPblintdCldCheck : public UnitWrap::UnitTest }; // Read baseline data - for (auto& d : cldcheck_data_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : cldcheck_data_baseline) { + d.read(Base::m_fid); + } } for (auto& d : cldcheck_data_cxx) { diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp index 1f167520c90..1a44d74782f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_height_tests.cpp @@ -202,8 +202,10 @@ struct UnitWrap::UnitTest::TestPblintdHeight : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp index 5e136ad35c2..9f7c2d65142 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_init_pot_test.cpp @@ -173,8 +173,10 @@ struct UnitWrap::UnitTest::TestPblintdInitPot : public UnitWrap::UnitTest: }; // Read baseline data - for (auto& d : pblintd_init_pot_data_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : pblintd_init_pot_data_baseline) { + d.read(Base::m_fid); + } } for (auto& d : pblintd_init_pot_data_cxx) { diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp index 4c60eef381a..2e876996a6a 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_surf_temp_tests.cpp @@ -138,8 +138,10 @@ struct UnitWrap::UnitTest::TestPblintdSurfTemp : public UnitWrap::UnitTest // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp index 9437487158f..dedc534fbd1 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pblintd_tests.cpp @@ -171,8 +171,10 @@ struct UnitWrap::UnitTest::TestPblintd : public UnitWrap::UnitTest::Base { // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp index 06802cf7cc1..165bf302e4c 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_adv_sgs_tke_tests.cpp @@ -219,8 +219,10 @@ struct UnitWrap::UnitTest::TestShocAdvSgsTke : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp index da560af2dab..d234273f4c0 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_column_stab_tests.cpp @@ -146,8 +146,10 @@ struct UnitWrap::UnitTest::TestShocIntColStab : public UnitWrap::UnitTest: // Assume all data is in C layout // Read baseline data - for (auto &d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto &d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp index 597cd955a64..b7fba522d8f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_isotropic_ts_tests.cpp @@ -203,8 +203,10 @@ struct UnitWrap::UnitTest::TestShocIsotropicTs : public UnitWrap::UnitTest // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp index 26664b3890f..00b60a5efdb 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_shr_prod_tests.cpp @@ -184,8 +184,10 @@ struct UnitWrap::UnitTest::TestShocShearProd : public UnitWrap::UnitTest:: // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp index da3fadfa2ce..5273607dd70 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_tke_tests.cpp @@ -275,8 +275,10 @@ struct UnitWrap::UnitTest::TestShocTke : public UnitWrap::UnitTest::Base { // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp index 8da7ce246d5..175be842928 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_update_prognostics_implicit_tests.cpp @@ -362,8 +362,10 @@ struct UnitWrap::UnitTest::TestUpdatePrognosticsImplicit : public UnitWrap::U // Assume all data is in C layout // Read baseline data - for (auto& d : baseline_data) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp index a3a915059ae..35d60abfa5f 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_varorcovar_tests.cpp @@ -297,8 +297,10 @@ void run_bfb() // Assume all data is in C layout // Read baseline data - for (auto& d : SDS_baseline) { - d.read(Base::m_fid); + if (this->m_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp index aeeb1ecd0fe..27326a0df16 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_vd_shoc_decomp_and_solve_tests.cpp @@ -49,7 +49,10 @@ struct UnitWrap::UnitTest::TestVdShocDecompandSolve : public UnitWrap::UnitTe // Assume all data is in C layout // Read baseline data. - for (Int i = 0; i < num_runs; ++i) { + if (this->m_baseline_action == COMPARE) { + for (auto& d: baseline_data) { + d.read(Base::m_fid); + } } // Get data from cxx diff --git a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp index a1f708402f1..895040f9b11 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_vertflux_tests.cpp @@ -161,8 +161,10 @@ struct UnitWrap::UnitTest::TestCalcShocVertflux : public UnitWrap::UnitTestm_baseline_action == COMPARE) { + for (auto& d : SDS_baseline) { + d.read(Base::m_fid); + } } // Get data from cxx From d52cea7f4c6744a8bfe99038fd530bcedf581b46 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 20 Nov 2024 16:41:24 -0800 Subject: [PATCH 301/529] Minor cleanup from code review --- components/mpas-albany-landice/src/Registry.xml | 10 ++-------- .../src/mode_forward/mpas_li_ocean_extrap.F | 13 ++++++++----- 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 4dac552d19b..9756d5d7904 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -809,8 +809,7 @@ - - + - - + @@ -1688,10 +1686,6 @@ is the value of that variable from the *previous* time level! - - diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 0677b9c63c6..f6d4d78a723 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -92,7 +92,6 @@ subroutine li_ocean_extrap_solve(domain, err) real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography - integer, dimension(:), pointer :: origOceanMaskHoriz integer, dimension(:,:), pointer :: orig3dOceanCavityMask ! CAS 8/16/2024 integer, dimension(:,:), pointer :: validOceanMask, validOceanMaskOrig, availOceanMask !masks to pass to flood-fill routine integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit @@ -132,8 +131,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) - call mpas_pool_get_array(extrapOceanDataPool, 'origOceanMaskHoriz', origOceanMaskHoriz) - call mpas_pool_get_array(extrapOceanDataPool, 'orig3dOceanCavityMask', orig3dOceanCavityMask) ! CAS 8/16/2024 + call mpas_pool_get_array(extrapOceanDataPool, 'orig3dOceanCavityMask', orig3dOceanCavityMask) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMaskOrig', validOceanMaskOrig) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) @@ -190,7 +188,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_field(scratchPool, 'seedMask', seedMaskField) call mpas_allocate_scratch_field(seedMaskField, single_block_in = .true.) connectedMarineMask => seedMaskField % array - connectedmarineMask(:) = 0 + connectedMarineMask(:) = 0 call mpas_pool_get_field(scratchPool, 'growMask', growMaskField) call mpas_allocate_scratch_field(growMaskField, single_block_in = .true.) growMask => growMaskField % array @@ -223,23 +221,28 @@ subroutine li_ocean_extrap_solve(domain, err) if (ismip6shelfMelt_zOcean(iLayer) >= 0.0_RKIND) then call mpas_log_write("ismip6shelfMelt_zOcean has invalid value of $r in layer $i", MPAS_LOG_ERR, & realArgs=(/ismip6shelfMelt_zOcean(iLayer)/), intArgs=(/iLayer/)) + call mpas_log_write("ismip6shelfMelt_zOcean must have negative values because they represent " // & + "depths below sea level.", MPAS_LOG_ERR) err = ior(err, 1) endif if ((ismip6shelfMelt_zBndsOcean(1,iLayer) > 0.0_RKIND) .or. & (ismip6shelfMelt_zBndsOcean(1,iLayer) < ismip6shelfMelt_zOcean(iLayer))) then call mpas_log_write("ismip6shelfMelt_zBndsOcean(1,:) has invalid value of $r in layer $i", MPAS_LOG_ERR, & realArgs=(/ismip6shelfMelt_zBndsOcean(1,iLayer)/), intArgs=(/iLayer/)) + call mpas_log_write("ismip6shelfMelt_zBndsOcean(1,:) must be less than or equal to zero " // & + "because it represents the upper bound of an ocean layer", MPAS_LOG_ERR) err = ior(err, 1) endif if ((ismip6shelfMelt_zBndsOcean(2,iLayer) >= 0.0_RKIND) .or. & (ismip6shelfMelt_zBndsOcean(2,iLayer) > ismip6shelfMelt_zOcean(iLayer))) then call mpas_log_write("ismip6shelfMelt_zBndsOcean(2,:) has invalid value of $r in layer $i", MPAS_LOG_ERR, & realArgs=(/ismip6shelfMelt_zBndsOcean(2,iLayer)/), intArgs=(/iLayer/)) + call mpas_log_write("ismip6shelfMelt_zBndsOcean(2,:) must be less than zero " // & + "because it represents the lower bound of an ocean layer", MPAS_LOG_ERR) err = ior(err, 1) endif enddo availOceanMask(:,:) = 0 - validOceanMask(:,:) = 0 do iCell = 1, nCells do iLayer = 1, nISMIP6OceanLayers layerTop = ismip6shelfMelt_zBndsOcean(1, iLayer) From 0f54aabec0487af1e451e30c4e81f6f5869d2086 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 20 Nov 2024 17:18:40 -0800 Subject: [PATCH 302/529] Clean up variable names * Rename orig3dOceanCavityMask to orig3dOceanMask. * Remove validOceanMaskOrig which is redundant with previous variable --- components/mpas-albany-landice/src/Registry.xml | 12 ++++-------- .../src/mode_forward/mpas_li_ocean_extrap.F | 16 ++++++---------- 2 files changed, 10 insertions(+), 18 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 9756d5d7904..176446b302e 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -809,7 +809,7 @@ - + - + - @@ -1686,15 +1685,12 @@ is the value of that variable from the *previous* time level! - - diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index f6d4d78a723..133c334a787 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -92,8 +92,8 @@ subroutine li_ocean_extrap_solve(domain, err) real (kind=RKIND), dimension(:,:), pointer :: ismip6shelfMelt_3dThermalForcing, ismip6shelfMelt_zBndsOcean real (kind=RKIND), dimension(:), pointer :: ismip6shelfMelt_zOcean real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography - integer, dimension(:,:), pointer :: orig3dOceanCavityMask ! CAS 8/16/2024 - integer, dimension(:,:), pointer :: validOceanMask, validOceanMaskOrig, availOceanMask !masks to pass to flood-fill routine + integer, dimension(:,:), pointer :: orig3dOceanMask + integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit integer, dimension(:), allocatable :: seedOceanMaskHorizOld integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra @@ -131,9 +131,8 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'ismip6shelfMelt_3dThermalForcing', ismip6shelfMelt_3dThermalForcing) - call mpas_pool_get_array(extrapOceanDataPool, 'orig3dOceanCavityMask', orig3dOceanCavityMask) + call mpas_pool_get_array(extrapOceanDataPool, 'orig3dOceanMask', orig3dOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMask', validOceanMask) - call mpas_pool_get_array(extrapOceanDataPool, 'validOceanMaskOrig', validOceanMaskOrig) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHoriz', seedOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'growOceanMaskHoriz', growOceanMaskHoriz) @@ -259,11 +258,8 @@ subroutine li_ocean_extrap_solve(domain, err) enddo enddo - ! CAS 8/16/2024 Hijacking Holly's code to test using the 3D SORRM cavity TF field. We set 3d valid ocean mask to original 3d ocean cavity mask. - validOceanMask(:,:) = orig3dOceanCavityMask(:,:) - - ! save the initial validOceanMask - validOceanMaskOrig(:,:) = validOceanMask(:,:) + ! Make a copy of original mask to use for extending the mask during extrapolation + validOceanMask(:,:) = orig3dOceanMask(:,:) ! initialize the TF field TFocean(:,:) = ismip6shelfMelt_3dThermalForcing(:,:) * validOceanMask(:,:) @@ -303,7 +299,7 @@ subroutine li_ocean_extrap_solve(domain, err) endif ! call the horizontal extrapolation routine call mpas_timer_start("horizontal scheme") - call horizontal_extrapolation(domain, availOceanMask, validOceanMask, validOceanMaskOrig, TFocean, err_tmp) + call horizontal_extrapolation(domain, availOceanMask, validOceanMask, orig3dOceanMask, TFocean, err_tmp) err = ior(err, err_tmp) call mpas_timer_stop("horizontal scheme") ! call the vertical extrapolation routine From 104e015f7802c4943889cae83c7b1c7def98b9ab Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 20 Nov 2024 19:43:06 -0800 Subject: [PATCH 303/529] Update variable descriptions in Registry Also remove more unused code --- components/mpas-albany-landice/src/Registry.xml | 16 ++++++++-------- .../src/mode_forward/mpas_li_ocean_extrap.F | 3 +-- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 176446b302e..45bb36032de 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -809,7 +809,8 @@ - + + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 133c334a787..024c0df4c5f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -94,7 +94,7 @@ subroutine li_ocean_extrap_solve(domain, err) real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography integer, dimension(:,:), pointer :: orig3dOceanMask integer, dimension(:,:), pointer :: validOceanMask, availOceanMask !masks to pass to flood-fill routine - integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz, seedOceanMaskHorizInit + integer, dimension(:), pointer :: seedOceanMaskHoriz, growOceanMaskHoriz integer, dimension(:), allocatable :: seedOceanMaskHorizOld integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra integer, dimension(:), pointer :: cellMask, nEdgesOnCell @@ -136,7 +136,6 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_pool_get_array(extrapOceanDataPool, 'availOceanMask', availOceanMask) call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHoriz', seedOceanMaskHoriz) call mpas_pool_get_array(extrapOceanDataPool, 'growOceanMaskHoriz', growOceanMaskHoriz) - call mpas_pool_get_array(extrapOceanDataPool, 'seedOceanMaskHorizInit', seedOceanMaskHorizInit) call mpas_pool_get_array(extrapOceanDataPool, 'TFoceanOld', TFoceanOld) call mpas_pool_get_array(extrapOceanDataPool, 'TFocean', TFocean) call mpas_pool_get_config(liConfigs, 'config_invalid_value_TF', invalid_value_TF) From 142105e2001affee59ac4de0e4814904bb22b795 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 20 Nov 2024 19:43:40 -0800 Subject: [PATCH 304/529] Remove variables that are not needed for restarts --- components/mpas-albany-landice/src/Registry.xml | 7 ------- 1 file changed, 7 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 45bb36032de..d4153991521 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -917,13 +917,6 @@ - - - - - - - From dea9fb25e88826256f560a5afe8c5bc75254a9ff Mon Sep 17 00:00:00 2001 From: Darin Comeau Date: Thu, 21 Nov 2024 12:29:43 -0600 Subject: [PATCH 305/529] Changing file name to meet naming conventions --- cime_config/config_grids.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index a6efa0287a0..dca52f7efc5 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -5660,7 +5660,7 @@ - cpl/cpl6/map_r05_to_SOwISC12to30E3r3_Ratio0.5_maxFlux0.001.Greenland100x+Antarctica100x.nc + cpl/cpl6/map_r05_to_SOwISC12to30E3r3_rat0.5_maxFlx0.001.Grlnd100x_Ant100x.cstmnn.20241120.nc cpl/cpl6/map_r05_to_SOwISC12to30E3r3_cstmnn.r150e300.20240808.nc From da584a6262bfc898eadee5372d9fcdca4fb59efe Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 21 Nov 2024 10:38:28 -0800 Subject: [PATCH 306/529] FATES API update to capture fuel class refactor This commit updates fates to API37 which is necessary to capture renaming per a fates-side fire refactor --- components/elm/src/external_models/fates | 2 +- components/elm/src/main/elmfates_interfaceMod.F90 | 6 +++--- components/elm/src/main/histFileMod.F90 | 10 +++++----- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/components/elm/src/external_models/fates b/components/elm/src/external_models/fates index 825579d0b40..de5f266a54d 160000 --- a/components/elm/src/external_models/fates +++ b/components/elm/src/external_models/fates @@ -1 +1 @@ -Subproject commit 825579d0b406fe99344591b5ed8356e5c7aeebec +Subproject commit de5f266a54df9a0464608f709486cda96f7526db diff --git a/components/elm/src/main/elmfates_interfaceMod.F90 b/components/elm/src/main/elmfates_interfaceMod.F90 index a20444d6758..e7134a580fd 100644 --- a/components/elm/src/main/elmfates_interfaceMod.F90 +++ b/components/elm/src/main/elmfates_interfaceMod.F90 @@ -3517,7 +3517,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) use FatesInterfaceTypesMod, only : nlevage_fates => nlevage use FatesInterfaceTypesMod, only : nlevheight_fates => nlevheight use FatesInterfaceTypesMod, only : nlevdamage_fates => nlevdamage - use FatesLitterMod, only : nfsc_fates => nfsc + use FatesFuelClassesMod, only : nfc_fates => num_fuel_classes use FatesLitterMod, only : ncwd_fates => ncwd use EDParamsMod, only : nlevleaf_fates => nlevleaf use EDParamsMod, only : nclmax_fates => nclmax @@ -3555,7 +3555,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%sizeage_class_end = nlevsclass_fates * nlevage_fates fates%fuel_begin = 1 - fates%fuel_end = nfsc_fates + fates%fuel_end = nfc_fates fates%cdpf_begin = 1 fates%cdpf_end = nlevdamage_fates * numpft_fates * nlevsclass_fates @@ -3606,7 +3606,7 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) fates%coage_class_end = nlevcoage fates%agefuel_begin = 1 - fates%agefuel_end = nlevage_fates * nfsc_fates + fates%agefuel_end = nlevage_fates * nfc_fates fates%landuse_begin = 1 fates%landuse_end = n_landuse_cats diff --git a/components/elm/src/main/histFileMod.F90 b/components/elm/src/main/histFileMod.F90 index 1b86c3a1618..8de3f27c30e 100644 --- a/components/elm/src/main/histFileMod.F90 +++ b/components/elm/src/main/histFileMod.F90 @@ -28,7 +28,7 @@ module histFileMod use FatesInterfaceTypesMod , only : nlevheight_fates => nlevheight use FatesInterfaceTypesMod , only : nlevdamage_fates => nlevdamage use FatesInterfaceTypesMod , only : nlevcoage - use FatesLitterMod , only : nfsc_fates => nfsc + use FatesFuelClassesMod , only : nfc_fates => num_fuel_classes use FatesConstantsMod , only : n_landuse_cats use FatesLitterMod , only : ncwd_fates => ncwd use FatesInterfaceTypesMod , only : numpft_fates => numpft @@ -1933,7 +1933,7 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'fates_levcacls',nlevcoage, dimid) call ncd_defdim(lnfid, 'fates_levpft', numpft_fates, dimid) call ncd_defdim(lnfid, 'fates_levage', nlevage_fates, dimid) - call ncd_defdim(lnfid, 'fates_levfuel', nfsc_fates, dimid) + call ncd_defdim(lnfid, 'fates_levfuel', nfc_fates, dimid) call ncd_defdim(lnfid, 'fates_levcwdsc', ncwd_fates, dimid) call ncd_defdim(lnfid, 'fates_levscpf', nlevsclass_fates*numpft_fates, dimid) call ncd_defdim(lnfid, 'fates_levcapf', nlevcoage*numpft_fates, dimid) @@ -1951,7 +1951,7 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'fates_levelpft', nelements_fates * numpft_fates, dimid) call ncd_defdim(lnfid, 'fates_levelcwd', nelements_fates * ncwd_fates, dimid) call ncd_defdim(lnfid, 'fates_levelage', nelements_fates * nlevage_fates, dimid) - call ncd_defdim(lnfid, 'fates_levagefuel', nlevage_fates * nfsc_fates, dimid) + call ncd_defdim(lnfid, 'fates_levagefuel', nlevage_fates * nfc_fates, dimid) call ncd_defdim(lnfid, 'fates_levlanduse', n_landuse_cats, dimid) call ncd_defdim(lnfid, 'fates_levlulu', n_landuse_cats * n_landuse_cats, dimid) end if @@ -4796,7 +4796,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, case ('fates_levelage') num2d = nelements_fates*nlevage_fates case ('fates_levagefuel') - num2d = nlevage_fates*nfsc_fates + num2d = nlevage_fates*nfc_fates case('cft') if (cft_size > 0) then num2d = cft_size @@ -4842,7 +4842,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, case ('fates_levage') num2d = nlevage_fates case ('fates_levfuel') - num2d = nfsc_fates + num2d = nfc_fates case ('fates_levcwdsc') num2d = ncwd_fates case ('fates_levscpf') From 0ad93902c174b8b4c6494210f0f7ca880607c44a Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Tue, 29 Oct 2024 15:36:43 -0700 Subject: [PATCH 307/529] Update layerNormalVelocity in each RK stage Update layerNormalVelocity in each RK stage. While velocity was being solved for each stage, layerNormalVelocity was not being updated based on the updated velocity, which is a major bug. --- .../mpas_li_time_integration_fe_rk.F | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index 148dda8ddff..a530c67708e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -1045,6 +1045,11 @@ subroutine advection_solver(domain, err) real (kind=RKIND), dimension(:), pointer :: thicknessNew real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:,:), pointer :: layerThickness + real (kind=RKIND), dimension(:,:), pointer :: normalVelocity + real (kind=RKIND), dimension(:,:), pointer :: layerNormalVelocity + + integer, dimension(:), pointer :: edgeMask + real (kind=RKIND) :: allowableDtACFL real (kind=RKIND), dimension(:,:), pointer :: temperature real (kind=RKIND), dimension(:,:), pointer :: waterFrac @@ -1094,6 +1099,18 @@ subroutine advection_solver(domain, err) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_array(velocityPool, 'normalVelocity', normalVelocity) + call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) + call mpas_pool_get_array(velocityPool, 'layerNormalVelocity', layerNormalVelocity) + + call li_layer_normal_velocity( & + meshPool, & + normalVelocity, & + edgeMask, & + layerNormalVelocity, & + allowableDtACFL, & + err_tmp) + err = ior(err,err_tmp) call calculate_layerThicknessEdge(meshPool, geometryPool, velocityPool, err_tmp) err = ior(err,err_tmp) From 0da3f2cba13d168f325e1aa6b3b054bb043ef69b Mon Sep 17 00:00:00 2001 From: Wuyin Lin Date: Thu, 21 Nov 2024 10:53:38 -0800 Subject: [PATCH 308/529] Remove commented out lines for falling ice flux calculations --- components/eam/src/physics/p3/eam/micro_p3.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/components/eam/src/physics/p3/eam/micro_p3.F90 b/components/eam/src/physics/p3/eam/micro_p3.F90 index a07e0c006b1..e82c4fa0a96 100644 --- a/components/eam/src/physics/p3/eam/micro_p3.F90 +++ b/components/eam/src/physics/p3/eam/micro_p3.F90 @@ -4350,7 +4350,6 @@ subroutine ice_sedimentation(kts,kte,ktop,kbot,kdir, & dt_left, prt_accum, inv_dz, inv_rho, rho, num_arrays, vs, fluxes, qnr, dt_sub) do k = k_qxbot,k_qxtop,kdir -! precip_ice_flux(k+1) = precip_ice_flux(k+1) + flux_qit(k)*dt_sub ! shanyp sflx(k+1) = sflx(k+1) + flux_qit(k)*dt_sub enddo @@ -4363,7 +4362,6 @@ subroutine ice_sedimentation(kts,kte,ktop,kbot,kdir, & bm_incld(:) = bm(:)/cld_frac_i(:) enddo substep_sedi_i -! precip_ice_flux(:)=precip_ice_flux(:)*inv_dt sflx(:)=sflx(:)*inv_dt precip_ice_surf = precip_ice_surf + prt_accum*inv_rho_h2o*inv_dt From a714d58227ca6a50aac926a01578f30a0a50c130 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 21 Nov 2024 11:51:00 -0800 Subject: [PATCH 309/529] update fates tag to sci.1.79.3_api.37.0.0 --- components/elm/src/external_models/fates | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/elm/src/external_models/fates b/components/elm/src/external_models/fates index de5f266a54d..e3e7d2cd86a 160000 --- a/components/elm/src/external_models/fates +++ b/components/elm/src/external_models/fates @@ -1 +1 @@ -Subproject commit de5f266a54df9a0464608f709486cda96f7526db +Subproject commit e3e7d2cd86a66f8ca0e8f6dc4a823246a2bdb95b From d7b2e498fec75326366d218928d38a36fc5633c3 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Thu, 21 Nov 2024 13:31:39 -0700 Subject: [PATCH 310/529] fix to address merge conflict --- components/eam/src/physics/cam/gw_drag.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/components/eam/src/physics/cam/gw_drag.F90 b/components/eam/src/physics/cam/gw_drag.F90 index 96ac9f70021..6017d588682 100644 --- a/components/eam/src/physics/cam/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw_drag.F90 @@ -120,8 +120,7 @@ module gw_drag ! namelist logical :: history_amwg ! output the variables used by the AMWG diag package - integer :: pblh_idx = 0 - ! + !========================================================================== contains !========================================================================== @@ -305,7 +304,7 @@ subroutine gw_init(pbuf2d) !----------------------------------------------------------------------- call oro_drag_init(pbuf2d) - + ! Set model flags. do_spectral_waves = (pgwv > 0 .and. (use_gw_front .or. use_gw_convect)) orographic_only = (use_gw_oro .and. .not. do_spectral_waves) @@ -676,7 +675,6 @@ subroutine gw_tend(state, sgh, pbuf, dt, ptend, cam_in) real(r8) :: dummx_fd(pcols) real(r8) :: dummy_fd(pcols) ! - real(r8), pointer :: pblh(:) real(r8) :: dx(pcols),dy(pcols) !---------------------------Local storage------------------------------- From 90adcd96301bd1f3e1db0682bd3233a6bfb646be Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Thu, 21 Nov 2024 12:42:57 -0800 Subject: [PATCH 311/529] Only recalculate layerNormalVelocity when using RK time integration Only recalculate layerNormalVelocity when using RK time integration. Recalculating when using forward Euler integration led to an inconstency in edgeMask because of face-melting. This commit leads to a slight inconsistency between forward Euler and RK treatments, which should be fixed in the future, likely by moving face-melting to after advection and before the velocity solve, similar to the treatment of calving. --- .../mpas_li_time_integration_fe_rk.F | 29 ++++++++++--------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index a530c67708e..e6051a3ec75 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -1060,6 +1060,7 @@ subroutine advection_solver(domain, err) character (len=StrKIND), pointer :: config_thickness_advection logical, pointer :: config_restore_thickness_after_advection character (len=StrKIND), pointer :: config_tracer_advection + character (len=StrKIND), pointer :: config_time_integration logical, pointer :: config_print_thickness_advection_info @@ -1073,6 +1074,7 @@ subroutine advection_solver(domain, err) call mpas_pool_get_config(liConfigs, 'config_thickness_advection', config_thickness_advection) call mpas_pool_get_config(liConfigs, 'config_tracer_advection', config_tracer_advection) + call mpas_pool_get_config(liConfigs, 'config_time_integration', config_time_integration) call mpas_pool_get_config(liConfigs, 'config_print_thickness_advection_info', config_print_thickness_advection_info) call mpas_pool_get_config(liConfigs, 'config_restore_thickness_after_advection', config_restore_thickness_after_advection) @@ -1099,19 +1101,20 @@ subroutine advection_solver(domain, err) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) - call mpas_pool_get_array(velocityPool, 'normalVelocity', normalVelocity) - call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) - call mpas_pool_get_array(velocityPool, 'layerNormalVelocity', layerNormalVelocity) - - call li_layer_normal_velocity( & - meshPool, & - normalVelocity, & - edgeMask, & - layerNormalVelocity, & - allowableDtACFL, & - err_tmp) - err = ior(err,err_tmp) - + if (trim(config_time_integration) == "runge_kutta") then + call mpas_pool_get_array(velocityPool, 'normalVelocity', normalVelocity) + call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) + call mpas_pool_get_array(velocityPool, 'layerNormalVelocity', layerNormalVelocity) + + call li_layer_normal_velocity( & + meshPool, & + normalVelocity, & + edgeMask, & + layerNormalVelocity, & + allowableDtACFL, & + err_tmp) + err = ior(err,err_tmp) + endif call calculate_layerThicknessEdge(meshPool, geometryPool, velocityPool, err_tmp) err = ior(err,err_tmp) From 27b3a2918f342ed5dfaa598799fba9a2196897d3 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Thu, 21 Nov 2024 15:01:05 -0600 Subject: [PATCH 312/529] Add support for using flds_tf to wrap including the new field in the cpl --- .../mpas-albany-landice/driver/glc_comp_mct.F | 3 +- driver-mct/cime_config/buildnml | 1 + .../cime_config/config_component_e3sm.xml | 12 ++++++++ .../cime_config/namelist_definition_drv.xml | 12 ++++++++ driver-mct/shr/seq_flds_mod.F90 | 29 ++++++++++++------- 5 files changed, 45 insertions(+), 12 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index ba1043e52e7..f2ca8c5e19a 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -1410,7 +1410,8 @@ subroutine glc_import_mct(x2g_g, errorCode) n = n + 1 sfcMassBal(i) = x2g_g % rAttr(index_x2g_Flgl_qice, n) floatingBasalMassBal(i) = x2g_g % rAttr(index_x2g_Fogx_qiceli, n) - ismip6_2dThermalForcing(i) = x2g_g % rAttr(index_x2g_So_tf2d, n) + if (index_x2g_So_tf2d /= 0) & + ismip6_2dThermalForcing(i) = x2g_g % rAttr(index_x2g_So_tf2d, n) ! surfaceTemperature(i) = x2g_g % rAttr(index_x2g_Sl_tsrf, n) !JW basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogo_qiceh, n) ! basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogx_qicehi, n) diff --git a/driver-mct/cime_config/buildnml b/driver-mct/cime_config/buildnml index 4938e9da0b1..c65a6047555 100755 --- a/driver-mct/cime_config/buildnml +++ b/driver-mct/cime_config/buildnml @@ -41,6 +41,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['CPL_EPBAL'] = case.get_value('CPL_EPBAL') config['FLDS_WISO'] = case.get_value('FLDS_WISO') config['FLDS_POLAR'] = case.get_value('FLDS_POLAR') + config['FLDS_TF'] = case.get_value('FLDS_TF') config['BUDGETS'] = case.get_value('BUDGETS') config['MACH'] = case.get_value('MACH') config['MPILIB'] = case.get_value('MPILIB') diff --git a/driver-mct/cime_config/config_component_e3sm.xml b/driver-mct/cime_config/config_component_e3sm.xml index 8fc93b607d4..4964a3c427b 100755 --- a/driver-mct/cime_config/config_component_e3sm.xml +++ b/driver-mct/cime_config/config_component_e3sm.xml @@ -185,6 +185,18 @@ Turn on the passing of polar fields through the coupler + + logical + TRUE,FALSE + FALSE + + TRUE + + run_flags + env_run.xml + Turn on the passing of ocean thermal forcing fields through the coupler + + char minus1p8,linear_salt,mushy diff --git a/driver-mct/cime_config/namelist_definition_drv.xml b/driver-mct/cime_config/namelist_definition_drv.xml index 316f24a0f58..5995c5f482d 100644 --- a/driver-mct/cime_config/namelist_definition_drv.xml +++ b/driver-mct/cime_config/namelist_definition_drv.xml @@ -149,6 +149,18 @@ + + logical + seq_flds + seq_cplflds_inparm + + If set to .true. thermal forcing fields will be passed from the ocean to the coupler. + + + $FLDS_TF + + + logical seq_flds diff --git a/driver-mct/shr/seq_flds_mod.F90 b/driver-mct/shr/seq_flds_mod.F90 index 4fb616b9cec..d0f46ed36e2 100644 --- a/driver-mct/shr/seq_flds_mod.F90 +++ b/driver-mct/shr/seq_flds_mod.F90 @@ -382,11 +382,12 @@ subroutine seq_flds_set(nmlfile, ID, infodata) logical :: flds_bgc_oi logical :: flds_wiso logical :: flds_polar + logical :: flds_tf integer :: glc_nec namelist /seq_cplflds_inparm/ & - flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_wiso, flds_polar, glc_nec, & - ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & + flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_wiso, flds_polar, flds_tf, & + glc_nec, ice_ncat, seq_flds_i2o_per_cat, flds_bgc_oi, & nan_check_component_fields, rof_heat, atm_flux_method, atm_gustiness, & rof2ocn_nutrients, lnd_rof_two_way, ocn_rof_two_way, rof_sed @@ -420,6 +421,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) flds_bgc_oi = .false. flds_wiso = .false. flds_polar = .false. + flds_tf = .false. glc_nec = 0 ice_ncat = 1 seq_flds_i2o_per_cat = .false. @@ -454,6 +456,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call shr_mpi_bcast(flds_bgc_oi , mpicom) call shr_mpi_bcast(flds_wiso , mpicom) call shr_mpi_bcast(flds_polar , mpicom) + call shr_mpi_bcast(flds_tf , mpicom) call shr_mpi_bcast(glc_nec , mpicom) call shr_mpi_bcast(ice_ncat , mpicom) call shr_mpi_bcast(seq_flds_i2o_per_cat, mpicom) @@ -2987,15 +2990,19 @@ subroutine seq_flds_set(nmlfile, ID, infodata) attname = 'So_rhoeff' call metadata_set(attname, longname, stdname, units) - name = 'So_tf2d' - call seq_flds_add(o2x_states,trim(name)) - call seq_flds_add(x2g_states,trim(name)) - call seq_flds_add(x2g_tf_states_from_ocn,trim(name)) - longname = 'ocean thermal forcing at predefined critical depth' - stdname = 'ocean_thermal_forcing_at_critical_depth' - units = 'C' - attname = name - call metadata_set(attname, longname, stdname, units) + if (flds_tf) then + + name = 'So_tf2d' + call seq_flds_add(o2x_states,trim(name)) + call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_tf_states_from_ocn,trim(name)) + longname = 'ocean thermal forcing at predefined critical depth' + stdname = 'ocean_thermal_forcing_at_critical_depth' + units = 'C' + attname = name + call metadata_set(attname, longname, stdname, units) + + end if name = 'Fogx_qicelo' call seq_flds_add(g2x_fluxes,trim(name)) From 0d3b7da72c3694ec612ed80cf1e7cc398f6efb50 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 21 Nov 2024 17:02:50 -0700 Subject: [PATCH 313/529] Workflows: simplified and fixed eamxx workflow files * Remove pre_process_pr jobs, in favor of paths filters * Remove support for skip labels * Simplified setting of env vars (e.g., submit/generate) --- .github/workflows/eamxx-sa-testing.yml | 118 ++++------------------ .github/workflows/eamxx-scripts-tests.yml | 65 +----------- .github/workflows/eamxx-v1-testing.yml | 106 +++++-------------- 3 files changed, 48 insertions(+), 241 deletions(-) diff --git a/.github/workflows/eamxx-sa-testing.yml b/.github/workflows/eamxx-sa-testing.yml index a4397d4fdba..e3657266cb6 100644 --- a/.github/workflows/eamxx-sa-testing.yml +++ b/.github/workflows/eamxx-sa-testing.yml @@ -5,6 +5,17 @@ on: pull_request: branches: [ master ] types: [opened, synchronize, ready_for_review, reopened] + paths: + # first, yes to these + - '.github/workflows/eamxx-sa-testing.yml' + - 'cime_config/machine/config_machines.xml' + - 'components/eamxx/**' + - 'components/homme/**' + - 'externals/ekat' + - 'externals/scorpio' + # second, no to these + - '!components/eamxx/docs/**' + - '!components/eamxx/mkdocs.yml' # Manual run is used to bless workflow_dispatch: @@ -40,83 +51,18 @@ concurrency: env: # Submit to cdash only for nightlies or if the user explicitly forced a submission via workflow dispatch submit: ${{ github.event_name == 'schedule' || (github.event_name == 'workflow_dispatch' && inputs.submit) }} + generate: ${{ github.event_name == 'workflow_dispatch' && inputs.bless }} jobs: - pre_process_pr: - if: ${{ github.event_name == 'pull_request' }} - runs-on: ubuntu-latest # This job can run anywhere - outputs: - relevant_paths: ${{ steps.check_paths.outputs.value }} - labels: ${{ steps.get_labels.outputs.labels }} - steps: - - name: Check files modified by PR - id: check_paths - run: | - paths=( - components/eamxx - components/eam/src/physics/rrtmgp - components/eam/src/physics/p3/scream - components/eam/src/physics/cam - components/eam/src/physics/rrtmgp/external - externals/ekat - externals/scorpio - externals/haero - externals/YAKL - .github/workflows/eamxx-sa-testing.yml - ) - pattern=$(IFS=\|; echo "${paths[*]}") - - # Use the GitHub API to get the list of changed files - # There are page size limits, so do it in chunks - page=1 - while true; do - response=$(curl -s -H "Authorization: token ${{ secrets.GITHUB_TOKEN }}" \ - "https://api.github.com/repos/E3SM-Project/scream/pulls/${{ github.event.number }}/files?per_page=100&page=$page") - - # Check if the response is empty, and break if it is - [ -z "$response" ] && break - - changed_files+=$(echo "$response" | grep -o '"filename": *"[^"]*"' | sed 's/"filename": *//; s/"//g')$'\n' - - # Check if there are more pages, and quite if there aren't - [[ $(echo "$response" | jq '. | length') -lt 100 ]] && break - - page=$((page + 1)) - done - - # Check for matches and echo the matching files (or "" if none) - matching_files=$(echo "$changed_files" | grep -E "^($pattern)" || echo "") - if [[ -n "$matching_files" ]]; then - echo "Found relevant files: $matching_files" - echo "value=true" >> $GITHUB_OUTPUT - else - echo "No relevant files touched by this PR." - echo "value=false" >> $GITHUB_OUTPUT - fi - - name: Retrieve PR labels - id: get_labels - run: | - labels="${{ join(github.event.pull_request.labels.*.name, ',') }}" - echo "labels=${labels}" >> $GITHUB_OUTPUT gcc-openmp: - needs: [pre_process_pr] if: | - !failure() && !cancelled() && - ( - github.event_name == 'schedule' || + ${{ + github.event_name != 'workflow_dispatch' || ( - github.event_name == 'pull_request' && - needs.pre_process_pr.outputs.relevant_paths=='true' && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip gcc') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip openmp') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip eamxx-sa') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip eamxx-all') - ) || ( - github.event_name == 'workflow_dispatch' && github.event.inputs.job_to_run == 'gcc-openmp' || github.event.inputs.job_to_run == 'all' ) - ) + }} runs-on: [self-hosted, ghci-snl-cpu, gcc] strategy: fail-fast: false @@ -132,14 +78,6 @@ jobs: submodules: recursive - name: Show action trigger uses: ./.github/actions/show-workflow-trigger - - name: Set test-all inputs based on event specs - run: | - echo "generate=false" >> $GITHUB_ENV - if [ "${{ github.event_name }}" == "workflow_dispatch" ]; then - if [ "${{ inputs.bless }}" == "true" ]; then - echo "generate=true" >> $GITHUB_ENV - fi - fi - name: Run tests uses: ./.github/actions/test-all-scream with: @@ -149,24 +87,14 @@ jobs: submit: ${{ env.submit }} cmake-configs: Kokkos_ENABLE_OPENMP=ON gcc-cuda: - needs: [pre_process_pr] if: | - !failure() && !cancelled() && - ( - github.event_name == 'schedule' || + ${{ + github.event_name != 'workflow_dispatch' || ( - github.event_name == 'pull_request' && - needs.pre_process_pr.outputs.relevant_paths=='true' && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip gcc') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip cuda') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip eamxx-sa') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip eamxx-all') - ) || ( - github.event_name == 'workflow_dispatch' && - github.event.inputs.job_to_run == 'gcc-cuda' || + github.event.inputs.job_to_run == 'gcc-cuda' || github.event.inputs.job_to_run == 'all' ) - ) + }} runs-on: [self-hosted, ghci-snl-cuda, cuda, gcc] strategy: fail-fast: false @@ -182,14 +110,6 @@ jobs: submodules: recursive - name: Show action trigger uses: ./.github/actions/show-workflow-trigger - - name: Set test-all inputs based on event specs - run: | - echo "generate=false" >> $GITHUB_ENV - if [ "${{ github.event_name }}" == "workflow_dispatch" ]; then - if [ "${{ inputs.bless }}" == "true" ]; then - echo "generate=true" >> $GITHUB_ENV - fi - fi - name: Get CUDA Arch run: | # Ensure nvidia-smi is available diff --git a/.github/workflows/eamxx-scripts-tests.yml b/.github/workflows/eamxx-scripts-tests.yml index a14cdc4f350..2cdd6f8758f 100644 --- a/.github/workflows/eamxx-scripts-tests.yml +++ b/.github/workflows/eamxx-scripts-tests.yml @@ -5,6 +5,10 @@ on: pull_request: branches: [ master ] types: [opened, synchronize, ready_for_review, reopened] + paths: + - 'components/eamxx/scripts/**' + - 'components/eamxx/cime_config/**' + - '.github/workflows/eamxx-scripts-tests.yml' # Manual run for debug purposes only workflow_dispatch: @@ -30,68 +34,7 @@ env: submit: ${{ github.event_name == 'schedule' || (github.event_name == 'workflow_dispatch' && inputs.submit) }} jobs: - pre_process_pr: - if: ${{ github.event_name == 'pull_request' }} - runs-on: ubuntu-latest # This job can run anywhere - outputs: - relevant_paths: ${{ steps.check_paths.outputs.value}} - labels: ${{ steps.get_labels.outputs.labels }} - steps: - - name: Check files modified by PR - id: check_paths - run: | - paths=( - components/eamxx/scripts - components/eamxx/cime_config/eamxx - components/eamxx/cime_config/build - components/eamxx/cime_config/yaml_utils.py - .github/workflows/eamxx-scripts-tests.yml - ) - pattern=$(IFS=\|; echo "${paths[*]}") - - # Use the GitHub API to get the list of changed files - # There are page size limits, so do it in chunks - page=1 - while true; do - response=$(curl -s -H "Authorization: token ${{ secrets.GITHUB_TOKEN }}" \ - "https://api.github.com/repos/E3SM-Project/scream/pulls/${{ github.event.number }}/files?per_page=100&page=$page") - - # Check if the response is empty, and break if it is - [ -z "$response" ] && break - - changed_files+=$(echo "$response" | grep -o '"filename": *"[^"]*"' | sed 's/"filename": *//; s/"//g')$'\n' - - # Check if there are more pages, and quite if there aren't - [[ $(echo "$response" | jq '. | length') -lt 100 ]] && break - - page=$((page + 1)) - done - - # Check for matches and echo the matching files (or "" if none) - matching_files=$(echo "$changed_files" | grep -E "^($pattern)" || echo "") - if [[ -n "$matching_files" ]]; then - echo "Found relevant files: $matching_files" - echo "value=true" >> $GITHUB_OUTPUT - else - echo "No relevant files touched by this PR." - echo "value=false" >> $GITHUB_OUTPUT - fi - - name: Retrieve PR labels - id: get_labels - run: | - labels="${{ join(github.event.pull_request.labels.*.name, ',') }}" - echo "labels=${labels}" >> $GITHUB_OUTPUT cpu-gcc: - needs: [pre_process_pr] - if: | - !failure() && !cancelled() && - ( - github.event_name != 'pull_request' || - ( - needs.pre_process_pr.outputs.relevant_paths == 'true' && - !contains(needs.pre_process_pr.outputs.labels, 'CI: skip eamxx-all') - ) - ) runs-on: [self-hosted, gcc, ghci-snl-cpu] steps: - name: Check out the repository diff --git a/.github/workflows/eamxx-v1-testing.yml b/.github/workflows/eamxx-v1-testing.yml index d55ed8252a5..9145961bdfe 100644 --- a/.github/workflows/eamxx-v1-testing.yml +++ b/.github/workflows/eamxx-v1-testing.yml @@ -5,6 +5,17 @@ on: pull_request: branches: [ master ] types: [opened, synchronize, ready_for_review, reopened] + paths: + # first, yes to these + - '.github/workflows/eamxx-v1-testing.yml' + - 'cime_config/machine/config_machines.xml' + - 'components/eamxx/**' + - 'components/homme/**' + - 'externals/ekat' + - 'externals/scorpio' + # second, no to these + - '!components/eamxx/docs/**' + - '!components/eamxx/mkdocs.yml' # Manual run is used to bless workflow_dispatch: @@ -28,81 +39,26 @@ concurrency: group: ${{ github.workflow }}-${{ github.ref }} cancel-in-progress: true -jobs: - pre_process_pr: - if: ${{ github.event_name == 'pull_request' }} - runs-on: ubuntu-latest # This job can run anywhere - outputs: - relevant_paths: ${{ steps.check_paths.outputs.value }} - labels: ${{ steps.get_labels.outputs.labels }} - steps: - - name: Check files modified by PR - id: check_paths - run: | - paths=( - components/eamxx - components/eam/src/physics/rrtmgp - components/eam/src/physics/p3/scream - components/eam/src/physics/cam - components/eam/src/physics/rrtmgp/external - externals/ekat - externals/scorpio - externals/haero - externals/YAKL - .github/workflows/eamxx-v1-testing.yml - ) - pattern=$(IFS=\|; echo "${paths[*]}") - - # Use the GitHub API to get the list of changed files - # There are page size limits, so do it in chunks - page=1 - while true; do - response=$(curl -s -H "Authorization: token ${{ secrets.GITHUB_TOKEN }}" \ - "https://api.github.com/repos/E3SM-Project/scream/pulls/${{ github.event.number }}/files?per_page=100&page=$page") - - # Check if the response is empty, and break if it is - [ -z "$response" ] && break - - changed_files+=$(echo "$response" | grep -o '"filename": *"[^"]*"' | sed 's/"filename": *//; s/"//g')$'\n' - - # Check if there are more pages, and quite if there aren't - [[ $(echo "$response" | jq '. | length') -lt 100 ]] && break +env: + # Submit to cdash only for nightlies or if the user explicitly forced a submission via workflow dispatch + submit: ${{ github.event_name == 'schedule' || (github.event_name == 'workflow_dispatch' && inputs.submit) }} + # Generate only if user requested via workflow_dispatch + generate: ${{ github.event_name == 'workflow_dispatch' && inputs.bless }} + # Correct case folder suffix for generate/compare, used to find files to upload as artifacts + folder_suffix: ${{ github.event_name == 'workflow_dispatch' && inputs.bless && '.G' || '.C' }} + # Compare/generate flags for create_test + flags: ${{ github.event_name == 'workflow_dispatch' && inputs.bless && '-o -g -b master' || '-c -b master' }} - page=$((page + 1)) - done - - # Check for matches and echo the matching files (or "" if none) - matching_files=$(echo "$changed_files" | grep -E "^($pattern)" || echo "") - if [[ -n "$matching_files" ]]; then - echo "Found relevant files: $matching_files" - echo "value=true" >> $GITHUB_OUTPUT - else - echo "No relevant files touched by this PR." - echo "value=false" >> $GITHUB_OUTPUT - fi - - name: Retrieve PR labels - id: get_labels - run: | - labels="${{ join(github.event.pull_request.labels.*.name, ',') }}" - echo "labels=${labels}" >> $GITHUB_OUTPUT +jobs: cpu-gcc: - needs: [pre_process_pr] if: | - !failure() && !cancelled() && - ( - github.event_name == 'schedule' || + ${{ + github.event_name != 'workflow_dispatch' || ( - github.event_name == 'pull_request' && - needs.pre_process_pr.outputs.relevant_paths=='true' && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip gcc') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip eamxx-v1') && - !contains(needs.pre_process_pr.outputs.labels,'CI: skip eamxx-all') - ) || ( - github.event_name == 'workflow_dispatch' && - github.event.inputs.job_to_run == 'cpu-gcc' || + github.event.inputs.job_to_run == 'cpu-gcc' || github.event.inputs.job_to_run == 'all' ) - ) + }} runs-on: [self-hosted, gcc, ghci-snl-cpu] strategy: matrix: @@ -142,18 +98,6 @@ jobs: echo "Unsupported Linux distribution" exit 1 fi - - name: Establish cmp/gen flag - run: | - dir_suffix=".C" - cmp_gen_flag="-c" - if [ "${{ github.event_name }}" == "workflow_dispatch" ]; then - if [ ${{ inputs.bless }} ]; then - cmp_gen_flag="-o -g" - dir_suffix=".G" - fi - fi - echo "flags=$cmp_gen_flag -b master" >> $GITHUB_ENV - echo "folder_suffix=$dir_suffix" >> $GITHUB_ENV - name: Run test run: | ./cime/scripts/create_test ${{ matrix.test.full_name }} ${{ env.flags }} --wait From febfb90f207a05fd507749714a2ee04af63fc519 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Fri, 22 Nov 2024 09:38:35 -0600 Subject: [PATCH 314/529] update pam to conform to new eamxx p3 --- components/eam/src/physics/crm/pam/external | 2 +- components/eam/src/physics/crm/pam/pam_driver.cpp | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/components/eam/src/physics/crm/pam/external b/components/eam/src/physics/crm/pam/external index 1c37054d1ff..9b3e543d8bd 160000 --- a/components/eam/src/physics/crm/pam/external +++ b/components/eam/src/physics/crm/pam/external @@ -1 +1 @@ -Subproject commit 1c37054d1ff9b160290cc286dcbd3cdc6cd7e7f6 +Subproject commit 9b3e543d8bda43371a10cc1748397e69da9823ee diff --git a/components/eam/src/physics/crm/pam/pam_driver.cpp b/components/eam/src/physics/crm/pam/pam_driver.cpp index c7038343f08..e3070cce240 100644 --- a/components/eam/src/physics/crm/pam/pam_driver.cpp +++ b/components/eam/src/physics/crm/pam/pam_driver.cpp @@ -20,7 +20,6 @@ // Needed for p3_init #include "p3_functions.hpp" -#include "p3_f90.hpp" #include "pam_debug.h" bool constexpr enable_check_state = false; @@ -203,7 +202,8 @@ extern "C" void pam_driver() { #if defined(P3_CXX) if (is_first_step || is_restart) { auto am_i_root = coupler.get_option("am_i_root"); - scream::p3::p3_init(/*write_tables=*/false, am_i_root); + using P3F = scream::p3::Functions; + P3F::p3_init(/*write_tables=*/false, am_i_root); pam::p3_init_lookup_tables(); // Load P3 lookup table data - avoid re-loading every CRM call } #endif From 19f7c0dfe74643b6cedaf36dc55812494fd5998d Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 13 Nov 2024 21:58:03 -0700 Subject: [PATCH 315/529] EAMxx: rework vertical remapper * Allow to build from existing grids * Handle masked as well as P0 extrapolation * Handle top/bot extrapolations separately --- .../share/grid/remap/vertical_remapper.cpp | 526 +++++++++----- .../share/grid/remap/vertical_remapper.hpp | 59 +- .../eamxx/src/share/io/scorpio_output.cpp | 10 +- .../share/tests/vertical_remapper_tests.cpp | 657 ++++++++++++------ 4 files changed, 841 insertions(+), 411 deletions(-) diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp index 9b524cec5e4..8e13fd4e6df 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp @@ -17,61 +17,56 @@ namespace scream { +std::shared_ptr VerticalRemapper:: -VerticalRemapper (const grid_ptr_type& src_grid, - const std::string& map_file, - const Field& pmid_src, - const Field& pint_src) - : VerticalRemapper(src_grid,map_file,pmid_src,pint_src,constants::DefaultFillValue::value) +create_tgt_grid (const grid_ptr_type& src_grid, + const std::string& map_file) { - // Nothing to do here -} - -VerticalRemapper:: -VerticalRemapper (const grid_ptr_type& src_grid, - const std::string& map_file, - const Field& pmid_src, - const Field& pint_src, - const Real mask_val) - : AbstractRemapper() - , m_comm (src_grid->get_comm()) - , m_mask_val(mask_val) -{ - using namespace ShortFieldTagsNames; - - // Sanity checks - EKAT_REQUIRE_MSG (src_grid->type()==GridType::Point, - "Error! VerticalRemapper only works on PointGrid grids.\n" - " - src grid name: " + src_grid->name() + "\n" - " - src_grid_type: " + e2str(src_grid->type()) + "\n"); - EKAT_REQUIRE_MSG (src_grid->is_unique(), - "Error! VerticalRemapper requires a unique source grid.\n"); - - // This is a vertical remapper. We only go in one direction - m_bwd_allowed = false; - - // Create tgt_grid that is a clone of the src grid but with - // the correct number of levels. Note that when vertically - // remapping the target field will be defined on the same DOFs - // as the source field, but will have a different number of - // vertical levels. + // Create tgt_grid as a clone of src_grid with different nlevs scorpio::register_file(map_file,scorpio::FileMode::Read); auto nlevs_tgt = scorpio::get_dimlen(map_file,"lev"); auto tgt_grid = src_grid->clone("vertical_remap_tgt_grid",true); tgt_grid->reset_num_vertical_lev(nlevs_tgt); - this->set_grids(src_grid,tgt_grid); - - // Set the LEV and ILEV vertical profiles for interpolation from - set_source_pressure_fields(pmid_src,pint_src); // Gather the pressure level data for vertical remapping - set_pressure_levels(map_file); + auto layout = tgt_grid->get_vertical_layout(true); + Field p_tgt(FieldIdentifier("p_levs",layout,ekat::units::Pa,tgt_grid->name())); + p_tgt.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + p_tgt.allocate_view(); + scorpio::read_var(map_file,"p_levs",p_tgt.get_view().data()); + p_tgt.sync_to_dev(); // Add tgt pressure levels to the tgt grid - tgt_grid->set_geometry_data(m_tgt_pressure); + tgt_grid->set_geometry_data(p_tgt); scorpio::release_file(map_file); + + return tgt_grid; +} + +VerticalRemapper:: +VerticalRemapper (const grid_ptr_type& src_grid, + const std::string& map_file) + : VerticalRemapper(src_grid,create_tgt_grid(src_grid,map_file)) +{ + // NOTE: we prescribe a uniform tgt pressure levels, so pmid_tgt = pint_tgt (1d field) + // Cannot call set_target_pressure(p_tgt,p_tgt), since in there we do check the + // number of levels (i.e., pint/pmid cannot have the same nlevs). Since we remap + // every field (mid or int) to the same pressure coords, we just hard-code them. + m_tgt_pmid = m_tgt_pint = m_tgt_grid->get_geometry_data("p_levs"); +} + +VerticalRemapper:: +VerticalRemapper (const grid_ptr_type& src_grid, + const grid_ptr_type& tgt_grid) +{ + m_bwd_allowed = false; + + EKAT_REQUIRE_MSG (src_grid->get_2d_scalar_layout().congruent(tgt_grid->get_2d_scalar_layout()), + "Error! Source and target grid can only differ for their number of level.\n"); + + this->set_grids (src_grid,tgt_grid); } FieldLayout VerticalRemapper:: @@ -136,32 +131,30 @@ create_layout (const FieldLayout& fl_in, } void VerticalRemapper:: -set_pressure_levels(const std::string& map_file) +set_extrapolation_type (const ExtrapType etype, const TopBot where) { - // Ensure each map file gets a different decomp name - static std::map file2idx; - if (file2idx.find(map_file)==file2idx.end()) { - file2idx[map_file] = file2idx.size(); + if (where & Top) { + m_etype_top = etype; } + if (where & Bot) { + m_etype_bot = etype; + } +} - using namespace ShortFieldTagsNames; - auto layout = m_tgt_grid->get_vertical_layout(true); - FieldIdentifier fid("p_levs",layout,ekat::units::Pa,m_tgt_grid->name()); - m_tgt_pressure = Field(fid); - // Just in case input fields are packed - m_tgt_pressure.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); - m_tgt_pressure.allocate_view(); - - auto remap_pres_data = m_tgt_pressure.get_view().data(); - scorpio::read_var(map_file,"p_levs",remap_pres_data); +void VerticalRemapper:: +set_mask_value (const Real mask_val) +{ + EKAT_REQUIRE_MSG (not ekat::is_invalid(mask_val), + "[VerticalRemapper::set_mask_value] Error! Input mask value must be a valid number.\n"); - m_tgt_pressure.sync_to_dev(); + m_mask_val = mask_val; } void VerticalRemapper:: -set_source_pressure_fields(const Field& pmid, const Field& pint) +set_source_pressure (const Field& pmid, const Field& pint) { using namespace ShortFieldTagsNames; + using PackT = ekat::Pack; EKAT_REQUIRE_MSG(pmid.is_allocated(), "Error! Source midpoint pressure field is not yet allocated.\n" @@ -171,23 +164,60 @@ set_source_pressure_fields(const Field& pmid, const Field& pint) "Error! Source interface pressure field is not yet allocated.\n" " - field name: " + pint.name() + "\n"); + EKAT_REQUIRE_MSG(pmid.get_header().get_alloc_properties().is_compatible(), + "Error! Source midpoints pressure field not compatible with default pack size.\n" + " - pack size: " + std::to_string(SCREAM_PACK_SIZE) + "\n"); + EKAT_REQUIRE_MSG(pint.get_header().get_alloc_properties().is_compatible(), + "Error! Source interfaces pressure field not compatible with default pack size.\n" + " - pack size: " + std::to_string(SCREAM_PACK_SIZE) + "\n"); + const auto& pmid_layout = pmid.get_header().get_identifier().get_layout(); const auto& pint_layout = pint.get_header().get_identifier().get_layout(); - EKAT_REQUIRE_MSG(pmid_layout.congruent(m_src_grid->get_3d_scalar_layout(true)), + EKAT_REQUIRE_MSG(pmid_layout.dim(LEV)==m_src_grid->get_num_vertical_levels(), "Error! Source midpoint pressure field has the wrong layout.\n" " - field name: " + pmid.name() + "\n" " - field layout: " + pmid_layout.to_string() + "\n" - " - expected layout: " + m_src_grid->get_3d_scalar_layout(true).to_string() + "\n"); - EKAT_REQUIRE_MSG(pint_layout.congruent(m_src_grid->get_3d_scalar_layout(false)), + " - expected num levels: " + std::to_string(m_src_grid->get_num_vertical_levels()) + "\n"); + EKAT_REQUIRE_MSG(pint_layout.dim(ILEV)==m_src_grid->get_num_vertical_levels()+1, "Error! Source interface pressure field has the wrong layout.\n" " - field name: " + pint.name() + "\n" " - field layout: " + pint_layout.to_string() + "\n" - " - expected layout: " + m_src_grid->get_3d_scalar_layout(false).to_string() + "\n"); + " - expected num levels: " + std::to_string(m_src_grid->get_num_vertical_levels()+1) + "\n"); m_src_pmid = pmid; m_src_pint = pint; } +void VerticalRemapper:: +set_target_pressure (const Field& pmid, const Field& pint) +{ + using namespace ShortFieldTagsNames; + + EKAT_REQUIRE_MSG(pmid.is_allocated(), + "Error! Target midpoint pressure field is not yet allocated.\n" + " - field name: " + pmid.name() + "\n"); + + EKAT_REQUIRE_MSG(pint.is_allocated(), + "Error! Target interface pressure field is not yet allocated.\n" + " - field name: " + pint.name() + "\n"); + + const auto& pmid_layout = pmid.get_header().get_identifier().get_layout(); + const auto& pint_layout = pint.get_header().get_identifier().get_layout(); + EKAT_REQUIRE_MSG(pmid_layout.dim(LEV)==m_tgt_grid->get_num_vertical_levels(), + "Error! Target midpoint pressure field has the wrong layout.\n" + " - field name: " + pmid.name() + "\n" + " - field layout: " + pmid_layout.to_string() + "\n" + " - expected num levels: " + std::to_string(m_tgt_grid->get_num_vertical_levels()) + "\n"); + EKAT_REQUIRE_MSG(pint_layout.dim(ILEV)==m_tgt_grid->get_num_vertical_levels()+1, + "Error! Target interface pressure field has the wrong layout.\n" + " - field name: " + pint.name() + "\n" + " - field layout: " + pint_layout.to_string() + "\n" + " - expected num levels: " + std::to_string(m_tgt_grid->get_num_vertical_levels()+1) + "\n"); + + m_tgt_pmid = pmid; + m_tgt_pint = pint; +} + void VerticalRemapper:: do_register_field (const identifier_type& src, const identifier_type& tgt) { @@ -198,7 +228,7 @@ do_register_field (const identifier_type& src, const identifier_type& tgt) // could have src with ILEV and tgt with LEV) auto src_layout = src.get_layout().clone(); auto tgt_layout = tgt.get_layout().clone(); - EKAT_REQUIRE_MSG(src_layout.strip_dims({ILEV,LEV}).congruent(tgt_layout.strip_dims({LEV})), + EKAT_REQUIRE_MSG(src_layout.strip_dims({ILEV,LEV}).congruent(tgt_layout.strip_dims({LEV,ILEV})), "[VerticalRemapper] Error! Once vertical level tag is stripped, src/tgt layouts are incompatible.\n" " - src field name: " + src.name() + "\n" " - tgt field name: " + tgt.name() + "\n" @@ -231,54 +261,56 @@ do_bind_field (const int ifield, const field_type& src, const field_type& tgt) ft.packed = src.get_header().get_alloc_properties().is_compatible() and tgt.get_header().get_alloc_properties().is_compatible(); - // NOTE: for now we assume that masking is determined only by the COL,LEV location in space - // and that fields with multiple components will have the same masking for each component - // at a specific COL,LEV - src_layout.strip_dims({CMP}); + if (m_etype_top==Mask or m_etype_bot==Mask) { + // NOTE: for now we assume that masking is determined only by the COL,LEV location in space + // and that fields with multiple components will have the same masking for each component + // at a specific COL,LEV + src_layout.strip_dims({CMP}); - // I this mask has already been created, retrieve it, otherwise create it - const auto mask_name = m_tgt_grid->name() + "_" + ekat::join(src_layout.names(),"_") + "_mask"; - Field tgt_mask; - if (m_field2type.count(mask_name)==0) { - auto nondim = ekat::units::Units::nondimensional(); - // Create this src/tgt mask fields, and assign them to these src/tgt fields extra data + // I this mask has already been created, retrieve it, otherwise create it + const auto mask_name = m_tgt_grid->name() + "_" + ekat::join(src_layout.names(),"_") + "_mask"; + Field tgt_mask; + if (m_field2type.count(mask_name)==0) { + auto nondim = ekat::units::Units::nondimensional(); + // Create this src/tgt mask fields, and assign them to these src/tgt fields extra data - FieldIdentifier src_mask_fid (mask_name, src_layout, nondim, m_src_grid->name() ); - FieldIdentifier tgt_mask_fid = create_tgt_fid(src_mask_fid); + FieldIdentifier src_mask_fid (mask_name, src_layout, nondim, m_src_grid->name() ); + FieldIdentifier tgt_mask_fid = create_tgt_fid(src_mask_fid); - Field src_mask (src_mask_fid); - src_mask.allocate_view(); + Field src_mask (src_mask_fid); + src_mask.allocate_view(); - tgt_mask = Field (tgt_mask_fid); - tgt_mask.allocate_view(); + tgt_mask = Field (tgt_mask_fid); + tgt_mask.allocate_view(); - // Initialize the src mask values to 1.0 - src_mask.deep_copy(1.0); + // Initialize the src mask values to 1.0 + src_mask.deep_copy(1.0); - m_src_masks.push_back(src_mask); - m_tgt_masks.push_back(tgt_mask); + m_src_masks.push_back(src_mask); + m_tgt_masks.push_back(tgt_mask); - auto& mt = m_field2type[src_mask_fid.name()]; - mt.packed = false; - mt.midpoints = src_layout.has_tag(LEV); - } else { - for (size_t i=0; i void VerticalRemapper:: setup_lin_interp (const ekat::LinInterp& lin_interp, - const Field& p_src) const + const Field& p_src, const Field& p_tgt) const { using LI_t = ekat::LinInterp; using ESU = ekat::ExeSpaceUtils; using PackT = ekat::Pack; - auto p_src_v = p_src.get_view(); - auto p_tgt_v = m_tgt_pressure.get_view(); + using view2d = typename KokkosTypes::view; + using view1d = typename KokkosTypes::view; + + auto src1d = p_src.rank()==1; + auto tgt1d = p_tgt.rank()==1; + + view2d p_src2d_v, p_tgt2d_v; + view1d p_src1d_v, p_tgt1d_v; + if (src1d) { + p_src1d_v = p_src.get_view(); + } else { + p_src2d_v = p_src.get_view(); + } + if (tgt1d) { + p_tgt1d_v = p_tgt.get_view(); + } else { + p_tgt2d_v = p_tgt.get_view(); + } auto lambda = KOKKOS_LAMBDA(typename LI_t::MemberType const& team) { const int icol = team.league_rank(); - lin_interp.setup(team,ekat::subview(p_src_v,icol), - p_tgt_v); + // Extract subviews if src/tgt were not 1d to start with + auto x_src = p_src1d_v; + if (not src1d) + x_src = ekat::subview(p_src2d_v,icol); + auto x_tgt = p_tgt1d_v; + if (not tgt1d) + x_tgt = ekat::subview(p_tgt2d_v,icol); + + lin_interp.setup(team,x_src,x_tgt); }; - const int ncols = m_src_grid->get_num_local_dofs(); const int nlevs_tgt = m_tgt_grid->get_num_vertical_levels(); const int npacks_tgt = ekat::PackInfo::num_packs(nlevs_tgt); @@ -465,8 +523,7 @@ template void VerticalRemapper:: apply_vertical_interpolation(const ekat::LinInterp& lin_interp, const Field& f_src, const Field& f_tgt, - const Field& p_src, - const Real mask_val) const + const Field& p_src, const Field& p_tgt) const { // Note: if Packsize==1, we grab packs of size 1, which are for sure // compatible with the allocation @@ -474,44 +531,51 @@ apply_vertical_interpolation(const ekat::LinInterp& lin_interp, using PackT = ekat::Pack; using ESU = ekat::ExeSpaceUtils; - auto p_src_v = p_src.get_view(); - auto x_tgt = m_tgt_pressure.get_view(); - const auto& f_src_l = f_src.get_header().get_identifier().get_layout(); + using view2d = typename KokkosTypes::view; + using view1d = typename KokkosTypes::view; + + auto src1d = p_src.rank()==1; + auto tgt1d = p_tgt.rank()==1; + + view2d p_src2d_v, p_tgt2d_v; + view1d p_src1d_v, p_tgt1d_v; + if (src1d) { + p_src1d_v = p_src.get_view(); + } else { + p_src2d_v = p_src.get_view(); + } + if (tgt1d) { + p_tgt1d_v = p_tgt.get_view(); + } else { + p_tgt2d_v = p_tgt.get_view(); + } + + const auto& f_tgt_l = f_tgt.get_header().get_identifier().get_layout(); const int ncols = m_src_grid->get_num_local_dofs(); - const int nlevs_tgt = m_tgt_grid->get_num_vertical_levels(); - const int nlevs_src = f_src_l.dims().back(); + const int nlevs_tgt = f_tgt_l.dims().back(); const int npacks_tgt = ekat::PackInfo::num_packs(nlevs_tgt); - const int last_src_pack_idx = ekat::PackInfo::last_pack_idx(nlevs_src); - const int last_src_pack_end = ekat::PackInfo::last_vec_end(nlevs_src); - switch(f_src.rank()) { case 2: { auto f_src_v = f_src.get_view(); auto f_tgt_v = f_tgt.get_view< PackT**>(); auto policy = ESU::get_default_team_policy(ncols,npacks_tgt); - auto lambda = KOKKOS_LAMBDA(typename LI_t::MemberType const& team) { - - // Interpolate + auto lambda = KOKKOS_LAMBDA(typename LI_t::MemberType const& team) + { const int icol = team.league_rank(); - auto x_src = ekat::subview(p_src_v,icol); + + // Extract subviews if src/tgt pressures were not 1d to start with + auto x_src = p_src1d_v; + auto x_tgt = p_tgt1d_v; + if (not src1d) + x_src = ekat::subview(p_src2d_v,icol); + if (not tgt1d) + x_tgt = ekat::subview(p_tgt2d_v,icol); + auto y_src = ekat::subview(f_src_v,icol); auto y_tgt = ekat::subview(f_tgt_v,icol); lin_interp.lin_interp(team,x_src,x_tgt,y_src,y_tgt,icol); - team.team_barrier(); - - // If x_tgt is extrapolated, set to mask_val - auto x_min = x_src[0][0]; - auto x_max = x_src[last_src_pack_idx][last_src_pack_end-1]; - auto set_mask = [&](const int ipack) { - auto in_range = ekat::range(ipack*Packsize) < nlevs_tgt; - auto oob = (x_tgt[ipack]x_max) and in_range; - if (oob.any()) { - y_tgt[ipack].set(oob,mask_val); - } - }; - Kokkos::parallel_for (Kokkos::TeamThreadRange(team,npacks_tgt), set_mask); }; Kokkos::parallel_for("VerticalRemapper::apply_vertical_interpolation",policy,lambda); break; @@ -520,31 +584,25 @@ apply_vertical_interpolation(const ekat::LinInterp& lin_interp, { auto f_src_v = f_src.get_view(); auto f_tgt_v = f_tgt.get_view< PackT***>(); - const auto& layout = f_src.get_header().get_identifier().get_layout(); - const int ncomps = layout.get_vector_dim(); + const int ncomps = f_tgt_l.get_vector_dim(); auto policy = ESU::get_default_team_policy(ncols*ncomps,npacks_tgt); auto lambda = KOKKOS_LAMBDA(typename LI_t::MemberType const& team) { - // Interpolate const int icol = team.league_rank() / ncomps; const int icmp = team.league_rank() % ncomps; - auto x_src = ekat::subview(p_src_v,icol); + + // Extract subviews if src/tgt pressures were not 1d to start with + auto x_src = p_src1d_v; + auto x_tgt = p_tgt1d_v; + if (not src1d) + x_src = ekat::subview(p_src2d_v,icol); + if (not tgt1d) + x_tgt = ekat::subview(p_tgt2d_v,icol); + auto y_src = ekat::subview(f_src_v,icol,icmp); auto y_tgt = ekat::subview(f_tgt_v,icol,icmp); lin_interp.lin_interp(team,x_src,x_tgt,y_src,y_tgt,icol); - team.team_barrier(); - - // If x_tgt is extrapolated, set to mask_val - auto x_min = x_src[0][0]; - auto x_max = x_src[last_src_pack_idx][last_src_pack_end-1]; - auto set_mask = [&](const int ipack) { - auto oob = x_tgt[ipack]x_max; - if (oob.any()) { - y_tgt[ipack].set(oob,mask_val); - } - }; - Kokkos::parallel_for (Kokkos::TeamThreadRange(team,npacks_tgt), set_mask); }; Kokkos::parallel_for("VerticalRemapper::apply_vertical_interpolation",policy,lambda); break; @@ -557,4 +615,148 @@ apply_vertical_interpolation(const ekat::LinInterp& lin_interp, } } +void VerticalRemapper:: +extrapolate (const Field& f_src, + const Field& f_tgt, + const Field& p_src, + const Field& p_tgt, + const Real mask_val) const +{ + using ESU = ekat::ExeSpaceUtils; + + using view2d = typename KokkosTypes::view; + using view1d = typename KokkosTypes::view; + + auto src1d = p_src.rank()==1; + auto tgt1d = p_tgt.rank()==1; + + view2d p_src2d_v, p_tgt2d_v; + view1d p_src1d_v, p_tgt1d_v; + if (src1d) { + p_src1d_v = p_src.get_view(); + } else { + p_src2d_v = p_src.get_view(); + } + if (tgt1d) { + p_tgt1d_v = p_tgt.get_view(); + } else { + p_tgt2d_v = p_tgt.get_view(); + } + + const auto& f_tgt_l = f_tgt.get_header().get_identifier().get_layout(); + const auto& f_src_l = f_src.get_header().get_identifier().get_layout(); + const int ncols = m_src_grid->get_num_local_dofs(); + const int nlevs_tgt = f_tgt_l.dims().back(); + const int nlevs_src = f_src_l.dims().back(); + + auto etop = m_etype_top; + auto ebot = m_etype_bot; + auto mid = nlevs_tgt / 2; + switch(f_src.rank()) { + case 2: + { + auto f_src_v = f_src.get_view(); + auto f_tgt_v = f_tgt.get_view< Real**>(); + auto policy = ESU::get_default_team_policy(ncols,nlevs_tgt); + auto lambda = KOKKOS_LAMBDA(const auto& team) + { + const int icol = team.league_rank(); + + // Extract subviews if src/tgt pressures were not 1d to start with + auto x_src = p_src1d_v; + auto x_tgt = p_tgt1d_v; + if (not src1d) + x_src = ekat::subview(p_src2d_v,icol); + if (not tgt1d) + x_tgt = ekat::subview(p_tgt2d_v,icol); + + auto y_src = ekat::subview(f_src_v,icol); + auto y_tgt = ekat::subview(f_tgt_v,icol); + + auto x_min = x_src[0]; + auto x_max = x_src[nlevs_src-1]; + auto extrapolate = [&](const int ilev) { + if (ilev>=mid) { + // Near surface + if (x_tgt[ilev]>x_max) { + if (ebot==P0) { + y_tgt[ilev] = y_src[nlevs_src-1]; + } else { + y_tgt[ilev] = mask_val; + } + } + } else { + // Near top + if (x_tgt[ilev](); + auto f_tgt_v = f_tgt.get_view< Real***>(); + const int ncomps = f_tgt_l.get_vector_dim(); + auto policy = ESU::get_default_team_policy(ncols*ncomps,nlevs_tgt); + + auto lambda = KOKKOS_LAMBDA(const auto& team) + { + const int icol = team.league_rank() / ncomps; + const int icmp = team.league_rank() % ncomps; + + // Extract subviews if src/tgt pressures were not 1d to start with + auto x_src = p_src1d_v; + auto x_tgt = p_tgt1d_v; + if (not src1d) + x_src = ekat::subview(p_src2d_v,icol); + if (not tgt1d) + x_tgt = ekat::subview(p_tgt2d_v,icol); + + auto y_src = ekat::subview(f_src_v,icol,icmp); + auto y_tgt = ekat::subview(f_tgt_v,icol,icmp); + auto x_min = x_src[0]; + auto x_max = x_src[nlevs_src-1]; + auto extrapolate = [&](const int ilev) { + if (ilev>=mid) { + // Near surface + if (x_tgt[ilev]>x_max) { + if (ebot==P0) { + y_tgt[ilev] = y_src[nlevs_src-1]; + } else { + y_tgt[ilev] = mask_val; + } + } + } else { + // Near top + if (x_tgt[ilev] + create_tgt_grid (const grid_ptr_type& src_grid, + const std::string& map_file); + protected: FieldLayout create_layout (const FieldLayout& fl_in, @@ -89,25 +105,23 @@ class VerticalRemapper : public AbstractRemapper EKAT_ERROR_MSG ("VerticalRemapper only supports fwd remapping.\n"); } - void set_pressure_levels (const std::string& map_file); - void do_print(); - #ifdef KOKKOS_ENABLE_CUDA public: #endif template void apply_vertical_interpolation (const ekat::LinInterp& lin_interp, const Field& f_src, const Field& f_tgt, - const Field& p_src, - const Real mask_value) const; + const Field& p_src, const Field& p_tgt) const; + void extrapolate (const Field& f_src, const Field& f_tgt, + const Field& p_src, const Field& p_tgt, + const Real mask_val) const; template void setup_lin_interp (const ekat::LinInterp& lin_interp, - const Field& p_src) const; + const Field& p_src, const Field& p_tgt) const; protected: - void set_source_pressure_fields(const Field& pmid, const Field& pint); void create_lin_interp (); using KT = KokkosTypes; @@ -122,14 +136,19 @@ class VerticalRemapper : public AbstractRemapper // Source and target fields std::vector m_src_fields; std::vector m_tgt_fields; - std::vector m_tgt_masks; std::vector m_src_masks; + std::vector m_tgt_masks; // Vertical profile fields, both for source and target - Real m_mask_val; - Field m_tgt_pressure; - Field m_src_pmid; // Src vertical profile for LEV layouts - Field m_src_pint; // Src vertical profile for ILEV layouts + Field m_src_pmid; + Field m_src_pint; + Field m_tgt_pmid; + Field m_tgt_pint; + + // Extrapolation settings at top/bottom. Default to P0 extrapolation + ExtrapType m_etype_top = P0; + ExtrapType m_etype_bot = P0; + Real m_mask_val = std::numeric_limits::quiet_NaN(); // We need to remap mid/int fields separately, and we want to use packs if possible, // so we need to divide input fields into 4 separate categories diff --git a/components/eamxx/src/share/io/scorpio_output.cpp b/components/eamxx/src/share/io/scorpio_output.cpp index e8f322b85f3..47a5616aec5 100644 --- a/components/eamxx/src/share/io/scorpio_output.cpp +++ b/components/eamxx/src/share/io/scorpio_output.cpp @@ -227,9 +227,13 @@ AtmosphereOutput (const ekat::Comm& comm, const ekat::ParameterList& params, if (use_vertical_remap_from_file) { // We build a remapper, to remap fields from the fm grid to the io grid auto vert_remap_file = params.get("vertical_remap_file"); - auto f_lev = get_field("p_mid","sim"); - auto f_ilev = get_field("p_int","sim"); - m_vert_remapper = std::make_shared(io_grid,vert_remap_file,f_lev,f_ilev,m_fill_value); + auto p_mid = get_field("p_mid","sim"); + auto p_int = get_field("p_int","sim"); + auto vert_remapper = std::make_shared(io_grid,vert_remap_file); + vert_remapper->set_source_pressure (p_mid,p_int); + vert_remapper->set_mask_value(m_fill_value); + vert_remapper->set_extrapolation_type(VerticalRemapper::Mask); // both Top AND Bot + m_vert_remapper = vert_remapper; io_grid = m_vert_remapper->get_tgt_grid(); set_grid(io_grid); diff --git a/components/eamxx/src/share/tests/vertical_remapper_tests.cpp b/components/eamxx/src/share/tests/vertical_remapper_tests.cpp index 34351c65db8..b4f1627a16e 100644 --- a/components/eamxx/src/share/tests/vertical_remapper_tests.cpp +++ b/components/eamxx/src/share/tests/vertical_remapper_tests.cpp @@ -4,37 +4,46 @@ #include "share/grid/remap/coarsening_remapper.hpp" #include "share/grid/point_grid.hpp" #include "share/io/scream_scorpio_interface.hpp" +#include "share/util/scream_timing.hpp" +#include "share/field/field_utils.hpp" namespace scream { -template -typename ViewT::HostMirror -cmvc (const ViewT& v) { - auto vh = Kokkos::create_mirror_view(v); - Kokkos::deep_copy(vh,v); - return vh; -} +constexpr int vec_dim = 3; +constexpr auto P0 = VerticalRemapper::P0; +constexpr auto Mask = VerticalRemapper::Mask; +constexpr auto Top = VerticalRemapper::Top; +constexpr auto Bot = VerticalRemapper::Bot; +constexpr auto TopBot = VerticalRemapper::TopAndBot; +constexpr Real mask_val = -99999.0; -void print (const std::string& msg, const ekat::Comm& comm) { +template +void print (const std::string& fmt, const ekat::Comm& comm, Args&&... args) { + if (comm.am_i_root()) { + printf(fmt.c_str(),std::forward(args)...); + } +} +// Overload for when there are no additional arguments +void print(const std::string& fmt, const ekat::Comm& comm) { if (comm.am_i_root()) { - printf("%s",msg.c_str()); + printf(fmt.c_str()); } } // Helper function to create a grid given the number of dof's and a comm group. std::shared_ptr -build_src_grid(const ekat::Comm& comm, const int nldofs_src, const int nlevs_src) +build_grid(const ekat::Comm& comm, const int nldofs, const int nlevs) { using gid_type = AbstractGrid::gid_type; - auto src_grid = std::make_shared("src",nldofs_src,nlevs_src,comm); + auto grid = std::make_shared("src",nldofs,nlevs,comm); - auto src_dofs = src_grid->get_dofs_gids(); - auto src_dofs_h = src_dofs.get_view(); - std::iota(src_dofs_h.data(),src_dofs_h.data()+nldofs_src,nldofs_src*comm.rank()); - src_dofs.sync_to_dev(); + auto dofs = grid->get_dofs_gids(); + auto dofs_h = dofs.get_view(); + std::iota(dofs_h.data(),dofs_h.data()+nldofs,nldofs*comm.rank()); + dofs.sync_to_dev(); - return src_grid; + return grid; } // Helper function to create fields @@ -64,7 +73,133 @@ Real data_func(const int col, const int vec, const Real pres) { // - pres, the current pressure // Should ensure that the interpolated values match exactly, since vertical interp is also a linear interpolator. // Note, we don't use the level, because here the vertical interpolation is over pressure, so it represents the level. - return col*pres + vec*100.0; + return (col+1)*pres + vec*100.0; +} + +void compute_field (const Field& f, const Field& p) +{ + Field::view_host_t p1d; + Field::view_host_t p2d; + bool rank1 = p.rank()==1; + const auto& l = f.get_header().get_identifier().get_layout(); + const int ncols = l.dims().front(); + const int nlevs = l.dims().back(); + if (rank1) { + p1d = p.get_view(); + } else { + p2d = p.get_view(); + } + + // Grab correct pressure (1d or 2d) + auto pval = [&](int i, int k) { + if (rank1) return p1d(k); + else return p2d(i,k); + }; + + switch (l.type()) { + case LayoutType::Scalar2D: + { + const auto v = f.get_view(); + for (int i=0; i(); + for (int i=0; i(); + for (int i=0; i(); + for (int i=0; i p1d_src,p1d_tgt; + Field::view_host_t p2d_src,p2d_tgt; + if (p_src.rank()==1) { + p1d_src = p_src.get_view(); + } else { + p2d_src = p_src.get_view(); + } + if (p_tgt.rank()==1) { + p1d_tgt = p_tgt.get_view(); + } else { + p2d_tgt = p_tgt.get_view(); + } + + auto pval = [&](auto p1d, auto p2d, int i, int k, int rank) { + if (rank==1) return p1d(k); + else return p2d(i,k); + }; + + const auto& l = f.get_header().get_identifier().get_layout(); + const int ncols = l.dims().front(); + const int nlevs = l.dims().back(); + const int nlevs_src = p_src.get_header().get_identifier().get_layout().dims().back(); + // print_field_hyperslab(p_src); + switch (l.type()) { + case LayoutType::Scalar2D: break; + case LayoutType::Vector2D: break; + case LayoutType::Scalar3D: + { + const auto v = f.get_view(); + for (int i=0; ipmax) { + v(i,j) = etype_bot==Mask ? mask_val : data_func(i,0,pmax); + } else if (p(); + for (int i=0; ipmax) { + v(i,j,k) = etype_bot==Mask ? mask_val : data_func(i,j,pmax); + } else if (p dofs_p(nlevs_tgt); std::iota(dofs_p.begin(),dofs_p.end(),0); std::vector p_tgt; - for (int ii=0; ii creating map file ... done!\n",comm); // -------------------------------------- // - // Build src grid and remapper // + // Build src grid // // -------------------------------------- // - print (" -> creating grid and remapper ...\n",comm); + print (" -> creating src grid ...\n",comm); + auto src_grid = build_grid(comm, nldofs, nlevs_src); + print (" -> creating src grid ... done!\n",comm); - const Real mask_val = -99999.0; + // -------------------------------------- // + // Retrieve tgt grid // + // -------------------------------------- // - auto src_grid = build_src_grid(comm, nldofs_src, nlevs_src); - - // We need the source pressure level fields for both p_mid and p_int - auto pmid_src = create_field("p_mid", src_grid, false, false, true, SCREAM_PACK_SIZE); - auto pint_src = create_field("p_int", src_grid, false, false, false, SCREAM_PACK_SIZE); - // Set the source pressures - { - // By adding 1 to the pbot_tgt and subtrating 1 from ptop_tgt we ensure some masking, which - // we also want to check. - const Real ptop_src = ptop_tgt-1; - const Real pbot_src = pbot_tgt+1; - const Real dp_src = (pbot_src-ptop_src)/(nlevs_src-1); - auto pmid_v = pmid_src.get_view(); - auto pint_v = pint_src.get_view(); - for (int ii=0; ii(src_grid,filename,pmid_src,pint_src,mask_val); - print (" -> creating grid and remapper ... done!\n",comm); + print (" -> retreiving tgt grid ...\n",comm); + auto tgt_grid = VerticalRemapper::create_tgt_grid (src_grid,filename); + print (" -> retreiving tgt grid ... done!\n",comm); // -------------------------------------- // - // Create src/tgt grid fields // + // Check tgt grid // // -------------------------------------- // - print (" -> creating fields ...\n",comm); - constexpr int vec_dim = 3; + print (" -> checking tgt grid ...\n",comm); + REQUIRE (tgt_grid->get_num_local_dofs()==src_grid->get_num_local_dofs()); + REQUIRE (tgt_grid->get_num_vertical_levels()==nlevs_tgt); + REQUIRE (tgt_grid->has_geometry_data("p_levs")); + auto p_levs = tgt_grid->get_geometry_data("p_levs"); + auto p_levs_v = p_levs.get_view(); + for (int k=0; kget_tgt_grid(); - // Check that the target grid made by the remapper has the same number of columns as the source grid. - // Also check that the number of levels matches the expectation. - REQUIRE(tgt_grid->get_num_vertical_levels()==nlevs_tgt); - REQUIRE(tgt_grid->get_num_global_dofs()==src_grid->get_num_global_dofs()); - - auto src_s2d = create_field("s2d", src_grid,true,false); - auto src_v2d = create_field("v2d", src_grid,true,true); - // For now we can only support PS = SCREAM_PACK_SIZE because the source and target pressure levels will assume that packsize. - // If we use a smaller packsize we throw an error in the property check step of the vertical interpolation scheme. - // TODO: Fix that. - auto src_s3d_m = create_field("s3d_m",src_grid,false,false,true, 1); - auto src_s3d_i = create_field("s3d_i",src_grid,false,false,false,SCREAM_PACK_SIZE); - auto src_v3d_m = create_field("v3d_m",src_grid,false,true ,true, 1); - auto src_v3d_i = create_field("v3d_i",src_grid,false,true ,false,SCREAM_PACK_SIZE); - - auto tgt_s2d = create_field("s2d", tgt_grid,true,false); - auto tgt_v2d = create_field("v2d", tgt_grid,true,true); - auto tgt_s3d_m = create_field("s3d_m",tgt_grid,false,false,true, 1); - auto tgt_s3d_i = create_field("s3d_i",tgt_grid,false,false,true, SCREAM_PACK_SIZE); - auto tgt_v3d_m = create_field("v3d_m",tgt_grid,false,true ,true, 1); - auto tgt_v3d_i = create_field("v3d_i",tgt_grid,false,true ,true, SCREAM_PACK_SIZE); - - std::vector src_f = {src_s2d,src_v2d,src_s3d_m,src_s3d_i,src_v3d_m,src_v3d_i}; - std::vector tgt_f = {tgt_s2d,tgt_v2d,tgt_s3d_m,tgt_s3d_i,tgt_v3d_m,tgt_v3d_i}; - - print (" -> creating fields ... done!\n",comm); + print (" -> checking tgt grid ... done!\n",comm); - // -------------------------------------- // - // Register fields in the remapper // - // -------------------------------------- // + // Clean up scorpio stuff + scorpio::finalize_subsystem(); - print (" -> registering fields ...\n",comm); - remap->registration_begins(); - remap->register_field(src_s2d, tgt_s2d); - remap->register_field(src_v2d, tgt_v2d); - remap->register_field(src_s3d_m,tgt_s3d_m); - remap->register_field(src_s3d_i,tgt_s3d_i); - remap->register_field(src_v3d_m,tgt_v3d_m); - remap->register_field(src_v3d_i,tgt_v3d_i); - remap->registration_ends(); - print (" -> registering fields ... done!\n",comm); + print ("Testing retrieval of tgt grid from map file ...\n",comm); +} +TEST_CASE ("vertical_remapper") { // -------------------------------------- // - // Check remapper internals // + // Init MPI and PIO // // -------------------------------------- // - print (" -> Checking remapper internal state ...\n",comm); + ekat::Comm comm(MPI_COMM_WORLD); + print ("Testing vertical remapper ...\n",comm); - // Check the pressure levels read from map file + scorpio::init_subsystem(comm); // -------------------------------------- // - // Generate data for src fields // + // Set grid/map sizes // // -------------------------------------- // - print (" -> generate src fields data ...\n",comm); - using namespace ShortFieldTagsNames; - // Generate data in a deterministic way, so that when we check results, - // we know a priori what the input data that generated the tgt field's - // values was, even if that data was off rank. - auto pmid_v = pmid_src.get_view(); - auto pint_v = pint_src.get_view(); - auto src_gids = remap->get_src_grid()->get_dofs_gids().get_view(); - for (const auto& f : src_f) { - const auto& l = f.get_header().get_identifier().get_layout(); - switch (l.type()) { - case LayoutType::Scalar2D: - { - const auto v_src = f.get_view(); - for (int i=0; i creating src grid ...\n",comm); + auto src_grid = build_grid(comm, nldofs, nlevs_src); + print (" nlevs src: %d\n",comm,nlevs_src); + print (" -> creating src grid ...done!\n",comm); + + // Tgt grid must have same 2d layout as src grid + REQUIRE_THROWS (std::make_shared(src_grid,build_grid(comm,nldofs+1,nlevs_src))); + + // Helper lambda, to create p_int profile. If it is a 3d field, make same profile on each col + auto create_pint = [&](const auto& grid, const bool one_d, const Real ptop, const Real pbot) { + auto layout = one_d ? grid->get_vertical_layout(false) + : grid->get_3d_scalar_layout(false); + FieldIdentifier fid("p_int",layout,ekat::units::Pa,grid->name()); + Field pint (fid); + pint.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + pint.allocate_view(); + + int nlevs = grid->get_num_vertical_levels(); + const Real dp = (pbot-ptop)/nlevs; + + if (one_d) { + auto pv = pint.get_view(); + pv(nlevs) = pbot; + for (int k=nlevs; k>0; --k) { + pv(k-1) = pv(k) - dp; + } + } else { + auto pv = pint.get_view(); + for (int i=0; i0; --k) { + pv(i,k-1) = pv(i,k) - dp; } - } break; - case LayoutType::Vector2D: - { - const auto v_src = f.get_view(); - for (int i=0; i(); - for (int i=0; i(); - for (int i=0; i generate src fields data ... done!\n",comm); - - // No bwd remap - REQUIRE_THROWS(remap->remap(false)); - - for (int irun=0; irun<5; ++irun) { - print (" -> run remap ...\n",comm); - remap->remap(true); - print (" -> run remap ... done!\n",comm); - - // -------------------------------------- // - // Check remapped fields // - // -------------------------------------- // - - print (" -> check tgt fields ...\n",comm); - const auto tgt_gids = tgt_grid->get_dofs_gids().get_view(); - const int ntgt_gids = tgt_gids.size(); - for (size_t ifield=0; ifield Checking field with source layout " + ls +" " + dots + "\n",comm); - - f.sync_to_host(); - - switch (lsrc.type()) { - case LayoutType::Scalar2D: - { - // This is a flat array w/ no LEV tag so the interpolated value for source and target should match. - const auto v_src = fsrc.get_view(); - const auto v_tgt = f.get_view(); - for (int i=0; i(); - const auto v_src = fsrc.get_view(); - for (int i=0; i(); - for (int i=0; ip_v(i,nlevs_p-1) || p_tgt[j](); - for (int i=0; ip_v(i,nlevs_p-1) || p_tgt[k](); + auto pmid_v = pmid.get_view< Real*,Host>(); + for (int k=0; k(); + auto pmid_v = pmid.get_view< Real**,Host>(); + for (int i=0; i Checking field with source layout " + ls + " " + dots + " OK!\n",comm); + // Test tgt grid with 2x and 0.5x as many levels as src grid + for (int nlevs_tgt : {nlevs_src/2, 2*nlevs_src}) { + for (bool src_1d : {true, false}) { + for (bool tgt_1d : {true, false}) { + for (auto etype_top : {P0, Mask}) { + for (auto etype_bot : {P0, Mask}) { + print ("************************************************\n",comm); + print (" nlevs tgt: %d\n",comm,nlevs_tgt); + print (" src pressure is 1d: %s\n",comm,src_1d ? "true" : "false"); + print (" tgt pressure is 1d: %s\n",comm,tgt_1d ? "true" : "false"); + print (" extrap type at top: %s\n",comm,etype_top==P0 ? "p0" : "masked"); + print (" extrap type at bot: %s\n",comm,etype_bot==P0 ? "p0" : "masked"); + print ("************************************************\n",comm); + + print (" -> creating tgt grid ...\n",comm); + auto tgt_grid = src_grid->clone("tgt",true); + tgt_grid->reset_num_vertical_lev(nlevs_tgt); + print (" -> creating tgt grid ...done!\n",comm); + + print (" -> creating src/tgt pressure fields ...\n",comm); + auto pint_src = create_pint(src_grid, src_1d, ptop_src, pbot_src); + auto pmid_src = create_pmid(pint_src); + + // Make ptop_tgtpsurf_src, so we do have extrapolation + const Real ptop_tgt = 10; + const Real pbot_tgt = 1020; + auto pint_tgt = create_pint(tgt_grid, tgt_1d, ptop_tgt, pbot_tgt); + auto pmid_tgt = create_pmid(pint_tgt); + print (" -> creating src/tgt pressure fields ... done!\n",comm); + + print (" -> creating fields ... done!\n",comm); + auto src_s2d = create_field("s2d", src_grid,true,false); + auto src_v2d = create_field("v2d", src_grid,true,true); + auto src_s3d_m = create_field("s3d_m",src_grid,false,false,true, 1); + auto src_s3d_i = create_field("s3d_i",src_grid,false,false,false,SCREAM_PACK_SIZE); + auto src_v3d_m = create_field("v3d_m",src_grid,false,true ,true, 1); + auto src_v3d_i = create_field("v3d_i",src_grid,false,true ,false,SCREAM_PACK_SIZE); + + auto tgt_s2d = create_field("s2d", tgt_grid,true,false); + auto tgt_v2d = create_field("v2d", tgt_grid,true,true); + auto tgt_s3d_m = create_field("s3d_m",tgt_grid,false,false,true, 1); + auto tgt_s3d_i = create_field("s3d_i",tgt_grid,false,false,true, SCREAM_PACK_SIZE); + auto tgt_v3d_m = create_field("v3d_m",tgt_grid,false,true ,true, 1); + auto tgt_v3d_i = create_field("v3d_i",tgt_grid,false,true ,true, SCREAM_PACK_SIZE); + + auto expected_s2d = tgt_s2d.clone(); + auto expected_v2d = tgt_v2d.clone(); + auto expected_s3d_m = tgt_s3d_m.clone(); + auto expected_s3d_i = tgt_s3d_i.clone(); + auto expected_v3d_m = tgt_v3d_m.clone(); + auto expected_v3d_i = tgt_v3d_i.clone(); + print (" -> creating fields ... done!\n",comm); + + // -------------------------------------- // + // Register fields in the remapper // + // -------------------------------------- // + + print (" -> creating and initializing remapper ...\n",comm); + auto remap = std::make_shared(src_grid,tgt_grid); + remap->set_source_pressure (pmid_src, pint_src); + remap->set_target_pressure (pmid_tgt, pint_tgt); + remap->set_extrapolation_type(etype_top,Top); + remap->set_extrapolation_type(etype_bot,Bot); + REQUIRE_THROWS (remap->set_mask_value(std::numeric_limits::quiet_NaN())); + remap->set_mask_value(mask_val); // Only needed if top and/or bot use etype=Mask + + remap->registration_begins(); + remap->register_field(src_s2d, tgt_s2d); + remap->register_field(src_v2d, tgt_v2d); + remap->register_field(src_s3d_m,tgt_s3d_m); + remap->register_field(src_s3d_i,tgt_s3d_i); + remap->register_field(src_v3d_m,tgt_v3d_m); + remap->register_field(src_v3d_i,tgt_v3d_i); + remap->registration_ends(); + print (" -> creating and initializing remapper ... done!\n",comm); + + // -------------------------------------- // + // Generate data for src fields // + // -------------------------------------- // + + print (" -> generate fields data ...\n",comm); + compute_field(src_s2d, pmid_src); + compute_field(src_v2d, pmid_src); + compute_field(src_s3d_m,pmid_src); + compute_field(src_s3d_i,pint_src); + compute_field(src_v3d_m,pmid_src); + compute_field(src_v3d_i,pint_src); + + // Pre-compute what we expect the tgt fields to be + compute_field(expected_s2d, pmid_tgt); + compute_field(expected_v2d, pmid_tgt); + compute_field(expected_s3d_m,pmid_tgt); + compute_field(expected_s3d_i,pint_tgt); + compute_field(expected_v3d_m,pmid_tgt); + compute_field(expected_v3d_i,pint_tgt); + + extrapolate(pmid_src,pmid_tgt,expected_s2d, etype_top,etype_bot); + extrapolate(pmid_src,pmid_tgt,expected_v2d, etype_top,etype_bot); + extrapolate(pmid_src,pmid_tgt,expected_s3d_m,etype_top,etype_bot); + extrapolate(pint_src,pint_tgt,expected_s3d_i,etype_top,etype_bot); + extrapolate(pmid_src,pmid_tgt,expected_v3d_m,etype_top,etype_bot); + extrapolate(pint_src,pint_tgt,expected_v3d_i,etype_top,etype_bot); + print (" -> generate fields data ... done!\n",comm); + + // -------------------------------------- // + // Perform remap // + // -------------------------------------- // + + // No bwd remap + REQUIRE_THROWS(remap->remap(false)); + + print (" -> run remap ...\n",comm); + remap->remap(true); + print (" -> run remap ... done!\n",comm); + + // -------------------------------------- // + // Check remapped fields // + // -------------------------------------- // + + using namespace Catch::Matchers; + Real tol = 10*std::numeric_limits::epsilon(); + + print (" -> check tgt fields ...\n",comm); + { + auto diff = tgt_s2d.clone("diff"); + auto ex_norm = frobenius_norm(expected_s2d); + diff.update(expected_s2d,1/ex_norm,-1/ex_norm); + REQUIRE (frobenius_norm(diff)(expected_v2d); + diff.update(expected_v2d,1/ex_norm,-1/ex_norm); + REQUIRE (frobenius_norm(diff)(expected_s3d_m); + diff.update(expected_s3d_m,1/ex_norm,-1/ex_norm); + REQUIRE (frobenius_norm(diff)(expected_s3d_i); + diff.update(expected_s3d_i,1/ex_norm,-1/ex_norm); + REQUIRE (frobenius_norm(diff)(expected_v3d_m); + diff.update(expected_v3d_m,1 / ex_norm,-1 / ex_norm); + REQUIRE (frobenius_norm(diff)(expected_v3d_i); + diff.update(expected_v3d_i,1 / ex_norm,-1 / ex_norm); + REQUIRE (frobenius_norm(diff) check tgt fields ... done!\n",comm); + } + } + } } - print ("check tgt fields ... done!\n",comm); } // Clean up scorpio stuff scorpio::finalize_subsystem(); + + print ("Testing vertical remapper ... done!\n",comm); } } // namespace scream From aebf3cb33a073148ac5efca15ef5bf008eecb54d Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 13 Nov 2024 22:16:27 -0700 Subject: [PATCH 316/529] EAMxx: fix creation of layouts in VerticalRemapper --- .../share/grid/remap/vertical_remapper.cpp | 47 +++++++++---------- .../share/grid/remap/vertical_remapper.hpp | 7 +-- 2 files changed, 25 insertions(+), 29 deletions(-) diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp index 8e13fd4e6df..39056a50d46 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp @@ -55,6 +55,8 @@ VerticalRemapper (const grid_ptr_type& src_grid, // number of levels (i.e., pint/pmid cannot have the same nlevs). Since we remap // every field (mid or int) to the same pressure coords, we just hard-code them. m_tgt_pmid = m_tgt_pint = m_tgt_grid->get_geometry_data("p_levs"); + + m_tgt_int_same_as_mid = true; } VerticalRemapper:: @@ -72,13 +74,10 @@ VerticalRemapper (const grid_ptr_type& src_grid, FieldLayout VerticalRemapper:: create_src_layout (const FieldLayout& tgt_layout) const { - using namespace ShortFieldTagsNames; - - EKAT_REQUIRE_MSG (is_valid_tgt_layout(tgt_layout), - "[VerticalRemapper] Error! Input target layout is not valid for this remapper.\n" - " - input layout: " + tgt_layout.to_string()); - - return create_layout(tgt_layout,m_src_grid); + // Since we don't know if the tgt layout is "LEV for everything", + // we cannot infer what the corresponding src layout was. + // This function should never be used for this remapper. + EKAT_ERROR_MSG ("Error! VerticalRemapper does not support creating a src layout from a tgt layout.\n"); } FieldLayout VerticalRemapper:: @@ -90,44 +89,40 @@ create_tgt_layout (const FieldLayout& src_layout) const "[VerticalRemapper] Error! Input source layout is not valid for this remapper.\n" " - input layout: " + src_layout.to_string()); - return create_layout(src_layout,m_tgt_grid); -} - -FieldLayout VerticalRemapper:: -create_layout (const FieldLayout& fl_in, - const grid_ptr_type& grid_out) const -{ - // NOTE: for the vert remapper, it doesn't really make sense to distinguish - // between midpoints and interfaces: we're simply asking for a quantity - // at a given set of pressure levels. So we choose to have fl_out - // to *always* have LEV as vertical tag. - auto fl_out = FieldLayout::invalid(); - switch (fl_in.type()) { + // If we remap to a fixed set of pressure levels during I/O, + // it doesn't really make sense to distinguish between midpoints + // and interfaces, so choose fl_out to have LEV as vertical tag. + auto tgt_layout = FieldLayout::invalid(); + bool midpoints; + switch (src_layout.type()) { case LayoutType::Scalar0D: [[ fallthrough ]]; case LayoutType::Vector0D: [[ fallthrough ]]; case LayoutType::Scalar2D: [[ fallthrough ]]; case LayoutType::Vector2D: [[ fallthrough ]]; case LayoutType::Tensor2D: // These layouts do not have vertical dim tags, so no change - fl_out = fl_in; + tgt_layout = src_layout; break; case LayoutType::Scalar1D: - fl_out = grid_out->get_vertical_layout(true); + midpoints = m_tgt_int_same_as_mid || src_layout.tags().back()==LEV; + tgt_layout = m_tgt_grid->get_vertical_layout(midpoints); break; case LayoutType::Scalar3D: - fl_out = grid_out->get_3d_scalar_layout(true); + midpoints = m_tgt_int_same_as_mid || src_layout.tags().back()==LEV; + tgt_layout = m_tgt_grid->get_3d_scalar_layout(midpoints); break; case LayoutType::Vector3D: - fl_out = grid_out->get_3d_vector_layout(true,fl_in.get_vector_dim()); + midpoints = m_tgt_int_same_as_mid || src_layout.tags().back()==LEV; + tgt_layout = m_tgt_grid->get_3d_vector_layout(midpoints,src_layout.get_vector_dim()); break; default: // NOTE: this also include Tensor3D. We don't really have any atm proc // that needs to handle a tensor3d quantity, so no need to add it EKAT_ERROR_MSG ( "[VerticalRemapper] Error! Layout not supported by VerticalRemapper.\n" - " - input layout: " + fl_in.to_string() + "\n"); + " - input layout: " + src_layout.to_string() + "\n"); } - return fl_out; + return tgt_layout; } void VerticalRemapper:: diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.hpp b/components/eamxx/src/share/grid/remap/vertical_remapper.hpp index d763cddceab..a22a9bb56df 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.hpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.hpp @@ -75,9 +75,6 @@ class VerticalRemapper : public AbstractRemapper protected: - FieldLayout create_layout (const FieldLayout& fl_in, - const grid_ptr_type& grid_out) const; - const identifier_type& do_get_src_field_id (const int ifield) const override { return m_src_fields[ifield].get_header().get_identifier(); } @@ -145,6 +142,10 @@ class VerticalRemapper : public AbstractRemapper Field m_tgt_pmid; Field m_tgt_pint; + // If we remap to a fixed set of pressure levels during I/O, + // our tgt pint would be the same as tgt pmid. + bool m_tgt_int_same_as_mid = false; + // Extrapolation settings at top/bottom. Default to P0 extrapolation ExtrapType m_etype_top = P0; ExtrapType m_etype_bot = P0; From 14df8d281ea57ecee39b2474c0d86d7842e618f4 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 14 Nov 2024 15:16:10 -0700 Subject: [PATCH 317/529] EAMxx: add comment regarding no bwd remap --- components/eamxx/src/share/grid/remap/vertical_remapper.cpp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp index 39056a50d46..94f87395106 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp @@ -63,6 +63,9 @@ VerticalRemapper:: VerticalRemapper (const grid_ptr_type& src_grid, const grid_ptr_type& tgt_grid) { + // We only go in one direction for simplicity, since we need to setup some + // infrsatructures, and we don't want to setup 2x as many "just in case". + // If you need to remap bwd, just create another remapper with src/tgt grids swapped. m_bwd_allowed = false; EKAT_REQUIRE_MSG (src_grid->get_2d_scalar_layout().congruent(tgt_grid->get_2d_scalar_layout()), From fb91a5e613633cf4bb405dc8097d266c0de28145 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 22 Nov 2024 10:15:34 -0700 Subject: [PATCH 318/529] EAMxx: change specs of valgrind build * Use RelWithDebInfo to compromise speed and analysis * Limit number of OMP threads to 2 --- components/eamxx/CMakeLists.txt | 4 ---- components/eamxx/scripts/test_factory.py | 6 ++++-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 07c3cda7672..693b8ae8a09 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -453,10 +453,6 @@ if (NOT SCREAM_LIB_ONLY) # for LONG use 100. It is *completely* up to the test to decide what short, medium, and long mean. if (EKAT_ENABLE_COVERAGE OR EKAT_ENABLE_CUDA_MEMCHECK OR EKAT_ENABLE_VALGRIND OR EKAT_ENABLE_COMPUTE_SANITIZER) set (SCREAM_TEST_SIZE_DEFAULT SHORT) - # also set thread_ing=$max_thread - 1, so we test at most 2 threading configurations - if (SCREAM_TEST_MAX_THREADS GREATER 1) - math (EXPR SCREAM_TEST_THREAD_INC ${SCREAM_TEST_MAX_THREADS}-1) - endif() else() set (SCREAM_TEST_SIZE_DEFAULT MEDIUM) endif() diff --git a/components/eamxx/scripts/test_factory.py b/components/eamxx/scripts/test_factory.py index a4d7bceea82..a81e9dbdd48 100644 --- a/components/eamxx/scripts/test_factory.py +++ b/components/eamxx/scripts/test_factory.py @@ -153,8 +153,10 @@ def __init__(self, tas): TestProperty.__init__( self, "valgrind", - "debug with valgrind", - [("CMAKE_BUILD_TYPE", "Debug"), ("EKAT_ENABLE_VALGRIND", "True")], + "Release build where tests run through valgrind", + [("CMAKE_BUILD_TYPE", "RelWithDebInfo"), + ("EKAT_ENABLE_VALGRIND", "True"), + ("SCREAM_TEST_MAX_THREADS", "2")], uses_baselines=False, on_by_default=False, default_test_len="short" From 7566586d78c269e6b01b2a85fdc042046317b040 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 12:35:36 -0500 Subject: [PATCH 319/529] Pacer basic timer interface --- share/pacer/Pacer.cpp | 74 +++++++++++++++++++++++++++++++++++++++++++ share/pacer/Pacer.h | 53 +++++++++++++++++++++++++++++++ share/pacer/test.cpp | 33 +++++++++++++++++++ 3 files changed, 160 insertions(+) create mode 100644 share/pacer/Pacer.cpp create mode 100644 share/pacer/Pacer.h create mode 100644 share/pacer/test.cpp diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp new file mode 100644 index 00000000000..7838f96d760 --- /dev/null +++ b/share/pacer/Pacer.cpp @@ -0,0 +1,74 @@ +//===-- Pacer.cpp - Timers for E3SM --*- C++ -*-===// +// +// \file +// \brief Timer infrastructure for E3SM C++ components +// +// +////===------------------------------------------===// + +#include "Pacer.h" +#include +#include + +#define STANDALONE_OMEGA + + bool Pacer::initialize(MPI_Comm InComm) { + +#ifdef STANDALONE_OMEGA + // GPTL set default options + + if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) + std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; + + GPTLinitialize(); + +#endif + return true; + } + + + bool Pacer::start(const std::string &TimerName) + { + GPTLstart(TimerName.c_str()); + return true; + } + + bool Pacer::stop(const std::string &TimerName) + { + GPTLstop(TimerName.c_str()); + return true; + } + + bool Pacer::setPrefix(const std::string &Prefix) + { + GPTLprefix_set(Prefix.c_str()); + + return true; + } + + bool Pacer::unsetPrefix() + { + GPTLprefix_unset(); + return true; + } + + bool Pacer::print(const std::string &TimerFilePrefix) + { + // https://github.com/E3SM-Project/E3SM/blob/master/share/timing/perf_mod.F90 + //GPTLpr(0); + GPTLpr_file(TimerFilePrefix.c_str()); + // https://github.com/jmrosinski/GPTL/blob/master/tests/global.c + //GPTLpr_summary_file(Comm) + return true; + } + + bool Pacer::finalize() + { +#ifdef STANDALONE_OMEGA + GPTLfinalize(); +#endif + return true; + } + + +//===----------------------------------------------------------------------===// diff --git a/share/pacer/Pacer.h b/share/pacer/Pacer.h new file mode 100644 index 00000000000..b0c21da6080 --- /dev/null +++ b/share/pacer/Pacer.h @@ -0,0 +1,53 @@ +#ifndef PACER_H +#define PACER_H + +//===-- Pacer.h - time stepper -----------------------*- C++ +////-*-===// +//// +///// \file +///// \brief Provides timer functionality for E3SM +///// +///// The Pacer class provides an interface to timers for +///// E3SM components. +//// +////===------------------------------------------------===// + +#include +#include + +#define STANDALONE_OMEGA + +namespace Pacer +{ + //private: + /// Flag to determine if the timing infrastructure is initialized + static bool IsInitialized; + + /// Timers will be output with this filename or the + /// constructed filename based on this template + //static std::string TimerFilePrefix; + + static MPI_Comm InternalComm; + + static std::map openTimers; + + // public: + bool initialize(MPI_Comm InComm); + + bool start(const std::string &TimerName); + + bool stop(const std::string &TimerName); + + bool setPrefix(const std::string &Prefix); + + bool unsetPrefix(); + + bool print(const std::string &TimerFilePrefix); + + bool finalize(); + +}; + + + +#endif diff --git a/share/pacer/test.cpp b/share/pacer/test.cpp new file mode 100644 index 00000000000..25112e374df --- /dev/null +++ b/share/pacer/test.cpp @@ -0,0 +1,33 @@ +#include +#include +#include "Pacer.h" + +int main(int argc, char **argv){ + + int err; + int myrank; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + Pacer::initialize(MPI_COMM_WORLD); + + Pacer::setPrefix("Omega"); + + Pacer::start("run_loop"); + + float tmp = 1; + + for (int i = 1; i <= 1000; i++){ + tmp *= i; + } + + Pacer::stop("run_loop"); + + + if (myrank == 0) + Pacer::print("omega_timing.0"); + + Pacer::finalize(); +} + From 00c5286057b06ac0784beb4e424a03424f42558d Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 13:05:23 -0500 Subject: [PATCH 320/529] PACER: Track open timers and warn if not closed properly --- share/pacer/Pacer.cpp | 18 ++++++++++++++++++ share/pacer/Pacer.h | 4 +++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 7838f96d760..8539d098b9e 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -30,12 +30,22 @@ bool Pacer::start(const std::string &TimerName) { GPTLstart(TimerName.c_str()); + auto it = OpenTimers.find(TimerName); + if (it != OpenTimers.end() ) + OpenTimers[TimerName]++; + else + OpenTimers[TimerName] = 1; return true; } bool Pacer::stop(const std::string &TimerName) { GPTLstop(TimerName.c_str()); + if ( OpenTimers[TimerName] == 1 ) + OpenTimers.erase(TimerName); + else + OpenTimers[TimerName]--; + return true; } @@ -67,6 +77,14 @@ #ifdef STANDALONE_OMEGA GPTLfinalize(); #endif + + if (OpenTimers.size() > 0){ + cerr << "PACER: Following timers are not closed." << endl; + for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) + cerr << i->first << endl; + + } + return true; } diff --git a/share/pacer/Pacer.h b/share/pacer/Pacer.h index b0c21da6080..a831e68690d 100644 --- a/share/pacer/Pacer.h +++ b/share/pacer/Pacer.h @@ -29,7 +29,9 @@ namespace Pacer static MPI_Comm InternalComm; - static std::map openTimers; + static int Rank; + + static std::unorder_map OpenTimers; // public: bool initialize(MPI_Comm InComm); From 5d4d37a67ea9b78c6689b207dc12da66a846908a Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 13:37:24 -0500 Subject: [PATCH 321/529] PACER: print file updates --- share/pacer/Pacer.cpp | 18 +++++++++++++----- share/pacer/Pacer.h | 8 ++++---- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 8539d098b9e..1066f482f64 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -9,9 +9,10 @@ #include "Pacer.h" #include #include +#include #define STANDALONE_OMEGA - + bool Pacer::initialize(MPI_Comm InComm) { #ifdef STANDALONE_OMEGA @@ -22,6 +23,9 @@ GPTLinitialize(); + MPI_Comm_rank(InternalComm, &MyRank); + + IsInitialized = true; #endif return true; } @@ -66,9 +70,13 @@ { // https://github.com/E3SM-Project/E3SM/blob/master/share/timing/perf_mod.F90 //GPTLpr(0); - GPTLpr_file(TimerFilePrefix.c_str()); + if (MyRank == 0) { + std::string TimerFileName = TimerFilePrefix + ".timing"; + std::string SummaryFileName = TimerFilePrefix + ".summary"; + GPTLpr_file(TimerFileName.c_str()); + GPTLpr_summary_file(InternalComm, SummaryFileName.c_str()); + } // https://github.com/jmrosinski/GPTL/blob/master/tests/global.c - //GPTLpr_summary_file(Comm) return true; } @@ -79,9 +87,9 @@ #endif if (OpenTimers.size() > 0){ - cerr << "PACER: Following timers are not closed." << endl; + std::cerr << "PACER: Following timers are not closed." << std::endl; for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) - cerr << i->first << endl; + std::cerr << i->first << std::endl; } diff --git a/share/pacer/Pacer.h b/share/pacer/Pacer.h index a831e68690d..c3812e64a75 100644 --- a/share/pacer/Pacer.h +++ b/share/pacer/Pacer.h @@ -14,11 +14,11 @@ #include #include +#include #define STANDALONE_OMEGA -namespace Pacer -{ +namespace Pacer { //private: /// Flag to determine if the timing infrastructure is initialized static bool IsInitialized; @@ -29,9 +29,9 @@ namespace Pacer static MPI_Comm InternalComm; - static int Rank; + static int MyRank; - static std::unorder_map OpenTimers; + static std::unordered_map OpenTimers; // public: bool initialize(MPI_Comm InComm); From 04eaa5112005e6338611e039ae80af7ff28483d1 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 13:37:53 -0500 Subject: [PATCH 322/529] PACER: Simple test --- share/pacer/test.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/share/pacer/test.cpp b/share/pacer/test.cpp index 25112e374df..da68d55fc05 100644 --- a/share/pacer/test.cpp +++ b/share/pacer/test.cpp @@ -26,7 +26,7 @@ int main(int argc, char **argv){ if (myrank == 0) - Pacer::print("omega_timing.0"); + Pacer::print("omega"); Pacer::finalize(); } From ebff5dda2768981034ede895986f0fea2ecde0f6 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 14:28:32 -0500 Subject: [PATCH 323/529] Pacer: set default GPTL options --- share/pacer/Pacer.cpp | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 1066f482f64..1ebc56cc700 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -17,14 +17,21 @@ #ifdef STANDALONE_OMEGA // GPTL set default options + GPTLsetoption(GPTLdepthlimit, 20); + GPTLsetoption(GPTLdetaillimit, 20); + GPTLsetoption(GPTLdopr_quotes, 1); + GPTLsetoption(GPTLprofile_ovhd, 1); + // default is set to 52 + // GPTLsetoption(GPTLmaxthreads) + GPTLsetutr(GPTLmpiwtime) + if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; + MPI_Comm_rank(InternalComm, &MyRank); GPTLinitialize(); - MPI_Comm_rank(InternalComm, &MyRank); - IsInitialized = true; #endif return true; From 6ea6e29541532fdc2db25ddecfd03dcd9588ac63 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 14:48:07 -0500 Subject: [PATCH 324/529] Pacer: set underlying timer properly --- share/pacer/Pacer.cpp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 1ebc56cc700..23bfc610e35 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -18,13 +18,12 @@ #ifdef STANDALONE_OMEGA // GPTL set default options GPTLsetoption(GPTLdepthlimit, 20); - GPTLsetoption(GPTLdetaillimit, 20); GPTLsetoption(GPTLdopr_quotes, 1); GPTLsetoption(GPTLprofile_ovhd, 1); // default is set to 52 // GPTLsetoption(GPTLmaxthreads) - GPTLsetutr(GPTLmpiwtime) + GPTLsetutr(GPTLmpiwtime); if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; From 68fa6e0f57d02b3294ed6c4b101867e8dc7d307c Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 14:54:55 -0500 Subject: [PATCH 325/529] Pacer: Testing set/unset prefix and dangling timer --- share/pacer/Pacer.cpp | 4 ++-- share/pacer/test.cpp | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 23bfc610e35..9d7682655c1 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -92,8 +92,8 @@ GPTLfinalize(); #endif - if (OpenTimers.size() > 0){ - std::cerr << "PACER: Following timers are not closed." << std::endl; + if ( (MyRank == 0) && ( OpenTimers.size() > 0) ){ + std::cerr << "PACER Warning: Following timers are not closed." << std::endl; for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) std::cerr << i->first << std::endl; diff --git a/share/pacer/test.cpp b/share/pacer/test.cpp index da68d55fc05..1352ba5a1f8 100644 --- a/share/pacer/test.cpp +++ b/share/pacer/test.cpp @@ -12,18 +12,20 @@ int main(int argc, char **argv){ Pacer::initialize(MPI_COMM_WORLD); - Pacer::setPrefix("Omega"); + Pacer::setPrefix("Omega:"); Pacer::start("run_loop"); float tmp = 1; - for (int i = 1; i <= 1000; i++){ + for (int i = 1; i <= 10000; i++){ tmp *= i; } Pacer::stop("run_loop"); + Pacer::unsetPrefix(); + Pacer::start("final"); if (myrank == 0) Pacer::print("omega"); From 499d42c4187d79fa66277286cd4c8dc956a32b90 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 15:12:58 -0500 Subject: [PATCH 326/529] Pacer: Explict header inclusion --- share/pacer/Pacer.h | 1 + 1 file changed, 1 insertion(+) diff --git a/share/pacer/Pacer.h b/share/pacer/Pacer.h index c3812e64a75..11616c6ed49 100644 --- a/share/pacer/Pacer.h +++ b/share/pacer/Pacer.h @@ -15,6 +15,7 @@ #include #include #include +#include #define STANDALONE_OMEGA From 9e235495906fee5c243a3bcb534704de0048da5a Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Wed, 13 Nov 2024 16:04:13 -0500 Subject: [PATCH 327/529] Pacer: Unit test instructions --- share/pacer/Pacer.h | 28 +++++++++++-------------- share/pacer/TestPacer.cpp | 43 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 16 deletions(-) create mode 100644 share/pacer/TestPacer.cpp diff --git a/share/pacer/Pacer.h b/share/pacer/Pacer.h index 11616c6ed49..392a75ccd5a 100644 --- a/share/pacer/Pacer.h +++ b/share/pacer/Pacer.h @@ -1,16 +1,16 @@ #ifndef PACER_H #define PACER_H -//===-- Pacer.h - time stepper -----------------------*- C++ -////-*-===// -//// -///// \file -///// \brief Provides timer functionality for E3SM -///// -///// The Pacer class provides an interface to timers for -///// E3SM components. -//// -////===------------------------------------------------===// +//===-- Pacer.h - Pacer timing interface -------------*- C++ +//-*-===// +// +// \file +// \brief Provides timer functionality for E3SM +// +// The Pacer class provides an interface to timers for +// E3SM components. +// +//===------------------------------------------------===// #include #include @@ -20,21 +20,17 @@ #define STANDALONE_OMEGA namespace Pacer { - //private: /// Flag to determine if the timing infrastructure is initialized static bool IsInitialized; - /// Timers will be output with this filename or the - /// constructed filename based on this template - //static std::string TimerFilePrefix; - static MPI_Comm InternalComm; static int MyRank; static std::unordered_map OpenTimers; - // public: + // Initialize Pacer timing. + // InComm: overall MPI communicator used by application. bool initialize(MPI_Comm InComm); bool start(const std::string &TimerName); diff --git a/share/pacer/TestPacer.cpp b/share/pacer/TestPacer.cpp new file mode 100644 index 00000000000..51f60e3ca34 --- /dev/null +++ b/share/pacer/TestPacer.cpp @@ -0,0 +1,43 @@ +// This test exercises basic timer functionality +// with the Pacer API. +// +// This test program should create two files: +// test_pacer.timing and test_pacer.summary +// It is also expected to issue a warning about +// the "final" timer still being open. + +#include +#include +#include "Pacer.h" + +int main(int argc, char **argv){ + + int err; + int myrank; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + Pacer::initialize(MPI_COMM_WORLD); + + Pacer::setPrefix("Omega:"); + + Pacer::start("run_loop"); + + float tmp = 1; + + for (int i = 1; i <= 10000; i++){ + tmp *= i; + } + + Pacer::stop("run_loop"); + + Pacer::unsetPrefix(); + Pacer::start("final"); + + if (myrank == 0) + Pacer::print("test_pacer"); + + Pacer::finalize(); +} + From 8185f14f4162bb44dd88c9249e38364041ba7778 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Fri, 15 Nov 2024 01:34:22 -0500 Subject: [PATCH 328/529] Pacer: feature additions Ability to print output from all ranks (disabled by default) Warn about stopping timer before starting it. --- share/pacer/Pacer.cpp | 68 ++++++++++++++++++++++++++----------------- share/pacer/Pacer.h | 6 +--- 2 files changed, 42 insertions(+), 32 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 9d7682655c1..0098610532c 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -11,28 +11,29 @@ #include #include -#define STANDALONE_OMEGA - +#define PACER_STANDALONE_MODE + bool Pacer::initialize(MPI_Comm InComm) { -#ifdef STANDALONE_OMEGA +#ifdef PACER_STANDALONE_MODE // GPTL set default options GPTLsetoption(GPTLdepthlimit, 20); GPTLsetoption(GPTLdopr_quotes, 1); GPTLsetoption(GPTLprofile_ovhd, 1); // default is set to 52 // GPTLsetoption(GPTLmaxthreads) - - GPTLsetutr(GPTLmpiwtime); - if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) - std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; - MPI_Comm_rank(InternalComm, &MyRank); + GPTLsetutr(GPTLmpiwtime); GPTLinitialize(); IsInitialized = true; #endif + + if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) + std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; + MPI_Comm_rank(InternalComm, &MyRank); + return true; } @@ -40,7 +41,7 @@ bool Pacer::start(const std::string &TimerName) { GPTLstart(TimerName.c_str()); - auto it = OpenTimers.find(TimerName); + auto it = OpenTimers.find(TimerName); if (it != OpenTimers.end() ) OpenTimers[TimerName]++; else @@ -50,11 +51,22 @@ bool Pacer::stop(const std::string &TimerName) { - GPTLstop(TimerName.c_str()); - if ( OpenTimers[TimerName] == 1 ) - OpenTimers.erase(TimerName); - else - OpenTimers[TimerName]--; + auto it = OpenTimers.find(TimerName); + + if (it != OpenTimers.end() ) { + GPTLstop(TimerName.c_str()); + + if ( OpenTimers[TimerName] == 1 ) + OpenTimers.erase(TimerName); + else + OpenTimers[TimerName]--; + } + else { + std::cerr << "Pacer Warning: Trying to stop timer:" + << TimerName << "before starting it." << std::endl; + + return false; + } return true; } @@ -72,30 +84,32 @@ return true; } - bool Pacer::print(const std::string &TimerFilePrefix) + bool Pacer::print(const std::string &TimerFilePrefix, bool PrintAllRanks /*= = false */) { - // https://github.com/E3SM-Project/E3SM/blob/master/share/timing/perf_mod.F90 - //GPTLpr(0); - if (MyRank == 0) { - std::string TimerFileName = TimerFilePrefix + ".timing"; - std::string SummaryFileName = TimerFilePrefix + ".summary"; - GPTLpr_file(TimerFileName.c_str()); - GPTLpr_summary_file(InternalComm, SummaryFileName.c_str()); + std::string TimerFileName = TimerFilePrefix + ".timing." + std::to_string(MyRank); + std::string SummaryFileName = TimerFilePrefix + ".summary"; + GPTLpr_summary_file(InternalComm, SummaryFileName.c_str()); + + if ( PrintAllRanks == false ) { + if (MyRank == 0) { + GPTLpr_file(TimerFileName.c_str()); + } } - // https://github.com/jmrosinski/GPTL/blob/master/tests/global.c + else + GPTLpr_file(TimerFileName.c_str()); + return true; } bool Pacer::finalize() { -#ifdef STANDALONE_OMEGA +#ifdef PACER_STANDALONE_MODE GPTLfinalize(); #endif - - if ( (MyRank == 0) && ( OpenTimers.size() > 0) ){ + if ( (MyRank == 0) && ( OpenTimers.size() > 0) ){ std::cerr << "PACER Warning: Following timers are not closed." << std::endl; for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) - std::cerr << i->first << std::endl; + std::cerr << '\t' << i->first << std::endl; } diff --git a/share/pacer/Pacer.h b/share/pacer/Pacer.h index 392a75ccd5a..cea1cc3e254 100644 --- a/share/pacer/Pacer.h +++ b/share/pacer/Pacer.h @@ -17,8 +17,6 @@ #include #include -#define STANDALONE_OMEGA - namespace Pacer { /// Flag to determine if the timing infrastructure is initialized static bool IsInitialized; @@ -41,12 +39,10 @@ namespace Pacer { bool unsetPrefix(); - bool print(const std::string &TimerFilePrefix); + bool print(const std::string &TimerFilePrefix, bool PrintAllRanks = false); bool finalize(); }; - - #endif From d974d1f67afea4fb406e018270de7e77c4257fb4 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Fri, 15 Nov 2024 02:13:20 -0500 Subject: [PATCH 329/529] Pacer: updates to test and formatting warnings --- share/pacer/Pacer.cpp | 4 ++-- share/pacer/TestPacer.cpp | 30 +++++++++++++++++++++++++----- 2 files changed, 27 insertions(+), 7 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 0098610532c..aceed2fb582 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -63,7 +63,7 @@ } else { std::cerr << "Pacer Warning: Trying to stop timer:" - << TimerName << "before starting it." << std::endl; + << TimerName << " before starting it." << std::endl; return false; } @@ -107,7 +107,7 @@ GPTLfinalize(); #endif if ( (MyRank == 0) && ( OpenTimers.size() > 0) ){ - std::cerr << "PACER Warning: Following timers are not closed." << std::endl; + std::cerr << "Pacer Warning: Following timers are not closed." << std::endl; for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) std::cerr << '\t' << i->first << std::endl; diff --git a/share/pacer/TestPacer.cpp b/share/pacer/TestPacer.cpp index 51f60e3ca34..e9410d8c212 100644 --- a/share/pacer/TestPacer.cpp +++ b/share/pacer/TestPacer.cpp @@ -1,10 +1,18 @@ +////===-- TestPacer.cpp - Simple test for Pacer --*- C++ -*-===// +// +// \file +// \brief Simple example illustrating Pacer API usage. +// // This test exercises basic timer functionality // with the Pacer API. // // This test program should create two files: -// test_pacer.timing and test_pacer.summary -// It is also expected to issue a warning about -// the "final" timer still being open. +// test.timing.0 and test.summary +// It is also expected to issue couple of warnings +// to illustrate likely scenarios where a timer is +// not started/stopped properly. +// +////===-----------------------------------------------------===// #include #include @@ -33,10 +41,22 @@ int main(int argc, char **argv){ Pacer::stop("run_loop"); Pacer::unsetPrefix(); + + + // illustrating situation where attempt to stop timer before starting + // will print a warning + Pacer::stop("final"); + + // as well as dangling timer which is never stopped explicitly + // will print a warning at the end during finalize Pacer::start("final"); - if (myrank == 0) - Pacer::print("test_pacer"); + + // print: First argument is the prefix used for timing output file names + // Second argument (optional) controls if timing output should be from all ranks + // default is false, only rank 0 writes timing output + Pacer::print("test"); + // Pacer::print("test_pacer", true); Pacer::finalize(); } From bf4ec5070fc6bda995b2119b2d8ce72723c3e371 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Fri, 22 Nov 2024 12:38:53 -0500 Subject: [PATCH 330/529] Pacer: Add comprehensive error checking and documentation. --- share/pacer/Pacer.cpp | 205 +++++++++++++++++++++++++------------- share/pacer/Pacer.h | 47 +++++++-- share/pacer/TestPacer.cpp | 5 +- 3 files changed, 175 insertions(+), 82 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index aceed2fb582..21270d5b548 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -11,110 +11,175 @@ #include #include -#define PACER_STANDALONE_MODE +#define PACER_CHECK_INIT() { if (!IsInitialized) { std::cerr << "[ERROR] Pacer: Not initialized." << std::endl; return false; } } + +/// Helper function to check if GPTL is initialized +/// Function declaration is missing in gptl.h +/// Hence the declaration here +extern "C" { + extern int GPTLis_initialized(void); +} + +/// Check if Pacer is initialized +/// Returns true if initialized +inline bool Pacer::isInitialized(void){ + if (!IsInitialized) { + std::cerr << "[ERROR] Pacer: Not initialized." << std::endl; + return false; + } + return true; +} + +/// Initialize Pacer timing +/// InComm: overall MPI communicator used by application. +/// InMode: Pacer standalone (default) or within CIME +bool Pacer::initialize(MPI_Comm InComm, PacerModeType InMode /* = PACER_STANDALONE */) { - bool Pacer::initialize(MPI_Comm InComm) { + int errCode; -#ifdef PACER_STANDALONE_MODE + PacerMode = InMode; + + if (PacerMode == PACER_STANDALONE ) { // GPTL set default options GPTLsetoption(GPTLdepthlimit, 20); GPTLsetoption(GPTLdopr_quotes, 1); GPTLsetoption(GPTLprofile_ovhd, 1); - // default is set to 52 - // GPTLsetoption(GPTLmaxthreads) + // GPTL default is set to 52 + // Presently setting to 64 + GPTLsetoption(GPTLmaxthreads, 64); GPTLsetutr(GPTLmpiwtime); - GPTLinitialize(); - - IsInitialized = true; -#endif - if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; MPI_Comm_rank(InternalComm, &MyRank); - return true; - } - + errCode = GPTLinitialize(); - bool Pacer::start(const std::string &TimerName) - { - GPTLstart(TimerName.c_str()); - auto it = OpenTimers.find(TimerName); - if (it != OpenTimers.end() ) - OpenTimers[TimerName]++; + if (errCode) { + std::cerr << "[ERROR] Pacer: Unable to initialize GPTL." << std::endl; + return false; + } else - OpenTimers[TimerName] = 1; - return true; + IsInitialized = true; } + else if (PacerMode == PACER_INTEGRATED) { + // GPTL is assumed to be initialized by E3SM driver in coupled modeling context - bool Pacer::stop(const std::string &TimerName) - { - auto it = OpenTimers.find(TimerName); + // Check if GPTL is initialized + errCode = GPTLis_initialized(); - if (it != OpenTimers.end() ) { - GPTLstop(TimerName.c_str()); - - if ( OpenTimers[TimerName] == 1 ) - OpenTimers.erase(TimerName); - else - OpenTimers[TimerName]--; + if (errCode == true) { + IsInitialized = true; } else { - std::cerr << "Pacer Warning: Trying to stop timer:" - << TimerName << " before starting it." << std::endl; - + IsInitialized = false; + std::cerr << "[ERROR] Pacer: GPTL is not initialized in PACER_INTEGRATED mode." << std::endl; return false; } - - return true; } - bool Pacer::setPrefix(const std::string &Prefix) - { - GPTLprefix_set(Prefix.c_str()); + return true; +} - return true; - } +/// Start the time named TimerName +bool Pacer::start(const std::string &TimerName) +{ + PACER_CHECK_INIT(); - bool Pacer::unsetPrefix() - { - GPTLprefix_unset(); - return true; - } + GPTLstart(TimerName.c_str()); + auto it = OpenTimers.find(TimerName); + if (it != OpenTimers.end() ) + OpenTimers[TimerName]++; + else + OpenTimers[TimerName] = 1; + return true; +} - bool Pacer::print(const std::string &TimerFilePrefix, bool PrintAllRanks /*= = false */) - { - std::string TimerFileName = TimerFilePrefix + ".timing." + std::to_string(MyRank); - std::string SummaryFileName = TimerFilePrefix + ".summary"; - GPTLpr_summary_file(InternalComm, SummaryFileName.c_str()); +/// Stop the time named TimerName +/// Issues warning if timer hasn't been started yet +bool Pacer::stop(const std::string &TimerName) +{ + PACER_CHECK_INIT(); - if ( PrintAllRanks == false ) { - if (MyRank == 0) { - GPTLpr_file(TimerFileName.c_str()); - } - } - else - GPTLpr_file(TimerFileName.c_str()); + auto it = OpenTimers.find(TimerName); + + if (it != OpenTimers.end() ) { + GPTLstop(TimerName.c_str()); - return true; + if ( OpenTimers[TimerName] == 1 ) + OpenTimers.erase(TimerName); + else + OpenTimers[TimerName]--; } + else { + std::cerr << "[WARNING] Pacer: Trying to stop timer: \"" + << TimerName << "\" before starting it." << std::endl; - bool Pacer::finalize() - { -#ifdef PACER_STANDALONE_MODE - GPTLfinalize(); -#endif - if ( (MyRank == 0) && ( OpenTimers.size() > 0) ){ - std::cerr << "Pacer Warning: Following timers are not closed." << std::endl; - for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) - std::cerr << '\t' << i->first << std::endl; + return false; + } + return true; +} + +/// Sets named prefix for all subsequent timers +bool Pacer::setPrefix(const std::string &Prefix) +{ + PACER_CHECK_INIT(); + + GPTLprefix_set(Prefix.c_str()); + return true; +} + +/// Unsets prefix for all subsequent timers +bool Pacer::unsetPrefix() +{ + PACER_CHECK_INIT(); + + GPTLprefix_unset(); + return true; +} + +/// Prints timing statistics and global summary files +/// Output Files: TimerFilePrefix.timing. +/// TimerFilePrefix.summary +/// PrintAllRanks: flag to control if per rank timing files are printed +bool Pacer::print(const std::string &TimerFilePrefix, bool PrintAllRanks /*= = false */) +{ + PACER_CHECK_INIT(); + + std::string TimerFileName = TimerFilePrefix + ".timing." + std::to_string(MyRank); + std::string SummaryFileName = TimerFilePrefix + ".summary"; + GPTLpr_summary_file(InternalComm, SummaryFileName.c_str()); + + if ( PrintAllRanks == false ) { + if (MyRank == 0) { + GPTLpr_file(TimerFileName.c_str()); } + } + else + GPTLpr_file(TimerFileName.c_str()); + + return true; +} + +/// Cleans up Pacer +/// Issues warning if any timers are still open +bool Pacer::finalize() +{ + PACER_CHECK_INIT(); - return true; + if ( PacerMode == PACER_STANDALONE ) + GPTLfinalize(); + + if ( (MyRank == 0) && ( OpenTimers.size() > 0) ){ + std::cerr << "[WARNING] Pacer: Following timers are not closed" << std::endl; + for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) + std::cerr << '\t' << i->first << std::endl; } + return true; +} + -//===----------------------------------------------------------------------===// +//===----------------------------------------------------------------------------===// diff --git a/share/pacer/Pacer.h b/share/pacer/Pacer.h index cea1cc3e254..3c64f001fa8 100644 --- a/share/pacer/Pacer.h +++ b/share/pacer/Pacer.h @@ -1,6 +1,3 @@ -#ifndef PACER_H -#define PACER_H - //===-- Pacer.h - Pacer timing interface -------------*- C++ //-*-===// // @@ -8,9 +5,11 @@ // \brief Provides timer functionality for E3SM // // The Pacer class provides an interface to timers for -// E3SM components. +// E3SM components. // -//===------------------------------------------------===// +//===--------------------------------------------------===// +#ifndef PACER_H +#define PACER_H #include #include @@ -18,29 +17,57 @@ #include namespace Pacer { - /// Flag to determine if the timing infrastructure is initialized - static bool IsInitialized; + /// Flag to determine if the timing infrastructure is initialized + static bool IsInitialized = false; + + /// MPI communicator used within Pacer static MPI_Comm InternalComm; + /// MPI rank of process static int MyRank; + /// hash table of open timers with count (for multiple parents) static std::unordered_map OpenTimers; - // Initialize Pacer timing. - // InComm: overall MPI communicator used by application. - bool initialize(MPI_Comm InComm); + enum PacerModeType { PACER_STANDALONE, PACER_INTEGRATED }; + + /// Pacer Mode: standalone or within CIME + static PacerModeType PacerMode; + + /// Initialize Pacer timing + /// InComm: overall MPI communicator used by application. + /// InMode: Pacer Mode: standalone (default) or within CIME + bool initialize(MPI_Comm InComm, PacerModeType InMode = PACER_STANDALONE); + + /// Check if Pacer is initialized + /// Returns true if initialized + bool isInitialized(void); + + /// IntegratedMode: Pacer standalone (default:false) or within CIME (true) + // bool initialize(MPI_Comm InComm, bool IntegratedMode = false); + /// Start the time named TimerName bool start(const std::string &TimerName); + /// Stop the time named TimerName + /// Issues warning if timer hasn't been started yet bool stop(const std::string &TimerName); + /// Sets named prefix for all subsequent timers bool setPrefix(const std::string &Prefix); + /// Unsets prefix for all subsequent timers bool unsetPrefix(); + /// Prints timing statistics and global summary files + /// Output Files: TimerFilePrefix.timing. + /// TimerFilePrefix.summary + /// PrintAllRanks: flag to control if per rank timing files are printed bool print(const std::string &TimerFilePrefix, bool PrintAllRanks = false); + /// Cleans up Pacer + /// Issues warning if any timers are still open bool finalize(); }; diff --git a/share/pacer/TestPacer.cpp b/share/pacer/TestPacer.cpp index e9410d8c212..96f29786232 100644 --- a/share/pacer/TestPacer.cpp +++ b/share/pacer/TestPacer.cpp @@ -27,6 +27,8 @@ int main(int argc, char **argv){ MPI_Comm_rank(MPI_COMM_WORLD, &myrank); Pacer::initialize(MPI_COMM_WORLD); + // Second argument is optional (default is Pacer::PACER_STANDALONE) + // Pacer::initialize(MPI_COMM_WORLD, Pacer::PACER_STANDALONE); Pacer::setPrefix("Omega:"); @@ -42,7 +44,6 @@ int main(int argc, char **argv){ Pacer::unsetPrefix(); - // illustrating situation where attempt to stop timer before starting // will print a warning Pacer::stop("final"); @@ -56,7 +57,7 @@ int main(int argc, char **argv){ // Second argument (optional) controls if timing output should be from all ranks // default is false, only rank 0 writes timing output Pacer::print("test"); - // Pacer::print("test_pacer", true); + // Pacer::print("test", true); Pacer::finalize(); } From e0a1cbff002b5e0dfe3ef650d991727afa44e211 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Fri, 22 Nov 2024 13:21:24 -0500 Subject: [PATCH 331/529] Pacer: Comprehensive error checking of GPTL functions --- share/pacer/Pacer.cpp | 46 +++++++++++++++++++++++++++++-------------- 1 file changed, 31 insertions(+), 15 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 21270d5b548..e1555ef6da0 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -11,7 +11,19 @@ #include #include -#define PACER_CHECK_INIT() { if (!IsInitialized) { std::cerr << "[ERROR] Pacer: Not initialized." << std::endl; return false; } } +#define PACER_CHECK_INIT() {\ + if (!IsInitialized) { \ + std::cerr << "[ERROR] Pacer: Not initialized." << std::endl; \ + return false; \ + } \ +} + +#define PACER_CHECK_ERROR(x) {\ + if ( (x) != 0 ) { \ + std::cerr << "[ERROR] Pacer: Failure calling GPTL function: " << #x << std::endl; \ + return false; \ + } \ +} /// Helper function to check if GPTL is initialized /// Function declaration is missing in gptl.h @@ -41,14 +53,14 @@ bool Pacer::initialize(MPI_Comm InComm, PacerModeType InMode /* = PACER_STANDALO if (PacerMode == PACER_STANDALONE ) { // GPTL set default options - GPTLsetoption(GPTLdepthlimit, 20); - GPTLsetoption(GPTLdopr_quotes, 1); - GPTLsetoption(GPTLprofile_ovhd, 1); + PACER_CHECK_ERROR(GPTLsetoption(GPTLdepthlimit, 20)); + PACER_CHECK_ERROR(GPTLsetoption(GPTLdopr_quotes, 1)); + PACER_CHECK_ERROR(GPTLsetoption(GPTLprofile_ovhd, 1)); // GPTL default is set to 52 // Presently setting to 64 - GPTLsetoption(GPTLmaxthreads, 64); + PACER_CHECK_ERROR(GPTLsetoption(GPTLmaxthreads, 64)); - GPTLsetutr(GPTLmpiwtime); + PACER_CHECK_ERROR(GPTLsetutr(GPTLmpiwtime)); if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; @@ -87,7 +99,8 @@ bool Pacer::start(const std::string &TimerName) { PACER_CHECK_INIT(); - GPTLstart(TimerName.c_str()); + PACER_CHECK_ERROR(GPTLstart(TimerName.c_str())); + auto it = OpenTimers.find(TimerName); if (it != OpenTimers.end() ) OpenTimers[TimerName]++; @@ -105,7 +118,7 @@ bool Pacer::stop(const std::string &TimerName) auto it = OpenTimers.find(TimerName); if (it != OpenTimers.end() ) { - GPTLstop(TimerName.c_str()); + PACER_CHECK_ERROR(GPTLstop(TimerName.c_str())); if ( OpenTimers[TimerName] == 1 ) OpenTimers.erase(TimerName); @@ -127,7 +140,8 @@ bool Pacer::setPrefix(const std::string &Prefix) { PACER_CHECK_INIT(); - GPTLprefix_set(Prefix.c_str()); + PACER_CHECK_ERROR(GPTLprefix_set(Prefix.c_str())); + return true; } @@ -136,7 +150,8 @@ bool Pacer::unsetPrefix() { PACER_CHECK_INIT(); - GPTLprefix_unset(); + PACER_CHECK_ERROR(GPTLprefix_unset()); + return true; } @@ -150,15 +165,16 @@ bool Pacer::print(const std::string &TimerFilePrefix, bool PrintAllRanks /*= = f std::string TimerFileName = TimerFilePrefix + ".timing." + std::to_string(MyRank); std::string SummaryFileName = TimerFilePrefix + ".summary"; - GPTLpr_summary_file(InternalComm, SummaryFileName.c_str()); + + PACER_CHECK_ERROR(GPTLpr_summary_file(InternalComm, SummaryFileName.c_str())); if ( PrintAllRanks == false ) { if (MyRank == 0) { - GPTLpr_file(TimerFileName.c_str()); + PACER_CHECK_ERROR(GPTLpr_file(TimerFileName.c_str())); } } else - GPTLpr_file(TimerFileName.c_str()); + PACER_CHECK_ERROR(GPTLpr_file(TimerFileName.c_str())); return true; } @@ -170,10 +186,10 @@ bool Pacer::finalize() PACER_CHECK_INIT(); if ( PacerMode == PACER_STANDALONE ) - GPTLfinalize(); + PACER_CHECK_ERROR(GPTLfinalize()); if ( (MyRank == 0) && ( OpenTimers.size() > 0) ){ - std::cerr << "[WARNING] Pacer: Following timers are not closed" << std::endl; + std::cerr << "[WARNING] Pacer: Following " << OpenTimers.size() << " timer(s) is/are still open." << std::endl; for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) std::cerr << '\t' << i->first << std::endl; } From e40f8609433d8512675d1a573ac15d15dd71ebd0 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Fri, 22 Nov 2024 14:00:02 -0500 Subject: [PATCH 332/529] Pacer: Remove obsolete test --- share/pacer/test.cpp | 35 ----------------------------------- 1 file changed, 35 deletions(-) delete mode 100644 share/pacer/test.cpp diff --git a/share/pacer/test.cpp b/share/pacer/test.cpp deleted file mode 100644 index 1352ba5a1f8..00000000000 --- a/share/pacer/test.cpp +++ /dev/null @@ -1,35 +0,0 @@ -#include -#include -#include "Pacer.h" - -int main(int argc, char **argv){ - - int err; - int myrank; - - MPI_Init(&argc, &argv); - MPI_Comm_rank(MPI_COMM_WORLD, &myrank); - - Pacer::initialize(MPI_COMM_WORLD); - - Pacer::setPrefix("Omega:"); - - Pacer::start("run_loop"); - - float tmp = 1; - - for (int i = 1; i <= 10000; i++){ - tmp *= i; - } - - Pacer::stop("run_loop"); - - Pacer::unsetPrefix(); - Pacer::start("final"); - - if (myrank == 0) - Pacer::print("omega"); - - Pacer::finalize(); -} - From fd534ad0729f620f75c1e5fd12612381c6c66add Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 22 Nov 2024 14:14:23 -0700 Subject: [PATCH 333/529] EAMxx: fix scripts tests for mem check builds --- components/eamxx/scripts/scripts-tests | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/eamxx/scripts/scripts-tests b/components/eamxx/scripts/scripts-tests index e83ce9308ae..67416b23d2b 100755 --- a/components/eamxx/scripts/scripts-tests +++ b/components/eamxx/scripts/scripts-tests @@ -292,12 +292,13 @@ class TestTestAllScream(TestBaseOuter.TestBase): self._machine) run_cmd_assert_result(self, cmd, from_dir=TEST_DIR) builddir = "compute_sanitizer_memcheck" if self._machine.gpu_arch=="cuda" else "valgrind" - test_cmake_cache_contents(self, builddir, "CMAKE_BUILD_TYPE", "Debug") test_cmake_cache_contents(self, builddir, "SCREAM_TEST_SIZE", "SHORT") if self._machine.gpu_arch=="cuda": + test_cmake_cache_contents(self, builddir, "CMAKE_BUILD_TYPE", "Debug") test_cmake_cache_contents(self, builddir, "EKAT_ENABLE_COMPUTE_SANITIZER", "TRUE") test_cmake_cache_contents(self, builddir, "EKAT_COMPUTE_SANITIZER_OPTIONS", "--tool=memcheck") else: + test_cmake_cache_contents(self, builddir, "CMAKE_BUILD_TYPE", "RelWithDebInfo") test_cmake_cache_contents(self, builddir, "EKAT_ENABLE_VALGRIND", "TRUE") else: self.skipTest("Skipping config-only run for jenkins test") From 84d6d09bdb600d505c941af689a37543d5e6a7fa Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 22 Nov 2024 18:59:40 -0700 Subject: [PATCH 334/529] EAMxx: remove generic host-device lambdas in VerticalRemapper --- .../eamxx/src/share/grid/remap/vertical_remapper.cpp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp index 94f87395106..67c72e045a7 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp @@ -656,7 +656,9 @@ extrapolate (const Field& f_src, auto f_src_v = f_src.get_view(); auto f_tgt_v = f_tgt.get_view< Real**>(); auto policy = ESU::get_default_team_policy(ncols,nlevs_tgt); - auto lambda = KOKKOS_LAMBDA(const auto& team) + + using MemberType = typename decltype(policy)::member_type; + auto lambda = KOKKOS_LAMBDA(const MemberType& team) { const int icol = team.league_rank(); @@ -706,7 +708,8 @@ extrapolate (const Field& f_src, const int ncomps = f_tgt_l.get_vector_dim(); auto policy = ESU::get_default_team_policy(ncols*ncomps,nlevs_tgt); - auto lambda = KOKKOS_LAMBDA(const auto& team) + using MemberType = typename decltype(policy)::member_type; + auto lambda = KOKKOS_LAMBDA(const MemberType& team) { const int icol = team.league_rank() / ncomps; const int icmp = team.league_rank() % ncomps; From 0525510299bc8c12afaf11430da573653a637438 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 22 Nov 2024 19:34:54 -0700 Subject: [PATCH 335/529] EAMxx: fix ghci-snl-cpu env We were missing the gator initial mb env var --- components/eamxx/scripts/machines_specs.py | 1 + 1 file changed, 1 insertion(+) diff --git a/components/eamxx/scripts/machines_specs.py b/components/eamxx/scripts/machines_specs.py index c9c9f973022..13b4bdca4b8 100644 --- a/components/eamxx/scripts/machines_specs.py +++ b/components/eamxx/scripts/machines_specs.py @@ -214,6 +214,7 @@ class GHCISNLCPU(Machine): def setup(cls): super().setup_base("ghci-snl-cpu") cls.baselines_dir = "/projects/e3sm/baselines/scream/ghci-snl-cpu" + cls.env_setup = ["export GATOR_INITIAL_MB=4000MB"] ############################################################################### class GHCISNLCuda(Machine): From cdd7fc78ce043be5ab9508dc309f987aeee57562 Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Sat, 23 Nov 2024 10:10:26 -0500 Subject: [PATCH 336/529] Workflows: upgrade container to include more files --- .github/workflows/e3sm-gh-ci-cime-tests.yml | 2 +- .github/workflows/e3sm-gh-ci-w-cime-tests.yml | 2 +- .github/workflows/eamxx-gh-ci-standalone.yml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/e3sm-gh-ci-cime-tests.yml b/.github/workflows/e3sm-gh-ci-cime-tests.yml index 5c6ff081f73..061bbad6999 100644 --- a/.github/workflows/e3sm-gh-ci-cime-tests.yml +++ b/.github/workflows/e3sm-gh-ci-cime-tests.yml @@ -40,7 +40,7 @@ jobs: - SMS_D_Ln5_P4.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.ghci-oci_gnu - ERS_Ld5_P4.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.ghci-oci_gnu.eamxx-prod container: - image: ghcr.io/e3sm-project/containers-ghci:ghci-0.2.0 + image: ghcr.io/e3sm-project/containers-ghci:ghci-0.2.1 steps: - diff --git a/.github/workflows/e3sm-gh-ci-w-cime-tests.yml b/.github/workflows/e3sm-gh-ci-w-cime-tests.yml index f51aa88a34c..7c173e47b67 100644 --- a/.github/workflows/e3sm-gh-ci-w-cime-tests.yml +++ b/.github/workflows/e3sm-gh-ci-w-cime-tests.yml @@ -27,7 +27,7 @@ jobs: - SMS_D_Ld1_P8.ne4pg2_oQU480.WCYCL2010NS.ghci-oci_gnu - ERS_Ld3_P8.ne4pg2_oQU480.WCYCL2010NS.ghci-oci_gnu.allactive-wcprod_1850 container: - image: ghcr.io/e3sm-project/containers-ghci:ghci-0.2.0 + image: ghcr.io/e3sm-project/containers-ghci:ghci-0.2.1 steps: - diff --git a/.github/workflows/eamxx-gh-ci-standalone.yml b/.github/workflows/eamxx-gh-ci-standalone.yml index 19a2ec9cd8e..aded5d0c95b 100644 --- a/.github/workflows/eamxx-gh-ci-standalone.yml +++ b/.github/workflows/eamxx-gh-ci-standalone.yml @@ -33,7 +33,7 @@ jobs: - dbg - fpe container: - image: ghcr.io/e3sm-project/containers-standalone-ghci:standalone-ghci-0.1.0 + image: ghcr.io/e3sm-project/containers-standalone-ghci:standalone-ghci-0.1.1 steps: - From 0f2229108d6e8f8706c294451572d505f857cbed Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Sat, 23 Nov 2024 10:11:14 -0500 Subject: [PATCH 337/529] Workflows: remove inputdata checks --- .github/workflows/eamxx_default_files.yml | 69 ----------------------- 1 file changed, 69 deletions(-) delete mode 100644 .github/workflows/eamxx_default_files.yml diff --git a/.github/workflows/eamxx_default_files.yml b/.github/workflows/eamxx_default_files.yml deleted file mode 100644 index 38c528306c4..00000000000 --- a/.github/workflows/eamxx_default_files.yml +++ /dev/null @@ -1,69 +0,0 @@ -name: inputdata - -on: - push: - branches: [ master ] - pull_request: - branches: [ master ] - paths: - - 'components/eamxx/cime_config/namelist_defaults_scream.xml' - schedule: - - cron: '00 00 * * *' - workflow_dispatch: - -concurrency: - group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.run_id }} - cancel-in-progress: true - -jobs: - scream-defaults: - if: ${{ github.repository == 'E3SM-Project/E3SM' }} - runs-on: ubuntu-latest - outputs: - event_name: ${{ github.event_name }} - steps: - - name: Check out the repository - uses: actions/checkout@v4 - with: - show-progress: false - submodules: false - - name: Set up Python 3.11 - uses: actions/setup-python@v5 - with: - python-version: "3.11" - - name: Run unit tests - working-directory: components/eamxx/cime_config/ - run: | - python -m unittest tests/eamxx_default_files.py -v - - notify-scream-defaults: - needs: scream-defaults - if: ${{ failure() && needs.scream-defaults.outputs.event_name != 'pull_request' }} - runs-on: ubuntu-latest - steps: - - name: Create issue - run: | - previous_issue_number=$(gh issue list \ - --label "$LABELS" \ - --json number \ - --jq '.[0].number') - if [[ -n $previous_issue_number ]]; then - gh issue comment "$previous_issue_number" \ - --body "$BODY" - else - gh issue create \ - --title "$TITLE" \ - --assignee "$ASSIGNEES" \ - --label "$LABELS" \ - --body "$BODY" - fi - env: - GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} - GH_REPO: ${{ github.repository }} - TITLE: Inputdata server file missing - ASSIGNEES: mahf708,bartgol - LABELS: bug,input file,notify-file-gh-action - BODY: | - Workflow failed! There's likely a missing file specified in the configs! For more information, please see: - - Workflow URL: https://github.com/${{ github.repository }}/actions/runs/${{ github.run_id }} (number ${{ github.run_number }}, attempt ${{ github.run_attempt }}) - - Workflow SHA: ${{ github.sha }} From 379dae7c0377541e533d91d442e1ed55de33ce0e Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Sat, 23 Nov 2024 10:11:44 -0500 Subject: [PATCH 338/529] Workflows: remove obsolute scream gh-pages --- .github/workflows/eamxx-gh-pages.yml | 89 ---------------------------- 1 file changed, 89 deletions(-) delete mode 100644 .github/workflows/eamxx-gh-pages.yml diff --git a/.github/workflows/eamxx-gh-pages.yml b/.github/workflows/eamxx-gh-pages.yml deleted file mode 100644 index 488c2b11a02..00000000000 --- a/.github/workflows/eamxx-gh-pages.yml +++ /dev/null @@ -1,89 +0,0 @@ -# This workflow aims to automatically rebuild eamxx documentation -# every time the master branch is updated on github and within every PR - -name: EAMxx Docs - -on: - # Runs every time master branch is updated - push: - branches: [ master ] - # Only if docs-related files are touched - paths: - - components/eamxx/mkdocs.yml - - components/eamxx/docs/** - - components/eamxx/cime_config/namelist_defaults_scream.xml - # Runs every time a PR is open against master - pull_request: - branches: [ master ] - # Only if docs-related files are touched - paths: - - components/eamxx/mkdocs.yml - - components/eamxx/docs/** - - components/eamxx/cime_config/namelist_defaults_scream.xml - - label: - types: - - created - - workflow_dispatch: - -concurrency: - # Prevent 2+ copies of this workflow from running concurrently - group: eamxx-docs-action - -jobs: - - eamxx-docs: - if: ${{ github.repository == 'E3SM-Project/scream' }} - runs-on: ubuntu-latest - - steps: - - name: Check out the repository - uses: actions/checkout@v4 - with: - persist-credentials: false - show-progress: false - # TODO: git rid of dependency on CIME - # TODO: another option to investigate is a sparse checkout. - # In the scream repo, all other components do not need to be checked out. - # And even in the upstream, we mainly need only components/xyz/docs (and a few more places). - submodules: true - - - name: Show action trigger - run: | - echo "= The job was automatically triggered by a ${{github.event_name}} event." - - - name: Set up Python 3.11 - uses: actions/setup-python@v5 - with: - python-version: "3.11" - - - name: Install Python deps - run: | - pip install mkdocs pymdown-extensions mkdocs-material mdutils mkdocs-bibtex - - - name: Generate EAMxx params docs - working-directory: components/eamxx/scripts - run: | - ./eamxx-params-docs-autogen - - - name: Build docs - working-directory: components/eamxx - run: | - mkdocs build --strict --verbose - - # only deploy to the main github page when there is a push to master - - if: ${{ github.event_name == 'push' }} - name: GitHub Pages action - uses: JamesIves/github-pages-deploy-action@v4 - with: - # Do not remove existing pr-preview pages - clean-exclude: pr-preview - folder: ./components/eamxx/site - - # If it's a PR from within the same repo, deploy to a preview page - - if: ${{ github.event_name == 'pull_request' && github.event.pull_request.head.repo.full_name == github.repository }} - name: Preview docs - uses: rossjrw/pr-preview-action@v1 - with: - source-dir: components/eamxx/site/ From 4c35514d823563e6cf9964519bf31708439a0a75 Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Sat, 23 Nov 2024 10:12:14 -0500 Subject: [PATCH 339/529] Workflows: make the md-linter run on eamxx docs --- .github/workflows/e3sm-gh-md-linter.yml | 2 -- 1 file changed, 2 deletions(-) diff --git a/.github/workflows/e3sm-gh-md-linter.yml b/.github/workflows/e3sm-gh-md-linter.yml index ad24487695e..ff0c61cf576 100644 --- a/.github/workflows/e3sm-gh-md-linter.yml +++ b/.github/workflows/e3sm-gh-md-linter.yml @@ -7,8 +7,6 @@ on: branches: ["master"] paths: - '**/*.md' - # for now let's not lint files in eamxx - - '!components/eamxx/**/*.md' concurrency: group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.run_id }} From 33038ef68c3f3e6134c4947414d91dbc251aebf4 Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Sat, 23 Nov 2024 10:13:00 -0500 Subject: [PATCH 340/529] Workflows: remove gh-standalone as it is covered by eamxx pr testing --- .github/workflows/eamxx-gh-ci-standalone.yml | 60 -------------------- 1 file changed, 60 deletions(-) delete mode 100644 .github/workflows/eamxx-gh-ci-standalone.yml diff --git a/.github/workflows/eamxx-gh-ci-standalone.yml b/.github/workflows/eamxx-gh-ci-standalone.yml deleted file mode 100644 index aded5d0c95b..00000000000 --- a/.github/workflows/eamxx-gh-ci-standalone.yml +++ /dev/null @@ -1,60 +0,0 @@ -name: gh-standalone - -on: - pull_request: - branches: [ master ] - paths: - # first, yes to these - - '.github/workflows/eamxx-gh-ci-standalone.yml' - - 'cime_config/machine/config_machines.xml' - - 'components/eamxx/**' - - 'components/homme/**' - # second, no to these - - '!components/eamxx/docs/**' - - '!components/eamxx/mkdocs.yml' - - workflow_dispatch: - -concurrency: - group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.run_id }} - cancel-in-progress: true - -jobs: - - ci: - if: ${{ github.repository == 'E3SM-Project/E3SM' }} - runs-on: ubuntu-latest - strategy: - fail-fast: false - matrix: - test: - - sp - - opt - - dbg - - fpe - container: - image: ghcr.io/e3sm-project/containers-standalone-ghci:standalone-ghci-0.1.1 - - steps: - - - name: Checkout - uses: actions/checkout@v4 - with: - show-progress: false - submodules: recursive - - - name: standalone - env: - SHELL: sh - run: | - # TODO: get rid of this extra line if we can? - git config --global safe.directory '*' - ./components/eamxx/scripts/test-all-scream -m ghci-oci -t ${{ matrix.test }} -c BUILD_SHARED_LIBS=ON - - - name: Artifacts - uses: actions/upload-artifact@v4 - if: ${{ always() }} - with: - name: ${{ matrix.test }} - path: | - components/eamxx/ctest-build/*/Testing/Temporary/Last*.log From 9a29e2ec65a1b694400ee3b4e4749d9eb22ebdc3 Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Sat, 23 Nov 2024 10:15:35 -0500 Subject: [PATCH 341/529] Workflows: make bartgol the integrator for dependabot updates --- .github/dependabot.yml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/.github/dependabot.yml b/.github/dependabot.yml index 4fb88c2dc67..94078c40720 100644 --- a/.github/dependabot.yml +++ b/.github/dependabot.yml @@ -7,9 +7,6 @@ updates: schedule: interval: "weekly" assignees: - - "rljacob" + - "bartgol" reviewers: - "mahf708" - - "bartgol" - labels: - - "AT: Integrate Without Testing" From 1373e9c45b6025492797de1e86612e3e470d9025 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Sat, 23 Nov 2024 16:12:53 -0800 Subject: [PATCH 342/529] EAMxx: add column reduction utility to fields --- .../eamxx/src/share/field/field_utils.hpp | 12 ++ .../share/field/field_utils_impl_colred.hpp | 123 ++++++++++++++++++ .../eamxx/src/share/tests/field_utils.cpp | 88 +++++++++++++ 3 files changed, 223 insertions(+) create mode 100644 components/eamxx/src/share/field/field_utils_impl_colred.hpp diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index 8f977a7caa1..b75effa9359 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -2,6 +2,7 @@ #define SCREAM_FIELD_UTILS_HPP #include "share/field/field_utils_impl.hpp" +#include "share/field/field_utils_impl_colred.hpp" namespace scream { @@ -111,6 +112,17 @@ void perturb (const Field& f, impl::perturb(f, engine, pdf, base_seed, level_mask, dof_gids); } +template +Field column_reduction(const Field &f1, const Field &f2, + const ekat::Comm *comm = nullptr) { + EKAT_REQUIRE_MSG(f1.is_allocated() && f2.is_allocated(), + "Error! Input fields must be allocated."); + EKAT_REQUIRE_MSG(f1.data_type() == f2.data_type(), + "Error! Input fields must have matching data types."); + + return impl::column_reduction(f1, f2, comm); +} + template ST frobenius_norm(const Field& f, const ekat::Comm* comm = nullptr) { diff --git a/components/eamxx/src/share/field/field_utils_impl_colred.hpp b/components/eamxx/src/share/field/field_utils_impl_colred.hpp new file mode 100644 index 00000000000..5a18b42b7a2 --- /dev/null +++ b/components/eamxx/src/share/field/field_utils_impl_colred.hpp @@ -0,0 +1,123 @@ +#ifndef SCREAM_FIELD_UTILS_IMPL_COLRED_HPP +#define SCREAM_FIELD_UTILS_IMPL_COLRED_HPP + +#include "ekat/kokkos/ekat_kokkos_utils.hpp" +#include "ekat/mpi/ekat_comm.hpp" +#include "share/field/field.hpp" + +namespace scream { +namespace impl { + +// Utility to compute the reduction of a field along its column dimension. +// This is equivalent to einsum('i,i...k->...k', f1, f2); i is the column. +// The layouts are such that: +// - The first dimension is for the columns (COL) +// - There can be only up to 3 dimensions + +template +Field column_reduction(const Field &f1, const Field &f2, const ekat::Comm *co) { + using KT = ekat::KokkosTypes; + using RangePolicy = Kokkos::RangePolicy; + using TeamPolicy = Kokkos::TeamPolicy; + using TeamMember = typename TeamPolicy::member_type; + using ESU = ekat::ExeSpaceUtils; + using namespace ShortFieldTagsNames; + + const auto &l1 = f1.get_header().get_identifier().get_layout(); + + EKAT_REQUIRE_MSG(l1.rank() == 1, + "Error! First field f1 must be rank-1.\n" + "The input has rank " + << l1.rank() << ".\n"); + EKAT_REQUIRE_MSG(l1.tags() == std::vector({COL}), + "Error! First field f1 must have a column dimension.\n" + "The input f1 layout is " + << l1.tags() << ".\n"); + + const auto &n2 = f2.get_header().get_identifier().name(); + const auto &l2 = f2.get_header().get_identifier().get_layout(); + const auto &u2 = f2.get_header().get_identifier().get_units(); + const auto &g2 = f2.get_header().get_identifier().get_grid_name(); + + EKAT_REQUIRE_MSG(l2.rank() <= 3, + "Error! Second field f2 must be at most rank-3.\n" + "The input f2 rank is " + << l2.rank() << ".\n"); + EKAT_REQUIRE_MSG(l2.tags()[0] == COL, + "Error! Second field f2 must have a column dimension.\n" + "The input f2 layout is " + << l2.tags() << ".\n"); + EKAT_REQUIRE_MSG( + l1.dim(0) == l2.dim(0), + "Error! The two input fields must have the same dimension along " + "which we are taking the reducing the field.\n" + "The first field f1 has dimension " + << l1.dim(0) + << " while " + "the second field f2 has dimension " + << l2.dim(0) << ".\n"); + + auto v1 = f1.get_view(); + + FieldIdentifier fo_id(n2 + "_colred", l2.clone().strip_dim(0), u2, g2); + Field fo(fo_id); + fo.allocate_view(); + fo.deep_copy(0); + + const int d0 = l2.dim(0); + + switch(l2.rank()) { + case 1: { + auto v2 = f2.get_view(); + auto vo = fo.get_view(); + Kokkos::parallel_reduce( + fo.name(), RangePolicy(0, d0), + KOKKOS_LAMBDA(const int i, ST &ls) { ls += v1(i) * v2(i); }, vo); + } break; + case 2: { + auto v2 = f2.get_view(); + auto vo = fo.get_view(); + const int d1 = l2.dim(1); + auto p = ESU::get_default_team_policy(d1, d0); + Kokkos::parallel_for( + fo.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int j = tm.league_rank(); + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, d0), + [&](int i, ST &ac) { ac += v1(i) * v2(i, j); }, vo(j)); + }); + } break; + case 3: { + auto v2 = f2.get_view(); + auto vo = fo.get_view(); + const int d1 = l2.dim(1); + const int d2 = l2.dim(2); + auto p = ESU::get_default_team_policy(d1 * d2, d0); + Kokkos::parallel_for( + fo.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int idx = tm.league_rank(); + const int j = idx / d2; + const int k = idx % d2; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, d0), + [&](int i, ST &ac) { ac += v1(i) * v2(i, j, k); }, vo(j, k)); + }); + } break; + default: + EKAT_ERROR_MSG("Error! Unsupported field rank.\n"); + } + + if(co) { + Kokkos::fence(); + fo.sync_to_host(); + co->all_reduce(fo.template get_internal_view_data(), + l2.size() / l2.dim(0), MPI_SUM); + fo.sync_to_dev(); + } + return fo; +} + +} // namespace impl +} // namespace scream + +#endif // SCREAM_FIELD_UTILS_IMPL_COLRED_HPP diff --git a/components/eamxx/src/share/tests/field_utils.cpp b/components/eamxx/src/share/tests/field_utils.cpp index f444ec75d52..052eaa07826 100644 --- a/components/eamxx/src/share/tests/field_utils.cpp +++ b/components/eamxx/src/share/tests/field_utils.cpp @@ -126,6 +126,94 @@ TEST_CASE("utils") { REQUIRE(field_sum(f1,&comm)==gsum); } + SECTION("column_reduction") { + using RPDF = std::uniform_real_distribution; + auto engine = setup_random_test(); + RPDF pdf(0, 1); + + int dim0 = 3; + int dim1 = 9; + int dim2 = 2; + FieldIdentifier f00("f", {{COL}, {dim0}}, m / s, "g"); + Field field00(f00); + field00.allocate_view(); + field00.sync_to_host(); + auto v00 = field00.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + v00(i) = (i + 1) / sp(6); + } + field00.sync_to_dev(); + + FieldIdentifier f10("f", {{COL, CMP}, {dim0, dim1}}, m / s, "g"); + FieldIdentifier f11("f", {{COL, LEV}, {dim0, dim2}}, m / s, "g"); + FieldIdentifier f20("f", {{COL, CMP, LEV}, {dim0, dim1, dim2}}, m / s, "g"); + + Field field10(f10); + Field field11(f11); + Field field20(f20); + field10.allocate_view(); + field11.allocate_view(); + field20.allocate_view(); + + randomize(field10, engine, pdf); + randomize(field11, engine, pdf); + randomize(field20, engine, pdf); + + FieldIdentifier F_x("fx", {{COL}, {dim1}}, m/s, "g"); + FieldIdentifier F_y("fy", {{LEV}, {dim2}}, m/s, "g"); + + Field field_x(F_x); + Field field_y(F_y); + + REQUIRE_THROWS(column_reduction(field00, field_x)); // x not allocated + + field_x.allocate_view(); + field_y.allocate_view(); + + REQUIRE_THROWS(column_reduction(field_x, field_y)); // unmatching layout + REQUIRE_THROWS(column_reduction(field11, field11)); // wrong f1 layout + + Field result; + + result = column_reduction(field00, field00); + result.sync_to_host(); + auto v = result.get_view(); + REQUIRE(v() == (1 / sp(36) + 4 / sp(36) + 9 / sp(36))); + + result = column_reduction(field00, field10); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({CMP})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); + + result = column_reduction(field00, field11); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({LEV})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim2); + + result = column_reduction(field00, field20); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({CMP, LEV})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); + REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim2); + + field20.sync_to_host(); + auto manual_result = result.clone(); + manual_result.deep_copy(0); + manual_result.sync_to_host(); + auto v2 = field20.get_strided_view(); + auto mr = manual_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim1; ++j) { + for(int k = 0; k < dim2; ++k) { + mr(j, k) += v00(i) * v2(i, j, k); + } + } + } + field20.sync_to_dev(); + manual_result.sync_to_dev(); + REQUIRE(views_are_equal(result, manual_result)); + } + SECTION ("frobenius") { auto v1 = f1.get_strided_view(); From 71b1a350fca3e7c96f0480e2bdea39af85f91e11 Mon Sep 17 00:00:00 2001 From: Youngsung Kim Date: Wed, 20 Nov 2024 13:19:33 -0500 Subject: [PATCH 343/529] Update Frontier machine and compilerconfigurations (Nov. 25 2024) * Changed from Core/24.07 to Core/24.00 * Changed from cmake/3.27.9 to cmake/3.21.3 * Restored '--allow-shlib-undefined --allow-multiple-definition' in CMAKE_EXE_LINKER_FLAGS * Removed 'craype-accel-amd-gfx90a' module load for amdclanggpu_frontier * Added two mosart source files into NOOPT_FILES to workaround to prevent optcg crayclanggpu build error --- cime_config/machines/Depends.crayclanggpu.cmake | 2 ++ .../cmake_macros/crayclanggpu_frontier.cmake | 3 +-- cime_config/machines/config_machines.xml | 16 +++++++++++----- 3 files changed, 14 insertions(+), 7 deletions(-) diff --git a/cime_config/machines/Depends.crayclanggpu.cmake b/cime_config/machines/Depends.crayclanggpu.cmake index eaff237a27f..3b0881ccd04 100644 --- a/cime_config/machines/Depends.crayclanggpu.cmake +++ b/cime_config/machines/Depends.crayclanggpu.cmake @@ -4,6 +4,8 @@ list(APPEND NOOPT_FILES elm/src/data_types/VegetationDataType.F90 elm/src/biogeochem/CNNitrogenFluxType.F90 elm/src/biogeochem/CNCarbonFluxType.F90 + mosart/src/wrm/WRM_subw_IO_mod.F90 + mosart/src/riverroute/RtmMod.F90 ) # Files added below to mitigate excessive compilation times diff --git a/cime_config/machines/cmake_macros/crayclanggpu_frontier.cmake b/cime_config/machines/cmake_macros/crayclanggpu_frontier.cmake index 92567416c56..49463844347 100644 --- a/cime_config/machines/cmake_macros/crayclanggpu_frontier.cmake +++ b/cime_config/machines/cmake_macros/crayclanggpu_frontier.cmake @@ -1,6 +1,5 @@ set(MPICC "cc") set(MPICXX "mpicxx") -#set(MPICXX "CC") set(MPIFC "ftn") set(SCC "cc") set(SCXX "hipcc") @@ -34,7 +33,7 @@ set(HAS_F2008_CONTIGUOUS "TRUE") # -Wl,--allow-shlib-undefined was added to address rocm 5.4.3 Fortran linker issue: # /opt/rocm-5.4.3/lib/libhsa-runtime64.so.1: undefined reference to `std::condition_variable::wait(std::unique_lock&)@GLIBCXX_3.4.30' # AMD started building with GCC 12.2.0, which brings in a GLIBCXX symbol that isn't in CCE's default GCC toolchain. -#string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,--allow-multiple-definition -Wl,--allow-shlib-undefined") +string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,--allow-shlib-undefined -Wl,--allow-multiple-definition") # Switching to O3 for performance benchmarking # Will revisit any failing tests diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index fce20fca185..f7b9f5ff487 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -1069,7 +1069,7 @@ /usr/share/lmod/lmod/libexec/lmod python - Core Core/24.07 + Core Core/24.00 PrgEnv-cray PrgEnv-cray/8.3.3 cce cce/15.0.1 @@ -1082,16 +1082,22 @@ - Core Core/24.07 + Core Core/24.00 PrgEnv-cray PrgEnv-amd/8.3.3 amd amd/5.4.0 + + + - Core Core/24.07 + Core Core/24.00 PrgEnv-cray PrgEnv-gnu/8.3.3 gcc gcc/12.2.0 @@ -1100,9 +1106,9 @@ rocm/5.4.0 - cray-python/3.11.5 + cray-python/3.9.13.1 cray-libsci - cmake/3.27.9 + cmake/3.21.3 subversion git zlib From 93ddbc72524232603762ee0d551cfdd03b9eabcf Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Mon, 25 Nov 2024 13:37:53 -0500 Subject: [PATCH 344/529] Pacer: clear unordered_map at finalization --- share/pacer/Pacer.cpp | 1 + 1 file changed, 1 insertion(+) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index e1555ef6da0..0045a9b3d12 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -193,6 +193,7 @@ bool Pacer::finalize() for (auto i = OpenTimers.begin(); i != OpenTimers.end(); i++) std::cerr << '\t' << i->first << std::endl; } + OpenTimers.clear(); return true; } From bbd39ee0159aaab594dc63a6977edcc89a18f1f2 Mon Sep 17 00:00:00 2001 From: Sarat Sreepathi Date: Mon, 25 Nov 2024 14:01:23 -0500 Subject: [PATCH 345/529] Pacer: Check duplicate init and clear state at finalization --- share/pacer/Pacer.cpp | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/share/pacer/Pacer.cpp b/share/pacer/Pacer.cpp index 0045a9b3d12..ac1ad329b54 100644 --- a/share/pacer/Pacer.cpp +++ b/share/pacer/Pacer.cpp @@ -51,6 +51,15 @@ bool Pacer::initialize(MPI_Comm InComm, PacerModeType InMode /* = PACER_STANDALO PacerMode = InMode; + // Check if already initialized and return + if (IsInitialized) + return true; + + // Duplicate comm and get MPI rank for both standalone and integrated modes + if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) + std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; + MPI_Comm_rank(InternalComm, &MyRank); + if (PacerMode == PACER_STANDALONE ) { // GPTL set default options PACER_CHECK_ERROR(GPTLsetoption(GPTLdepthlimit, 20)); @@ -62,10 +71,6 @@ bool Pacer::initialize(MPI_Comm InComm, PacerModeType InMode /* = PACER_STANDALO PACER_CHECK_ERROR(GPTLsetutr(GPTLmpiwtime)); - if (MPI_Comm_dup(InComm, &InternalComm) != MPI_SUCCESS) - std::cerr << "Pacer: Error duplicating MPI communicator" << std::endl; - MPI_Comm_rank(InternalComm, &MyRank); - errCode = GPTLinitialize(); if (errCode) { @@ -195,6 +200,10 @@ bool Pacer::finalize() } OpenTimers.clear(); + // Clear Pacer state and free communicator + IsInitialized = false; + MPI_Comm_free(&InternalComm); + return true; } From 1e3f3b9e7c2fc6b2e7ca469ef74941ce8be3a065 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Mon, 25 Nov 2024 15:21:48 -0600 Subject: [PATCH 346/529] Add call to zero out x2g_gx if the accum counter is 1 --- driver-mct/main/cime_comp_mod.F90 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index f9678b3e7c9..687050464a3 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -2523,6 +2523,7 @@ subroutine cime_run() logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep logical :: prep_glc_accum_avg_called ! Whether prep_glc_accum_avg has been called this timestep integer :: i, nodeId + integer :: l2gacc_lx_cnt character(len=15) :: c_ymdtod character(len=18) :: c_mprof_file @@ -3047,6 +3048,14 @@ subroutine cime_run() !---------------------------------------------------------- !| GLC SETUP-SEND !---------------------------------------------------------- + ! zero out x2g_gx if this is the first call to prep_glc_accum_avg + if (glc_present) then + l2gacc_lx_cnt = prep_glc_get_l2gacc_lx_cnt() + if (l2gacc_lx_cnt.eq.1) then + call prep_glc_zero_fields() + endif + endif + if (glc_present .and. glcrun_alarm) then call cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_called) endif @@ -3095,6 +3104,7 @@ subroutine cime_run() endif endif + !---------------------------------------------------------- !| Budget with old fractions !---------------------------------------------------------- @@ -4745,7 +4755,7 @@ subroutine cime_run_calc_budgets1(in_cplrun) call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_x2i=.true.) endif if (glc_present) then - !call seq_diag_glc_mct(glc(ens1), fractions_gx(ens1), infodata, do_x2g=.true., do_g2x=.true.) !SFP: comment out for now while debugging + call seq_diag_glc_mct(glc(ens1), fractions_gx(ens1), infodata, do_x2g=.true.) endif if (do_bgc_budgets) then if (rof_present) then @@ -4787,7 +4797,7 @@ subroutine cime_run_calc_budgets2(in_cplrun) call seq_diag_ice_mct(ice(ens1), fractions_ix(ens1), infodata, do_i2x=.true.) endif if (glc_present) then - call seq_diag_glc_mct(glc(ens1), fractions_gx(ens1), infodata, do_x2g=.true., do_g2x=.true.) + call seq_diag_glc_mct(glc(ens1), fractions_gx(ens1), infodata, do_g2x=.true.) endif if (do_bgc_budgets) then if (atm_present) then @@ -5596,3 +5606,4 @@ function copy_and_trim_rpointer_file(src, dst) result(out) end function copy_and_trim_rpointer_file end module cime_comp_mod + From 61c49ba2408aeaa2187d3beed5686b330eab182d Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Mon, 25 Nov 2024 15:24:32 -0600 Subject: [PATCH 347/529] Add l2gacc_lx_cnt_avg to count number of times used in averaging --- driver-mct/main/prep_glc_mod.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/driver-mct/main/prep_glc_mod.F90 b/driver-mct/main/prep_glc_mod.F90 index 07aeb9890bd..d2b309e5374 100644 --- a/driver-mct/main/prep_glc_mod.F90 +++ b/driver-mct/main/prep_glc_mod.F90 @@ -45,6 +45,7 @@ module prep_glc_mod public :: prep_glc_get_l2gacc_lx public :: prep_glc_get_l2gacc_lx_one_instance public :: prep_glc_get_l2gacc_lx_cnt + public :: prep_glc_get_l2gacc_lx_cnt_avg public :: prep_glc_get_o2x_gx public :: prep_glc_get_x2gacc_gx @@ -91,6 +92,7 @@ module prep_glc_mod type(mct_aVect), pointer :: l2gacc_lx(:) ! Lnd export, lnd grid, cpl pes - allocated in driver integer , target :: l2gacc_lx_cnt ! l2gacc_lx: number of time samples accumulated + integer , target :: l2gacc_lx_cnt_avg ! l2gacc_lx: number of time samples averaged ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -195,6 +197,7 @@ subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) call mct_aVect_zero(l2gacc_lx(eli)) end do l2gacc_lx_cnt = 0 + l2gacc_lx_cnt_avg = 0 end if if (glc_present .and. lnd_c2_glc) then @@ -502,6 +505,7 @@ subroutine prep_glc_accum_avg(timer, lnd2glc_averaged_now) call mct_avect_avg(l2gacc_lx(eli), l2gacc_lx_cnt) end do end if + l2gacc_lx_cnt_avg = l2gacc_lx_cnt l2gacc_lx_cnt = 0 ! Accumulation for OCN @@ -950,6 +954,7 @@ subroutine prep_glc_zero_fields() type(mct_avect), pointer :: x2g_gx !--------------------------------------------------------------- + do egi = 1,num_inst_glc x2g_gx => component_get_x2c_cx(glc(egi)) call mct_aVect_zero(x2g_gx) @@ -1424,6 +1429,11 @@ function prep_glc_get_l2gacc_lx_cnt() prep_glc_get_l2gacc_lx_cnt => l2gacc_lx_cnt end function prep_glc_get_l2gacc_lx_cnt + function prep_glc_get_l2gacc_lx_cnt_avg() + integer, pointer :: prep_glc_get_l2gacc_lx_cnt_avg + prep_glc_get_l2gacc_lx_cnt_avg => l2gacc_lx_cnt_avg + end function prep_glc_get_l2gacc_lx_cnt_avg + function prep_glc_get_o2x_gx() type(mct_aVect), pointer :: prep_glc_get_o2x_gx(:) prep_glc_get_o2x_gx => o2x_gx(:) From 8461481114698dfd3633aa1d4f32fae94ea30303 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Mon, 25 Nov 2024 15:27:48 -0600 Subject: [PATCH 348/529] Use l2gacc_lx_cnt_avg for calculating some glc budget terms --- driver-mct/main/seq_diag_mct.F90 | 30 +++++++++--------------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 94446a3a349..425ab1be517 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -48,7 +48,7 @@ module seq_diag_mct use shr_reprosum_mod, only : shr_reprosum_calc use seq_diagBGC_mct, only : seq_diagBGC_preprint_mct, seq_diagBGC_print_mct - use prep_glc_mod, only : prep_glc_get_x2gacc_gx_cnt + use prep_glc_mod, only : prep_glc_get_l2gacc_lx_cnt_avg use glc_elevclass_mod, only: glc_get_num_elevation_classes implicit none @@ -447,7 +447,7 @@ module seq_diag_mct integer :: index_x2i_Faxa_snow_HDO integer :: glc_nec - integer :: x2gacc_gx_cnt + integer :: l2gacc_lx_cnt_avg !=============================================================================== contains @@ -1319,7 +1319,7 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) !----- local ----- type(mct_aVect), pointer :: g2x_g - type(mct_aVect), pointer :: x2gacc_g + type(mct_aVect), pointer :: x2g_g type(mct_ggrid), pointer :: dom_g integer(in) :: n,ic,nf,ip ! generic index integer(in) :: kArea ! index of area field in aVect @@ -1327,7 +1327,6 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) real(r8) :: ca_g ! area of a grid cell logical,save :: first_time = .true. - integer,save :: counter,smb_counter,calving_counter ! SFP: Debugging integer,save :: smb_vector_length,calving_vector_length !----- formats ----- @@ -1343,7 +1342,7 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) dom_g => component_get_dom_cx(glc) g2x_g => component_get_c2x_cx(glc) - x2gacc_g => component_get_x2c_cx(glc) + x2g_g => component_get_x2c_cx(glc) ip = p_inst @@ -1351,7 +1350,6 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) if (first_time) then - calving_counter=0 calving_vector_length = 0 index_g2x_Fogg_rofl = mct_aVect_indexRA(g2x_g,'Fogg_rofl') @@ -1377,37 +1375,27 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) if( present(do_x2g))then ! do fields from coupler to glc (x2g_) - x2gacc_gx_cnt = prep_glc_get_x2gacc_gx_cnt() ! counter for how many times SMB flux accumulation has occured - ! note that this would be useful below but does not seem to work currently - ! (being reset to zero before being called here?) if (first_time) then - smb_counter=0 ! something like this (or above) needed to turn average flux - ! into accumulated flux (i.e., multiply average flux by no. of lnd coupling intervals) + index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') - index_x2g_Flgl_qice = mct_aVect_indexRA(x2gacc_g,'Flgl_qice') ! While name suggests this holds accumulated flux, - ! it appears to actually be the average flux (e.g. see - ! subroutine 'prep_glc_accum_avg' in prep_glc_mod.f90. - ! (also note that this same value gets copied to x2g_) end if + l2gacc_lx_cnt_avg = prep_glc_get_l2gacc_lx_cnt_avg() ! counter for how many times SMB flux accumulation has occured ic = c_glc_gs kArea = mct_aVect_indexRA(dom_g%data,afldname) - lSize = mct_avect_lSize(x2gacc_g) + lSize = mct_avect_lSize(x2g_g) do n=1,lSize ca_g = dom_g%data%rAttr(kArea,n) - nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2gacc_g%rAttr(index_x2g_Flgl_qice,n) + nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) end do - !budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * x2gacc_gx_cnt ! ideally use something like this for multiplying average flux - ! to get accumulated flux (but currently always zero) - budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * smb_counter ! works for now, but sloppy and only works for a 1 day run + budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) * l2gacc_lx_cnt_avg budg_dataL(f_hgsmb,ic,ip) = budg_dataL(f_wgsmb,ic,ip)*shr_const_latice smb_vector_length = smb_vector_length +lSize - smb_counter = smb_counter + 1 end if ! end do fields from coupler to glc (x2g_) From d98b0997b4db7d4e8594067f4a58258034e44f75 Mon Sep 17 00:00:00 2001 From: Chloe Date: Mon, 25 Nov 2024 13:46:53 -0800 Subject: [PATCH 349/529] mods to QICE long name --- components/elm/src/data_types/ColumnDataType.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/elm/src/data_types/ColumnDataType.F90 b/components/elm/src/data_types/ColumnDataType.F90 index fd1a17d74d6..460a1f71577 100644 --- a/components/elm/src/data_types/ColumnDataType.F90 +++ b/components/elm/src/data_types/ColumnDataType.F90 @@ -5852,17 +5852,17 @@ subroutine col_wf_init(this, begc, endc) if (create_glacier_mec_landunit) then this%qflx_glcice(begc:endc) = spval call hist_addfld1d (fname='QICE', units='mm/s', & - avgflag='A', long_name='ice growth/melt', & + avgflag='A', long_name='ice growth/melt (with active GLC/MECs)', & ptr_col=this%qflx_glcice, l2g_scale_type='ice') this%qflx_glcice_frz(begc:endc) = spval call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & - avgflag='A', long_name='ice growth', & + avgflag='A', long_name='ice growth (with active GLC/MECs)', & ptr_col=this%qflx_glcice_frz, l2g_scale_type='ice') this%qflx_glcice_melt(begc:endc) = spval call hist_addfld1d (fname='QICE_MELT', units='mm/s', & - avgflag='A', long_name='ice melt', & + avgflag='A', long_name='ice melt (with active GLC/MECs)', & ptr_col=this%qflx_glcice_melt, l2g_scale_type='ice') else this%qflx_glcice_diag(begc:endc) = spval From c522aad6933df6c2e175fd76af07ad3bf89e08f9 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Mon, 25 Nov 2024 16:16:59 -0700 Subject: [PATCH 350/529] minor fixes --- components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp | 8 ++++---- .../eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp | 8 ++++++-- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp index ff069032013..1f28173df8e 100644 --- a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp @@ -263,15 +263,15 @@ int main (int argc, char** argv) { for (int i = 1; i < argc-1; ++i) { if (ekat::argv_matches(argv[i], "-g", "--generate")) { generate = true; no_baseline = false; } if (ekat::argv_matches(argv[i], "-c", "--compare")) { no_baseline = false; } - if (ekat::argv_matches(argv[i], "-t", "--tol")) { + if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) { expect_another_arg(i, argc); ++i; - tol = std::atof(argv[i]); + baseline_fn = argv[i]; } - if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) { + if (ekat::argv_matches(argv[i], "-t", "--tol")) { expect_another_arg(i, argc); ++i; - baseline_fn = argv[i]; + tol = std::atof(argv[i]); } if (ekat::argv_matches(argv[i], "-s", "--steps")) { expect_another_arg(i, argc); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp index 529d352dea4..fe28e77e1ad 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp @@ -217,7 +217,7 @@ int main (int argc, char** argv) { return 1; } - bool generate = false, no_baseline = false; + bool generate = false, no_baseline = true; scream::Real tol = SCREAM_BFB_TESTING ? 0 : std::numeric_limits::infinity(); Int nsteps = 10; Int dt = 150; @@ -294,7 +294,11 @@ int main (int argc, char** argv) { if (generate) { std::cout << "Generating to " << baseline_fn << "\n"; nerr += bln.generate_baseline(baseline_fn); - } else { + } else if (no_baseline) { + printf("Running with no baseline actions\n"); + nerr += bln.run_and_cmp(baseline_fn, tol, no_baseline); + } + else { printf("Comparing with %s at tol %1.1e\n", baseline_fn.c_str(), tol); nerr += bln.run_and_cmp(baseline_fn, tol, no_baseline); } From 203df58e67448429f07ff9af7d77121b8494fd62 Mon Sep 17 00:00:00 2001 From: xie7 Date: Mon, 25 Nov 2024 17:39:41 -0800 Subject: [PATCH 351/529] Minor edits on orodrag documentation. modified: tech-guide/orodrag.md modified: user-guide/namelist_parameters.md [BFB] --- components/eam/docs/tech-guide/orodrag.md | 6 +++--- components/eam/docs/user-guide/namelist_parameters.md | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/components/eam/docs/tech-guide/orodrag.md b/components/eam/docs/tech-guide/orodrag.md index 8c6df04eae2..f71fc07f282 100644 --- a/components/eam/docs/tech-guide/orodrag.md +++ b/components/eam/docs/tech-guide/orodrag.md @@ -2,17 +2,17 @@ ## Overview -The orographic drag schemes includes two main options: the default Gravity Wave Drag schemeof McFarlane (1987)[@mcfarlane_the_1987] and a new suite of orographic drag parameterization schemes. The new suite includes 4 components all combined in one module (i.e. subroutine gwdo2d). The schemes include orographic gravity wave drag (oGWD, Xie et al.,2020)[@xie_an_2020], flow-blocking drag (FBD, Xie et al.,2020)[@xie_an_2020], small-scale GWD (sGWD, Tsiringakis et al.,2017)[@tsiringakis_small_2020], and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004)[@beljaars_a_2020]. The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987)[@mcfarlane_the_1987] and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010)[@richter_the_2010] module in EAM, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. The conceptual location of each scheme is illustrate below. +The orographic drag schemes includes two main options: the default Gravity Wave Drag scheme of McFarlane (1987)[@mcfarlane_the_1987] and a new suite of orographic drag parameterization schemes. The new suite includes 4 components all combined in one module (i.e. subroutine gwdo2d). The schemes include orographic gravity wave drag (oGWD, Xie et al.,2020)[@xie_an_2020], flow-blocking drag (FBD, Xie et al.,2020)[@xie_an_2020], small-scale GWD (sGWD, Tsiringakis et al.,2017)[@tsiringakis_small_2020], and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004)[@beljaars_a_2020]. The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987)[@mcfarlane_the_1987] and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010)[@richter_the_2010] module in EAM, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. The conceptual location of each scheme is illustrate below. Currently, only the scheme of McFarlane (1987) is opened as default in E3SMv3.0. ![orodrag figure](../figures/orodrag.png) ### Default oGWD scheme -The current default oGWD scheme in E3SMv3 is from McFarlane (1987)[@mcfarlane_the_1987]. It is a linear orographic gravity wave drag scheme that parameterizes the subgrid process of vertical propagation of gravity wave originated from orographic source. The output from this scheme is a vertical profile of drag (or deceleration terms) when gravity wave breaks at higher levels and deposit momemtum flux to that level. This scheme is shown to have impact on excessive westerly wind in the extratropics and the wind bias in the polar region. +The current default oGWD scheme in E3SMv3.0 is from McFarlane (1987)[@mcfarlane_the_1987]. It is a linear orographic gravity wave drag scheme that parameterizes the subgrid process of vertical propagation of gravity wave originating from orographic source. The output from this scheme is a vertical profile of drag (or deceleration terms) when gravity wave breaks at higher levels and deposits momemtum flux to that level. This scheme is shown to have improve the excessive westerly wind bias in the extratropics and the wind bias in the polar region. This scheme is turned on by default in E3SMv3.0. ### Default TMS scheme -The turbulent mountain stress (TMS) scheme parameterizes is documented on Richter et al.,(2010)[@richter_the_2010]. It parameterizes the turbulent scale form drag (TOFD) through adding enhanced effective roughness length to the model. This method is justified by the observation that area-averaged wind sufficiently far above hilly terrain behave logarithmically. It leads to significant decrease of overspeed surface wind in the model. It is turned OFF in E3SMv3.0. +The turbulent mountain stress (TMS) scheme is documented on Richter et al.,(2010)[@richter_the_2010]. It parameterizes the turbulent scale form drag (TOFD) through adding enhanced effective roughness length to the model. This method is justified by the observation that area-averaged wind sufficiently far above hilly terrain behave logarithmically. It leads to significant decrease of overspeed surface wind in the model. It is turned OFF in E3SMv3.0. ### New oGWD scheme diff --git a/components/eam/docs/user-guide/namelist_parameters.md b/components/eam/docs/user-guide/namelist_parameters.md index 73d3c262fff..8aa4b40299c 100644 --- a/components/eam/docs/user-guide/namelist_parameters.md +++ b/components/eam/docs/user-guide/namelist_parameters.md @@ -166,10 +166,10 @@ | `effgw_oro` | Efficiency associated with orographic gravity waves. | `0.375` | | `tms_orocnst` | Turbulent mountain stress parameter used when TMS calculation is turned on | `1.0` | | `tms_z0fac` | Factor determining z_0 from orographic standard deviation [ no unit ] for TMS. | `0.75` | -| `use_od_ls` | This namelist controls the new nonlinear oGWD, if used, the nonlinear oGWD is turned on. use_od_ls should not be used at the same time with use_gw_oro. | `true` | -| `use_od_bl` | This namelist controls the Flow-blocking drag (FBD) scheme, if used, the FBD scheme is turned on. | `true` | -| `use_od_ss` | This namelist controls the small-scale GWD (sGWD) scheme, if used, the sGWD scheme is turned on. | `true` | -| `use_od_fd` | This namelist controls the Turbulent orographic form drag (TOFD) scheme, if used, the TOFD scheme is turned on. | `true` | +| `use_od_ls` | This namelist controls the new nonlinear oGWD, if used, the nonlinear oGWD is turned on. use_od_ls should not be used at the same time with use_gw_oro. | `false` | +| `use_od_bl` | This namelist controls the Flow-blocking drag (FBD) scheme, if used, the FBD scheme is turned on. | `false` | +| `use_od_ss` | This namelist controls the small-scale GWD (sGWD) scheme, if used, the sGWD scheme is turned on. | `false` | +| `use_od_fd` | This namelist controls the Turbulent orographic form drag (TOFD) scheme, if used, the TOFD scheme is turned on. | `false` | | `od_ls_ncleff` | Tuning parameter of nonlinear oGWD. Stands for effective resolution of the grid for oGWD. Scales the magnitude of nonlinear oGWD. | `3` | | `od_bl_ncd` | Tuning parameter of FBD. Stands for bulk drag coefficient. Scales the magnitude of FBD. | `3` | | `od_ss_sncleff` | Tuning parameter of sGWD. Stands for effective resolution of the grid for sGWD.Scales the magnitude of sGWD. | `1` | From 30e29fc1da9f49b74923a2f9702823c6b1a7cf1d Mon Sep 17 00:00:00 2001 From: mahf708 Date: Mon, 25 Nov 2024 20:42:52 -0500 Subject: [PATCH 352/529] remove obsolete inputdata testing script --- .../cime_config/tests/eamxx_default_files.py | 99 ------------------- 1 file changed, 99 deletions(-) delete mode 100644 components/eamxx/cime_config/tests/eamxx_default_files.py diff --git a/components/eamxx/cime_config/tests/eamxx_default_files.py b/components/eamxx/cime_config/tests/eamxx_default_files.py deleted file mode 100644 index b39d2d5c155..00000000000 --- a/components/eamxx/cime_config/tests/eamxx_default_files.py +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/env python3 - -import os -import http -import pathlib -import unittest -import urllib.request -import xml.etree.ElementTree as ET - - -class testNamelistDefaultsScream(unittest.TestCase): - def setUp(self): - """ - Set up the environment for the test by setting the DIN_LOC_ROOT - environment variable. Parse the 'namelist_defaults_scream.xml' - file and extract the files of interest based on the DIN_LOC_ROOT - variable or the array(file) type. Assign the extracted files - to the 'my_files' attribute of the test instance. - """ - - os.environ["DIN_LOC_ROOT"] = "https://web.lcrc.anl.gov/public/e3sm/inputdata/" - - scream_defaults_path = pathlib.Path(__file__) - tree = ET.parse(f"{scream_defaults_path.parent.parent}/namelist_defaults_scream.xml") - root = tree.getroot() - - files_of_interest = [ - child.text for child in root.findall(".//") - if child.text and child.text.startswith("${DIN_LOC_ROOT}") - ] - - more_files_of_interest = [ - child.text for child in root.findall(".//") - if child.text and "type" in child.attrib.keys() and child.attrib["type"]=="array(file)" - ] - - files_of_interest.extend( - text.strip() for text_list in more_files_of_interest for text in text_list.split(",") - if text.strip().startswith("${DIN_LOC_ROOT}") - ) - - self.my_files = [ - file.replace("${DIN_LOC_ROOT}/", "") - for file in files_of_interest - ] - - self.my_lines = [] - with open( - f"{scream_defaults_path.parent.parent}/namelist_defaults_scream.xml", - "r" - ) as the_file: - for a_line in the_file: - self.my_lines.append(a_line) - - def test_ascii_lines(self): - """ - Test that all lines are ASCII - """ - - for i_line, a_line in enumerate(self.my_lines): - with self.subTest(i_line=i_line): - self.assertTrue( - a_line.isascii(), - msg=f"\nERROR! This line is not ASCII!\n{a_line}" - ) - - def test_opening_files(self): - """ - Test the opening of files from the inputdata server. - """ - - for i_file in range(len(self.my_files)): - with self.subTest(i_file=i_file): - try: - request_return = urllib.request.urlopen( - f"{os.environ['DIN_LOC_ROOT']}{self.my_files[i_file]}" - ) - self.assertIsInstance(request_return, http.client.HTTPResponse) - except urllib.error.HTTPError: - file_name = f"{os.environ['DIN_LOC_ROOT']}{self.my_files[i_file]}" - self.assertTrue( - False, - msg=f"\nERROR! This file doesn't exist!\n{file_name}" - ) - - def test_expected_fail(self): - """ - Test an expected failure by manipulating the file name. - """ - - with self.assertRaises(urllib.error.HTTPError): - some_phony_file = f"{self.my_files[5][:-5]}some_phony_file.nc" - urllib.request.urlopen( - f"{os.environ['DIN_LOC_ROOT']}{some_phony_file}" - ) - - -if __name__ == '__main__': - unittest.main() From 7bd74c698287050a42113790cae376fb7bf09b37 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Mon, 25 Nov 2024 20:35:18 -0600 Subject: [PATCH 353/529] Add logic to make sure glc_nec is at least one --- driver-mct/main/seq_diag_mct.F90 | 36 +++++++++++++++++++------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 425ab1be517..00ef16dcd77 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -917,9 +917,11 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) ! get number of elevation classes and allocate relevant sets of indices glc_nec = glc_get_num_elevation_classes() - if (first_time) then - allocate(index_l2x_Flgl_qice(0:glc_nec)) - allocate(index_x2l_Sg_ice_covered(0:glc_nec)) + if (glc_nec.ge.1) then + if (first_time) then + allocate(index_l2x_Flgl_qice(0:glc_nec)) + allocate(index_x2l_Sg_ice_covered(0:glc_nec)) + end if end if if (present(do_l2x)) then @@ -937,13 +939,15 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_irrig = mct_aVect_indexRA(l2x_l,'Flrl_irrig', perrWith='quiet') index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') - do num=0,glc_nec - write(cnum,'(i2.2)') num - name = 'Flgl_qice' // cnum - index_l2x_Flgl_qice(num) = mct_avect_indexRA(l2x_l,trim(name)) - name = 'Sg_ice_covered' // cnum - index_x2l_Sg_ice_covered(num) = mct_avect_indexRA(x2l_l,trim(name)) - end do + if (glc_nec.ge.1) then + do num=0,glc_nec + write(cnum,'(i2.2)') num + name = 'Flgl_qice' // cnum + index_l2x_Flgl_qice(num) = mct_avect_indexRA(l2x_l,trim(name)) + name = 'Sg_ice_covered' // cnum + index_x2l_Sg_ice_covered(num) = mct_avect_indexRA(x2l_l,trim(name)) + end do + end if index_l2x_Fall_evap_16O = mct_aVect_indexRA(l2x_l,'Fall_evap_16O',perrWith='quiet') if ( index_l2x_Fall_evap_16O /= 0 ) flds_wiso_lnd = .true. @@ -981,11 +985,13 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) nf = f_wioff ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - ca_l*l2x_l%rAttr(index_l2x_Flrl_rofi,n) ! contribution from land ice calving currently zero l2x_Flgl_qice_col_sum = 0.0d0 - do num=0,glc_nec - ! sums the contributions from fluxes in each set of elevation classes - ! RHS product is flux times fraction of area in specific elevation class times land cell area - l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) * ca_l - end do + if (glc_nec.ge.1) then + do num=0,glc_nec + ! sums the contributions from fluxes in each set of elevation classes + ! RHS product is flux times fraction of area in specific elevation class times land cell area + l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) * ca_l + end do + end if nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - l2x_Flgl_qice_col_sum if ( flds_wiso_lnd )then From 31d46ed3414f9f0944977572ea7e2e17f95066e0 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Mon, 25 Nov 2024 20:39:19 -0600 Subject: [PATCH 354/529] Fix trailing white space --- driver-mct/main/seq_diag_mct.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 00ef16dcd77..26d21a2879a 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -940,12 +940,12 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') if (glc_nec.ge.1) then - do num=0,glc_nec + do num=0,glc_nec write(cnum,'(i2.2)') num name = 'Flgl_qice' // cnum index_l2x_Flgl_qice(num) = mct_avect_indexRA(l2x_l,trim(name)) name = 'Sg_ice_covered' // cnum - index_x2l_Sg_ice_covered(num) = mct_avect_indexRA(x2l_l,trim(name)) + index_x2l_Sg_ice_covered(num) = mct_avect_indexRA(x2l_l,trim(name)) end do end if From 84d85663490c454e1426acaf0f2d07cf512a7d66 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Mon, 25 Nov 2024 17:50:05 -0800 Subject: [PATCH 355/529] EAMxx: rework horizontal contraction utility impl --- .../eamxx/src/share/field/field_utils.hpp | 109 +++++++++++++++- .../src/share/field/field_utils_impl.hpp | 72 ++++++++++ .../share/field/field_utils_impl_colred.hpp | 123 ------------------ .../eamxx/src/share/tests/field_utils.cpp | 56 ++++++-- 4 files changed, 219 insertions(+), 141 deletions(-) delete mode 100644 components/eamxx/src/share/field/field_utils_impl_colred.hpp diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index b75effa9359..57e06241078 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -2,7 +2,6 @@ #define SCREAM_FIELD_UTILS_HPP #include "share/field/field_utils_impl.hpp" -#include "share/field/field_utils_impl_colred.hpp" namespace scream { @@ -112,15 +111,111 @@ void perturb (const Field& f, impl::perturb(f, engine, pdf, base_seed, level_mask, dof_gids); } +// Utility to compute the contraction of a field along its column dimension. +// This is equivalent to einsum('i,i...k->...k', weight, f_in); i is the column. +// The layouts are such that: +// - The first dimension is for the columns (COL) +// - There can be only up to 3 dimensions template -Field column_reduction(const Field &f1, const Field &f2, +Field horiz_contraction(const Field &f_in, const Field *weight = nullptr, + const ekat::Comm *comm = nullptr) { + const auto &l_in = f_in.get_header().get_identifier().get_layout(); + const auto &n_in = f_in.get_header().get_identifier().name(); + const auto &u_in = f_in.get_header().get_identifier().get_units(); + const auto &g_in = f_in.get_header().get_identifier().get_grid_name(); + + FieldIdentifier f_out_id(n_in + "_horiz_contraction", + l_in.clone().strip_dim(0), u_in, g_in); + // Allocate the output field + Field f_out(f_out_id); + f_out.allocate_view(); + f_out.deep_copy(0); + + // Call the implementation + horiz_contraction(f_out, f_in, weight, comm); + return f_out; +} + +template +void horiz_contraction(const Field &f_out, const Field &f_in, + const Field *weight = nullptr, const ekat::Comm *comm = nullptr) { - EKAT_REQUIRE_MSG(f1.is_allocated() && f2.is_allocated(), - "Error! Input fields must be allocated."); - EKAT_REQUIRE_MSG(f1.data_type() == f2.data_type(), - "Error! Input fields must have matching data types."); + using namespace ShortFieldTagsNames; + + const auto &l_out = f_out.get_header().get_identifier().get_layout(); + const auto &l_in = f_in.get_header().get_identifier().get_layout(); + const auto &n_in = f_in.get_header().get_identifier().name(); + const auto &u_in = f_in.get_header().get_identifier().get_units(); + const auto &g_in = f_in.get_header().get_identifier().get_grid_name(); + + // If weight is not provided, we set it as a field of ones + Field wt; + if(weight) { + wt = *weight; + } else { + FieldIdentifier wt_id(n_in + "_weight", {{COL}, {l_in.dim(0)}}, u_in, g_in); + wt = Field(wt_id); + wt.allocate_view(); + wt.deep_copy(1); + } - return impl::column_reduction(f1, f2, comm); + const auto &l_w = wt.get_header().get_identifier().get_layout(); + + // Sanity checks before handing off to the implementation + EKAT_REQUIRE_MSG(l_w.rank() == 1, + "Error! The weight field must be rank-1.\n" + "The input has rank " + << l_w.rank() << ".\n"); + EKAT_REQUIRE_MSG(l_w.tags() == std::vector({COL}), + "Error! The weight field must have a column dimension.\n" + "The input f1 layout is " + << l_w.tags() << ".\n"); + EKAT_REQUIRE_MSG(l_in.rank() <= 3, + "Error! The input field must be at most rank-3.\n" + "The input f_in rank is " + << l_in.rank() << ".\n"); + EKAT_REQUIRE_MSG(l_in.tags()[0] == COL, + "Error! The input field must have a column dimension.\n" + "The input f_in layout is " + << l_in.to_string() << ".\n"); + EKAT_REQUIRE_MSG( + l_w.dim(0) == l_in.dim(0), + "Error! input and weight fields must have the same dimension along " + "which we are taking the reducing the field.\n" + "The weight field has dimension " + << l_w.dim(0) + << " while " + "the input field has dimension " + << l_in.dim(0) << ".\n"); + EKAT_REQUIRE_MSG( + l_in.dim(0) > 0, + "Error! The input field must have a non-zero column dimension.\n" + "The input f_in layout is " + << l_in.to_string() << ".\n"); + EKAT_REQUIRE_MSG( + l_out.rank() == l_in.rank() - 1, + "Error! The output field must have rank one less than the input field.\n" + "The input f_in rank is " + << l_in.rank() << " and the output f_out rank is " << l_out.rank() + << ".\n"); + EKAT_REQUIRE_MSG( + l_out == l_in.clone().strip_dim(0), + "Error! The output field must have the same layout as the input field " + "without the column dimension.\n" + "The input f_in layout is " + << l_in.to_string() << " and the output f_out layout is " + << l_out.to_string() << ".\n"); + EKAT_REQUIRE_MSG( + f_out.is_allocated() && f_in.is_allocated() && wt.is_allocated(), + "Error! All fields must be allocated."); + EKAT_REQUIRE_MSG(f_out.data_type() == f_in.data_type(), + "Error! In/out Fields have matching data types."); + EKAT_REQUIRE_MSG( + f_out.data_type() == wt.data_type(), + "Error! Weight field must have the same data type as input fields."); + + // All good, call the implementation + impl::horiz_contraction(f_out, f_in, wt, comm); } template diff --git a/components/eamxx/src/share/field/field_utils_impl.hpp b/components/eamxx/src/share/field/field_utils_impl.hpp index eaedb1f62dd..292db33094d 100644 --- a/components/eamxx/src/share/field/field_utils_impl.hpp +++ b/components/eamxx/src/share/field/field_utils_impl.hpp @@ -5,6 +5,8 @@ #include "ekat/mpi/ekat_comm.hpp" +#include "ekat/kokkos/ekat_kokkos_utils.hpp" + #include #include @@ -293,6 +295,76 @@ void perturb (const Field& f, } } +template +void horiz_contraction(const Field &f_out, const Field &f_in, + const Field &weight, const ekat::Comm *comm) { + using KT = ekat::KokkosTypes; + using RangePolicy = Kokkos::RangePolicy; + using TeamPolicy = Kokkos::TeamPolicy; + using TeamMember = typename TeamPolicy::member_type; + using ESU = ekat::ExeSpaceUtils; + + auto l_out = f_out.get_header().get_identifier().get_layout(); + auto l_in = f_in.get_header().get_identifier().get_layout(); + const int ncols = l_in.dim(0); + + auto v_w = weight.get_view(); + + switch(l_in.rank()) { + case 1: { + auto v_in = f_in.get_view(); + auto v_out = f_out.get_view(); + Kokkos::parallel_reduce( + f_out.name(), RangePolicy(0, ncols), + KOKKOS_LAMBDA(const int i, ST &ls) { ls += v_w(i) * v_in(i); }, + v_out); + } break; + case 2: { + auto v_in = f_in.get_view(); + auto v_out = f_out.get_view(); + const int d1 = l_in.dim(1); + auto p = ESU::get_default_team_policy(d1, ncols); + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int j = tm.league_rank(); + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, ncols), + [&](int i, ST &ac) { ac += v_w(i) * v_in(i, j); }, v_out(j)); + }); + } break; + case 3: { + auto v_in = f_in.get_view(); + auto v_out = f_out.get_view(); + const int d1 = l_in.dim(1); + const int d2 = l_in.dim(2); + auto p = ESU::get_default_team_policy(d1 * d2, ncols); + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int idx = tm.league_rank(); + const int j = idx / d2; + const int k = idx % d2; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, ncols), + [&](int i, ST &ac) { ac += v_w(i) * v_in(i, j, k); }, + v_out(j, k)); + }); + } break; + default: + EKAT_ERROR_MSG("Error! Unsupported field rank.\n"); + } + + if(comm) { + // TODO: use device-side MPI calls + // TODO: the dev ptr seems to cause problems; revisit this later + // TODO: doing cuda-aware MPI allreduce would be ~10% faster + Kokkos::fence(); + f_out.sync_to_host(); + comm->all_reduce(f_out.template get_internal_view_data(), + l_out.size(), MPI_SUM); + f_out.sync_to_dev(); + } +} + template ST frobenius_norm(const Field& f, const ekat::Comm* comm) { diff --git a/components/eamxx/src/share/field/field_utils_impl_colred.hpp b/components/eamxx/src/share/field/field_utils_impl_colred.hpp deleted file mode 100644 index 5a18b42b7a2..00000000000 --- a/components/eamxx/src/share/field/field_utils_impl_colred.hpp +++ /dev/null @@ -1,123 +0,0 @@ -#ifndef SCREAM_FIELD_UTILS_IMPL_COLRED_HPP -#define SCREAM_FIELD_UTILS_IMPL_COLRED_HPP - -#include "ekat/kokkos/ekat_kokkos_utils.hpp" -#include "ekat/mpi/ekat_comm.hpp" -#include "share/field/field.hpp" - -namespace scream { -namespace impl { - -// Utility to compute the reduction of a field along its column dimension. -// This is equivalent to einsum('i,i...k->...k', f1, f2); i is the column. -// The layouts are such that: -// - The first dimension is for the columns (COL) -// - There can be only up to 3 dimensions - -template -Field column_reduction(const Field &f1, const Field &f2, const ekat::Comm *co) { - using KT = ekat::KokkosTypes; - using RangePolicy = Kokkos::RangePolicy; - using TeamPolicy = Kokkos::TeamPolicy; - using TeamMember = typename TeamPolicy::member_type; - using ESU = ekat::ExeSpaceUtils; - using namespace ShortFieldTagsNames; - - const auto &l1 = f1.get_header().get_identifier().get_layout(); - - EKAT_REQUIRE_MSG(l1.rank() == 1, - "Error! First field f1 must be rank-1.\n" - "The input has rank " - << l1.rank() << ".\n"); - EKAT_REQUIRE_MSG(l1.tags() == std::vector({COL}), - "Error! First field f1 must have a column dimension.\n" - "The input f1 layout is " - << l1.tags() << ".\n"); - - const auto &n2 = f2.get_header().get_identifier().name(); - const auto &l2 = f2.get_header().get_identifier().get_layout(); - const auto &u2 = f2.get_header().get_identifier().get_units(); - const auto &g2 = f2.get_header().get_identifier().get_grid_name(); - - EKAT_REQUIRE_MSG(l2.rank() <= 3, - "Error! Second field f2 must be at most rank-3.\n" - "The input f2 rank is " - << l2.rank() << ".\n"); - EKAT_REQUIRE_MSG(l2.tags()[0] == COL, - "Error! Second field f2 must have a column dimension.\n" - "The input f2 layout is " - << l2.tags() << ".\n"); - EKAT_REQUIRE_MSG( - l1.dim(0) == l2.dim(0), - "Error! The two input fields must have the same dimension along " - "which we are taking the reducing the field.\n" - "The first field f1 has dimension " - << l1.dim(0) - << " while " - "the second field f2 has dimension " - << l2.dim(0) << ".\n"); - - auto v1 = f1.get_view(); - - FieldIdentifier fo_id(n2 + "_colred", l2.clone().strip_dim(0), u2, g2); - Field fo(fo_id); - fo.allocate_view(); - fo.deep_copy(0); - - const int d0 = l2.dim(0); - - switch(l2.rank()) { - case 1: { - auto v2 = f2.get_view(); - auto vo = fo.get_view(); - Kokkos::parallel_reduce( - fo.name(), RangePolicy(0, d0), - KOKKOS_LAMBDA(const int i, ST &ls) { ls += v1(i) * v2(i); }, vo); - } break; - case 2: { - auto v2 = f2.get_view(); - auto vo = fo.get_view(); - const int d1 = l2.dim(1); - auto p = ESU::get_default_team_policy(d1, d0); - Kokkos::parallel_for( - fo.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { - const int j = tm.league_rank(); - Kokkos::parallel_reduce( - Kokkos::TeamVectorRange(tm, d0), - [&](int i, ST &ac) { ac += v1(i) * v2(i, j); }, vo(j)); - }); - } break; - case 3: { - auto v2 = f2.get_view(); - auto vo = fo.get_view(); - const int d1 = l2.dim(1); - const int d2 = l2.dim(2); - auto p = ESU::get_default_team_policy(d1 * d2, d0); - Kokkos::parallel_for( - fo.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { - const int idx = tm.league_rank(); - const int j = idx / d2; - const int k = idx % d2; - Kokkos::parallel_reduce( - Kokkos::TeamVectorRange(tm, d0), - [&](int i, ST &ac) { ac += v1(i) * v2(i, j, k); }, vo(j, k)); - }); - } break; - default: - EKAT_ERROR_MSG("Error! Unsupported field rank.\n"); - } - - if(co) { - Kokkos::fence(); - fo.sync_to_host(); - co->all_reduce(fo.template get_internal_view_data(), - l2.size() / l2.dim(0), MPI_SUM); - fo.sync_to_dev(); - } - return fo; -} - -} // namespace impl -} // namespace scream - -#endif // SCREAM_FIELD_UTILS_IMPL_COLRED_HPP diff --git a/components/eamxx/src/share/tests/field_utils.cpp b/components/eamxx/src/share/tests/field_utils.cpp index 052eaa07826..ef7fad074d4 100644 --- a/components/eamxx/src/share/tests/field_utils.cpp +++ b/components/eamxx/src/share/tests/field_utils.cpp @@ -126,7 +126,7 @@ TEST_CASE("utils") { REQUIRE(field_sum(f1,&comm)==gsum); } - SECTION("column_reduction") { + SECTION("horiz_contraction") { using RPDF = std::uniform_real_distribution; auto engine = setup_random_test(); RPDF pdf(0, 1); @@ -134,6 +134,8 @@ TEST_CASE("utils") { int dim0 = 3; int dim1 = 9; int dim2 = 2; + + // Set a weight field FieldIdentifier f00("f", {{COL}, {dim0}}, m / s, "g"); Field field00(f00); field00.allocate_view(); @@ -144,10 +146,10 @@ TEST_CASE("utils") { } field00.sync_to_dev(); + // Create (random) sample fields FieldIdentifier f10("f", {{COL, CMP}, {dim0, dim1}}, m / s, "g"); FieldIdentifier f11("f", {{COL, LEV}, {dim0, dim2}}, m / s, "g"); FieldIdentifier f20("f", {{COL, CMP, LEV}, {dim0, dim1, dim2}}, m / s, "g"); - Field field10(f10); Field field11(f11); Field field20(f20); @@ -159,43 +161,49 @@ TEST_CASE("utils") { randomize(field11, engine, pdf); randomize(field20, engine, pdf); - FieldIdentifier F_x("fx", {{COL}, {dim1}}, m/s, "g"); - FieldIdentifier F_y("fy", {{LEV}, {dim2}}, m/s, "g"); + FieldIdentifier F_x("fx", {{COL}, {dim1}}, m / s, "g"); + FieldIdentifier F_y("fy", {{LEV}, {dim2}}, m / s, "g"); Field field_x(F_x); Field field_y(F_y); - REQUIRE_THROWS(column_reduction(field00, field_x)); // x not allocated + // Test invalid inputs + REQUIRE_THROWS( + horiz_contraction(field_x, &field00)); // x not allocated field_x.allocate_view(); field_y.allocate_view(); - REQUIRE_THROWS(column_reduction(field_x, field_y)); // unmatching layout - REQUIRE_THROWS(column_reduction(field11, field11)); // wrong f1 layout + REQUIRE_THROWS( + horiz_contraction(field_y, &field_x)); // unmatching layout + REQUIRE_THROWS( + horiz_contraction(field11, &field11)); // wrong f1 layout Field result; - result = column_reduction(field00, field00); + // Ensure a scalar case works + result = horiz_contraction(field00, &field00); result.sync_to_host(); auto v = result.get_view(); REQUIRE(v() == (1 / sp(36) + 4 / sp(36) + 9 / sp(36))); - result = column_reduction(field00, field10); + result = horiz_contraction(field10, &field00); REQUIRE(result.get_header().get_identifier().get_layout().tags() == std::vector({CMP})); REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); - result = column_reduction(field00, field11); + result = horiz_contraction(field11, &field00); REQUIRE(result.get_header().get_identifier().get_layout().tags() == std::vector({LEV})); REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim2); - result = column_reduction(field00, field20); + result = horiz_contraction(field20, &field00); REQUIRE(result.get_header().get_identifier().get_layout().tags() == std::vector({CMP, LEV})); REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim2); + // Check a 3D case field20.sync_to_host(); auto manual_result = result.clone(); manual_result.deep_copy(0); @@ -212,6 +220,32 @@ TEST_CASE("utils") { field20.sync_to_dev(); manual_result.sync_to_dev(); REQUIRE(views_are_equal(result, manual_result)); + + // Test overloaded function with already allocated output field + auto another_result = result.clone(); + another_result.deep_copy(0); + horiz_contraction(another_result, field20, &field00); + REQUIRE(views_are_equal(manual_result, another_result)); + + // Test a case of unweighted contraction + field20.sync_to_host(); + auto unweighted_result = result.clone(); + unweighted_result.deep_copy(0); + unweighted_result.sync_to_host(); + auto ur = unweighted_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim1; ++j) { + for(int k = 0; k < dim2; ++k) { + ur(j, k) += 1 * v2(i, j, k); + } + } + } + field20.sync_to_dev(); + unweighted_result.sync_to_dev(); + auto some_other_result = another_result.clone(); + some_other_result.deep_copy(-999); + horiz_contraction(some_other_result, field20); + REQUIRE(views_are_equal(some_other_result, unweighted_result)); } SECTION ("frobenius") { From 180138108f8c5b2eab3033de611077a724448dae Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Fri, 2 Aug 2024 08:09:26 -0500 Subject: [PATCH 356/529] First draft of scaled DISMF module --- components/mpas-ocean/bld/build-namelist | 2 + .../namelist_defaults_mpaso.xml | 2 + .../namelist_definition_mpaso.xml | 16 ++ components/mpas-ocean/src/Registry.xml | 36 +++ .../src/shared/mpas_ocn_scaled_dismf.F | 266 ++++++++++++++++++ 5 files changed, 322 insertions(+) create mode 100644 components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index c84e60ae498..e204ace8809 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -740,6 +740,8 @@ if (($OCN_ISMF ne 'none') && ($OCN_FORCING ne 'active_atm')) { } else { add_default($nl, 'config_remove_ais_river_runoff', 'val'=>".false."); } +add_default($nl, 'config_scale_dismf_by_removed_ice_runoff'); +add_default($nl, 'config_ais_ice_runoff_running_mean_days'); ###################################### # Namelist group: shortwaveRadiation # diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index d3b5995418f..7af5f87d6f9 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -364,6 +364,8 @@ .false. .false. +.false. +7300 'jerlov' diff --git a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml index bea1e98d9de..dffa857e8c5 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml @@ -1271,6 +1271,22 @@ Valid values: .true. or .false. Default: Defined in namelist_defaults.xml + +Whether to scale data ice-shelf melt fluxes by the running mean of removed ice runoff. + +Valid values: .true. or .false. +Default: Defined in namelist_defaults.xml + + + +The number of days over which a running mean of the AIS ice runoff is computed. The default is 7300 days (20 years) + +Valid values: Any positive integer +Default: Defined in namelist_defaults.xml + + diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 9bad1f14612..ae468d15d76 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -113,6 +113,9 @@ + @@ -807,6 +810,14 @@ description="If true, solid runoff from the Antarctic Ice Sheet (below 60S latitude) coming from the coupled is zeroed in the coupler import routines. To be used with data iceberg fluxes coming from the sea ice model." possible_values=".true. or .false." /> + + + @@ -2043,6 +2055,10 @@ + + + + + + + + + diff --git a/components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F b/components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F new file mode 100644 index 00000000000..d4005c085a2 --- /dev/null +++ b/components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F @@ -0,0 +1,266 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.io/license.html +! +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! +! ocn_scaled_dismf +!> \brief MPAS ocean scale data ice-shelf melt fluxes +!> \author Xylar Asay-Davis +!> \date July 2024 +!> \details +!> This module contains routines for scaling data ice-shelf melt fluxes by +!> the running mean of the removed ice runoff +!> Design document located at: +!> https://acme-climate.atlassian.net/wiki/spaces/PSC/pages/4210098268/Design+Document+Data+iceberg+and+ice-shelf+melt+flux+patterns+for+E3SM+runs +! +!----------------------------------------------------------------------- + +module ocn_scaled_dismf + + use mpas_kind_types + use mpas_derived_types + use mpas_global_sum_mod + use mpas_timekeeping + use mpas_timer + use ocn_config + use ocn_mesh + + implicit none + private + save + + !-------------------------------------------------------------------- + ! + ! Public parameters + ! + !-------------------------------------------------------------------- + + !-------------------------------------------------------------------- + ! + ! Public member functions + ! + !-------------------------------------------------------------------- + + public :: ocn_init_scaled_dismf, & + ocn_update_scaled_dismf + + !-------------------------------------------------------------------- + ! + ! Private module variables + ! + !-------------------------------------------------------------------- + + logical :: scaledDISMFOn + character (len=*), parameter :: alarmID = 'scaledDISMFUpdateAlarm' + +!*********************************************************************** + +contains + + +!*********************************************************************** +! +! routine ocn_init_scaled_dismf +! +!> \brief Initialize scaling of data ice-shelf melt fluxes +!> \author Xylar Asay-Davis +!> \date July 2024 +!> \details +!> Set alarms needed to compute daily and running means of removed ice runoff +! +!----------------------------------------------------------------------- + + subroutine ocn_init_scaled_dismf(domain)!{{{ + + type (domain_type), intent(inout) :: domain + + ! Alarm variables + type (MPAS_Time_Type) :: alarmTime + type (MPAS_TimeInterval_type) :: alarmTimeStep + + integer :: err_tmp + + if (config_scale_dismf_by_removed_ice_runoff) then + scaledDISMFOn = .true. + else + scaledDISMFOn = .false. + return + endif + + if (.not. config_remove_ais_ice_runoff) then + call mpas_log_write('config_scale_dismf_by_removed_ice_runoff = .true. requires config_remove_ais_ice_runoff = .true.', & + MPAS_LOG_CRIT) + endif + + if (trim(config_land_ice_flux_mode) /= 'data') then + call mpas_log_write('config_scale_dismf_by_removed_ice_runoff = .true. requires config_land_ice_flux_mode = "data"', & + MPAS_LOG_CRIT) + endif + + ! Setup Alarm for updating of scaled DISMF + alarmTime = mpas_get_clock_time(domain % clock, & + MPAS_START_TIME, & + ierr=err_tmp) + call mpas_set_timeInterval(alarmTimeStep, & + timeString='0000-00-01_00:00:00', & + ierr=err_tmp) + call mpas_add_clock_alarm(domain % clock, alarmID, alarmTime + alarmTimeStep, & + alarmTimeInterval=alarmTimeStep, ierr=err_tmp) + + end subroutine ocn_init_scaled_dismf!}}} + + +!*********************************************************************** +! +! routine ocn_update_scaled_dismf +! +!> \brief Update scaled data ice-shelf melt fluxes +!> \author Xylar Asay-Davis +!> \date August 2024 +!> \details +!> Accumulate daily mean of removed runoff. If we are at the end of a day, +!> update the running mean of removed ice runoff, and use it to scale +!> the ice shelf melt flux based on the pattern from a data file +! +!----------------------------------------------------------------------- + + subroutine ocn_update_scaled_dismf(domain)!{{{ + + type (domain_type), intent(inout) :: domain + + integer :: err_tmp + + if (.not. scaledDISMFOn) then + return + end if + + ! Compute pgf additions due to self-attraction and loading + if(mpas_is_alarm_ringing(domain % clock, alarmID, ierr=err_tmp)) then +#ifdef MPAS_DEBUG + call mpas_log_write(' Computing Scaled DISMF') +#endif + call update_scaled_dismf(domain) + call mpas_reset_clock_alarm(domain % clock, alarmID, ierr=err_tmp) + endif + + call accumulate_mean_removed_ice_runoff(domain) + + end subroutine ocn_update_scaled_dismf!}}} + + +!*********************************************************************** +! +! routine accumulate_mean_removed_ice_runoff +! +!> \brief Accumulate mean removed ice runoff +!> \author Xylar Asay-Davis +!> \date August 2024 +!> \details +!> Accumulate current removed ice runoff into the daily mean value +! +!----------------------------------------------------------------------- + + subroutine accumulate_mean_removed_ice_runoff(domain)!{{{ + + type (domain_type), intent(inout) :: domain + + type (block_type), pointer :: block_ptr + type (mpas_pool_type), pointer :: forcingPool + + real (kind=RKIND), dimension(:), pointer :: removedIceRunoffFlux + real (kind=RKIND), pointer :: avgRemovedIceRunoff + integer, pointer :: nCellsSolve, nAccumulated + + real (kind=RKIND) :: totalFlux + real (kind=RKIND), dimension(:), allocatable :: localArrayForReproSum + + integer :: iCell + + block_ptr => domain % blocklist + + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + + ! independent of blocks + call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoff', avgRemovedIceRunoff) + call mpas_pool_get_dimension(forcingPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_array(forcingPool, 'nAccumulatedRemovedIceRunoff', nAccumulated) + + do while(associated(block_ptr)) + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + + call mpas_pool_get_array(forcingPool, 'removedIceRunoffFlux', removedIceRunoffFlux) + call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoff', avgRemovedIceRunoff) + + call mpas_pool_get_dimension(forcingPool, 'nCellsSolve', nCellsSolve) + + call mpas_pool_get_array(forcingPool, 'nAccumulatedRemovedIceRunoff', nAccumulated) + + + allocate(localArrayForReproSum(nCellsSolve)) + localArrayForReproSum(:) = 0.0_RKIND + + !$omp parallel + !$omp do schedule(runtime) + do iCell=1,nCellsSolve + localArrayForReproSum(iCell) = removedIceRunoffFlux(iCell) * areaCell(iCell) + enddo + !$omp end do + !$omp end parallel + + block_ptr => block_ptr % next + end do ! block_ptr + + totalFlux = mpas_global_sum(localArrayForReproSum, domain % dminfo % comm) + + deallocate (localArrayForReproSum) + + avgRemovedIceRunoff = (avgRemovedIceRunoff * nAccumulated + totalFlux) & + / ( nAccumulated + 1 ) + + nAccumulated = nAccumulated + 1 + + end subroutine accumulate_mean_removed_ice_runoff!}}} + + + +!*********************************************************************** +! +! routine update_scaled_dismf +! +!> \brief Update scaled data ice-shelf melt fluxes +!> \author Xylar Asay-Davis +!> \date August 2024 +!> \details +!> Update the running mean of removed ice runoff, and use it to scale +!> the ice shelf melt flux based on the pattern from a data file +! +!----------------------------------------------------------------------- + + subroutine update_scaled_dismf(domain)!{{{ + + type (domain_type), intent(inout) :: domain + + type (block_type), pointer :: block_ptr + type (mpas_pool_type), pointer :: forcingPool + + real (kind=RKIND), pointer :: avgRemovedIceRunoff + integer, pointer :: nAccumulated + + block_ptr => domain % blocklist + + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + + call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoff', avgRemovedIceRunoff) + call mpas_pool_get_array(forcingPool, 'nAccumulatedRemovedIceRunoff', nAccumulated) + + ! reset daily averaging of the removed runoff + nAccumulated = 0 + avgRemovedIceRunoff = 0.0_RKIND + + end subroutine update_scaled_dismf!}}} + +end module ocn_scaled_dismf \ No newline at end of file From 7ed03e8bc550897397419afa974c6c379e0bda8a Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Fri, 2 Aug 2024 08:27:51 -0500 Subject: [PATCH 357/529] Hook up activation of scaledDISMFPKG package --- .../mpas-ocean/src/driver/mpas_ocn_core_interface.F | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/components/mpas-ocean/src/driver/mpas_ocn_core_interface.F b/components/mpas-ocean/src/driver/mpas_ocn_core_interface.F index 6d542fb0c3f..66c2349e151 100644 --- a/components/mpas-ocean/src/driver/mpas_ocn_core_interface.F +++ b/components/mpas-ocean/src/driver/mpas_ocn_core_interface.F @@ -140,6 +140,7 @@ function ocn_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{ logical, pointer :: verticalRemapPKGActive logical, pointer :: activeWavePKGActive logical, pointer :: subgridWetDryPKGActive + logical, pointer :: scaledDISMFPKGActive type (mpas_pool_iterator_type) :: pkgItr logical, pointer :: packageActive @@ -175,6 +176,7 @@ function ocn_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{ logical, pointer :: config_use_gotm logical, pointer :: config_use_active_wave logical, pointer :: config_use_subgrid_wetting_drying + logical, pointer :: config_scale_dismf_by_removed_ice_runoff character (len=StrKIND), pointer :: config_time_integrator character (len=StrKIND), pointer :: config_ocean_run_mode @@ -449,6 +451,17 @@ function ocn_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{ subgridWetDryPKGActive = .true. end if + ! + ! test for scaling data ice-shelf melt fluxes by the running mean of removed ice runoff + ! + call mpas_pool_get_package(packagePool, 'scaledDISMFPKGActive', scaledDISMFPKGActive) + call mpas_pool_get_config(configPool, & + 'config_scale_dismf_by_removed_ice_runoff', & + config_scale_dismf_by_removed_ice_runoff) + if (config_scale_dismf_by_removed_ice_runoff) then + scaledDISMFPKGActive = .true. + end if + ! ! call into analysis member driver to set analysis member packages ! From 1bed5eb1a16a1ac6d231a5bcb6f22fb757be322f Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Fri, 2 Aug 2024 08:28:38 -0500 Subject: [PATCH 358/529] Add subroutine calls to ocean mct driver --- components/mpas-ocean/driver/ocn_comp_mct.F | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index d1b140563bb..10a7743f535 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -69,6 +69,7 @@ module ocn_comp_mct use ocn_config use ocn_submesoscale_eddies use ocn_eddy_parameterization_helpers + use ocn_scaled_dismf ! ! !PUBLIC MEMBER FUNCTIONS: implicit none @@ -815,6 +816,9 @@ end subroutine xml_stream_get_attributes call ocn_time_average_coupled_accumulate(statePool, forcingPool, 1) block_ptr => block_ptr % next end do + + ! initialize scaled data ice-shelf melt fluxes based on remove ice runoff + call ocn_init_scaled_dismf(domain) end if !----------------------------------------------------------------------- @@ -860,6 +864,9 @@ end subroutine xml_stream_get_attributes call ocn_time_average_coupled_accumulate(statePool, forcingPool, 1) block_ptr => block_ptr % next end do + + ! initialize scaled data ice-shelf melt fluxes based on remove ice runoff + call ocn_init_scaled_dismf(domain) end if call t_stopf ('mpaso_mct_init') @@ -1247,6 +1254,11 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ block_ptr => block_ptr % next end do + ! update scaled data ice-shelf melt fluxes based on remove ice runoff + ! this only happens once per coupling interval because it is based on + ! an input field from the coupler + call ocn_update_scaled_dismf(domain) + ! Check if coupler wants us to write a restart file. ! We only write restart files at the end of a coupling interval if (seq_timemgr_RestartAlarmIsOn(EClock)) then From a5a96f9e850377ed8fb1514adb1df50380aab722 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Fri, 2 Aug 2024 09:06:50 -0500 Subject: [PATCH 359/529] Add ocn_scaled_dismf module to cmake build --- components/mpas-ocean/src/ocean.cmake | 1 + 1 file changed, 1 insertion(+) diff --git a/components/mpas-ocean/src/ocean.cmake b/components/mpas-ocean/src/ocean.cmake index 8866a8cea3d..f2d5303fdd7 100644 --- a/components/mpas-ocean/src/ocean.cmake +++ b/components/mpas-ocean/src/ocean.cmake @@ -114,6 +114,7 @@ list(APPEND RAW_SOURCES core_ocean/shared/mpas_ocn_stokes_drift.F core_ocean/shared/mpas_ocn_manufactured_solution.F core_ocean/shared/mpas_ocn_subgrid.F + core_ocean/shared/mpas_ocn_scaled_dismf.F ) set(OCEAN_DRIVER From 6359b61578193245ffda05767a7e08945947933b Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Mon, 5 Aug 2024 09:54:53 -0500 Subject: [PATCH 360/529] Update history and running mean of removed ice runoff --- components/mpas-ocean/bld/build-namelist | 2 +- .../namelist_defaults_mpaso.xml | 2 +- .../namelist_definition_mpaso.xml | 4 +- components/mpas-ocean/src/Registry.xml | 19 +++---- .../src/shared/mpas_ocn_scaled_dismf.F | 49 +++++++++++++++++-- 5 files changed, 59 insertions(+), 17 deletions(-) diff --git a/components/mpas-ocean/bld/build-namelist b/components/mpas-ocean/bld/build-namelist index e204ace8809..43a57037902 100755 --- a/components/mpas-ocean/bld/build-namelist +++ b/components/mpas-ocean/bld/build-namelist @@ -741,7 +741,7 @@ if (($OCN_ISMF ne 'none') && ($OCN_FORCING ne 'active_atm')) { add_default($nl, 'config_remove_ais_river_runoff', 'val'=>".false."); } add_default($nl, 'config_scale_dismf_by_removed_ice_runoff'); -add_default($nl, 'config_ais_ice_runoff_running_mean_days'); +add_default($nl, 'config_ais_ice_runoff_history_days'); ###################################### # Namelist group: shortwaveRadiation # diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index 7af5f87d6f9..97ded057092 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -365,7 +365,7 @@ .false. .false. .false. -7300 +7301 'jerlov' diff --git a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml index dffa857e8c5..ad9fd84633d 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml @@ -1279,9 +1279,9 @@ Valid values: .true. or .false. Default: Defined in namelist_defaults.xml - -The number of days over which a running mean of the AIS ice runoff is computed. The default is 7300 days (20 years) +The number of days over for which the history of removed AIS runoff is stored. The default is 7301 days (20 years + 1 day). Valid values: Any positive integer Default: Defined in namelist_defaults.xml diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index ae468d15d76..8b28c8085fb 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -113,8 +113,8 @@ - @@ -814,8 +814,8 @@ description="Whether to scale data ice-shelf melt fluxes by the running mean of removed ice runoff." possible_values=".true. or .false." /> - @@ -2057,8 +2057,9 @@ - - + + + - - domain % blocklist + real (kind=RKIND), dimension(:), allocatable :: tmpHistory + + real (kind=RKIND) :: previousTotal, timeInterval + integer :: nHistory + block_ptr => domain % blocklist call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) - call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoff', avgRemovedIceRunoff) call mpas_pool_get_array(forcingPool, 'nAccumulatedRemovedIceRunoff', nAccumulated) + call mpas_pool_get_array(forcingPool, 'nValidTotalRemovedIceRunoffHistory', nValidHistory) + call mpas_pool_get_array(forcingPool, 'avgRemovedIceRunoff', avgRemovedIceRunoff) + call mpas_pool_get_array(forcingPool, 'totalRemovedIceRunoffHistory', totalRemovedIceRunoffHistory) + call mpas_pool_get_array(forcingPool, 'runningMeanRemovedIceRunoff', runningMeanRemovedIceRunoff) + + nHistory = config_ais_ice_runoff_history_days + + if (nValidHistory == 0) then + previousTotal = 0.0_RKIND + else + previousTotal = totalRemovedIceRunoffHistory(nValidHistory) + end if + + if (nValidHistory == nHistory) then + ! we need to shift the history, since it's full + allocate(tmpHistory(nHistory)) + tmpHistory(:) = totalRemovedIceRunoffHistory(:) + totalRemovedIceRunoffHistory(1:nHistory - 1) = tmpHistory(2:nHistory) + else + ! the history isn't full yet, so we just add to the end + nValidHistory = nValidHistory + 1 + end if + + ! add the new total, the previous total plus the new daily average + totalRemovedIceRunoffHistory(nValidHistory) = previousTotal + SHR_CONST_CDAY * avgRemovedIceRunoff + + if (nValidHistory > 1) then + timeInterval = SHR_CONST_CDAY * (nValidHistory - 1) + ! the running mean is the difference between the newest and oldest + ! totals divided by the time between them + runningMeanRemovedIceRunoff = & + (totalRemovedIceRunoffHistory(nValidHistory) - totalRemovedIceRunoffHistory(1)) & + / timeInterval + end if ! reset daily averaging of the removed runoff nAccumulated = 0 From 1fccb845952b079920b02fcdb82c5f11c8e36cd1 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Tue, 6 Aug 2024 02:50:55 -0500 Subject: [PATCH 361/529] Update DISMF files to include total fluxes Read in areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux from these files --- components/mpas-ocean/cime_config/buildnml | 3 ++- components/mpas-ocean/src/Registry.xml | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/components/mpas-ocean/cime_config/buildnml b/components/mpas-ocean/cime_config/buildnml index d45d94344fe..f50984d46e0 100755 --- a/components/mpas-ocean/cime_config/buildnml +++ b/components/mpas-ocean/cime_config/buildnml @@ -376,7 +376,7 @@ def buildnml(case, caseroot, compname): ic_prefix = 'mpaso.IcoswISC30E3r5.20231120+MARBL_ICfromOMIP_64levels' eco_forcing_file = 'ecoForcingSurfaceMonthly.IcoswISC30E3r5.20231215.nc' if ocn_ismf == 'data': - data_ismf_file = 'prescribed_ismf_paolo2023.IcoswISC30E3r5.20240227.nc' + data_ismf_file = 'prescribed_ismf_paolo2023.IcoswISC30E3r5.20240805.nc' if ocn_tidal_mixing == 'true': u_tidal_rms_file = 'velocityTidalRMS_CATS2008.IcoswISC30E3r5.20231120.nc' if ocn_sgr == 'data': @@ -1818,6 +1818,7 @@ def buildnml(case, caseroot, compname): lines.append(' packages="dataLandIceFluxesPKG">') lines.append(' ') lines.append(' ') + lines.append(' ') lines.append('') lines.append('') diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 8b28c8085fb..24ec6703a78 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -4056,6 +4056,10 @@ description="Flux of heat into the ocean at land ice-ocean interface, as read in from a forcing file. Positive into ocean." packages="dataLandIceFluxesPKG" /> + Date: Fri, 9 Aug 2024 10:16:05 -0500 Subject: [PATCH 362/529] Remove trailing whitespace --- components/mpas-seaice/driver/ice_comp_mct.F | 44 ++++++++++---------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index 3c579aee77a..b27792de958 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -241,7 +241,7 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ integer :: size_list, index_list type(mct_string) :: mctOStr ! character(CXX) :: mct_field, modelStr -#endif +#endif #endif logical, pointer :: tempLogicalConfig @@ -730,7 +730,7 @@ end subroutine xml_stream_get_attributes allocate (x2i_im(lsize, nrecv) ) i2x_im = 0._r8 x2i_im = 0._r8 - ! define tags according to the seq_flds_i2x_fields + ! define tags according to the seq_flds_i2x_fields ! also zero them out tagtype = 1 ! dense, double numco = 1 ! one value per cell / entity @@ -763,7 +763,7 @@ end subroutine xml_stream_get_attributes endif #endif - + !----------------------------------------------------------------------- ! @@ -827,10 +827,10 @@ end subroutine xml_stream_get_attributes else if (trim(tempCharConfig) == "column_package") then call seaice_column_coupling_prep(domain) endif ! config_column_physics_type - + call MPAS_pool_get_config(domain % configs, "config_use_floe_size_distribution", tempLogicalConfig) if (tempLogicalConfig) then - call mpas_log_write('FloeSizeDistribution coming online soon. Turn FSD off for now.', MPAS_LOG_CRIT) + call mpas_log_write('FloeSizeDistribution coming online soon. Turn FSD off for now.', MPAS_LOG_CRIT) endif !----------------------------------------------------------------------- ! @@ -854,7 +854,7 @@ end subroutine xml_stream_get_attributes ! ! get intial state from driver ! - call ice_import_mct(x2i_i, errorCode) + call ice_import_mct(x2i_i, errorCode) if (errorCode /= 0) then call mpas_log_write('Error in ice_import_mct', MPAS_LOG_CRIT) endif @@ -862,7 +862,7 @@ end subroutine xml_stream_get_attributes #ifdef HAVE_MOAB #ifdef MOABCOMP - mpicom_moab = mpicom_i ! save it for run method + mpicom_moab = mpicom_i ! save it for run method ! loop over all fields in seq_flds_x2i_fields call mct_list_init(temp_list ,seq_flds_x2i_fields) size_list=mct_list_nitem (temp_list) @@ -879,8 +879,8 @@ end subroutine xml_stream_get_attributes #endif call ice_import_moab(Eclock) -#endif - +#endif + currTime = mpas_get_clock_time(domain % clock, MPAS_NOW, ierr) call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr) @@ -1173,7 +1173,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ integer :: size_list, index_list, ent_type type(mct_string) :: mctOStr ! character(CXX) :: mct_field, modelStr, tagname -#endif +#endif iam = domain % dminfo % my_proc_id @@ -2998,8 +2998,8 @@ subroutine frazil_mass(freezingPotential, frazilMassFlux, seaSurfaceSalinity) qi0new, & vi0new - call MPAS_pool_get_config(domain % configs, "config_thermodynamics_type", config_thermodynamics_type) - call MPAS_pool_get_config(domain % configs, "config_column_physics_type", config_column_physics_type) + call MPAS_pool_get_config(domain % configs, "config_thermodynamics_type", config_thermodynamics_type) + call MPAS_pool_get_config(domain % configs, "config_column_physics_type", config_column_physics_type) if (freezingPotential > 0.0_RKIND) then @@ -3479,15 +3479,15 @@ subroutine ice_import_moab(Eclock)!{{{ ! o dhdx -- ocn surface slope, zonal ! o dhdy -- ocn surface slope, meridional ! o lwdn -- downward lw heat flux -! o rain -- prec: liquid -! o snow -- prec: frozen +! o rain -- prec: liquid +! o snow -- prec: frozen ! o swndr -- sw: nir direct downward ! o swvdr -- sw: vis direct downward ! o swndf -- sw: nir diffuse downward ! o swvdf -- sw: vis diffuse downward ! o swnet -- sw: net ! o q -- ocn frazil heat flux(+) / melt potential(-) -! o frazil -- ocn frazil mass flux +! o frazil -- ocn frazil mass flux ! o bcphidry -- Black Carbon hydrophilic dry deposition flux ! o bcphodry -- Black Carbon hydrophobic dry deposition flux ! o bcphiwet -- Black Carbon hydrophilic wet deposition flux @@ -3502,10 +3502,10 @@ subroutine ice_import_moab(Eclock)!{{{ ! o dstdry2 -- Size 2 dust -- dry deposition flux ! o dstdry3 -- Size 3 dust -- dry deposition flux ! o dstdry4 -- Size 4 dust -- dry deposition flux -! +! ! The following fields are sometimes received from the coupler, ! depending on model options: -! +! ! o algae1 -- ! o algae2 -- ! o algae3 -- @@ -3530,7 +3530,7 @@ subroutine ice_import_moab(Eclock)!{{{ ! o zaer4 -- ! o zaer5 -- ! o zaer6 -- -! +! !----------------------------------------------------------------------- ! ! !REVISION HISTORY: @@ -3550,7 +3550,7 @@ subroutine ice_import_moab(Eclock)!{{{ character (len=StrKIND) :: & label, & message - + integer :: & i,n @@ -3687,10 +3687,10 @@ subroutine ice_import_moab(Eclock)!{{{ if (ierr > 0 ) then write(iceLogUnit,*) 'Fail to write ice state ' endif -#endif -!----------------------------------------------------------------------- +#endif +!----------------------------------------------------------------------- ! -! zero out padded cells +! zero out padded cells ! !----------------------------------------------------------------------- From 37446d5de20aa8ebf5b8d273bbe8a3b4080ba892 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Tue, 6 Aug 2024 03:33:31 -0500 Subject: [PATCH 363/529] Update DIB files to include total fluxes Read in areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux from these files --- components/mpas-seaice/cime_config/buildnml | 3 ++- components/mpas-seaice/src/Registry.xml | 13 ++++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/components/mpas-seaice/cime_config/buildnml b/components/mpas-seaice/cime_config/buildnml index 29b017f6d8b..89621f011f0 100755 --- a/components/mpas-seaice/cime_config/buildnml +++ b/components/mpas-seaice/cime_config/buildnml @@ -300,7 +300,7 @@ def buildnml(case, caseroot, compname): grid_prefix = 'mpassi.IcoswISC30E3r5' decomp_date = '20231120' decomp_prefix = 'partitions/mpas-seaice.graph.info.' - data_iceberg_file = 'Iceberg_Climatology_Merino.IcoswISC30E3r5.20231120.nc' + data_iceberg_file = 'Iceberg_Climatology_Merino.IcoswISC30E3r5.20240805.nc' dust_iron_file = 'ecoForcingSurfaceMonthly+WetDryDustSolFrac.IcoswISC30E3r5.20240511.nc' if ice_ic_mode == 'spunup': if iceberg_mode == 'data': @@ -668,6 +668,7 @@ def buildnml(case, caseroot, compname): lines.append(' input_interval="none" >') lines.append('') lines.append(' ') + lines.append(' ') lines.append(' ') lines.append('') lines.append('') diff --git a/components/mpas-seaice/src/Registry.xml b/components/mpas-seaice/src/Registry.xml index 78830161c62..06f8461efa0 100644 --- a/components/mpas-seaice/src/Registry.xml +++ b/components/mpas-seaice/src/Registry.xml @@ -2723,6 +2723,7 @@ + @@ -4956,12 +4957,22 @@ - + + + + From 58016e1de5f65533ffb0e986d03d6ac105f123b5 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Tue, 6 Aug 2024 04:05:33 -0500 Subject: [PATCH 364/529] Add scaling of DISMF by removed runoff --- .../shared/mpas_ocn_surface_land_ice_fluxes.F | 36 +++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_surface_land_ice_fluxes.F b/components/mpas-ocean/src/shared/mpas_ocn_surface_land_ice_fluxes.F index fe489029a13..db5df3dfbe0 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_surface_land_ice_fluxes.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_surface_land_ice_fluxes.F @@ -278,6 +278,12 @@ subroutine ocn_surface_land_ice_fluxes_thick(forcingPool, surfaceThicknessFlux, real (kind=RKIND), dimension(:), pointer :: landIceFreshwaterFlux, & dataLandIceFreshwaterFlux + real (kind=RKIND), pointer :: runningMeanRemovedIceRunoff, & + areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux + + + real (kind=RKIND) :: scaling + err = 0 if (.not.landIceFluxesOn) return @@ -287,6 +293,16 @@ subroutine ocn_surface_land_ice_fluxes_thick(forcingPool, surfaceThicknessFlux, call mpas_pool_get_array(forcingPool, 'landIceFreshwaterFlux', landIceFreshwaterFlux) if ( landIceDataOn ) then + + if (config_scale_dismf_by_removed_ice_runoff) then + call mpas_pool_get_array(forcingPool, 'runningMeanRemovedIceRunoff', runningMeanRemovedIceRunoff) + call mpas_pool_get_array(forcingPool, 'areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux', & + areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux) + scaling = runningMeanRemovedIceRunoff / areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux + else + scaling = 1.0_RKIND + end if + call mpas_pool_get_array(forcingPool, 'dataLandIceFreshwaterFlux', dataLandIceFreshwaterFlux) #ifdef MPAS_OPENACC !$acc enter data copyin(landIceFreshwaterFlux) @@ -297,7 +313,7 @@ subroutine ocn_surface_land_ice_fluxes_thick(forcingPool, surfaceThicknessFlux, !$omp do schedule(runtime) #endif do iCell = 1, nCellsAll - landIceFreshwaterFlux(iCell) = dataLandIceFreshwaterFlux(iCell) + landIceFreshwaterFlux(iCell) = scaling * dataLandIceFreshwaterFlux(iCell) end do #ifndef MPAS_OPENACC !$omp end do @@ -378,6 +394,12 @@ subroutine ocn_surface_land_ice_fluxes_active_tracers(meshPool, forcingPool, tra real (kind=RKIND), dimension(:), pointer :: landIceHeatFlux, & dataLandIceHeatFlux + real (kind=RKIND), pointer :: runningMeanRemovedIceRunoff, & + areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux + + + real (kind=RKIND) :: scaling + err = 0 if (.not.landIceFluxesOn) return @@ -387,11 +409,21 @@ subroutine ocn_surface_land_ice_fluxes_active_tracers(meshPool, forcingPool, tra call mpas_pool_get_array(forcingPool, 'landIceHeatFlux', landIceHeatFlux) if ( landIceDataOn ) then + + if (config_scale_dismf_by_removed_ice_runoff) then + call mpas_pool_get_array(forcingPool, 'runningMeanRemovedIceRunoff', runningMeanRemovedIceRunoff) + call mpas_pool_get_array(forcingPool, 'areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux', & + areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux) + scaling = runningMeanRemovedIceRunoff / areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux + else + scaling = 1.0_RKIND + end if + call mpas_pool_get_array(forcingPool, 'dataLandIceHeatFlux', dataLandIceHeatFlux) !$omp parallel !$omp do schedule(runtime) do iCell = 1, nCells - landIceHeatFlux(iCell) = dataLandIceHeatFlux(iCell) + landIceHeatFlux(iCell) = scaling * dataLandIceHeatFlux(iCell) end do !$omp end do !$omp end parallel From e4be90a5ae6cf9efcac6c8639cc31f1ed6402304 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Wed, 7 Aug 2024 06:36:41 -0500 Subject: [PATCH 365/529] Add support for scaling DIB Most of the support is in place, just not the coupling between MPAS-Ocean and MPAS-Seaice to pass `runningMeanRemovedIceRunoff` --- components/mpas-seaice/bld/build-namelist | 1 + .../mpas-seaice/bld/build-namelist-section | 1 + .../namelist_defaults_mpassi.xml | 1 + .../namelist_definition_mpassi.xml | 8 +++++ components/mpas-seaice/src/Registry.xml | 14 +++++++-- .../mpas_seaice_core_interface.F | 20 +++++++++---- .../src/shared/mpas_seaice_forcing.F | 29 +++++++++++++++++-- 7 files changed, 64 insertions(+), 10 deletions(-) diff --git a/components/mpas-seaice/bld/build-namelist b/components/mpas-seaice/bld/build-namelist index 3d7ce2c619f..87831cc94b0 100755 --- a/components/mpas-seaice/bld/build-namelist +++ b/components/mpas-seaice/bld/build-namelist @@ -946,6 +946,7 @@ if ($iceberg_mode eq 'data') { } else { add_default($nl, 'config_use_data_icebergs', 'val'=>"false"); } +add_default($nl, 'config_scale_dib_by_removed_ice_runoff'); add_default($nl, 'config_salt_flux_coupling_type'); add_default($nl, 'config_ice_ocean_drag_coefficient'); diff --git a/components/mpas-seaice/bld/build-namelist-section b/components/mpas-seaice/bld/build-namelist-section index d2866ee4c81..90dd6ce39f2 100644 --- a/components/mpas-seaice/bld/build-namelist-section +++ b/components/mpas-seaice/bld/build-namelist-section @@ -451,6 +451,7 @@ add_default($nl, 'config_ocean_heat_transfer_type'); add_default($nl, 'config_sea_freezing_temperature_type'); add_default($nl, 'config_ocean_surface_type'); add_default($nl, 'config_use_data_icebergs'); +add_default($nl, 'config_scale_dib_by_removed_ice_runoff'); add_default($nl, 'config_salt_flux_coupling_type'); add_default($nl, 'config_ice_ocean_drag_coefficient'); diff --git a/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml b/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml index 69294640ff6..8128c268c6e 100644 --- a/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml +++ b/components/mpas-seaice/bld/namelist_files/namelist_defaults_mpassi.xml @@ -456,6 +456,7 @@ 'mushy' 'free' false +false 'constant' 0.00536 diff --git a/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml b/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml index ba6ae4be4bb..d19f3f4eaad 100644 --- a/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml +++ b/components/mpas-seaice/bld/namelist_files/namelist_definition_mpassi.xml @@ -2686,6 +2686,14 @@ Valid values: true or false Default: Defined in namelist_defaults.xml + +Whether to scale data iceberg fluxes by the running mean of removed ice runoff + +Valid values: true or false +Default: Defined in namelist_defaults.xml + + Type of salt flux to ocean method diff --git a/components/mpas-seaice/src/Registry.xml b/components/mpas-seaice/src/Registry.xml index 06f8461efa0..d7b198b7574 100644 --- a/components/mpas-seaice/src/Registry.xml +++ b/components/mpas-seaice/src/Registry.xml @@ -1879,6 +1879,10 @@ description="Use data iceberg meltwater forcing" possible_values="true or false" /> + + - - + diff --git a/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F b/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F index 4b128d0c534..6240ea9f705 100644 --- a/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F +++ b/components/mpas-seaice/src/model_forward/mpas_seaice_core_interface.F @@ -8,6 +8,7 @@ module seaice_core_interface use seaice_analysis_driver use mpas_log, only: mpas_log_write + implicit none public contains @@ -546,10 +547,10 @@ end subroutine setup_packages_column_physics!}}} ! routine setup_packages_bergs ! !> \brief Setup icebergs package - !> \author Darin Comeau - !> \date 19 May 2017 - !> \details This routine is intended to set the icebergs package PkgBergs - !> as active/deactive based on the namelist option config_use_bergs. + !> \author Darin Comeau, Xylar Asay-Davis + !> \date August 2024 + !> \details This routine is intended to set the icebergs packages PkgBergs + !> and pkgScaledDIB as active/deactive based on the namelist options. ! !----------------------------------------------------------------------- @@ -561,10 +562,13 @@ subroutine setup_packages_bergs(configPool, packagePool, ierr)!{{{ ! icebergs package logical, pointer :: & - config_use_data_icebergs + config_use_data_icebergs, & + config_scale_dib_by_removed_ice_runoff + logical, pointer :: & - pkgBergsActive + pkgBergsActive, & + pkgScaledDIBActive ierr = 0 @@ -576,6 +580,10 @@ subroutine setup_packages_bergs(configPool, packagePool, ierr)!{{{ call MPAS_pool_get_package(packagePool, "pkgBergsActive", pkgBergsActive) pkgBergsActive = config_use_data_icebergs + call MPAS_pool_get_config(configPool, "config_scale_dib_by_removed_ice_runoff", config_scale_dib_by_removed_ice_runoff) + call MPAS_pool_get_package(packagePool, "pkgScaledDIBActive", pkgScaledDIBActive) + pkgScaledDIBActive = config_scale_dib_by_removed_ice_runoff + end subroutine setup_packages_bergs!}}} !*********************************************************************** diff --git a/components/mpas-seaice/src/shared/mpas_seaice_forcing.F b/components/mpas-seaice/src/shared/mpas_seaice_forcing.F index ca0c4c5a962..86818975700 100644 --- a/components/mpas-seaice/src/shared/mpas_seaice_forcing.F +++ b/components/mpas-seaice/src/shared/mpas_seaice_forcing.F @@ -3318,6 +3318,9 @@ subroutine get_data_iceberg_fluxes(domain) berg_forcing, & berg_fluxes + logical, pointer :: & + config_scale_dib_by_removed_ice_runoff + integer, pointer :: & nCellsSolve @@ -3326,14 +3329,36 @@ subroutine get_data_iceberg_fluxes(domain) bergFreshwaterFlux, & ! iceberg freshwater flux for ocean (kg/m^2/s) bergLatentHeatFlux ! iceberg latent heat flux for ocean (J/m^2/s) + real(kind=RKIND), pointer :: & + areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux, & ! area integrated, annual mean freshwater flux from icebegs and ice shelves (kg/s) + runningMeanRemovedIceRunoff ! the area integrated, running mean of removed ice runoff (kg/s) + integer :: & iCell + real(kind=RKIND) :: & + scaling + ! dc including as parameters here so as not to create new namelist options real(kind=RKIND), parameter :: & specificHeatFreshIce = 2106.0_RKIND, & ! specific heat of fresh ice J * kg^-1 * K^-1 bergTemperature = -4.0_RKIND ! iceberg temperature, assumed constant + + call MPAS_pool_get_config(domain % configs, "config_scale_dib_by_removed_ice_runoff", & + config_scale_dib_by_removed_ice_runoff) + + if (config_scale_dib_by_removed_ice_runoff) then + block => domain % blocklist + call MPAS_pool_get_subpool(block % structs, "berg_forcing", berg_forcing) + call mpas_pool_get_array(berg_forcing, 'runningMeanRemovedIceRunoff', runningMeanRemovedIceRunoff) + call mpas_pool_get_array(berg_forcing, 'areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux', & + areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux) + scaling = runningMeanRemovedIceRunoff / areaIntegAnnMeanDataIcebergIceShelfFreshwaterFlux + else + scaling = 1.0_RKIND + end if + block => domain % blocklist do while (associated(block)) @@ -3349,8 +3374,8 @@ subroutine get_data_iceberg_fluxes(domain) do iCell = 1, nCellsSolve - bergFreshwaterFlux(iCell) = bergFreshwaterFluxData(iCell) - bergLatentHeatFlux(iCell) = -bergFreshwaterFluxData(iCell) * & + bergFreshwaterFlux(iCell) = scaling * bergFreshwaterFluxData(iCell) + bergLatentHeatFlux(iCell) = -scaling * bergFreshwaterFluxData(iCell) * & (seaiceLatentHeatMelting - specificHeatFreshIce*bergTemperature) enddo From 926f9abc1c443dd0556604e429e8fded8ce94ea9 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Thu, 8 Aug 2024 06:17:54 -0500 Subject: [PATCH 366/529] Add ocn-->ice coupling of runningMeanRemovedIceRunoff --- components/mpas-ocean/driver/ocn_comp_mct.F | 37 ++++++++++++++-- components/mpas-seaice/driver/ice_comp_mct.F | 46 +++++++++++++++++--- driver-mct/main/seq_rest_mod.F90 | 2 + driver-mct/shr/seq_infodata_mod.F90 | 21 +++++++-- driver-moab/main/seq_rest_mod.F90 | 42 ++++++++++-------- driver-moab/shr/seq_infodata_mod.F90 | 25 ++++++++--- 6 files changed, 133 insertions(+), 40 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 10a7743f535..dae94a39b96 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -215,6 +215,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ character(len=StrKIND) :: iotype logical :: streamsExists integer :: mesh_iotype + logical :: ocn_c2_glcshelf logical, pointer :: tempLogicalConfig character(len=StrKIND), pointer :: tempCharConfig @@ -223,11 +224,14 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename )!{{{ logical, pointer :: config_use_CFCTracers logical, pointer :: config_use_activeTracers_surface_restoring logical, pointer :: config_use_surface_salinity_monthly_restoring + logical, pointer :: config_scale_dismf_by_removed_ice_runoff character (len=StrKIND), pointer :: config_land_ice_flux_mode ! ssh coupling interval initialization integer, pointer :: index_avgZonalSSHGradient, index_avgMeridionalSSHGradient real (kind=RKIND), dimension(:,:), pointer :: avgSSHGradient + real (kind=RKIND), pointer :: & + runningMeanRemovedIceRunoff ! the area integrated, running mean of removed ice runoff from the ocean #ifdef HAVE_MOAB character*100 outfile, wopts @@ -876,14 +880,25 @@ end subroutine xml_stream_get_attributes trim(config_land_ice_flux_mode) == 'pressure_only' .or. & trim(config_land_ice_flux_mode) == 'data' .or. & trim(config_land_ice_flux_mode) == 'standalone' ) then - call seq_infodata_PutData( infodata, ocn_prognostic=.true., ocnrof_prognostic=.true., & - ocn_c2_glcshelf=.false.) + ocn_c2_glcshelf = .false. else if ( trim(config_land_ice_flux_mode) .eq. 'coupled' ) then - call seq_infodata_PutData( infodata, ocn_prognostic=.true., ocnrof_prognostic=.true., & - ocn_c2_glcshelf=.true.) + ocn_c2_glcshelf = .true. else call mpas_log_write('ERROR: unknown land_ice_flux_mode: ' // trim(config_land_ice_flux_mode), MPAS_LOG_CRIT) end if + call seq_infodata_PutData(infodata, ocn_prognostic=.true., ocnrof_prognostic=.true., & + ocn_c2_glcshelf=ocn_c2_glcshelf) + + call mpas_pool_get_config(domain % configs, 'config_scale_dismf_by_removed_ice_runoff', & + config_scale_dismf_by_removed_ice_runoff) + if (config_scale_dismf_by_removed_ice_runoff) then + ! independent of space so should be no need to loop over blocks + block_ptr => domain % blocklist + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + call MPAS_pool_get_array(forcingPool, "runningMeanRemovedIceRunoff", & + runningMeanRemovedIceRunoff) + call seq_infodata_PutData(infodata, rmean_rmv_ice_runoff=runningMeanRemovedIceRunoff) + end if !----------------------------------------------------------------------- ! @@ -994,12 +1009,15 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ logical, pointer :: config_use_CFCTracers logical, pointer :: config_use_activeTracers_surface_restoring logical, pointer :: config_use_surface_salinity_monthly_restoring + logical, pointer :: config_scale_dismf_by_removed_ice_runoff character (len=StrKIND), pointer :: config_restart_timestamp_name character (len=StrKIND), pointer :: config_sw_absorption_type ! Added for coupling interval initialization integer, pointer :: index_avgZonalSSHGradient, index_avgMeridionalSSHGradient real (kind=RKIND), dimension(:,:), pointer :: avgSSHGradient + real (kind=RKIND), pointer :: & + runningMeanRemovedIceRunoff ! the area integrated, running mean of removed ice runoff from the ocean #ifdef HAVE_MOAB #ifdef MOABCOMP @@ -1302,6 +1320,17 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ #endif call check_clocks_sync(domain % clock, Eclock, ierr) + call mpas_pool_get_config(domain % configs, 'config_scale_dismf_by_removed_ice_runoff', & + config_scale_dismf_by_removed_ice_runoff) + if (config_scale_dismf_by_removed_ice_runoff) then + ! independent of space so should be no need to loop over blocks + block_ptr => domain % blocklist + call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool) + call MPAS_pool_get_array(forcingPool, "runningMeanRemovedIceRunoff", & + runningMeanRemovedIceRunoff) + call seq_infodata_PutData(infodata, rmean_rmv_ice_runoff=runningMeanRemovedIceRunoff) + end if + ! Reset I/O logs call shr_file_setLogUnit (shrlogunit) call shr_file_setLogLevel(shrloglev) diff --git a/components/mpas-seaice/driver/ice_comp_mct.F b/components/mpas-seaice/driver/ice_comp_mct.F index b27792de958..f9d79bab96f 100644 --- a/components/mpas-seaice/driver/ice_comp_mct.F +++ b/components/mpas-seaice/driver/ice_comp_mct.F @@ -194,7 +194,9 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ type (MPAS_TimeInterval_Type) :: alarmTimeStep type (block_type), pointer :: block - type (MPAS_Pool_Type), pointer :: shortwave + type (MPAS_Pool_Type), pointer :: & + shortwave, & + berg_forcing logical :: exists logical :: verbose_taskmap_output ! true then use verbose task-to-node mapping format @@ -244,12 +246,15 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename )!{{{ #endif #endif - logical, pointer :: tempLogicalConfig + logical, pointer :: & + tempLogicalConfig, & + config_scale_dib_by_removed_ice_runoff character(len=StrKIND), pointer :: tempCharConfig real (kind=RKIND), pointer :: tempRealConfig real(kind=RKIND), pointer :: & - dayOfNextShortwaveCalculation ! needed for CESM like coupled simulations + dayOfNextShortwaveCalculation, & ! needed for CESM like coupled simulations + runningMeanRemovedIceRunoff ! the area integrated, running mean of removed ice runoff from the ocean interface subroutine xml_stream_parser(xmlname, mgr_p, comm, ierr) bind(c) @@ -505,6 +510,9 @@ end subroutine xml_stream_get_attributes end if + call MPAS_pool_get_config(domain % configs, "config_scale_dib_by_removed_ice_runoff", & + config_scale_dib_by_removed_ice_runoff) + ! Setup MPASSI simulation clock ierr = domain % core % setup_clock(domain % clock, domain % configs) if ( ierr /= 0 ) then @@ -636,6 +644,15 @@ end subroutine xml_stream_get_attributes ! Determine coupling type call seq_infodata_GetData(infodata, cpl_seq_option=cpl_seq_option) + if (config_scale_dib_by_removed_ice_runoff) then + ! independent of space so should be no need to loop over blocks + block => domain % blocklist + call MPAS_pool_get_subpool(block % structs, "berg_forcing", berg_forcing) + call MPAS_pool_get_array(berg_forcing, "runningMeanRemovedIceRunoff", & + runningMeanRemovedIceRunoff) + call seq_infodata_GetData(infodata, rmean_rmv_ice_runoff=runningMeanRemovedIceRunoff ) + end if + ! Determine time of next atmospheric shortwave calculation block => domain % blocklist do while (associated(block)) @@ -1151,7 +1168,8 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ ! Variable related to MPASSI type (block_type), pointer :: block type (MPAS_Pool_type), pointer :: & - shortwave + shortwave, & + berg_forcing real (kind=RKIND) :: current_wallclock_time type (MPAS_Time_Type) :: currTime @@ -1159,13 +1177,16 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ type (MPAS_timeInterval_type) :: timeStep integer :: ierr, streamDirection, iam logical :: streamActive, debugOn - logical, pointer :: config_write_output_on_startup + logical, pointer :: & + config_write_output_on_startup, & + config_scale_dib_by_removed_ice_runoff logical, save :: first=.true. character (len=StrKIND), pointer :: & config_restart_timestamp_name, & config_column_physics_type real(kind=RKIND), pointer :: & - dayOfNextShortwaveCalculation ! needed for CESM like coupled simulations + dayOfNextShortwaveCalculation, & ! needed for CESM like coupled simulations + runningMeanRemovedIceRunoff ! the area integrated, running mean of removed ice runoff from the ocean #ifdef MOABCOMP real(r8) :: difference @@ -1187,8 +1208,10 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ mpas_log_info => domain % logInfo if (debugOn) call mpas_log_write("=== Beginning ice_run_mct ===") - call mpas_pool_get_config(domain % configs, 'config_restart_timestamp_name', config_restart_timestamp_name) + call MPAS_pool_get_config(domain % configs, 'config_restart_timestamp_name', config_restart_timestamp_name) call MPAS_pool_get_config(domain % configs, "config_column_physics_type", config_column_physics_type) + call MPAS_pool_get_config(domain % configs, "config_scale_dib_by_removed_ice_runoff", & + config_scale_dib_by_removed_ice_runoff) ! Setup log information. call shr_file_getLogUnit (shrlogunit) @@ -1225,6 +1248,15 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ ! Post coupling calls block => domain % blocklist + + if (config_scale_dib_by_removed_ice_runoff) then + ! independent of space so should be no need to loop over blocks + call MPAS_pool_get_subpool(block % structs, "berg_forcing", berg_forcing) + call MPAS_pool_get_array(berg_forcing, "runningMeanRemovedIceRunoff", & + runningMeanRemovedIceRunoff) + call seq_infodata_GetData(infodata, rmean_rmv_ice_runoff=runningMeanRemovedIceRunoff ) + end if + do while (associated(block)) ! Determine time of next atmospheric shortwave calculation diff --git a/driver-mct/main/seq_rest_mod.F90 b/driver-mct/main/seq_rest_mod.F90 index 0ad62de966f..53660278331 100644 --- a/driver-mct/main/seq_rest_mod.F90 +++ b/driver-mct/main/seq_rest_mod.F90 @@ -519,6 +519,8 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file,rvar,'seq_infodata_precip_fact',whead=whead,wdata=wdata) call seq_infodata_GetData(infodata,case_name=cvar) call seq_io_write(rest_file,trim(cvar),'seq_infodata_case_name',whead=whead,wdata=wdata) + call seq_infodata_GetData(infodata,rmean_rmv_ice_runoff=rvar) + call seq_io_write(rest_file,rvar,'seq_infodata_rmean_rmv_ice_runoff',whead=whead,wdata=wdata) call seq_timemgr_EClockGetData( EClock_d, start_ymd=ivar) call seq_io_write(rest_file,ivar,'seq_timemgr_start_ymd',whead=whead,wdata=wdata) diff --git a/driver-mct/shr/seq_infodata_mod.F90 b/driver-mct/shr/seq_infodata_mod.F90 index fcc6a21eef1..ccb58e9cf85 100644 --- a/driver-mct/shr/seq_infodata_mod.F90 +++ b/driver-mct/shr/seq_infodata_mod.F90 @@ -250,7 +250,8 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: iac_phase ! iac phase logical :: atm_aero ! atmosphere aerosols logical :: glc_g2lupdate ! update glc2lnd fields in lnd model - real(shr_kind_r8) :: max_cplstep_time ! abort if cplstep time exceeds this value + real(SHR_KIND_R8) :: max_cplstep_time ! abort if cplstep time exceeds this value + real(SHR_KIND_R8) :: rmean_rmv_ice_runoff ! running mean of removed Antarctic ice runoff !--- set from restart file --- character(SHR_KIND_CL) :: rest_case_name ! Short case identification !--- set by driver and may be time varying @@ -761,7 +762,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%atm_prognostic = .false. infodata%lnd_prognostic = .false. infodata%rof_prognostic = .false. - infodata%rofocn_prognostic = .false. + infodata%rofocn_prognostic = .false. infodata%ocn_prognostic = .false. infodata%ocnrof_prognostic = .false. infodata%ocn_c2_glcshelf = .false. @@ -808,6 +809,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%atm_aero = .false. infodata%glc_g2lupdate = .false. infodata%glc_valid_input = .true. + infodata%rmean_rmv_ice_runoff = -1.0_SHR_KIND_R8 infodata%max_cplstep_time = max_cplstep_time infodata%model_doi_url = model_doi_url @@ -907,11 +909,13 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) call seq_io_read(infodata%restart_file,pioid,infodata%nextsw_cday ,'seq_infodata_nextsw_cday') call seq_io_read(infodata%restart_file,pioid,infodata%precip_fact ,'seq_infodata_precip_fact') call seq_io_read(infodata%restart_file,pioid,infodata%rest_case_name,'seq_infodata_case_name') + call seq_io_read(infodata%restart_file,pioid,infodata%rmean_rmv_ice_runoff,'seq_infodata_rmean_rmv_ice_runoff') endif !--- Send from CPLID ROOT to GLOBALID ROOT, use bcast as surrogate call shr_mpi_bcast(infodata%nextsw_cday,mpicom,pebcast=seq_comm_gloroot(CPLID)) call shr_mpi_bcast(infodata%precip_fact,mpicom,pebcast=seq_comm_gloroot(CPLID)) call shr_mpi_bcast(infodata%rest_case_name,mpicom,pebcast=seq_comm_gloroot(CPLID)) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff,mpicom,pebcast=seq_comm_gloroot(CPLID)) endif if (seq_comm_iamroot(ID)) then @@ -1041,7 +1045,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & mct_usealltoall, mct_usevector, max_cplstep_time, model_doi_url, & - glc_valid_input, nlmaps_verbosity, nlmaps_exclude_fields) + glc_valid_input, nlmaps_verbosity, nlmaps_exclude_fields, & + rmean_rmv_ice_runoff) implicit none @@ -1228,6 +1233,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ real(shr_kind_r8), optional, intent(out) :: max_cplstep_time character(SHR_KIND_CL), optional, intent(OUT) :: model_doi_url logical, optional, intent(OUT) :: glc_valid_input + real(SHR_KIND_R8), optional, intent(out) :: rmean_rmv_ice_runoff !----- local ----- character(len=*), parameter :: subname = '(seq_infodata_GetData_explicit) ' @@ -1427,6 +1433,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(model_doi_url) ) model_doi_url = infodata%model_doi_url if ( present(glc_valid_input)) glc_valid_input = infodata%glc_valid_input + if ( present(rmean_rmv_ice_runoff) ) rmean_rmv_ice_runoff = infodata%rmean_rmv_ice_runoff END SUBROUTINE seq_infodata_GetData_explicit @@ -1595,7 +1602,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & mct_usealltoall, mct_usevector, glc_valid_input, & - nlmaps_verbosity, nlmaps_exclude_fields) + nlmaps_verbosity, nlmaps_exclude_fields, rmean_rmv_ice_runoff) implicit none @@ -1778,6 +1785,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: atm_aero ! atm aerosols logical, optional, intent(IN) :: glc_g2lupdate ! update glc2lnd fields in lnd model logical, optional, intent(IN) :: glc_valid_input + real(SHR_KIND_R8), optional, intent(IN) :: rmean_rmv_ice_runoff ! running mean of removed Antarctic ice runoff !EOP @@ -1963,6 +1971,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(atm_aero) ) infodata%atm_aero = atm_aero if ( present(glc_g2lupdate) ) infodata%glc_g2lupdate = glc_g2lupdate if ( present(glc_valid_input) ) infodata%glc_valid_input = glc_valid_input + if ( present(rmean_rmv_ice_runoff) ) infodata%rmean_rmv_ice_runoff = rmean_rmv_ice_runoff END SUBROUTINE seq_infodata_PutData_explicit @@ -2277,6 +2286,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glc_valid_input, mpicom) call shr_mpi_bcast(infodata%model_doi_url, mpicom) call shr_mpi_bcast(infodata%constant_zenith_deg, mpicom) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff, mpicom) end subroutine seq_infodata_bcast @@ -2617,6 +2627,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) if (ocn2cplr) then call shr_mpi_bcast(infodata%precip_fact, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff, mpicom, pebcast=cmppe) endif if (cpl2r) then @@ -2624,6 +2635,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%precip_fact, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_g2lupdate, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_valid_input, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff, mpicom, pebcast=cplpe) endif end subroutine seq_infodata_Exchange @@ -2995,6 +3007,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0S) subname,'iac_phase = ', infodata%iac_phase write(logunit,F0L) subname,'glc_g2lupdate = ', infodata%glc_g2lupdate + write(logunit,F0R) subname,'rmean_rmv_ice_runoff = ', infodata%rmean_rmv_ice_runoff ! endif END SUBROUTINE seq_infodata_print diff --git a/driver-moab/main/seq_rest_mod.F90 b/driver-moab/main/seq_rest_mod.F90 index ab40eab408a..dafd4d05668 100644 --- a/driver-moab/main/seq_rest_mod.F90 +++ b/driver-moab/main/seq_rest_mod.F90 @@ -97,7 +97,7 @@ module seq_rest_mod public :: seq_rest_mb_write ! read cpl7_moab restart data #ifdef MOABDEBUG - public :: write_moab_state ! debug, write files + public :: write_moab_state ! debug, write files #endif ! !PUBLIC DATA MEMBERS: @@ -367,7 +367,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances use iMOAB, only: iMOAB_GetGlobalInfo use seq_comm_mct , only: num_moab_exports ! it is used only as a counter for moab h5m files - + implicit none character(*) , intent(in) :: rest_file ! restart file path/name @@ -379,7 +379,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) real(r8),allocatable :: ns(:) ! for reshaping diag data for restart file character(CXX) :: moab_rest_file - character(CXX) :: tagname + character(CXX) :: tagname integer (in), pointer :: o2racc_om_cnt ! replacement, moab version for o2racc_ox_cnt integer (in), pointer :: x2oacc_om_cnt ! replacement, moab version for x2oacc_ox_cnt @@ -392,7 +392,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) real(r8), dimension(:,:), pointer :: p_l2racc_lm character(len=*), parameter :: subname = "(seq_rest_mb_read) " - + !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- @@ -517,7 +517,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) call seq_io_read(moab_rest_file, mboxid, 'fractions_ox', & 'afrac:ifrac:ofrac:ifrad:ofrad') ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' call seq_io_read(moab_rest_file, mboxid, 'o2x_ox', & - trim(seq_flds_o2x_fields)) + trim(seq_flds_o2x_fields)) tagname = trim(seq_flds_x2o_fields) x2oacc_om_cnt => prep_ocn_get_x2oacc_om_cnt() p_x2oacc_om => prep_ocn_get_x2oacc_om() @@ -525,7 +525,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) call seq_io_read (moab_rest_file, mboxid, 'x2oacc_ox', & trim(tagname), & matrix=p_x2oacc_om) - call seq_io_read(moab_rest_file, x2oacc_om_cnt, 'x2oacc_ox_cnt') + call seq_io_read(moab_rest_file, x2oacc_om_cnt, 'x2oacc_ox_cnt') ! tagname = trim(seq_flds_xao_fields)//C_NULL_CHAR ! arrsize = nxflds * lsize ! allocate (xao_om (lsize, nxflds)) ! ierr = iMOAB_GetDoubleTagStorage ( mbofxid, tagname, arrsize , ent_type, xao_om) @@ -548,7 +548,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) call seq_io_read(moab_rest_file, mbixid, 'fractions_ix', & 'afrac:ifrac:ofrac') ! fraclist_i = 'afrac:ifrac:ofrac' call seq_io_read(moab_rest_file, mbixid, 'i2x_ix', & - trim(seq_flds_i2x_fields) ) + trim(seq_flds_i2x_fields) ) ! gsmap => component_get_gsmap_cx(ice(1)) ! call seq_io_read(rest_file, gsmap, fractions_ix, 'fractions_ix') ! call seq_io_read(rest_file, ice, 'c2x', 'i2x_ix') @@ -557,7 +557,7 @@ subroutine seq_rest_mb_read(rest_file, infodata, samegrid_al) call seq_io_read(moab_rest_file, mbrxid, 'fractions_rx', & 'lfrac:lfrin:rfrac') ! fraclist_r = 'lfrac:lfrin:rfrac' call seq_io_read(moab_rest_file, mbrxid, 'r2x_rx', & - trim(seq_flds_r2x_fields) ) + trim(seq_flds_r2x_fields) ) ! gsmap => component_get_gsmap_cx(rof(1)) ! call seq_io_read(rest_file, gsmap, fractions_rx, 'fractions_rx') ! call seq_io_read(rest_file, rof, 'c2x', 'r2x_rx') @@ -799,6 +799,8 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file,rvar,'seq_infodata_precip_fact',whead=whead,wdata=wdata) call seq_infodata_GetData(infodata,case_name=cvar) call seq_io_write(rest_file,trim(cvar),'seq_infodata_case_name',whead=whead,wdata=wdata) + call seq_infodata_GetData(infodata,rmean_rmv_ice_runoff=rvar) + call seq_io_write(rest_file,rvar,'seq_infodata_rmean_rmv_ice_runoff',whead=whead,wdata=wdata) call seq_timemgr_EClockGetData( EClock_d, start_ymd=ivar) call seq_io_write(rest_file,ivar,'seq_timemgr_start_ymd',whead=whead,wdata=wdata) @@ -1120,6 +1122,8 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file,rvar,'seq_infodata_precip_fact',whead=whead,wdata=wdata) call seq_infodata_GetData(infodata,case_name=cvar) call seq_io_write(rest_file,trim(cvar),'seq_infodata_case_name',whead=whead,wdata=wdata) + call seq_infodata_GetData(infodata,rmean_rmv_ice_runoff=rvar) + call seq_io_write(rest_file,rvar,'seq_infodata_rmean_rmv_ice_runoff',whead=whead,wdata=wdata) call seq_timemgr_EClockGetData( EClock_d, start_ymd=ivar) call seq_io_write(rest_file,ivar,'seq_timemgr_start_ymd',whead=whead,wdata=wdata) @@ -1169,15 +1173,15 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ! nx for land will be from global nb atmosphere ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm call seq_io_write(rest_file, mblxid, 'fractions_lx', & - 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' - whead=whead, wdata=wdata, nx=nx_lnd) + 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + whead=whead, wdata=wdata, nx=nx_lnd) else call seq_io_write(rest_file, mblxid, 'fractions_lx', & - 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' whead=whead, wdata=wdata) endif ! call seq_io_write(rest_file, mblxid, 'fractions_lx', & - ! 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + ! 'afrac:lfrac:lfrin', & ! seq_frac_mod: character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' ! whead=whead, wdata=wdata) ! gsmap => component_get_gsmap_cx(lnd(1)) ! call seq_io_write(rest_file, gsmap, fractions_lx, 'fractions_lx', & @@ -1192,7 +1196,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & ierr = iMOAB_GetGlobalInfo(mbaxid, dummy, nx_lnd) ! max id for land will come from atm call seq_io_write(rest_file, mblxid, 'l2racc_lx', & trim(tagname), & - whead=whead, wdata=wdata, matrix = p_l2racc_lm, nx=nx_lnd) + whead=whead, wdata=wdata, matrix = p_l2racc_lm, nx=nx_lnd) else call seq_io_write(rest_file, mblxid, 'l2racc_lx', & trim(tagname), & @@ -1247,11 +1251,11 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & if (ocn_present) then ! gsmap => component_get_gsmap_cx(ocn(1)) ! x2oacc_ox => prep_ocn_get_x2oacc_ox() - + call seq_io_write(rest_file, mboxid, 'fractions_ox', & 'afrac:ifrac:ofrac:ifrad:ofrad', & ! fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' whead=whead, wdata=wdata) - + call seq_io_write(rest_file, mboxid, 'o2x_ox', & trim(seq_flds_o2x_fields), & whead=whead, wdata=wdata) @@ -1293,7 +1297,7 @@ subroutine seq_rest_mb_write(EClock_d, seq_SyncClock, infodata, & whead=whead, wdata=wdata) call seq_io_write(rest_file, mbixid, 'i2x_ix', & trim(seq_flds_i2x_fields), & - whead=whead, wdata=wdata) + whead=whead, wdata=wdata) ! gsmap => component_get_gsmap_cx(ice(1)) ! call seq_io_write(rest_file, gsmap, fractions_ix, 'fractions_ix', & ! whead=whead, wdata=wdata) @@ -1348,10 +1352,10 @@ end subroutine seq_rest_mb_write !=============================================================================== #ifdef MOABDEBUG - subroutine write_moab_state ( before_reading ) ! debug, write files + subroutine write_moab_state ( before_reading ) ! debug, write files use seq_comm_mct, only: mbaxid, mbixid, mboxid, mblxid, mbrxid, mbofxid ! coupler side instances use seq_comm_mct, only: num_moab_exports - use iso_c_binding + use iso_c_binding use iMOAB, only: iMOAB_WriteMesh implicit none @@ -1414,7 +1418,7 @@ subroutine write_moab_state ( before_reading ) ! debug, write files endif endif - end subroutine write_moab_state + end subroutine write_moab_state #endif end module seq_rest_mod diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 512adb853b6..749edc2fdaa 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -251,7 +251,8 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: iac_phase ! iac phase logical :: atm_aero ! atmosphere aerosols logical :: glc_g2lupdate ! update glc2lnd fields in lnd model - real(shr_kind_r8) :: max_cplstep_time ! abort if cplstep time exceeds this value + real(SHR_KIND_R8) :: max_cplstep_time ! abort if cplstep time exceeds this value + real(SHR_KIND_R8) :: rmean_rmv_ice_runoff ! running mean of removed Antarctic ice runoff !--- set from restart file --- character(SHR_KIND_CL) :: rest_case_name ! Short case identification !--- set by driver and may be time varying @@ -759,7 +760,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%atm_prognostic = .false. infodata%lnd_prognostic = .false. infodata%rof_prognostic = .false. - infodata%rofocn_prognostic = .false. + infodata%rofocn_prognostic = .false. infodata%ocn_prognostic = .false. infodata%ocnrof_prognostic = .false. infodata%ocn_c2_glcshelf = .false. @@ -795,8 +796,8 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%lnd_domain = 'none' infodata%rof_mesh = 'none' infodata%rof_domain = 'none' - infodata%ocn_domain = 'none' ! will be used for ocean data models only; will be used as a signal - infodata%ice_domain = 'none' ! will be used for ice data models only; will be used as a signal + infodata%ocn_domain = 'none' ! will be used for ocean data models only; will be used as a signal + infodata%ice_domain = 'none' ! will be used for ice data models only; will be used as a signal infodata%atm_mesh = 'none' ! will be used for atmosphere data models only; will be used as a signal ! not sure if it exists always actually @@ -813,6 +814,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%atm_aero = .false. infodata%glc_g2lupdate = .false. infodata%glc_valid_input = .true. + infodata%rmean_rmv_ice_runoff = -1.0_SHR_KIND_R8 infodata%max_cplstep_time = max_cplstep_time infodata%model_doi_url = model_doi_url @@ -912,11 +914,13 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) call seq_io_read(infodata%restart_file,pioid,infodata%nextsw_cday ,'seq_infodata_nextsw_cday') call seq_io_read(infodata%restart_file,pioid,infodata%precip_fact ,'seq_infodata_precip_fact') call seq_io_read(infodata%restart_file,pioid,infodata%rest_case_name,'seq_infodata_case_name') + call seq_io_read(infodata%restart_file,pioid,infodata%rmean_rmv_ice_runoff ,'seq_infodata_rmean_rmv_ice_runoff') endif !--- Send from CPLID ROOT to GLOBALID ROOT, use bcast as surrogate call shr_mpi_bcast(infodata%nextsw_cday,mpicom,pebcast=seq_comm_gloroot(CPLID)) call shr_mpi_bcast(infodata%precip_fact,mpicom,pebcast=seq_comm_gloroot(CPLID)) call shr_mpi_bcast(infodata%rest_case_name,mpicom,pebcast=seq_comm_gloroot(CPLID)) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff,mpicom,pebcast=seq_comm_gloroot(CPLID)) endif if (seq_comm_iamroot(ID)) then @@ -1047,7 +1051,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & mct_usealltoall, mct_usevector, max_cplstep_time, model_doi_url, & - glc_valid_input, nlmaps_verbosity) + glc_valid_input, nlmaps_verbosity, rmean_rmv_ice_runoff) implicit none @@ -1238,6 +1242,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ real(shr_kind_r8), optional, intent(out) :: max_cplstep_time character(SHR_KIND_CL), optional, intent(OUT) :: model_doi_url logical, optional, intent(OUT) :: glc_valid_input + real(SHR_KIND_R8), optional, intent(OUT) :: rmean_rmv_ice_runoff ! running mean of removed Antarctic ice runoff !----- local ----- character(len=*), parameter :: subname = '(seq_infodata_GetData_explicit) ' @@ -1442,6 +1447,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(model_doi_url) ) model_doi_url = infodata%model_doi_url if ( present(glc_valid_input)) glc_valid_input = infodata%glc_valid_input + if ( present(rmean_rmv_ice_runoff) ) rmean_rmv_ice_runoff = infodata%rmean_rmv_ice_runoff END SUBROUTINE seq_infodata_GetData_explicit @@ -1610,7 +1616,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ eps_aarea, eps_omask, eps_ogrid, eps_oarea, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & - mct_usealltoall, mct_usevector, glc_valid_input, nlmaps_verbosity) + mct_usealltoall, mct_usevector, glc_valid_input, nlmaps_verbosity, & + rmean_rmv_ice_runoff) implicit none @@ -1798,6 +1805,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: atm_aero ! atm aerosols logical, optional, intent(IN) :: glc_g2lupdate ! update glc2lnd fields in lnd model logical, optional, intent(IN) :: glc_valid_input + real(SHR_KIND_R8), optional, intent(IN) :: rmean_rmv_ice_runoff ! running mean of removed Antarctic ice runoff !EOP @@ -1988,6 +1996,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(atm_aero) ) infodata%atm_aero = atm_aero if ( present(glc_g2lupdate) ) infodata%glc_g2lupdate = glc_g2lupdate if ( present(glc_valid_input) ) infodata%glc_valid_input = glc_valid_input + if ( present(rmean_rmv_ice_runoff) ) infodata%rmean_rmv_ice_runoff = rmean_rmv_ice_runoff END SUBROUTINE seq_infodata_PutData_explicit @@ -2302,6 +2311,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glc_valid_input, mpicom) call shr_mpi_bcast(infodata%model_doi_url, mpicom) call shr_mpi_bcast(infodata%constant_zenith_deg, mpicom) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff, mpicom) end subroutine seq_infodata_bcast @@ -2648,6 +2658,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) if (ocn2cplr) then call shr_mpi_bcast(infodata%precip_fact, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff, mpicom, pebcast=cmppe) endif if (cpl2r) then @@ -2655,6 +2666,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%precip_fact, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_g2lupdate, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%glc_valid_input, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%rmean_rmv_ice_runoff, mpicom, pebcast=cplpe) endif end subroutine seq_infodata_Exchange @@ -3025,6 +3037,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0S) subname,'iac_phase = ', infodata%iac_phase write(logunit,F0L) subname,'glc_g2lupdate = ', infodata%glc_g2lupdate + write(logunit,F0R) subname,'rmean_rmv_ice_runoff = ', infodata%rmean_rmv_ice_runoff ! endif END SUBROUTINE seq_infodata_print From bfd11ad62e35792d67d7d28799602317542e2559 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Fri, 9 Aug 2024 10:45:16 -0500 Subject: [PATCH 367/529] Add a stelth exact restart test --- cime_config/tests.py | 1 + .../testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README | 8 ++++++++ .../testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpaso | 1 + .../testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpassi | 1 + 4 files changed, 11 insertions(+) create mode 100644 components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README create mode 100644 components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpaso create mode 100644 components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpassi diff --git a/cime_config/tests.py b/cime_config/tests.py index 46894e6ea96..2648abf35ac 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -269,6 +269,7 @@ "SMS_D_Ld1.T62_oQU240.GMPAS-IAF.mpaso-harmonic_mean_drag", "SMS_D_Ld1.T62_oQU240.GMPAS-IAF.mpaso-upwind_advection", "ERS_Ld5_D.T62_oQU240.GMPAS-IAF.mpaso-conservation_check", + "ERS.ne30pg2_r05_IcoswISC30E3r5.CRYO1850-DISMF.mpaso-scaled_dib_dismf", ) }, diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README new file mode 100644 index 00000000000..dfb12931696 --- /dev/null +++ b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README @@ -0,0 +1,8 @@ +This testdef is used to test a stealth feature in mpaso and mpassi introduced +by PR #XXXX. It simply changes sets the following namelist option in mpaso +to true + config_scale_dismf_by_removed_ice_runoff +and the following namelist option in mpassi to true + config_scale_dib_by_removed_ice_runoff +These flags only makes sense to use in a B-case runs with data icebergs (DIB) +and data ice-shelf melt fluxes (DISMF). diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpaso b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpaso new file mode 100644 index 00000000000..902d4418f5a --- /dev/null +++ b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpaso @@ -0,0 +1 @@ + config_scale_dismf_by_removed_ice_runoff = .true. diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpassi b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpassi new file mode 100644 index 00000000000..8512001af93 --- /dev/null +++ b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/user_nl_mpassi @@ -0,0 +1 @@ + config_scale_dib_by_removed_ice_runoff = .true. From 35ed6e762a6b721c688781dd8bd349ba3ec50355 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Sat, 10 Aug 2024 04:39:12 -0500 Subject: [PATCH 368/529] Accumulate daily mean before daily alarm Since the alarm rings at the end of a daily interval, we need to accumulate the removed runoff before, not after, we reset the daily accumulation. --- components/mpas-ocean/src/Registry.xml | 4 ++++ components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F | 9 ++++++--- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 24ec6703a78..151e3181eda 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -3852,6 +3852,10 @@ description="The daily mean, area integrated value of removedIceRunoffFlux." packages="scaledDISMFPKG" /> + Date: Sat, 10 Aug 2024 06:57:52 -0500 Subject: [PATCH 369/529] Move scaled DISMF update inside time stepping loop This is necessary becasue we want to update before streams get written. --- components/mpas-ocean/driver/ocn_comp_mct.F | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index dae94a39b96..e4e9a4a68fc 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -1218,6 +1218,9 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ block_ptr => block_ptr % next end do + ! update scaled data ice-shelf melt fluxes based on remove ice runoff + call ocn_update_scaled_dismf(domain) + if (debugOn) call mpas_log_write(' Computing analysis members') call ocn_analysis_compute(domain_ptr, ierr) if (iam==0.and.debugOn) then @@ -1272,11 +1275,6 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)!{{{ block_ptr => block_ptr % next end do - ! update scaled data ice-shelf melt fluxes based on remove ice runoff - ! this only happens once per coupling interval because it is based on - ! an input field from the coupler - call ocn_update_scaled_dismf(domain) - ! Check if coupler wants us to write a restart file. ! We only write restart files at the end of a coupling interval if (seq_timemgr_RestartAlarmIsOn(EClock)) then From 2d8e00b52e400ade3383c45d230d912d79fe28ea Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Sat, 10 Aug 2024 08:15:13 -0500 Subject: [PATCH 370/529] First zero entry in removed runoff history is zero We want this to be a valid entry that contributes to the running mean. --- .../src/shared/mpas_ocn_scaled_dismf.F | 21 +++++++++---------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F b/components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F index 45dbf1895df..bfdb39e49ad 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_scaled_dismf.F @@ -273,10 +273,11 @@ subroutine update_scaled_dismf(domain)!{{{ nHistory = config_ais_ice_runoff_history_days + previousTotal = totalRemovedIceRunoffHistory(nValidHistory) + if (nValidHistory == 0) then - previousTotal = 0.0_RKIND - else - previousTotal = totalRemovedIceRunoffHistory(nValidHistory) + ! we keep zero as the first entry in totalRemovedIceRunoffHistory + nValidHistory = 1 end if if (nValidHistory == nHistory) then @@ -292,14 +293,12 @@ subroutine update_scaled_dismf(domain)!{{{ ! add the new total, the previous total plus the new daily average totalRemovedIceRunoffHistory(nValidHistory) = previousTotal + SHR_CONST_CDAY * avgRemovedIceRunoff - if (nValidHistory > 1) then - timeInterval = SHR_CONST_CDAY * (nValidHistory - 1) - ! the running mean is the difference between the newest and oldest - ! totals divided by the time between them - runningMeanRemovedIceRunoff = & - (totalRemovedIceRunoffHistory(nValidHistory) - totalRemovedIceRunoffHistory(1)) & - / timeInterval - end if + timeInterval = SHR_CONST_CDAY * (nValidHistory - 1) + ! the running mean is the difference between the newest and oldest + ! totals divided by the time between them + runningMeanRemovedIceRunoff = & + (totalRemovedIceRunoffHistory(nValidHistory) - totalRemovedIceRunoffHistory(1)) & + / timeInterval ! reset daily averaging of the removed runoff nAccumulated = 0 From 07faf25dbea6ae2ca725832038bb0f50c0526c89 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Sat, 10 Aug 2024 11:35:35 -0500 Subject: [PATCH 371/529] Fix DISMF defaults for OCN_CO2_TYPE to match WCYCL --- components/mpas-ocean/cime_config/config_component.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/mpas-ocean/cime_config/config_component.xml b/components/mpas-ocean/cime_config/config_component.xml index 83b4501ee5e..ee55bf415d9 100644 --- a/components/mpas-ocean/cime_config/config_component.xml +++ b/components/mpas-ocean/cime_config/config_component.xml @@ -107,6 +107,8 @@ constant none + none + none constant constant diagnostic From d141bb528f1076a86b6f3561d8a4987838eee6d7 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Tue, 13 Aug 2024 08:25:07 -0500 Subject: [PATCH 372/529] Add runningMeanRemovedIceRunoff to global stats --- .../src/analysis_members/Registry_global_stats.xml | 4 ++++ .../src/analysis_members/mpas_ocn_global_stats.F | 10 +++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/components/mpas-ocean/src/analysis_members/Registry_global_stats.xml b/components/mpas-ocean/src/analysis_members/Registry_global_stats.xml index 480ad08ef3f..73f7e25aa99 100644 --- a/components/mpas-ocean/src/analysis_members/Registry_global_stats.xml +++ b/components/mpas-ocean/src/analysis_members/Registry_global_stats.xml @@ -810,6 +810,10 @@ description="Difference between change in ocean volume and freshwater input divided by volume change" packages="forwardMode;analysisMode" /> + domain % blocklist + call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool) + call mpas_pool_get_array(globalStatsAMPool, 'gsRunningMeanRemovedIceRunoff', gsRunningMeanRemovedIceRunoff) + call mpas_pool_get_array(forcingPool, 'runningMeanRemovedIceRunoff', runningMeanRemovedIceRunoff) + gsRunningMeanRemovedIceRunoff = runningMeanRemovedIceRunoff + end if + ! calculate fresh water conservation check quantities absoluteFreshWaterConservation = totalVolumeChange - netFreshwaterInput if (abs(totalVolumeChange) < 1e-12_RKIND) then From 034d29109cff3a16d75f53d572940ea2dd2a3a15 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Thu, 17 Oct 2024 15:24:07 -0500 Subject: [PATCH 373/529] Update DIB and DISMF files for SOwISC12to30E3r3 --- components/mpas-ocean/cime_config/buildnml | 2 +- components/mpas-seaice/cime_config/buildnml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/cime_config/buildnml b/components/mpas-ocean/cime_config/buildnml index f50984d46e0..778d268d570 100755 --- a/components/mpas-ocean/cime_config/buildnml +++ b/components/mpas-ocean/cime_config/buildnml @@ -417,7 +417,7 @@ def buildnml(case, caseroot, compname): ic_date = '20240829' ic_prefix = 'mpaso.SOwISC12to30E3r3.rstFromG-chrysalis' if ocn_ismf == 'data': - data_ismf_file = 'prescribed_ismf_paolo2023.SOwISC12to30E3r3.20240829.nc' + data_ismf_file = 'prescribed_ismf_paolo2023.SOwISC12to30E3r3.20241017.nc' #-------------------------------------------------------------------- diff --git a/components/mpas-seaice/cime_config/buildnml b/components/mpas-seaice/cime_config/buildnml index 89621f011f0..5df71d69b1a 100755 --- a/components/mpas-seaice/cime_config/buildnml +++ b/components/mpas-seaice/cime_config/buildnml @@ -335,7 +335,7 @@ def buildnml(case, caseroot, compname): grid_prefix = 'mpassi.SOwISC12to30E3r3' decomp_date = '20240829' decomp_prefix = 'partitions/mpas-seaice.graph.info.' - data_iceberg_file = 'Iceberg_Climatology_Merino.SOwISC12to30E3r3.20240829.nc' + data_iceberg_file = 'Iceberg_Climatology_Merino.SOwISC12to30E3r3.20241017.nc' if ice_ic_mode == 'spunup': grid_date = '20240829' grid_prefix = 'mpassi.SOwISC12to30E3r3.rstFromG-chrysalis' From 4986b82678cf9bca0f66b2cf7872750f837c2bf2 Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Thu, 17 Oct 2024 22:26:02 +0200 Subject: [PATCH 374/529] Shorten scaled_dib_dismf test to 5 days and use small layout --- cime_config/tests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/tests.py b/cime_config/tests.py index 2648abf35ac..c03b108e8e8 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -269,7 +269,7 @@ "SMS_D_Ld1.T62_oQU240.GMPAS-IAF.mpaso-harmonic_mean_drag", "SMS_D_Ld1.T62_oQU240.GMPAS-IAF.mpaso-upwind_advection", "ERS_Ld5_D.T62_oQU240.GMPAS-IAF.mpaso-conservation_check", - "ERS.ne30pg2_r05_IcoswISC30E3r5.CRYO1850-DISMF.mpaso-scaled_dib_dismf", + "ERS_Ld5_PS.ne30pg2_r05_IcoswISC30E3r5.CRYO1850-DISMF.mpaso-scaled_dib_dismf", ) }, From 2072cd4338de3bfa81c2dce4a1d4ac490fb1db2f Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Fri, 18 Oct 2024 01:40:01 +0200 Subject: [PATCH 375/529] Add PR number to test README --- .../testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README index dfb12931696..f9f97d27de1 100644 --- a/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README +++ b/components/mpas-ocean/cime_config/testdefs/testmods_dirs/mpaso/scaled_dib_dismf/README @@ -1,5 +1,5 @@ This testdef is used to test a stealth feature in mpaso and mpassi introduced -by PR #XXXX. It simply changes sets the following namelist option in mpaso +by PR #6696. It simply changes sets the following namelist option in mpaso to true config_scale_dismf_by_removed_ice_runoff and the following namelist option in mpassi to true From c8505ea7899bc9b43df826ec3a5eb43a5d2f8490 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Tue, 12 Nov 2024 13:03:43 -0600 Subject: [PATCH 376/529] Make bld files consistent with Registry --- components/mpas-ocean/bld/build-namelist-section | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/mpas-ocean/bld/build-namelist-section b/components/mpas-ocean/bld/build-namelist-section index c5dad5d935a..2c904e825d0 100644 --- a/components/mpas-ocean/bld/build-namelist-section +++ b/components/mpas-ocean/bld/build-namelist-section @@ -239,6 +239,8 @@ add_default($nl, 'config_sgr_salinity_prescribed'); add_default($nl, 'config_remove_ais_river_runoff'); add_default($nl, 'config_remove_ais_ice_runoff'); +add_default($nl, 'config_scale_dismf_by_removed_ice_runoff'); +add_default($nl, 'config_ais_ice_runoff_history_days'); ###################################### # Namelist group: shortwaveRadiation # From dd80901f1564029e4e895f0673ed0a24cfa4b57e Mon Sep 17 00:00:00 2001 From: Xylar Asay-Davis Date: Thu, 14 Nov 2024 20:51:48 -0600 Subject: [PATCH 377/529] Reduce config_ais_ice_runoff_history_days to 2 years --- .../mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml | 2 +- .../bld/namelist_files/namelist_definition_mpaso.xml | 2 +- components/mpas-ocean/src/Registry.xml | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml index 97ded057092..27727877227 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_defaults_mpaso.xml @@ -365,7 +365,7 @@ .false. .false. .false. -7301 +731 'jerlov' diff --git a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml index ad9fd84633d..46bbfde1f87 100644 --- a/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml +++ b/components/mpas-ocean/bld/namelist_files/namelist_definition_mpaso.xml @@ -1281,7 +1281,7 @@ Default: Defined in namelist_defaults.xml -The number of days over for which the history of removed AIS runoff is stored. The default is 7301 days (20 years + 1 day). +The number of days over for which the history of removed AIS runoff is stored. The default is 731 days (2 years + 1 day). Valid values: Any positive integer Default: Defined in namelist_defaults.xml diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml index 151e3181eda..f230276dca8 100644 --- a/components/mpas-ocean/src/Registry.xml +++ b/components/mpas-ocean/src/Registry.xml @@ -814,8 +814,8 @@ description="Whether to scale data ice-shelf melt fluxes by the running mean of removed ice runoff." possible_values=".true. or .false." /> - From b635da778898f728b85e3619fd0557bbef9070bc Mon Sep 17 00:00:00 2001 From: xie7 Date: Tue, 26 Nov 2024 11:07:58 -0800 Subject: [PATCH 378/529] Minor text fix. modified: orodrag.md [BFB] --- components/eam/docs/tech-guide/orodrag.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eam/docs/tech-guide/orodrag.md b/components/eam/docs/tech-guide/orodrag.md index f71fc07f282..a0be96e4f75 100644 --- a/components/eam/docs/tech-guide/orodrag.md +++ b/components/eam/docs/tech-guide/orodrag.md @@ -2,13 +2,13 @@ ## Overview -The orographic drag schemes includes two main options: the default Gravity Wave Drag scheme of McFarlane (1987)[@mcfarlane_the_1987] and a new suite of orographic drag parameterization schemes. The new suite includes 4 components all combined in one module (i.e. subroutine gwdo2d). The schemes include orographic gravity wave drag (oGWD, Xie et al.,2020)[@xie_an_2020], flow-blocking drag (FBD, Xie et al.,2020)[@xie_an_2020], small-scale GWD (sGWD, Tsiringakis et al.,2017)[@tsiringakis_small_2020], and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004)[@beljaars_a_2020]. The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987)[@mcfarlane_the_1987] and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010)[@richter_the_2010] module in EAM, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. The conceptual location of each scheme is illustrate below. Currently, only the scheme of McFarlane (1987) is opened as default in E3SMv3.0. +The orographic drag schemes includes two main options: the default Gravity Wave Drag scheme of McFarlane (1987)[@mcfarlane_the_1987] and a new suite of orographic drag parameterization schemes. The new suite includes 4 components all combined in one module (i.e. subroutine gwdo2d). The schemes include orographic gravity wave drag (oGWD, Xie et al.,2020)[@xie_an_2020], flow-blocking drag (FBD, Xie et al.,2020)[@xie_an_2020], small-scale GWD (sGWD, Tsiringakis et al.,2017)[@tsiringakis_small_2020], and turbulent-scale orographic form drag (TOFD, Beljaars et al., 2004)[@beljaars_a_2020]. The oGWD and TOFD schemes are used to replace the default oGWD (McFarlane, 1987)[@mcfarlane_the_1987] and Turbulent Mountain Stress (TMS, documented on Richter et al., 2010)[@richter_the_2010] module in EAM, while the FBD and sGWD are added enhanced drag schemes. Each of the schemes are used to predict and add enhanced drags from surface to high level that would help decelerate the wind especially over the mountainous regions among the globe. The oGWD, FBD, and sGWD are implemented in gw_drag.F90, while TOFD is implemented in clubb_intr.F90 to join the vertical diffusion process. There are also new topographic parameters (orographic asymmetry [OA], orographic convexity [OC], effective orographic length [OL]) are input into the model for the new oGWD and FBD scheme implmented. The concept of each scheme is illustrate in the figure below. Currently, only the scheme of McFarlane (1987) is turned on as default in E3SMv3.0. ![orodrag figure](../figures/orodrag.png) ### Default oGWD scheme -The current default oGWD scheme in E3SMv3.0 is from McFarlane (1987)[@mcfarlane_the_1987]. It is a linear orographic gravity wave drag scheme that parameterizes the subgrid process of vertical propagation of gravity wave originating from orographic source. The output from this scheme is a vertical profile of drag (or deceleration terms) when gravity wave breaks at higher levels and deposits momemtum flux to that level. This scheme is shown to have improve the excessive westerly wind bias in the extratropics and the wind bias in the polar region. This scheme is turned on by default in E3SMv3.0. +The current default oGWD scheme in E3SMv3.0 is from McFarlane (1987)[@mcfarlane_the_1987]. It is a linear orographic gravity wave drag scheme that parameterizes the subgrid process of vertical propagation of gravity wave originating from orographic source. The output from this scheme is a vertical profile of drag (or deceleration terms) when gravity wave breaks at higher levels and deposits momemtum flux to that level. This scheme is shown to improve the excessive westerly wind bias in the extratropics and the wind bias in the polar region. This scheme is turned on by default in E3SMv3.0. ### Default TMS scheme From 9f9ba3dcaaefd7dfdaf558f1e2ce2e6210acda48 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 26 Nov 2024 13:19:56 -0700 Subject: [PATCH 379/529] EAMxx: set valgrind supp file in ghci-snl mach file --- components/eamxx/cmake/machine-files/ghci-snl.cmake | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/eamxx/cmake/machine-files/ghci-snl.cmake b/components/eamxx/cmake/machine-files/ghci-snl.cmake index ac4db2a39f1..9782036d92c 100644 --- a/components/eamxx/cmake/machine-files/ghci-snl.cmake +++ b/components/eamxx/cmake/machine-files/ghci-snl.cmake @@ -17,3 +17,5 @@ option (EKAT_TEST_LAUNCHER_MANAGE_RESOURCES "" ON) # Needed by EkatCreateUnitTest set (EKAT_MPIRUN_EXE "mpirun" CACHE STRING "") set (EKAT_MPI_NP_FLAG "-n" CACHE STRING "") + +set(EKAT_VALGRIND_SUPPRESSION_FILE "/projects/e3sm/baselines/scream/ghci-snl-cpu/eamxx-valgrind.supp" CACHE FILEPATH "Use this valgrind suppression file if valgrind is enabled.") From 38ae4b0d97d842664fcbd9f55d2dc4a40c5c3946 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 26 Nov 2024 13:26:23 -0700 Subject: [PATCH 380/529] EAMxx: suppress cmake warning --- components/eamxx/cmake/BuildCprnc.cmake | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/components/eamxx/cmake/BuildCprnc.cmake b/components/eamxx/cmake/BuildCprnc.cmake index 287956c5a9d..05db9b60690 100644 --- a/components/eamxx/cmake/BuildCprnc.cmake +++ b/components/eamxx/cmake/BuildCprnc.cmake @@ -18,7 +18,9 @@ macro(BuildCprnc) configure_file (${SCREAM_BASE_DIR}/cmake/CprncTest.cmake.in ${CMAKE_BINARY_DIR}/bin/CprncTest.cmake @ONLY) else() - message(WARNING "Path ${CCSM_CPRNC} does not exist, so we will try to build it") + if (NOT "${CCSM_CPRNC}" STREQUAL "") + message(WARNING "Path ${CCSM_CPRNC} does not exist, so we will try to build it") + endif() # Make sure this is built only once if (NOT TARGET cprnc) if (SCREAM_CIME_BUILD) From 822cbef84ce423c6828fbeb61fe48d62d4e593fd Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Tue, 26 Nov 2024 15:39:30 -0600 Subject: [PATCH 381/529] Better way to handle call to prep_glc_zero_fields --- driver-mct/main/cime_comp_mod.F90 | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index 687050464a3..5ec98de349e 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -2523,7 +2523,6 @@ subroutine cime_run() logical :: lnd2glc_averaged_now ! Whether lnd2glc averages were taken this timestep logical :: prep_glc_accum_avg_called ! Whether prep_glc_accum_avg has been called this timestep integer :: i, nodeId - integer :: l2gacc_lx_cnt character(len=15) :: c_ymdtod character(len=18) :: c_mprof_file @@ -3048,18 +3047,14 @@ subroutine cime_run() !---------------------------------------------------------- !| GLC SETUP-SEND !---------------------------------------------------------- - ! zero out x2g_gx if this is the first call to prep_glc_accum_avg if (glc_present) then - l2gacc_lx_cnt = prep_glc_get_l2gacc_lx_cnt() - if (l2gacc_lx_cnt.eq.1) then + if (glcrun_alarm) then + call cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_called) + else call prep_glc_zero_fields() endif endif - if (glc_present .and. glcrun_alarm) then - call cime_run_glc_setup_send(lnd2glc_averaged_now, prep_glc_accum_avg_called) - endif - ! ------------------------------------------------------------------------ ! Also average lnd2glc fields if needed for requested l2x1yrg auxiliary history ! files, even if running with a stub glc model. From 3570441983790493e6e04c4447b9feed740b105d Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 26 Nov 2024 14:30:45 -0800 Subject: [PATCH 382/529] Modify TFocean vertical interpolation for depths outside of data range The ISMIP6 code for interpolating TF vertically does not give correct values for depths below the deepest data z-level. This commit handles that case by using the deepest TF value corrected by the freezing temperature depth-dependence. It also handles the less critical situation of depths above the shallowest data level by using the shallowest value unmodified. --- .../src/mode_forward/mpas_li_iceshelf_melt.F | 20 +++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F index 37d6578dd33..13425eb017f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F @@ -1162,6 +1162,8 @@ end subroutine calc_iceshelf_draft_info subroutine iceshelf_melt_ismip6(domain, err) + use li_constants, only: oceanFreezingTempDepthDependence + !----------------------------------------------------------------- ! input/output variables !----------------------------------------------------------------- @@ -1253,8 +1255,8 @@ subroutine iceshelf_melt_ismip6(domain, err) if ( li_mask_is_floating_ice(cellMask(iCell)) ) then ! 1 - Linear interpolation of the thermal forcing on the ice draft depth : - ksup=1 - do kk=2,nOceanLayers-1 + ksup=0 + do kk=1,nOceanLayers if ( zOcean(kk) >= lowerSurface(iCell) ) ksup = kk enddo kinf = ksup + 1 @@ -1279,8 +1281,18 @@ subroutine iceshelf_melt_ismip6(domain, err) err = ior(err, 1) endif - TFdraft(iCell) = ( (zOcean(ksup)-lowerSurface(iCell)) * TFocean(kinf, iCell) & - + (lowerSurface(iCell)-zOcean(kinf)) * TFocean(ksup, iCell) ) / (zOcean(ksup)-zOcean(kinf)) + if (ksup == 0) then + ! For depths shallower than shallowest layer center, use shallowest layer + TFdraft(iCell) = TFocean(1, iCell) + elseif (kinf > nOceanLayers) then + ! for depths below the deepest layer center, use deepest layer corrected for Tfreeze + TFdraft(iCell) = TFocean(nOceanLayers, iCell) - & + (zOcean(nOceanLayers) - lowerSurface(iCell)) * oceanFreezingTempDepthDependence + else + ! for depths between the first and last layer centers, linearly interpolate + TFdraft(iCell) = ( (zOcean(ksup)-lowerSurface(iCell)) * TFocean(kinf, iCell) & + + (lowerSurface(iCell)-zOcean(kinf)) * TFocean(ksup, iCell) ) / (zOcean(ksup)-zOcean(kinf)) + endif ! 2 - Mean Thermal forcing in individual basins (NB: fortran norm while basins start at zero): mean_TF(basinNumber(iCell)+1) = mean_TF(basinNumber(iCell)+1) + areaCell(iCell) * TFdraft(iCell) From cd2555782a85e4b8baf52514a3ba0411d800e19f Mon Sep 17 00:00:00 2001 From: mahf708 Date: Tue, 26 Nov 2024 18:51:02 -0800 Subject: [PATCH 383/529] EAMxx: make horizontal contraction utility stricter --- .../eamxx/src/share/field/field_utils.hpp | 64 ++++--------------- .../src/share/field/field_utils_impl.hpp | 9 +-- .../eamxx/src/share/tests/field_utils.cpp | 64 ++++++++----------- 3 files changed, 45 insertions(+), 92 deletions(-) diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index 57e06241078..8d507e5b76e 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -112,54 +112,24 @@ void perturb (const Field& f, } // Utility to compute the contraction of a field along its column dimension. -// This is equivalent to einsum('i,i...k->...k', weight, f_in); i is the column. -// The layouts are such that: +// This is equivalent to f_out = einsum('i,i...k->...k', weight, f_in). +// The impl is such that: +// - f_out, f_in, and weight must be provided and allocated // - The first dimension is for the columns (COL) -// - There can be only up to 3 dimensions -template -Field horiz_contraction(const Field &f_in, const Field *weight = nullptr, - const ekat::Comm *comm = nullptr) { - const auto &l_in = f_in.get_header().get_identifier().get_layout(); - const auto &n_in = f_in.get_header().get_identifier().name(); - const auto &u_in = f_in.get_header().get_identifier().get_units(); - const auto &g_in = f_in.get_header().get_identifier().get_grid_name(); - - FieldIdentifier f_out_id(n_in + "_horiz_contraction", - l_in.clone().strip_dim(0), u_in, g_in); - // Allocate the output field - Field f_out(f_out_id); - f_out.allocate_view(); - f_out.deep_copy(0); - - // Call the implementation - horiz_contraction(f_out, f_in, weight, comm); - return f_out; -} - +// - There can be only up to 3 dimensions of f_in template void horiz_contraction(const Field &f_out, const Field &f_in, - const Field *weight = nullptr, - const ekat::Comm *comm = nullptr) { + const Field &weight, const ekat::Comm *comm = nullptr) { using namespace ShortFieldTagsNames; const auto &l_out = f_out.get_header().get_identifier().get_layout(); - const auto &l_in = f_in.get_header().get_identifier().get_layout(); - const auto &n_in = f_in.get_header().get_identifier().name(); - const auto &u_in = f_in.get_header().get_identifier().get_units(); - const auto &g_in = f_in.get_header().get_identifier().get_grid_name(); - - // If weight is not provided, we set it as a field of ones - Field wt; - if(weight) { - wt = *weight; - } else { - FieldIdentifier wt_id(n_in + "_weight", {{COL}, {l_in.dim(0)}}, u_in, g_in); - wt = Field(wt_id); - wt.allocate_view(); - wt.deep_copy(1); - } - const auto &l_w = wt.get_header().get_identifier().get_layout(); + const auto &l_in = f_in.get_header().get_identifier().get_layout(); + const auto &n_in = f_in.get_header().get_identifier().name(); + const auto &u_in = f_in.get_header().get_identifier().get_units(); + const auto &g_in = f_in.get_header().get_identifier().get_grid_name(); + + const auto &l_w = weight.get_header().get_identifier().get_layout(); // Sanity checks before handing off to the implementation EKAT_REQUIRE_MSG(l_w.rank() == 1, @@ -192,12 +162,6 @@ void horiz_contraction(const Field &f_out, const Field &f_in, "Error! The input field must have a non-zero column dimension.\n" "The input f_in layout is " << l_in.to_string() << ".\n"); - EKAT_REQUIRE_MSG( - l_out.rank() == l_in.rank() - 1, - "Error! The output field must have rank one less than the input field.\n" - "The input f_in rank is " - << l_in.rank() << " and the output f_out rank is " << l_out.rank() - << ".\n"); EKAT_REQUIRE_MSG( l_out == l_in.clone().strip_dim(0), "Error! The output field must have the same layout as the input field " @@ -206,16 +170,16 @@ void horiz_contraction(const Field &f_out, const Field &f_in, << l_in.to_string() << " and the output f_out layout is " << l_out.to_string() << ".\n"); EKAT_REQUIRE_MSG( - f_out.is_allocated() && f_in.is_allocated() && wt.is_allocated(), + f_out.is_allocated() && f_in.is_allocated() && weight.is_allocated(), "Error! All fields must be allocated."); EKAT_REQUIRE_MSG(f_out.data_type() == f_in.data_type(), "Error! In/out Fields have matching data types."); EKAT_REQUIRE_MSG( - f_out.data_type() == wt.data_type(), + f_out.data_type() == weight.data_type(), "Error! Weight field must have the same data type as input fields."); // All good, call the implementation - impl::horiz_contraction(f_out, f_in, wt, comm); + impl::horiz_contraction(f_out, f_in, weight, comm); } template diff --git a/components/eamxx/src/share/field/field_utils_impl.hpp b/components/eamxx/src/share/field/field_utils_impl.hpp index 292db33094d..e6a8c41bfa3 100644 --- a/components/eamxx/src/share/field/field_utils_impl.hpp +++ b/components/eamxx/src/share/field/field_utils_impl.hpp @@ -304,12 +304,13 @@ void horiz_contraction(const Field &f_out, const Field &f_in, using TeamMember = typename TeamPolicy::member_type; using ESU = ekat::ExeSpaceUtils; - auto l_out = f_out.get_header().get_identifier().get_layout(); - auto l_in = f_in.get_header().get_identifier().get_layout(); - const int ncols = l_in.dim(0); + auto l_out = f_out.get_header().get_identifier().get_layout(); + auto l_in = f_in.get_header().get_identifier().get_layout(); auto v_w = weight.get_view(); + const int ncols = l_in.dim(0); + switch(l_in.rank()) { case 1: { auto v_in = f_in.get_view(); @@ -355,7 +356,7 @@ void horiz_contraction(const Field &f_out, const Field &f_in, if(comm) { // TODO: use device-side MPI calls - // TODO: the dev ptr seems to cause problems; revisit this later + // TODO: the dev ptr causes problems; revisit this later // TODO: doing cuda-aware MPI allreduce would be ~10% faster Kokkos::fence(); f_out.sync_to_host(); diff --git a/components/eamxx/src/share/tests/field_utils.cpp b/components/eamxx/src/share/tests/field_utils.cpp index ef7fad074d4..16da775d0a1 100644 --- a/components/eamxx/src/share/tests/field_utils.cpp +++ b/components/eamxx/src/share/tests/field_utils.cpp @@ -147,57 +147,71 @@ TEST_CASE("utils") { field00.sync_to_dev(); // Create (random) sample fields + FieldIdentifier fsc("f", {{}, {}}, m / s, "g"); // scalar FieldIdentifier f10("f", {{COL, CMP}, {dim0, dim1}}, m / s, "g"); FieldIdentifier f11("f", {{COL, LEV}, {dim0, dim2}}, m / s, "g"); FieldIdentifier f20("f", {{COL, CMP, LEV}, {dim0, dim1, dim2}}, m / s, "g"); + Field fieldsc(fsc); Field field10(f10); Field field11(f11); Field field20(f20); + fieldsc.allocate_view(); field10.allocate_view(); field11.allocate_view(); field20.allocate_view(); - + randomize(fieldsc, engine, pdf); randomize(field10, engine, pdf); randomize(field11, engine, pdf); randomize(field20, engine, pdf); - FieldIdentifier F_x("fx", {{COL}, {dim1}}, m / s, "g"); + FieldIdentifier F_x("fx", {{COL}, {dim0}}, m / s, "g"); FieldIdentifier F_y("fy", {{LEV}, {dim2}}, m / s, "g"); + FieldIdentifier F_z("fz", {{CMP}, {dim1}}, m / s, "g"); + FieldIdentifier F_w("fyz", {{CMP, LEV}, {dim1, dim2}}, m / s, "g"); Field field_x(F_x); Field field_y(F_y); + Field field_z(F_z); + Field field_w(F_w); // Test invalid inputs - REQUIRE_THROWS( - horiz_contraction(field_x, &field00)); // x not allocated + REQUIRE_THROWS(horiz_contraction(fieldsc, field_x, + field00)); // x not allocated yet field_x.allocate_view(); field_y.allocate_view(); + field_z.allocate_view(); + field_w.allocate_view(); - REQUIRE_THROWS( - horiz_contraction(field_y, &field_x)); // unmatching layout - REQUIRE_THROWS( - horiz_contraction(field11, &field11)); // wrong f1 layout + REQUIRE_THROWS(horiz_contraction(fieldsc, field_y, + field_x)); // unmatching layout + REQUIRE_THROWS(horiz_contraction(field_z, field11, + field11)); // wrong weight layout Field result; // Ensure a scalar case works - result = horiz_contraction(field00, &field00); + result = fieldsc.clone(); + horiz_contraction(result, field00, field00); result.sync_to_host(); auto v = result.get_view(); REQUIRE(v() == (1 / sp(36) + 4 / sp(36) + 9 / sp(36))); - result = horiz_contraction(field10, &field00); + // Test higher-order cases + result = field_z.clone(); + horiz_contraction(result, field10, field00); REQUIRE(result.get_header().get_identifier().get_layout().tags() == std::vector({CMP})); REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); - result = horiz_contraction(field11, &field00); + result = field_y.clone(); + horiz_contraction(result, field11, field00); REQUIRE(result.get_header().get_identifier().get_layout().tags() == std::vector({LEV})); REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim2); - result = horiz_contraction(field20, &field00); + result = field_w.clone(); + horiz_contraction(result, field20, field00); REQUIRE(result.get_header().get_identifier().get_layout().tags() == std::vector({CMP, LEV})); REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); @@ -220,32 +234,6 @@ TEST_CASE("utils") { field20.sync_to_dev(); manual_result.sync_to_dev(); REQUIRE(views_are_equal(result, manual_result)); - - // Test overloaded function with already allocated output field - auto another_result = result.clone(); - another_result.deep_copy(0); - horiz_contraction(another_result, field20, &field00); - REQUIRE(views_are_equal(manual_result, another_result)); - - // Test a case of unweighted contraction - field20.sync_to_host(); - auto unweighted_result = result.clone(); - unweighted_result.deep_copy(0); - unweighted_result.sync_to_host(); - auto ur = unweighted_result.get_strided_view(); - for(int i = 0; i < dim0; ++i) { - for(int j = 0; j < dim1; ++j) { - for(int k = 0; k < dim2; ++k) { - ur(j, k) += 1 * v2(i, j, k); - } - } - } - field20.sync_to_dev(); - unweighted_result.sync_to_dev(); - auto some_other_result = another_result.clone(); - some_other_result.deep_copy(-999); - horiz_contraction(some_other_result, field20); - REQUIRE(views_are_equal(some_other_result, unweighted_result)); } SECTION ("frobenius") { From 990c2f473c34ba5c8a3c23671e10789c4c2fa941 Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Wed, 27 Nov 2024 11:23:43 -0500 Subject: [PATCH 384/529] remove unused header id info --- components/eamxx/src/share/field/field_utils.hpp | 3 --- 1 file changed, 3 deletions(-) diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index 8d507e5b76e..4661d80db5d 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -125,9 +125,6 @@ void horiz_contraction(const Field &f_out, const Field &f_in, const auto &l_out = f_out.get_header().get_identifier().get_layout(); const auto &l_in = f_in.get_header().get_identifier().get_layout(); - const auto &n_in = f_in.get_header().get_identifier().name(); - const auto &u_in = f_in.get_header().get_identifier().get_units(); - const auto &g_in = f_in.get_header().get_identifier().get_grid_name(); const auto &l_w = weight.get_header().get_identifier().get_layout(); From c31e59925e0b38943f52edbd74159f9fc894fa17 Mon Sep 17 00:00:00 2001 From: Darin Comeau Date: Wed, 27 Nov 2024 11:05:49 -0600 Subject: [PATCH 385/529] Changing file name again --- cime_config/config_grids.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml index dca52f7efc5..6ca698b0a8d 100755 --- a/cime_config/config_grids.xml +++ b/cime_config/config_grids.xml @@ -5660,7 +5660,7 @@ - cpl/cpl6/map_r05_to_SOwISC12to30E3r3_rat0.5_maxFlx0.001.Grlnd100x_Ant100x.cstmnn.20241120.nc + cpl/cpl6/map_r05_to_SOwISC12to30E3r3_r250e1250_58NS.cstmnn.20241120.nc cpl/cpl6/map_r05_to_SOwISC12to30E3r3_cstmnn.r150e300.20240808.nc From bbb309f9e0fa0cf809335e5063fdbcf8e5a40081 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Wed, 27 Nov 2024 14:16:01 -0700 Subject: [PATCH 386/529] First shot to make chicoma-gpu look like chicoma-cpu --- .../cmake_macros/gnu_chicoma-gpu.cmake | 13 ++----- cime_config/machines/config_machines.xml | 38 ++++++++++--------- 2 files changed, 25 insertions(+), 26 deletions(-) diff --git a/cime_config/machines/cmake_macros/gnu_chicoma-gpu.cmake b/cime_config/machines/cmake_macros/gnu_chicoma-gpu.cmake index 807c7d0211e..a6c13942620 100644 --- a/cime_config/machines/cmake_macros/gnu_chicoma-gpu.cmake +++ b/cime_config/machines/cmake_macros/gnu_chicoma-gpu.cmake @@ -2,15 +2,10 @@ string(APPEND CONFIG_ARGS " --host=cray") if (COMP_NAME STREQUAL gptl) string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") endif() -string(APPEND SLIBS " -lblas -llapack") -set(CXX_LINKER "FORTRAN") -if (NOT DEBUG) - string(APPEND CFLAGS " -O2 -g") -endif() -if (NOT DEBUG) - string(APPEND FFLAGS " -O2 -g") -endif() -string(APPEND CXX_LIBS " -lstdc++") +set(PIO_FILESYSTEM_HINTS "lustre") +string(APPEND CMAKE_C_FLAGS_RELEASE " -O2 -g") +string(APPEND CMAKE_Fortran_FLAGS_RELEASE " -O2 -g") +string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,--enable-new-dtags") set(MPICC "cc") set(MPICXX "CC") set(MPIFC "ftn") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index f0a5a21b436..5dd3ff4da0d 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -4146,8 +4146,7 @@ - Chicoma GPU nodes at LANL IC. Each GPU node has single -AMD EPYC 7713 64-Core (Milan) (256GB) and 4 nvidia A100' + Chicoma GPU nodes at LANL IC. Each GPU node has single AMD EPYC 7713 64-Core (Milan) (256GB) and 4 nvidia A100' ch-fe* Linux gnugpu,gnu,nvidiagpu,nvidia @@ -4157,7 +4156,7 @@ AMD EPYC 7713 64-Core (Milan) (256GB) and 4 nvidia A100' /usr/projects/e3sm/inputdata/atm/datm7 /lustre/scratch5/$ENV{USER}/E3SM/archive/$CASE /lustre/scratch5/$ENV{USER}/E3SM/input_data/ccsm_baselines/$COMPILER - /usr/projects/climate/SHARED_CLIMATE/software/badger/cprnc + /usr/projects/e3sm/software/chicoma-cpu/cprnc 10 e3sm_developer 4 @@ -4181,11 +4180,11 @@ AMD EPYC 7713 64-Core (Milan) (256GB) and 4 nvidia A100' - /usr/share/lmod/8.3.1/init/perl + /usr/share/lmod/lmod/init/perl - /usr/share/lmod/8.3.1/init/python - /usr/share/lmod/8.3.1/init/sh - /usr/share/lmod/8.3.1/init/csh + /usr/share/lmod/lmod/init/python + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh /usr/share/lmod/lmod/libexec/lmod perl /usr/share/lmod/lmod/libexec/lmod python module @@ -4197,32 +4196,35 @@ AMD EPYC 7713 64-Core (Milan) (256GB) and 4 nvidia A100' cray-parallel-netcdf cray-netcdf cray-hdf5 - PrgEnv-gnu - PrgEnv-intel - PrgEnv-nvidia - PrgEnv-cray - PrgEnv-aocc intel intel-oneapi nvidia aocc cudatoolkit climate-utils + cray-libsci craype-accel-nvidia80 craype-accel-host perftools-base perftools darshan + PrgEnv-gnu + PrgEnv-intel + PrgEnv-nvidia + PrgEnv-cray + PrgEnv-aocc - PrgEnv-gnu/8.4.0 - gcc/11.2.0 + PrgEnv-gnu/8.5.0 + gcc/12.2.0 + cray-libsci/23.05.1.4 PrgEnv-nvidia/8.4.0 nvidia/22.7 + cray-libsci/23.05.1.4 @@ -4245,14 +4247,13 @@ AMD EPYC 7713 64-Core (Milan) (256GB) and 4 nvidia A100' - cray-libsci/23.05.1.4 + craype-accel-host craype/2.7.21 cray-mpich/8.1.26 - libfabric/1.15.2.0 cray-hdf5-parallel/1.12.2.3 cray-netcdf-hdf5parallel/4.9.0.3 cray-parallel-netcdf/1.12.3.3 - cmake/3.25.1 + cmake/3.27.7 @@ -4275,6 +4276,9 @@ AMD EPYC 7713 64-Core (Milan) (256GB) and 4 nvidia A100' $ENV{CRAY_PARALLEL_NETCDF_PREFIX} /usr/projects/e3sm/cudatoolkit:$ENV{PKG_CONFIG_PATH} + + /opt/cray/pe/gcc/12.2.0/snos/lib64:$ENV{LD_LIBRARY_PATH} + -1 From 40fefa533d2a000bb8ed9cfb63ff968a35d3b87d Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Wed, 27 Nov 2024 16:52:15 -0500 Subject: [PATCH 387/529] Workflows: remove mkatmsrffile test --- .../e3sm-gh-tools-mkatmsrffile-test.yml | 88 ------------------- 1 file changed, 88 deletions(-) delete mode 100644 .github/workflows/e3sm-gh-tools-mkatmsrffile-test.yml diff --git a/.github/workflows/e3sm-gh-tools-mkatmsrffile-test.yml b/.github/workflows/e3sm-gh-tools-mkatmsrffile-test.yml deleted file mode 100644 index cacb951b8a8..00000000000 --- a/.github/workflows/e3sm-gh-tools-mkatmsrffile-test.yml +++ /dev/null @@ -1,88 +0,0 @@ -name: mkatmsrffile - -on: - push: - branches: [ master ] - pull_request: - branches: [ master ] - paths: - - 'components/eam/tools/mkatmsrffile/mkatmsrffile.py' - schedule: - - cron: '00 15 * * 2' - workflow_dispatch: - -concurrency: - group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.run_id }} - cancel-in-progress: true - -jobs: - mkatmsrffile-test: - if: ${{ github.repository == 'E3SM-Project/E3SM' }} - runs-on: ubuntu-latest - defaults: - run: - shell: bash -l {0} - outputs: - event_name: ${{ github.event_name }} - steps: - - - name: Repository checkout - uses: actions/checkout@v4 - with: - show-progress: false - submodules: false - - - name: Conda setup - uses: conda-incubator/setup-miniconda@v3 - with: - activate-environment: "envmkatmsrffile" - miniforge-version: latest - channel-priority: strict - auto-update-conda: true - python-version: 3.11 - - - name: Install dependencies - run: | - echo $CONDA_PREFIX - conda install -y nco xarray numba numpy netcdf4 -c conda-forge - - - name: Run tests - working-directory: components/eam/tools/mkatmsrffile - run: | - echo $CONDA_PREFIX - wget https://web.lcrc.anl.gov/public/e3sm/inputdata/atm/cam/chem/trop_mozart/dvel/clim_soilw.nc - wget https://web.lcrc.anl.gov/public/e3sm/inputdata/atm/cam/chem/trop_mozart/dvel/regrid_vegetation.nc - wget https://web.lcrc.anl.gov/public/e3sm/inputdata/atm/cam/chem/trop_mozart/dvel/map_1x1_to_ne30pg2_traave_c20240903.nc - python mkatmsrffile.py --map_file=map_1x1_to_ne30pg2_traave_c20240903.nc --vegetation_file=regrid_vegetation.nc --soil_water_file=clim_soilw.nc --dst_grid=ne30pg2 - - mkatmsrffile-notify: - needs: mkatmsrffile-test - if: ${{ failure() && needs.mkatmsrffile-test.outputs.event_name != 'pull_request' }} - runs-on: ubuntu-latest - steps: - - name: Create issue - run: | - previous_issue_number=$(gh issue list \ - --label "$LABELS" \ - --json number \ - --jq '.[0].number') - if [[ -n $previous_issue_number ]]; then - gh issue comment "$previous_issue_number" \ - --body "$BODY" - else - gh issue create \ - --title "$TITLE" \ - --assignee "$ASSIGNEES" \ - --label "$LABELS" \ - --body "$BODY" - fi - env: - GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} - GH_REPO: ${{ github.repository }} - TITLE: mkatmsrffile test failure - ASSIGNEES: whannah1 - LABELS: bug,notify-mkatmsrffile-gh-action - BODY: | - Workflow failed! There's likely an issue in the mkatmsrffile tool! For more information, please see: - - Workflow URL: https://github.com/${{ github.repository }}/actions/runs/${{ github.run_id }} (number ${{ github.run_number }}, attempt ${{ github.run_attempt }}) - - Workflow SHA: ${{ github.sha }} From f1bc5d6153fbb42aac4ec090c3419a762c903cce Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 27 Nov 2024 15:36:17 -0700 Subject: [PATCH 388/529] FortranData should no longer be using lviews --- components/eamxx/src/physics/p3/tests/infra/p3_data.hpp | 6 +++--- .../eamxx/src/physics/shoc/tests/infra/shoc_data.hpp | 6 +++--- .../eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.cpp | 7 +++---- .../eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp | 6 ++---- 4 files changed, 11 insertions(+), 14 deletions(-) diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_data.hpp b/components/eamxx/src/physics/p3/tests/infra/p3_data.hpp index df5b25e311a..55e74300215 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_data.hpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_data.hpp @@ -16,9 +16,9 @@ struct P3Data { using KT = KokkosTypes; using Scalar = Real; - using Array1 = typename KT::template lview; - using Array2 = typename KT::template lview; - using Array3 = typename KT::template lview; + using Array1 = typename KT::template view_1d; + using Array2 = typename KT::template view_2d; + using Array3 = typename KT::template view_3d; bool do_predict_nc; bool do_prescribed_CCN; diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp index 5cc390aeebc..453ddbcda85 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_data.hpp @@ -16,9 +16,9 @@ struct FortranData { using KT = KokkosTypes; using Scalar = Real; - using Array1 = typename KT::template lview; - using Array2 = typename KT::template lview; - using Array3 = typename KT::template lview; + using Array1 = typename KT::template view_1d; + using Array2 = typename KT::template view_2d; + using Array3 = typename KT::template view_3d; Int shcol, nlev, nlevi, num_qtracers, nadv; diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.cpp index 6af7b1ed7c2..da651ef05ba 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_ic_cases.cpp @@ -16,11 +16,10 @@ namespace { // top and then flips everything, so we do the same. //------------------------------------------------------------------------ -using KT = KokkosTypes; using Scalar = Real; -using Array1 = typename KT::template lview; -using Array2 = typename KT::template lview; -using Array3 = typename KT::template lview; +using Array1 = typename FortranData::Array1; +using Array2 = typename FortranData::Array2; +using Array3 = typename FortranData::Array3; // Flip all vertical data in the given array. void flip_vertically(Array2& array) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp index 5445a44dded..0266b1e6b4b 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_main_wrap.cpp @@ -36,10 +36,8 @@ Int shoc_main(FortranData& d) { namespace { -using KT = KokkosTypes; -using Scalar = Real; -using Array2 = typename KT::template lview; -using Array3 = typename KT::template lview; +using Array2 = typename FortranData::Array2; +using Array3 = typename FortranData::Array3; // Returns a string representation of the given 2D array. std::string array_as_string(const Array2& array) From e2055b7f87641e5f72fdc6622234db867124af0f Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 27 Nov 2024 20:49:46 -0800 Subject: [PATCH 389/529] Fix indexing errors --- .../src/mode_forward/mpas_li_iceshelf_melt.F | 24 ++++++++++++------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F index 13425eb017f..89b7bb31a3d 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F @@ -1251,6 +1251,18 @@ subroutine iceshelf_melt_ismip6(domain, err) mean_TF(:) = 0.d0 IS_area(:) = 0.d0 + ! Check zOcean for valid values + if (minval(zOcean) == 0.0_RKIND) then + call mpas_log_write("Invalid value for zOcean. It should have negative values but min value of 0.0 was found", & + MPAS_LOG_ERR) + err = ior(err, 1) + endif + if (maxval(zOcean) > 0.0_RKIND) then + call mpas_log_write("Invalid value for zOcean. It should have negative values but max value greater than 0.0 was found", & + MPAS_LOG_ERR) + err = ior(err, 1) + endif + do iCell = 1, nCellsSolve if ( li_mask_is_floating_ice(cellMask(iCell)) ) then @@ -1259,14 +1271,8 @@ subroutine iceshelf_melt_ismip6(domain, err) do kk=1,nOceanLayers if ( zOcean(kk) >= lowerSurface(iCell) ) ksup = kk enddo - kinf = ksup + 1 - if ((zOcean(ksup)-zOcean(kinf)) == 0) then - call mpas_log_write("iceshelf_melt_ismip6: Invalid value for zOcean. " // & - "ksup=$i kinf=$i zOcean(ksup)=$r zOcean(kinf)=$r indexToCellID=$i lowerSurface=$r", MPAS_LOG_ERR, & - intArgs=(/ksup, kinf, indexToCellID(iCell)/), & - realArgs=(/zOcean(ksup), zOcean(kinf), lowerSurface(iCell) /) ) - err = ior(err, 1) - endif + kinf = min(ksup + 1, nOceanLayers) ! Don't let exceed maximum index to avoid errors below + !call mpas_log_write("kinf=$i, zOcean(kinf)=$r, TFocean=$r",realArgs=(/zOcean(kinf),TFocean(kinf,iCell)/), & ! intArgs=(/kinf/)) !call mpas_log_write("ksup=$i, zOcean(ksup)=$r, TFocean=$r",realArgs=(/zOcean(ksup),TFocean(ksup,iCell)/), & @@ -1284,7 +1290,7 @@ subroutine iceshelf_melt_ismip6(domain, err) if (ksup == 0) then ! For depths shallower than shallowest layer center, use shallowest layer TFdraft(iCell) = TFocean(1, iCell) - elseif (kinf > nOceanLayers) then + elseif (ksup == nOceanLayers) then ! for depths below the deepest layer center, use deepest layer corrected for Tfreeze TFdraft(iCell) = TFocean(nOceanLayers, iCell) - & (zOcean(nOceanLayers) - lowerSurface(iCell)) * oceanFreezingTempDepthDependence From c4829c422343ac1efbe175c5914d3a457650d847 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Fri, 29 Nov 2024 13:59:00 -0700 Subject: [PATCH 390/529] Fixes for minor test mistakes --- .../shoc/tests/infra/shoc_test_data.cpp | 21 ++----------------- .../shoc/tests/infra/shoc_test_data.hpp | 9 ++++---- .../physics/shoc/tests/shoc_run_and_cmp.cpp | 7 +++++-- 3 files changed, 11 insertions(+), 26 deletions(-) diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index e33a12882b7..f5c7b407425 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -283,23 +283,7 @@ void pblintd_height(PblintdHeightData& d) void vd_shoc_decomp_and_solve(VdShocDecompandSolveData& d) { - // Call decomp subroutine - // vd_shoc_decomp_host(d.shcol, d.nlev, d.nlevi, d.kv_term, d.tmpi, d.rdp_zt, d.dtime, d.flux, d.du, d.dl, d.d); - // // Call solver for each problem. The `var` array represents 3d - // // data with an entry per (shcol, nlev, n_rhs). Fortran requires - // // 2d data (shcol, nlev) for each rhs. - // const Int size = d.shcol*d.nlev; - // for (Int n=0; n; diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp index ad159059589..2eb4236b4ed 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.hpp @@ -860,12 +860,11 @@ struct VdShocDecompandSolveData : public PhysicsTestData { Real *kv_term, *tmpi, *rdp_zt, *flux; // Inputs/Outputs - Real *du, *dl, *d; - Real *var, *rhs; + Real *var; VdShocDecompandSolveData(Int shcol_, Int nlev_, Int nlevi_, Real dtime_, Int n_rhs_) : PhysicsTestData({{shcol_}, {shcol_, nlev_}, {shcol_, nlevi_}, {shcol_, nlev_, n_rhs_}}, - {{&flux}, {&rdp_zt, &du, &dl, &d, &rhs}, {&kv_term, &tmpi}, {&var } }, {}), + {{&flux}, {&rdp_zt}, {&kv_term, &tmpi}, {&var } }, {}), shcol(shcol_), nlev(nlev_), nlevi(nlevi_), n_rhs(n_rhs_), dtime(dtime_) {} PTD_STD_DEF(VdShocDecompandSolveData, 5, shcol, nlev, nlevi, dtime, n_rhs); @@ -1080,8 +1079,8 @@ Int shoc_main_host(Int shcol, Int nlev, Int nlevi, Real dtime, Int nadv, Int npb void pblintd_height_host(Int shcol, Int nlev, Int npbl, Real* z, Real* u, Real* v, Real* ustar, Real* thv, Real* thv_ref, Real* pblh, Real* rino, bool* check); -void vd_shoc_decomp_and_solve_host(Int shcol, Int nlev, Int nlevi, Int num_rhs, Real* kv_term, Real* tmpi, Real* rdp_zt, Real dtime, - Real* flux, Real* var); +void vd_shoc_decomp_and_solve_host(Int shcol, Int nlev, Int nlevi, Int num_rhs, Real dtime, Real* kv_term, Real* tmpi, Real* rdp_zt, Real* flux, Real* var); + void pblintd_surf_temp_host(Int shcol, Int nlev, Int nlevi, Real* z, Real* ustar, Real* obklen, Real* kbfs, Real* thv, Real* tlv, Real* pblh, bool* check, Real* rino); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp index fe28e77e1ad..e055c0d34d9 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp @@ -105,8 +105,11 @@ struct Baseline { } Int run_and_cmp (const std::string& filename, const double& tol, bool no_baseline) { - auto fid = ekat::FILEPtr(fopen(filename.c_str(), "r")); - EKAT_REQUIRE_MSG( fid, "generate_baseline can't read " << filename); + ekat::FILEPtr fid; + if (!no_baseline) { + fid = ekat::FILEPtr(fopen(filename.c_str(), "r")); + EKAT_REQUIRE_MSG( fid, "generate_baseline can't read " << filename); + } Int nerr = 0, ne; int case_num = 0; for (auto ps : params_) { From a48ed3bef186815524c8581097ba7f7d14dfa735 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Sat, 30 Nov 2024 06:44:16 -0800 Subject: [PATCH 391/529] Fix new indexing error introduced trying to fix indexing errors --- .../src/mode_forward/mpas_li_iceshelf_melt.F | 25 +++++++++++++------ 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F index 89b7bb31a3d..a0e91e1f126 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F @@ -1271,7 +1271,7 @@ subroutine iceshelf_melt_ismip6(domain, err) do kk=1,nOceanLayers if ( zOcean(kk) >= lowerSurface(iCell) ) ksup = kk enddo - kinf = min(ksup + 1, nOceanLayers) ! Don't let exceed maximum index to avoid errors below + kinf = ksup + 1 !call mpas_log_write("kinf=$i, zOcean(kinf)=$r, TFocean=$r",realArgs=(/zOcean(kinf),TFocean(kinf,iCell)/), & ! intArgs=(/kinf/)) @@ -1279,12 +1279,23 @@ subroutine iceshelf_melt_ismip6(domain, err) ! intArgs=(/ksup/)) ! check if any invalid TFocean value is used for calculating TF at the draft - if ( (TFocean(kinf, iCell) == invalid_value_TF .or. TFocean(ksup, iCell) == invalid_value_TF) ) then - call mpas_log_write("iceshelf_melt_ismip6: Invalid value for TFocean. " // & - "ksup=$i kinf=$i TFocean(ksup, iCell)=$r TFocean(kinf,iCell)=$r indexToCellID=$i", MPAS_LOG_ERR, & - intArgs=(/ksup, kinf, indexToCellID(iCell)/), & - realArgs=(/TFocean(ksup, iCell), TFocean(kinf, iCell) /) ) - err = ior(err, 1) + if (ksup >= 1) then + if (TFocean(ksup, iCell) == invalid_value_TF) then + call mpas_log_write("iceshelf_melt_ismip6: Invalid value for TFocean. " // & + "ksup=$i TFocean(ksup, iCell)=$r indexToCellID=$i", MPAS_LOG_ERR, & + intArgs=(/ksup, indexToCellID(iCell)/), & + realArgs=(/TFocean(ksup, iCell) /) ) + err = ior(err, 1) + endif + endif + if (kinf <= nOceanLayers) then + if (TFocean(kinf, iCell) == invalid_value_TF) then + call mpas_log_write("iceshelf_melt_ismip6: Invalid value for TFocean. " // & + "kinf=$i TFocean(kinf,iCell)=$r indexToCellID=$i", MPAS_LOG_ERR, & + intArgs=(/kinf, indexToCellID(iCell)/), & + realArgs=(/TFocean(kinf, iCell) /) ) + err = ior(err, 1) + endif endif if (ksup == 0) then From cbb5ee3ce0d0d8ded36daa1ccd5eb4ccbcfe7971 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Sat, 30 Nov 2024 18:14:52 -0800 Subject: [PATCH 392/529] Improve error checking in ocean extrap --- .../src/mode_forward/mpas_li_ocean_extrap.F | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F index 024c0df4c5f..de501d62960 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_ocean_extrap.F @@ -308,7 +308,7 @@ subroutine li_ocean_extrap_solve(domain, err) call mpas_timer_stop("vertical scheme") if (err > 0) then - call mpas_log_write("Ocean extraolation main iteration loop has encountered an error", MPAS_LOG_ERR) + call mpas_log_write("Ocean extrapolation main iteration loop has encountered an error", MPAS_LOG_ERR) return endif enddo @@ -378,6 +378,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers, nCellsExtra integer, dimension(:), pointer :: cellMask, nEdgesOnCell + integer, dimension(:), pointer :: indexToCellID integer, dimension(:,:), pointer :: cellsOnCell integer :: iCell, jCell, iLayer, iNeighbor, iter integer :: localLoopCount @@ -399,6 +400,7 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_array(meshPool, 'areaCell', areaCell) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) @@ -430,8 +432,9 @@ subroutine horizontal_extrapolation(domain, availOceanMask, validOceanMask, vali if ( validOceanMaskOld(iLayer,jCell) == 1 ) then if ( TFoceanOld(iLayer,jCell) > 1.0e6_RKIND) then ! raise error if an invalid ocean data value is used - call mpas_log_write("ocean data value used for extrapolation is invalid", & - MPAS_LOG_ERR) + call mpas_log_write("ocean data value used for extrapolation is invalid " // & + "in horizontal_extrapolation: cell id=$i, iLayer=$i, TF=$r", & + MPAS_LOG_ERR, intArgs=(/indexToCellID(jCell), iLayer/), realArgs=(/TFoceanOld(iLayer,jCell)/)) err = ior(err,1) else TFsum = TFsum + (TFoceanOld(iLayer,jCell) * areaCell(jCell)) @@ -533,6 +536,7 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas real (kind=RKIND), dimension(:), pointer :: thickness, bedTopography, areaCell integer, pointer :: nCells, nCellsSolve, nISMIP6OceanLayers integer, dimension(:), pointer :: cellMask, nEdgesOnCell + integer, dimension(:), pointer :: indexToCellID integer, dimension(:,:), pointer :: cellsOnCell integer :: iCell, jCell, iLayer, iNeighbor, iter integer :: localLoopCount, newMaskCountLocalAccum @@ -550,6 +554,7 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_array(meshPool, 'areaCell', areaCell) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) @@ -564,8 +569,9 @@ subroutine vertical_extrapolation(domain, availOceanMask, validOceanMask, newMas if ( validOceanMask(iLayer-1,iCell) == 1 ) then if (TFocean(iLayer-1,iCell) > 1.0e6_RKIND) then ! raise error if an invalid ocean data value is used - call mpas_log_write("ocean data value used for extrapolation is invalid", & - MPAS_LOG_ERR) + call mpas_log_write("ocean data value used for extrapolation is invalid " // & + "in vertical_extrapolation: cell id=$i, iLayer=$i, TF=$r", & + MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell), iLayer-1/), realArgs=(/TFocean(iLayer-1,iCell)/)) err = ior(err,1) else TFocean(iLayer,iCell) = TFocean(iLayer-1,iCell) - & From bf9c57de8c29cf91a6d619e668896ae9283d9c35 Mon Sep 17 00:00:00 2001 From: Darin Comeau Date: Mon, 2 Dec 2024 08:57:45 -0600 Subject: [PATCH 393/529] Increasing range of AIS ice removal to 45S --- components/mpas-ocean/driver/ocn_comp_mct.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 5d9a5d67011..82d428577c6 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -2181,7 +2181,7 @@ subroutine ocn_import_mct(x2o_o, errorCode)!{{{ call shr_sys_abort ('Error: incoming rofi_F is negative') end if if (config_remove_ais_ice_runoff) then - if (latCell(i) < -1.04719666667_RKIND) then ! 60S in radians + if (latCell(i) < -0.78539816325_RKIND) then ! 45S in radians removedIceRunoffFlux(i) = iceRunoffFlux(i) iceRunoffFlux(i) = 0.0_RKIND removedIceRunoffFluxThisProc = removedIceRunoffFluxThisProc + removedIceRunoffFlux(i) @@ -3714,7 +3714,7 @@ subroutine ocn_import_moab(Eclock, errorCode)!{{{ call shr_sys_abort ('Error: incoming rofi_F is negative') end if if (config_remove_ais_ice_runoff) then - if (latCell(i) < -1.04719666667_RKIND) then ! 60S in radians + if (latCell(i) < -0.78539816325_RKIND) then ! 45S in radians removedIceRunoffFlux(i) = iceRunoffFlux(i) iceRunoffFlux(i) = 0.0_RKIND removedIceRunoffFluxThisProc = removedIceRunoffFluxThisProc + removedIceRunoffFlux(i) From 0c5337cc83fa1f3133fbcb4d80d8827d7455e4f5 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Mon, 2 Dec 2024 15:39:31 -0700 Subject: [PATCH 394/529] Delete .mergify.yml While we tried to use this in the SCREAM repo to automize merging and to guard against accidental merges, we are not using it in the E3SM repo, and it is confusing at best. --- .mergify.yml | 53 ---------------------------------------------------- 1 file changed, 53 deletions(-) delete mode 100644 .mergify.yml diff --git a/.mergify.yml b/.mergify.yml deleted file mode 100644 index 89fcc821e57..00000000000 --- a/.mergify.yml +++ /dev/null @@ -1,53 +0,0 @@ -merge_protections: - - name: Enforce checks passing - description: Make sure that checks are not failing on the PR, and reviewers approved - if: - - base = master - success_conditions: - - "#approved-reviews-by >= 1" # At least 1 approval - - "#changes-requested-reviews-by == 0" # No reviewer asked for changes - - or: - - and: - - check-success="gcc-openmp / dbg" - - check-success="gcc-openmp / sp" - - check-success="gcc-openmp / fpe" - - check-success="gcc-openmp / opt" - - check-skipped={% raw %}gcc-openmp / ${{ matrix.build_type }}{% endraw %} - - or: - - and: - - check-success="gcc-cuda / dbg" - - check-success="gcc-cuda / sp" - - check-success="gcc-cuda / opt" - - check-skipped={% raw %}gcc-cuda / ${{ matrix.build_type }}{% endraw %} - - or: - - and: - - check-success="cpu-gcc / ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.scream-output-preset-2" - - check-success="cpu-gcc / ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.scream-dpxx-arm97" - - check-success="cpu-gcc / ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-small_kernels--scream-output-preset-5" - - check-success="cpu-gcc / SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-all_mam4xx_procs" - - check-skipped={% raw %}cpu-gcc / ${{ matrix.test.short_name }}{% endraw %} - - or: - - check-success=cpu-gcc - - check-skipped=cpu-gcc - -pull_request_rules: - - name: dismiss stale reviews - conditions: - - base=master - actions: - dismiss_reviews: - when: synchronize # Dismiss reviews when synchronize event happens - - name: Automatic merge when CI passes and approved - conditions: - - "label=CI: automerge" - - base=master - actions: - merge: - method: merge - commit_message_template: | - Merge pull request #{{number}} from {{head}} - - Automatically merged using mergify - PR title: {{title}} - PR author: {{author}} - PR labels: {{label}} From 38a43516388c5b0f264b491b2456e0247c55368f Mon Sep 17 00:00:00 2001 From: Darin Comeau Date: Tue, 3 Dec 2024 12:24:26 -0600 Subject: [PATCH 395/529] Changing threshold to 57S --- components/mpas-ocean/driver/ocn_comp_mct.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 82d428577c6..c31909abc6a 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -2181,7 +2181,7 @@ subroutine ocn_import_mct(x2o_o, errorCode)!{{{ call shr_sys_abort ('Error: incoming rofi_F is negative') end if if (config_remove_ais_ice_runoff) then - if (latCell(i) < -0.78539816325_RKIND) then ! 45S in radians + if (latCell(i) < -0.99483767345_RKIND) then ! 57S in radians removedIceRunoffFlux(i) = iceRunoffFlux(i) iceRunoffFlux(i) = 0.0_RKIND removedIceRunoffFluxThisProc = removedIceRunoffFluxThisProc + removedIceRunoffFlux(i) @@ -3714,7 +3714,7 @@ subroutine ocn_import_moab(Eclock, errorCode)!{{{ call shr_sys_abort ('Error: incoming rofi_F is negative') end if if (config_remove_ais_ice_runoff) then - if (latCell(i) < -0.78539816325_RKIND) then ! 45S in radians + if (latCell(i) < -0.99483767345_RKIND) then ! 57S in radians removedIceRunoffFlux(i) = iceRunoffFlux(i) iceRunoffFlux(i) = 0.0_RKIND removedIceRunoffFluxThisProc = removedIceRunoffFluxThisProc + removedIceRunoffFlux(i) From 45336f23c33fe7eb7d02331a3e41b55050410e00 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Tue, 3 Dec 2024 12:50:19 -0600 Subject: [PATCH 396/529] Rename PE-layouts: S-20n, M-40n, L-64n. --- cime_config/allactive/config_pesall.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index f3c92be3c6a..5c0d44f74ae 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -2180,7 +2180,7 @@ 576 - + allactive+chrysalis: v3.NARRM tri-grid on 20 nodes ~2 sypd 1152 @@ -2196,7 +2196,7 @@ 384 - + allactive+chrysalis: v3.NARRM tri-grid on 30 nodes ~3 sypd 1792 @@ -2212,7 +2212,7 @@ 512 - + allactive+chrysalis: v3.NARRM tri-grid on 40 nodes ~4 sypd 2368 @@ -2227,7 +2227,7 @@ 1408 - + allactive+chrysalis: v3.NARRM tri-grid on 50 nodes ~5 sypd 3008 @@ -2243,7 +2243,7 @@ 1152 - + allactive+chrysalis: v3.NARRM tri-grid on 64 nodes ~6 sypd 3840 From 832c06dc01adaff8fefb1be15aa0daf05b7e040f Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Tue, 3 Dec 2024 19:47:00 +0000 Subject: [PATCH 397/529] Move SYCL link flags to OMEGA_SYCL_EXE_LINKER_FLAGS --- cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake | 2 +- cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake index c26a0161cb4..1ad0d6e6b61 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_aurora.cmake @@ -4,5 +4,5 @@ if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 ") -string(APPEND SYCL_EXE_LINKER_FLAGS " -Xsycl-target-backend \"-device 12.60.7\" ") +string(APPEND OMEGA_SYCL_EXE_LINKER_FLAGS " -Xsycl-target-backend \"-device 12.60.7\" ") string(APPEND CMAKE_CXX_FLAGS " -Xclang -fsycl-allow-virtual-functions") diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake index c26a0161cb4..1ad0d6e6b61 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot.cmake @@ -4,5 +4,5 @@ if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 ") -string(APPEND SYCL_EXE_LINKER_FLAGS " -Xsycl-target-backend \"-device 12.60.7\" ") +string(APPEND OMEGA_SYCL_EXE_LINKER_FLAGS " -Xsycl-target-backend \"-device 12.60.7\" ") string(APPEND CMAKE_CXX_FLAGS " -Xclang -fsycl-allow-virtual-functions") From 87a6906f102affd2c5472a6b50904411a5557f70 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Tue, 3 Dec 2024 14:17:01 -0600 Subject: [PATCH 398/529] fix MMF build issues --- .../physics/crm/dummy_modules/clubb_intr.F90 | 31 +++++++++++++++++++ components/eam/src/physics/crm/physpkg.F90 | 2 +- 2 files changed, 32 insertions(+), 1 deletion(-) create mode 100644 components/eam/src/physics/crm/dummy_modules/clubb_intr.F90 diff --git a/components/eam/src/physics/crm/dummy_modules/clubb_intr.F90 b/components/eam/src/physics/crm/dummy_modules/clubb_intr.F90 new file mode 100644 index 00000000000..d6729e33f6b --- /dev/null +++ b/components/eam/src/physics/crm/dummy_modules/clubb_intr.F90 @@ -0,0 +1,31 @@ +module clubb_intr +!------------------------------------------------------------------------------- +! Dummy module to override src/physics/cam/clubb_intr.F90 +!------------------------------------------------------------------------------- +use shr_kind_mod, only: r8=>shr_kind_r8 +public :: clubb_implements_cnst +public :: clubb_init_cnst +public :: clubb_readnl +contains +!=============================================================================== +function clubb_implements_cnst(name) + ! Return true if specified constituent is implemented + character(len=*), intent(in) :: name ! constituent name + logical :: clubb_implements_cnst ! return value + clubb_implements_cnst = .false. +end function clubb_implements_cnst +!=============================================================================== +subroutine clubb_init_cnst(name, q, gcid) + ! Initialize the state if clubb_do_adv + character(len=*), intent(in) :: name ! constituent name + real(r8), intent(out) :: q(:,:) ! mass mixing ratio (gcol, plev) + integer, intent(in) :: gcid(:) ! global column id + return +end subroutine clubb_init_cnst +!=============================================================================== +subroutine clubb_readnl(nlfile) + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + return +end subroutine clubb_readnl +!=============================================================================== +end module clubb_intr diff --git a/components/eam/src/physics/crm/physpkg.F90 b/components/eam/src/physics/crm/physpkg.F90 index 33fab14066d..6ad53894f4e 100644 --- a/components/eam/src/physics/crm/physpkg.F90 +++ b/components/eam/src/physics/crm/physpkg.F90 @@ -638,7 +638,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out ) if (co2_transport()) call co2_init() call co2_diags_init(phys_state) - call gw_init() + call gw_init(pbuf2d) call rayleigh_friction_init() From 5dfdca97c33017db8891a1fa5581029c99f3d5de Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 3 Dec 2024 16:41:44 -0700 Subject: [PATCH 399/529] EAMxx: add a grids manager from pre-built grids This GM is useful for unit tests, but more generally for situations where only grids are avaialble, but interfaces require a grids manager. --- .../dynamics/homme/homme_grids_manager.cpp | 4 +- .../eamxx/src/share/grid/grids_manager.cpp | 30 ++++++++++-- .../eamxx/src/share/grid/grids_manager.hpp | 3 +- .../src/share/grid/library_grids_manager.hpp | 49 +++++++++++++++++++ .../share/grid/mesh_free_grids_manager.cpp | 4 +- 5 files changed, 81 insertions(+), 9 deletions(-) create mode 100644 components/eamxx/src/share/grid/library_grids_manager.hpp diff --git a/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp b/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp index df5de6827f6..7376e9af9dd 100644 --- a/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp +++ b/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp @@ -188,7 +188,7 @@ void HommeGridsManager::build_dynamics_grid () { initialize_vertical_coordinates(dyn_grid); dyn_grid->m_short_name = "dyn"; - add_grid(dyn_grid); + add_nonconst_grid(dyn_grid); } void HommeGridsManager:: @@ -307,7 +307,7 @@ build_physics_grid (const ci_string& type, const ci_string& rebalance) { } phys_grid->m_short_name = type; - add_grid(phys_grid); + add_nonconst_grid(phys_grid); } void HommeGridsManager:: diff --git a/components/eamxx/src/share/grid/grids_manager.cpp b/components/eamxx/src/share/grid/grids_manager.cpp index 77300aa51c9..45494947aca 100644 --- a/components/eamxx/src/share/grid/grids_manager.cpp +++ b/components/eamxx/src/share/grid/grids_manager.cpp @@ -7,7 +7,24 @@ auto GridsManager:: get_grid(const std::string& name) const -> grid_ptr_type { - auto g = get_grid_nonconst(name); + EKAT_REQUIRE_MSG (has_grid(name), + "Error! Grids manager '" + this->name() + "' does not provide grid '" + name + "'.\n" + " Avaialble grids are: " + print_available_grids() + "\n"); + + grid_ptr_type g; + for (const auto& it : m_grids) { + if (it.second->name()==name or + ekat::contains(it.second->aliases(),name)) { + g = it.second; + break; + } + } + + EKAT_REQUIRE_MSG (g!=nullptr, + "Something went wrong while looking up a grid.\n" + " - grids manager: " + this->name() + "\n" + " - grid name : " + name + "\n"); + return g; } @@ -51,7 +68,14 @@ create_remapper (const grid_ptr_type& from_grid, } void GridsManager:: -add_grid (nonconstgrid_ptr_type grid) +add_nonconst_grid (nonconstgrid_ptr_type grid) +{ + add_grid(grid); + m_nonconst_grids[grid->name()] = grid; +} + +void GridsManager:: +add_grid (grid_ptr_type grid) { const auto& name = grid->name(); EKAT_REQUIRE_MSG (not has_grid(name), @@ -59,7 +83,6 @@ add_grid (nonconstgrid_ptr_type grid) " - grids manager: " + this->name() + "\n" " - grid name : " + name + "\n"); - m_nonconst_grids[name] = grid; m_grids[name] = grid; } @@ -86,7 +109,6 @@ get_grid_nonconst (const std::string& name) const " - grid name : " + name + "\n"); return g; - } void GridsManager:: diff --git a/components/eamxx/src/share/grid/grids_manager.hpp b/components/eamxx/src/share/grid/grids_manager.hpp index 4a0e25bc233..e70bb9678f0 100644 --- a/components/eamxx/src/share/grid/grids_manager.hpp +++ b/components/eamxx/src/share/grid/grids_manager.hpp @@ -56,7 +56,8 @@ class GridsManager protected: - void add_grid (nonconstgrid_ptr_type grid); + void add_nonconst_grid (nonconstgrid_ptr_type grid); + void add_grid (grid_ptr_type grid); void alias_grid (const std::string& grid_name, const std::string& grid_alias); virtual remapper_ptr_type diff --git a/components/eamxx/src/share/grid/library_grids_manager.hpp b/components/eamxx/src/share/grid/library_grids_manager.hpp new file mode 100644 index 00000000000..fd5d3caaef2 --- /dev/null +++ b/components/eamxx/src/share/grid/library_grids_manager.hpp @@ -0,0 +1,49 @@ +#ifndef EAMXX_LIBRARY_GRIDS_MANAGER_HPP +#define EAMXX_LIBRARY_GRIDS_MANAGER_HPP + +#include "share/grid/grids_manager.hpp" + +namespace scream { + +// This class is meant to be used within scopes that need a grids manager +// object, but they only have pre-built grids. The user can then simply +// create a LibraryGridsManager, and add the pre-existing grids. Afterwards, +// it's business as usual with GridsManager's interfaces. + +class LibraryGridsManager : public GridsManager +{ +public: + template + explicit LibraryGridsManager(Pointers&&... ptrs) { + add_grids(std::forward(ptrs)...); + } + + virtual ~LibraryGridsManager () = default; + + std::string name () const { return "Library grids_manager"; } + + void build_grids () override {} + + void add_grids () {} + + template + void add_grids (grid_ptr_type p, Pointers&&... ptrs) { + add_grid(p); + add_grids(std::forward(ptrs)...); + } + +protected: + remapper_ptr_type + do_create_remapper (const grid_ptr_type from_grid, + const grid_ptr_type to_grid) const + { + EKAT_ERROR_MSG ( + "Error! LibraryGridsManager is not capable of creating remappers.\n" + " - from_grid: " + from_grid->name() + "\n" + " - to_grid: " + to_grid->name() + "\n"); + } +}; + +} // namespace scream + +#endif // EAMXX_LIBRARY_GRIDS_MANAGER_HPP diff --git a/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp b/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp index b083dfcfa48..4d505803e66 100644 --- a/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp +++ b/components/eamxx/src/share/grid/mesh_free_grids_manager.cpp @@ -106,7 +106,7 @@ build_se_grid (const std::string& name, ekat::ParameterList& params) se_grid->m_short_name = "se"; add_geo_data(se_grid); - add_grid(se_grid); + add_nonconst_grid(se_grid); } void MeshFreeGridsManager:: @@ -132,7 +132,7 @@ build_point_grid (const std::string& name, ekat::ParameterList& params) add_geo_data(pt_grid); pt_grid->m_short_name = "pt"; - add_grid(pt_grid); + add_nonconst_grid(pt_grid); } void MeshFreeGridsManager:: From a851099f111f6cabd7cf225ce1704e2bda65a597 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 3 Dec 2024 16:44:12 -0700 Subject: [PATCH 400/529] EAMxx: factor diagnostics creation out of IO class * Add free function to build a diagnostic obj from a diag field name * Adapt existing diags so that their name is "static", rather than matching the diag field name * Adapt AtmosphereOutput to use this utility. Enhances encapsulation, and avoids hiding the diag naming convention deep in the IO class --- .../eamxx/src/diagnostics/CMakeLists.txt | 10 +- .../eamxx/src/diagnostics/aerocom_cld.cpp | 5 +- .../eamxx/src/diagnostics/aerocom_cld.hpp | 2 +- .../eamxx/src/diagnostics/field_at_height.cpp | 23 +-- .../eamxx/src/diagnostics/field_at_height.hpp | 2 +- .../eamxx/src/diagnostics/field_at_level.hpp | 2 +- .../diagnostics/field_at_pressure_level.cpp | 32 ++-- .../diagnostics/field_at_pressure_level.hpp | 2 +- .../eamxx/src/diagnostics/number_path.cpp | 4 +- .../eamxx/src/diagnostics/number_path.hpp | 2 +- .../src/diagnostics/potential_temperature.cpp | 7 +- .../src/diagnostics/potential_temperature.hpp | 2 +- .../src/diagnostics/precip_surf_mass_flux.cpp | 2 +- .../src/diagnostics/precip_surf_mass_flux.hpp | 2 +- .../src/diagnostics/register_diagnostics.hpp | 9 +- .../src/diagnostics/tests/CMakeLists.txt | 94 +++++----- .../tests/field_at_height_tests.cpp | 28 ++- .../tests/field_at_pressure_level_tests.cpp | 3 +- .../tests/vertical_layer_tests.cpp | 14 +- .../eamxx/src/diagnostics/vapor_flux.cpp | 8 +- .../eamxx/src/diagnostics/vapor_flux.hpp | 2 +- .../eamxx/src/diagnostics/vertical_layer.cpp | 28 +-- .../eamxx/src/diagnostics/vertical_layer.hpp | 2 +- .../eamxx/src/diagnostics/water_path.cpp | 7 +- .../eamxx/src/diagnostics/water_path.hpp | 2 +- components/eamxx/src/share/io/CMakeLists.txt | 2 +- .../eamxx/src/share/io/scorpio_output.cpp | 148 +++------------- .../eamxx/src/share/io/scream_io_utils.cpp | 87 +++++++++ .../eamxx/src/share/io/scream_io_utils.hpp | 9 + .../eamxx/src/share/io/tests/CMakeLists.txt | 6 + .../eamxx/src/share/io/tests/create_diag.cpp | 166 ++++++++++++++++++ 31 files changed, 418 insertions(+), 294 deletions(-) create mode 100644 components/eamxx/src/share/io/tests/create_diag.cpp diff --git a/components/eamxx/src/diagnostics/CMakeLists.txt b/components/eamxx/src/diagnostics/CMakeLists.txt index be51f434615..8a8dfca560d 100644 --- a/components/eamxx/src/diagnostics/CMakeLists.txt +++ b/components/eamxx/src/diagnostics/CMakeLists.txt @@ -1,4 +1,7 @@ set(DIAGNOSTIC_SRCS + aerocom_cld.cpp + aodvis.cpp + atm_backtend.cpp atm_density.cpp dry_static_energy.cpp exner.cpp @@ -6,6 +9,7 @@ set(DIAGNOSTIC_SRCS field_at_level.cpp field_at_pressure_level.cpp longwave_cloud_forcing.cpp + number_path.cpp potential_temperature.cpp precip_surf_mass_flux.cpp relative_humidity.cpp @@ -17,15 +21,11 @@ set(DIAGNOSTIC_SRCS virtual_temperature.cpp water_path.cpp wind_speed.cpp - aodvis.cpp - number_path.cpp - aerocom_cld.cpp - atm_backtend.cpp ) add_library(diagnostics ${DIAGNOSTIC_SRCS}) target_link_libraries(diagnostics PUBLIC scream_share) -if (NOT SCREAM_LIB_ONLY) +if (NOT SCREAM_LIB_ONLY AND NOT SCREAM_ONLY_GENERATE_BASELINES) add_subdirectory(tests) endif() diff --git a/components/eamxx/src/diagnostics/aerocom_cld.cpp b/components/eamxx/src/diagnostics/aerocom_cld.cpp index 8606e065b9e..cca55f6c19f 100644 --- a/components/eamxx/src/diagnostics/aerocom_cld.cpp +++ b/components/eamxx/src/diagnostics/aerocom_cld.cpp @@ -22,8 +22,6 @@ AeroComCld::AeroComCld(const ekat::Comm &comm, "to be 'Bot' or 'Top' in its input parameters.\n"); } -std::string AeroComCld::name() const { return "AeroComCld" + m_topbot; } - void AeroComCld::set_grids( const std::shared_ptr grids_manager) { using namespace ekat::units; @@ -76,7 +74,8 @@ void AeroComCld::set_grids( m_dz.allocate_view(); // Construct and allocate the output field - FieldIdentifier fid(name(), vector1d_layout, nondim, grid_name); + + FieldIdentifier fid("AeroComCld"+m_topbot, vector1d_layout, nondim, grid_name); m_diagnostic_output = Field(fid); m_diagnostic_output.allocate_view(); diff --git a/components/eamxx/src/diagnostics/aerocom_cld.hpp b/components/eamxx/src/diagnostics/aerocom_cld.hpp index 694eed76f09..53a9a7f8e1b 100644 --- a/components/eamxx/src/diagnostics/aerocom_cld.hpp +++ b/components/eamxx/src/diagnostics/aerocom_cld.hpp @@ -15,7 +15,7 @@ class AeroComCld : public AtmosphereDiagnostic { AeroComCld(const ekat::Comm &comm, const ekat::ParameterList ¶ms); // The name of the diagnostic - std::string name() const override; + std::string name() const override { return "AeroComCld"; } // Set the grid void set_grids( diff --git a/components/eamxx/src/diagnostics/field_at_height.cpp b/components/eamxx/src/diagnostics/field_at_height.cpp index f61cd3a76c1..317bbffaf62 100644 --- a/components/eamxx/src/diagnostics/field_at_height.cpp +++ b/components/eamxx/src/diagnostics/field_at_height.cpp @@ -45,21 +45,16 @@ FieldAtHeight (const ekat::Comm& comm, const ekat::ParameterList& params) " - surface reference: " + surf_ref + "\n" " - valid options: sealevel, surface\n"); m_z_name = (surf_ref == "sealevel") ? "z" : "height"; - const auto& location = m_params.get("vertical_location"); - auto chars_start = location.find_first_not_of("0123456789."); - EKAT_REQUIRE_MSG (chars_start!=0 && chars_start!=std::string::npos, - "Error! Invalid string for height value for FieldAtHeight.\n" - " - input string : " + location + "\n" - " - expected format: Nm, with N integer\n"); - const auto z_str = location.substr(0,chars_start); - m_z = std::stod(z_str); - - const auto units = location.substr(chars_start); + + const auto units = m_params.get("height_units"); EKAT_REQUIRE_MSG (units=="m", - "Error! Invalid string for height value for FieldAtHeight.\n" - " - input string : " + location + "\n" - " - expected format: Nm, with N integer\n"); - m_diag_name = m_field_name + "_at_" + m_params.get("vertical_location") + "_above_" + surf_ref; + "Error! Invalid units for FieldAtHeight.\n" + " - input units: " + units + "\n" + " - valid units: m\n"); + + auto z_val = m_params.get("height_value"); + m_z = std::stod(z_val); + m_diag_name = m_field_name + "_at_" + z_val + units + "_above_" + surf_ref; } void FieldAtHeight:: diff --git a/components/eamxx/src/diagnostics/field_at_height.hpp b/components/eamxx/src/diagnostics/field_at_height.hpp index e6198153f94..91f6ae3eb1b 100644 --- a/components/eamxx/src/diagnostics/field_at_height.hpp +++ b/components/eamxx/src/diagnostics/field_at_height.hpp @@ -18,7 +18,7 @@ class FieldAtHeight : public AtmosphereDiagnostic FieldAtHeight (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic - std::string name () const { return m_diag_name; } + std::string name () const { return "FieldAtHeight"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/field_at_level.hpp b/components/eamxx/src/diagnostics/field_at_level.hpp index b63cda0a1a3..3ab9bee1557 100644 --- a/components/eamxx/src/diagnostics/field_at_level.hpp +++ b/components/eamxx/src/diagnostics/field_at_level.hpp @@ -21,7 +21,7 @@ class FieldAtLevel : public AtmosphereDiagnostic FieldAtLevel (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic - std::string name () const { return m_diag_name; } + std::string name () const { return "FieldAtLevel"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/field_at_pressure_level.cpp b/components/eamxx/src/diagnostics/field_at_pressure_level.cpp index 21c1ac78dd9..716c8f563af 100644 --- a/components/eamxx/src/diagnostics/field_at_pressure_level.cpp +++ b/components/eamxx/src/diagnostics/field_at_pressure_level.cpp @@ -15,30 +15,22 @@ FieldAtPressureLevel (const ekat::Comm& comm, const ekat::ParameterList& params) { m_field_name = m_params.get("field_name"); - // Figure out the pressure value - const auto& location = m_params.get("vertical_location"); - auto chars_start = location.find_first_not_of("0123456789."); - EKAT_REQUIRE_MSG (chars_start!=0 && chars_start!=std::string::npos, - "Error! Invalid string for pressure value for FieldAtPressureLevel.\n" - " - input string : " + location + "\n" - " - expected format: Nxyz, with N integer, and xyz='mb', 'hPa', or 'Pa'\n"); - const auto press_str = location.substr(0,chars_start); - m_pressure_level = std::stod(press_str); - - const auto units = location.substr(chars_start); + const auto units = m_params.get("pressure_units"); EKAT_REQUIRE_MSG (units=="mb" or units=="hPa" or units=="Pa", - "Error! Invalid string for pressure value for FieldAtPressureLevel.\n" - " - input string : " + location + "\n" - " - expected format: Nxyz, with N integer, and xyz='mb', 'hPa', or 'Pa'\n"); + "Error! Invalid units for FieldAtPressureLevel.\n" + " - input units: " + units + "\n" + " - valid units: 'mb', 'hPa', 'Pa'\n"); + + // Figure out the pressure value, and convert to Pa if needed + auto p_value = m_params.get("pressure_value"); - // Convert pressure level to Pa, the units of pressure in the simulation if (units=="mb" || units=="hPa") { - m_pressure_level *= 100; + m_pressure_level = std::stod(p_value)*100; + } else { + m_pressure_level = std::stod(p_value); } - m_mask_val = m_params.get("mask_value",Real(constants::DefaultFillValue::value)); - - m_diag_name = m_field_name + "_at_" + location; + m_diag_name = m_field_name + "_at_" + p_value + units; } void FieldAtPressureLevel:: @@ -91,6 +83,8 @@ initialize_impl (const RunType /*run_type*/) // Add a field representing the mask as extra data to the diagnostic field. auto nondim = ekat::units::Units::nondimensional(); const auto& gname = fid.get_grid_name(); + m_mask_val = m_params.get("mask_value",Real(constants::DefaultFillValue::value)); + std::string mask_name = name() + " mask"; FieldLayout mask_layout( {COL}, {num_cols}); diff --git a/components/eamxx/src/diagnostics/field_at_pressure_level.hpp b/components/eamxx/src/diagnostics/field_at_pressure_level.hpp index 950c0c5e2ee..58e476ec83b 100644 --- a/components/eamxx/src/diagnostics/field_at_pressure_level.hpp +++ b/components/eamxx/src/diagnostics/field_at_pressure_level.hpp @@ -20,7 +20,7 @@ class FieldAtPressureLevel : public AtmosphereDiagnostic FieldAtPressureLevel (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic - std::string name () const { return m_diag_name; } + std::string name () const { return "FieldAtPressureLevel"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/number_path.cpp b/components/eamxx/src/diagnostics/number_path.cpp index d4df2f1bc22..70e18c6dee3 100644 --- a/components/eamxx/src/diagnostics/number_path.cpp +++ b/components/eamxx/src/diagnostics/number_path.cpp @@ -33,8 +33,6 @@ NumberPathDiagnostic::NumberPathDiagnostic(const ekat::Comm &comm, } } -std::string NumberPathDiagnostic::name() const { return m_kind + "NumberPath"; } - void NumberPathDiagnostic::set_grids( const std::shared_ptr grids_manager) { using namespace ekat::units; @@ -55,7 +53,7 @@ void NumberPathDiagnostic::set_grids( add_field(m_nname, scalar3d, 1 / kg, grid_name); // Construct and allocate the diagnostic field - FieldIdentifier fid(name(), scalar2d, kg/(kg*m2), grid_name); + FieldIdentifier fid(m_kind + "NumberPath", scalar2d, kg/(kg*m2), grid_name); m_diagnostic_output = Field(fid); m_diagnostic_output.allocate_view(); } diff --git a/components/eamxx/src/diagnostics/number_path.hpp b/components/eamxx/src/diagnostics/number_path.hpp index 4888d3601f4..30b383b9452 100644 --- a/components/eamxx/src/diagnostics/number_path.hpp +++ b/components/eamxx/src/diagnostics/number_path.hpp @@ -16,7 +16,7 @@ class NumberPathDiagnostic : public AtmosphereDiagnostic { const ekat::ParameterList ¶ms); // The name of the diagnostic - std::string name() const; + std::string name() const override { return "NumberPath"; } // Set the grid void set_grids(const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/potential_temperature.cpp b/components/eamxx/src/diagnostics/potential_temperature.cpp index 67260e647f6..8cc45078de7 100644 --- a/components/eamxx/src/diagnostics/potential_temperature.cpp +++ b/components/eamxx/src/diagnostics/potential_temperature.cpp @@ -24,11 +24,6 @@ PotentialTemperatureDiagnostic::PotentialTemperatureDiagnostic (const ekat::Comm } } -std::string PotentialTemperatureDiagnostic::name() const -{ - return m_ptype; -} - // ========================================================================================= void PotentialTemperatureDiagnostic::set_grids(const std::shared_ptr grids_manager) { @@ -51,7 +46,7 @@ void PotentialTemperatureDiagnostic::set_grids(const std::shared_ptr("qc", scalar3d_layout_mid, kg/kg, grid_name, ps); // Construct and allocate the diagnostic field - FieldIdentifier fid (name(), scalar3d_layout_mid, K, grid_name); + FieldIdentifier fid (m_ptype, scalar3d_layout_mid, K, grid_name); m_diagnostic_output = Field(fid); auto& C_ap = m_diagnostic_output.get_header().get_alloc_properties(); C_ap.request_allocation(ps); diff --git a/components/eamxx/src/diagnostics/potential_temperature.hpp b/components/eamxx/src/diagnostics/potential_temperature.hpp index 37fd1a30806..0ac1a1201d8 100644 --- a/components/eamxx/src/diagnostics/potential_temperature.hpp +++ b/components/eamxx/src/diagnostics/potential_temperature.hpp @@ -22,7 +22,7 @@ class PotentialTemperatureDiagnostic : public AtmosphereDiagnostic PotentialTemperatureDiagnostic (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic - std::string name () const; + std::string name () const override { return "PotentialTemperature"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp b/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp index 068456f0522..329e83b6e9c 100644 --- a/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp +++ b/components/eamxx/src/diagnostics/precip_surf_mass_flux.cpp @@ -47,7 +47,7 @@ set_grids(const std::shared_ptr grids_manager) } // Construct and allocate the diagnostic field - FieldIdentifier fid(name(), scalar2d_layout_mid, m/s, grid_name); + FieldIdentifier fid(m_name, scalar2d_layout_mid, m/s, grid_name); m_diagnostic_output = Field(fid); m_diagnostic_output.get_header().get_alloc_properties().request_allocation(); m_diagnostic_output.allocate_view(); diff --git a/components/eamxx/src/diagnostics/precip_surf_mass_flux.hpp b/components/eamxx/src/diagnostics/precip_surf_mass_flux.hpp index 68dd1251646..6ff3458398d 100644 --- a/components/eamxx/src/diagnostics/precip_surf_mass_flux.hpp +++ b/components/eamxx/src/diagnostics/precip_surf_mass_flux.hpp @@ -17,7 +17,7 @@ class PrecipSurfMassFlux : public AtmosphereDiagnostic PrecipSurfMassFlux (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic - std::string name () const { return m_name; } + std::string name () const { return "PrecipSurfMassFlux"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/register_diagnostics.hpp b/components/eamxx/src/diagnostics/register_diagnostics.hpp index 45a04eebeb1..b4830c39e92 100644 --- a/components/eamxx/src/diagnostics/register_diagnostics.hpp +++ b/components/eamxx/src/diagnostics/register_diagnostics.hpp @@ -36,13 +36,6 @@ inline void register_diagnostics () { diag_factory.register_product("AtmosphereDensity",&create_atmosphere_diagnostic); diag_factory.register_product("Exner",&create_atmosphere_diagnostic); diag_factory.register_product("VirtualTemperature",&create_atmosphere_diagnostic); - diag_factory.register_product("z_int",&create_atmosphere_diagnostic); - diag_factory.register_product("z_mid",&create_atmosphere_diagnostic); - diag_factory.register_product("geopotential_int",&create_atmosphere_diagnostic); - diag_factory.register_product("geopotential_mid",&create_atmosphere_diagnostic); - diag_factory.register_product("height_int",&create_atmosphere_diagnostic); - diag_factory.register_product("height_mid",&create_atmosphere_diagnostic); - diag_factory.register_product("dz",&create_atmosphere_diagnostic); diag_factory.register_product("DryStaticEnergy",&create_atmosphere_diagnostic); diag_factory.register_product("SeaLevelPressure",&create_atmosphere_diagnostic); diag_factory.register_product("WaterPath",&create_atmosphere_diagnostic); @@ -50,6 +43,7 @@ inline void register_diagnostics () { diag_factory.register_product("LongwaveCloudForcing",&create_atmosphere_diagnostic); diag_factory.register_product("RelativeHumidity",&create_atmosphere_diagnostic); diag_factory.register_product("VaporFlux",&create_atmosphere_diagnostic); + diag_factory.register_product("VerticalLayer",&create_atmosphere_diagnostic); diag_factory.register_product("precip_surf_mass_flux",&create_atmosphere_diagnostic); diag_factory.register_product("surface_upward_latent_heat_flux",&create_atmosphere_diagnostic); diag_factory.register_product("wind_speed",&create_atmosphere_diagnostic); @@ -60,4 +54,5 @@ inline void register_diagnostics () { } } // namespace scream + #endif // SCREAM_REGISTER_DIAGNOSTICS_HPP diff --git a/components/eamxx/src/diagnostics/tests/CMakeLists.txt b/components/eamxx/src/diagnostics/tests/CMakeLists.txt index a684aa248fc..5b318a04922 100644 --- a/components/eamxx/src/diagnostics/tests/CMakeLists.txt +++ b/components/eamxx/src/diagnostics/tests/CMakeLists.txt @@ -1,4 +1,4 @@ -# NOTE: tests inside this if statement won't be built in a baselines-only build +include(ScreamUtils) function (createDiagTest test_name test_srcs) CreateUnitTest(${test_name} "${test_srcs}" @@ -6,72 +6,68 @@ function (createDiagTest test_name test_srcs) LABELS diagnostics) endfunction () -if (NOT SCREAM_ONLY_GENERATE_BASELINES) - include(ScreamUtils) +# Test extracting a single level of a field +CreateDiagTest(field_at_level "field_at_level_tests.cpp") - # Test extracting a single level of a field - CreateDiagTest(field_at_level "field_at_level_tests.cpp") +# Test interpolating a field onto a single pressure level +CreateDiagTest(field_at_pressure_level "field_at_pressure_level_tests.cpp") - # Test interpolating a field onto a single pressure level - CreateDiagTest(field_at_pressure_level "field_at_pressure_level_tests.cpp") - # Test interpolating a field at a specific height - CreateDiagTest(field_at_height "field_at_height_tests.cpp") +# Test interpolating a field at a specific height +CreateDiagTest(field_at_height "field_at_height_tests.cpp") - # Test potential temperature diagnostic - CreateDiagTest(potential_temperature "potential_temperature_test.cpp") +# Test potential temperature diagnostic +CreateDiagTest(potential_temperature "potential_temperature_test.cpp") - # Test exner diagnostic - CreateDiagTest(exner_function "exner_test.cpp") +# Test exner diagnostic +CreateDiagTest(exner_function "exner_test.cpp") - # Test virtual temperature - CreateDiagTest(virtual_temperature "virtual_temperature_test.cpp") +# Test virtual temperature +CreateDiagTest(virtual_temperature "virtual_temperature_test.cpp") - # Test atmosphere density - CreateDiagTest(atmosphere_density "atm_density_test.cpp") +# Test atmosphere density +CreateDiagTest(atmosphere_density "atm_density_test.cpp") - # Test vertical layer (dz, z_int, z_mid) - CreateDiagTest(vertical_layer "vertical_layer_tests.cpp") +# Test vertical layer (dz, z_int, z_mid) +CreateDiagTest(vertical_layer "vertical_layer_tests.cpp") - # Test dry static energy - CreateDiagTest(dry_static_energy "dry_static_energy_test.cpp") +# Test dry static energy +CreateDiagTest(dry_static_energy "dry_static_energy_test.cpp") - # Test sea level pressure - CreateDiagTest(sea_level_pressure "sea_level_pressure_test.cpp") +# Test sea level pressure +CreateDiagTest(sea_level_pressure "sea_level_pressure_test.cpp") - # Test total water path - CreateDiagTest(water_path "water_path_tests.cpp") +# Test total water path +CreateDiagTest(water_path "water_path_tests.cpp") - # Test shortwave cloud forcing - CreateDiagTest(shortwave_cloud_forcing "shortwave_cloud_forcing_tests.cpp") +# Test shortwave cloud forcing +CreateDiagTest(shortwave_cloud_forcing "shortwave_cloud_forcing_tests.cpp") - # Test longwave cloud forcing - CreateDiagTest(longwave_cloud_forcing "longwave_cloud_forcing_tests.cpp") +# Test longwave cloud forcing +CreateDiagTest(longwave_cloud_forcing "longwave_cloud_forcing_tests.cpp") - # Test Relative Humidity - CreateDiagTest(relative_humidity "relative_humidity_tests.cpp") +# Test Relative Humidity +CreateDiagTest(relative_humidity "relative_humidity_tests.cpp") - # Test Vapor Flux - CreateDiagTest(vapor_flux "vapor_flux_tests.cpp") +# Test Vapor Flux +CreateDiagTest(vapor_flux "vapor_flux_tests.cpp") - # Test precipitation mass surface flux - CreateDiagTest(precip_surf_mass_flux "precip_surf_mass_flux_tests.cpp") +# Test precipitation mass surface flux +CreateDiagTest(precip_surf_mass_flux "precip_surf_mass_flux_tests.cpp") - # Test surface latent heat flux - CreateDiagTest(surface_upward_latent_heat_flux "surf_upward_latent_heat_flux_tests.cpp") +# Test surface latent heat flux +CreateDiagTest(surface_upward_latent_heat_flux "surf_upward_latent_heat_flux_tests.cpp") - # Test wind speed diagnostic - CreateDiagTest(wind_speed "wind_speed_tests.cpp") +# Test wind speed diagnostic +CreateDiagTest(wind_speed "wind_speed_tests.cpp") - # Test AODVIS - CreateDiagTest(aodvis "aodvis_test.cpp") +# Test AODVIS +CreateDiagTest(aodvis "aodvis_test.cpp") - # Test "number" paths - CreateDiagTest(number_paths "number_paths_tests.cpp") +# Test "number" paths +CreateDiagTest(number_paths "number_paths_tests.cpp") - # Test AEROCOM_CLD - CreateDiagTest(aerocom_cld "aerocom_cld_test.cpp") +# Test AEROCOM_CLD +CreateDiagTest(aerocom_cld "aerocom_cld_test.cpp") - # Test atm_tend - CreateDiagTest(atm_backtend "atm_backtend_test.cpp") - -endif() +# Test atm_tend +CreateDiagTest(atm_backtend "atm_backtend_test.cpp") diff --git a/components/eamxx/src/diagnostics/tests/field_at_height_tests.cpp b/components/eamxx/src/diagnostics/tests/field_at_height_tests.cpp index e26d34dd1a5..6e071e4b201 100644 --- a/components/eamxx/src/diagnostics/tests/field_at_height_tests.cpp +++ b/components/eamxx/src/diagnostics/tests/field_at_height_tests.cpp @@ -104,12 +104,13 @@ TEST_CASE("field_at_height") // Lambda to create and run a diag, and return output auto run_diag = [&](const Field& f, const Field& z, - const std::string& loc, const std::string& surf_ref) { + const double h, const std::string& surf_ref) { util::TimeStamp t0 ({2022,1,1},{0,0,0}); auto& factory = AtmosphereDiagnosticFactory::instance(); ekat::ParameterList pl; pl.set("surface_reference",surf_ref); - pl.set("vertical_location",loc); + pl.set("height_value",std::to_string(h)); + pl.set("height_units",std::string("m")); pl.set("field_name",f.name()); pl.set("grid_name",grid->name()); auto diag = factory.create("FieldAtheight",comm,pl); @@ -173,13 +174,12 @@ TEST_CASE("field_at_height") // Make sure that an unsupported reference height throws an error. print(" -> Testing throws error with unsupported reference height...\n"); { - REQUIRE_THROWS(run_diag (s_mid,h_mid,"1m","foobar")); + REQUIRE_THROWS(run_diag (s_mid,h_mid,1.0,"foobar")); } print(" -> Testing throws error with unsupported reference height... OK\n"); // Run many times int z_tgt; - std::string loc; for (std::string surf_ref : {"sealevel","surface"}) { printf(" -> Testing for a reference height above %s...\n",surf_ref.c_str()); const auto mid_src = surf_ref == "sealevel" ? z_mid : h_mid; @@ -197,32 +197,31 @@ TEST_CASE("field_at_height") // Set target z-slice for testing to a random value. z_tgt = pdf_levs(engine)+max_surf_4test; - loc = std::to_string(z_tgt) + "m"; - printf(" -> test at height of %s.............\n",loc.c_str()); + printf(" -> test at height of %dm............\n",z_tgt); { print(" -> scalar midpoint field...............\n"); - auto d = run_diag(s_mid,mid_src,loc,surf_ref); + auto d = run_diag(s_mid,mid_src,z_tgt,surf_ref); f_z_tgt(inter,slope,z_tgt,mid_src,s_tgt); REQUIRE (views_are_approx_equal(d,s_tgt,tol)); print(" -> scalar midpoint field............... OK!\n"); } { print(" -> scalar interface field...............\n"); - auto d = run_diag (s_int,int_src,loc,surf_ref); + auto d = run_diag (s_int,int_src,z_tgt,surf_ref); f_z_tgt(inter,slope,z_tgt,int_src,s_tgt); REQUIRE (views_are_approx_equal(d,s_tgt,tol)); print(" -> scalar interface field............... OK!\n"); } { print(" -> vector midpoint field...............\n"); - auto d = run_diag (v_mid,mid_src,loc,surf_ref); + auto d = run_diag (v_mid,mid_src,z_tgt,surf_ref); f_z_tgt(inter,slope,z_tgt,mid_src,v_tgt); REQUIRE (views_are_approx_equal(d,v_tgt,tol)); print(" -> vector midpoint field............... OK!\n"); } { print(" -> vector interface field...............\n"); - auto d = run_diag (v_int,int_src,loc,surf_ref); + auto d = run_diag (v_int,int_src,z_tgt,surf_ref); f_z_tgt(inter,slope,z_tgt,int_src,v_tgt); REQUIRE (views_are_approx_equal(d,v_tgt,tol)); print(" -> vector interface field............... OK!\n"); @@ -230,8 +229,7 @@ TEST_CASE("field_at_height") { print(" -> Forced fail, give incorrect location...............\n"); const int z_tgt_adj = (z_tgt+max_surf_4test)/2; - std::string loc_err = std::to_string(z_tgt_adj) + "m"; - auto d = run_diag(s_int,int_src,loc_err,surf_ref); + auto d = run_diag(s_int,int_src,z_tgt_adj,surf_ref); f_z_tgt(inter,slope,z_tgt,int_src,s_tgt); REQUIRE (!views_are_approx_equal(d,s_tgt,tol,false)); print(" -> Forced fail, give incorrect location............... OK!\n"); @@ -243,15 +241,13 @@ TEST_CASE("field_at_height") auto inter = pdf_y0(engine); f_z_src(inter, slope, int_src, s_int); z_tgt = 2*z_top; - std::string loc = std::to_string(z_tgt) + "m"; - auto dtop = run_diag(s_int,int_src,loc,surf_ref); + auto dtop = run_diag(s_int,int_src,z_tgt,surf_ref); f_z_tgt(inter,slope,z_tgt,int_src,s_tgt); REQUIRE (views_are_approx_equal(dtop,s_tgt,tol)); print(" -> Forced extrapolation at top............... OK!\n"); print(" -> Forced extrapolation at bot...............\n"); z_tgt = 0; - loc = std::to_string(z_tgt) + "m"; - auto dbot = run_diag(s_int,int_src,loc,surf_ref); + auto dbot = run_diag(s_int,int_src,z_tgt,surf_ref); f_z_tgt(inter,slope,z_tgt,int_src,s_tgt); REQUIRE (views_are_approx_equal(dbot,s_tgt,tol)); print(" -> Forced extrapolation at bot............... OK!\n"); diff --git a/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp b/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp index 4e0deab1dfc..ba733980cad 100644 --- a/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp +++ b/components/eamxx/src/diagnostics/tests/field_at_pressure_level_tests.cpp @@ -224,7 +224,8 @@ get_test_diag(const ekat::Comm& comm, std::shared_ptr fm, st ekat::ParameterList params; params.set("field_name",field.name()); params.set("grid_name",fm->get_grid()->name()); - params.set("vertical_location",std::to_string(plevel) + "Pa"); + params.set("pressure_value",std::to_string(plevel)); + params.set("pressure_units",std::string("Pa")); auto diag = std::make_shared(comm,params); diag->set_grids(gm); for (const auto& req : diag->get_required_field_requests()) { diff --git a/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp b/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp index fe75114611d..631cb5acd8a 100644 --- a/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp +++ b/components/eamxx/src/diagnostics/tests/vertical_layer_tests.cpp @@ -50,14 +50,10 @@ void run (const std::string& diag_name, const std::string& location) // Construct the Diagnostic ekat::ParameterList params; - std::string name = diag_name; - if (location=="midpoints") { - name += "_mid"; - } else if (location=="interfaces") { - name += "_int"; - } - params.set("diag_name", name); - auto diag = diag_factory.create(name,comm,params); + + params.set("diag_name", diag_name); + params.set("vert_location",location); + auto diag = diag_factory.create("VerticalLayer",comm,params); diag->set_grids(gm); const bool needs_phis = diag_name=="z" or diag_name=="geopotential"; @@ -180,7 +176,7 @@ TEST_CASE("vertical_layer_test", "vertical_layer_test]"){ std::string msg = " -> Testing diag=dz "; std::string dots (50-msg.size(),'.'); root_print (msg + dots + "\n"); - run("dz", "UNUSED"); + run("dz", "midpoints"); root_print (msg + dots + " PASS!\n"); }; diff --git a/components/eamxx/src/diagnostics/vapor_flux.cpp b/components/eamxx/src/diagnostics/vapor_flux.cpp index ce88c144301..b6577bf1205 100644 --- a/components/eamxx/src/diagnostics/vapor_flux.cpp +++ b/components/eamxx/src/diagnostics/vapor_flux.cpp @@ -26,11 +26,6 @@ VaporFluxDiagnostic (const ekat::Comm& comm, const ekat::ParameterList& params) } } -std::string VaporFluxDiagnostic::name() const -{ - return m_component==0 ? "ZonalVapFlux" : "MeridionalVapFlux"; -} - void VaporFluxDiagnostic::set_grids(const std::shared_ptr grids_manager) { using namespace ekat::units; @@ -51,7 +46,8 @@ void VaporFluxDiagnostic::set_grids(const std::shared_ptr gr add_field("horiz_winds", vector3d, m/s, grid_name); // Construct and allocate the diagnostic field - FieldIdentifier fid (name(), scalar2d, kg/m/s, grid_name); + std::string dname = m_component==0 ? "ZonalVapFlux" : "MeridionalVapFlux"; + FieldIdentifier fid (dname, scalar2d, kg/m/s, grid_name); m_diagnostic_output = Field(fid); m_diagnostic_output.allocate_view(); } diff --git a/components/eamxx/src/diagnostics/vapor_flux.hpp b/components/eamxx/src/diagnostics/vapor_flux.hpp index 3d82fd882f8..5bacd78a9b7 100644 --- a/components/eamxx/src/diagnostics/vapor_flux.hpp +++ b/components/eamxx/src/diagnostics/vapor_flux.hpp @@ -17,7 +17,7 @@ class VaporFluxDiagnostic : public AtmosphereDiagnostic VaporFluxDiagnostic (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic - std::string name () const; + std::string name () const override { return "VaporFlux"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/vertical_layer.cpp b/components/eamxx/src/diagnostics/vertical_layer.cpp index 32d870da03c..f9ff526dfcd 100644 --- a/components/eamxx/src/diagnostics/vertical_layer.cpp +++ b/components/eamxx/src/diagnostics/vertical_layer.cpp @@ -13,25 +13,27 @@ VerticalLayerDiagnostic (const ekat::Comm& comm, const ekat::ParameterList& para : AtmosphereDiagnostic(comm,params) { m_diag_name = params.get("diag_name"); - std::vector supported = { - "z_int", - "z_mid", - "geopotential_int", - "geopotential_mid", - "height_int", - "height_mid", - "dz" - }; + std::vector supported = {"z","geopotential","height","dz"}; EKAT_REQUIRE_MSG(ekat::contains(supported,m_diag_name), "[VerticalLayerDiagnostic] Error! Invalid diag_name.\n" " - diag_name : " + m_diag_name + "\n" " - valid names: " + ekat::join(supported,", ") + "\n"); - m_is_interface_layout = m_diag_name.find("_int") != std::string::npos; + auto vert_pos = params.get("vert_location"); + EKAT_REQUIRE_MSG (vert_pos=="mid" || vert_pos=="int" || + vert_pos=="midpoints" || vert_pos=="interfaces", + "[VerticalLayerDiagnostic] Error! Invalid 'vert_location'.\n" + " - input value: " + vert_pos + "\n" + " - valid names: mid, midpoints, int, interfaces\n"); + m_is_interface_layout = vert_pos=="int" || vert_pos=="interfaces"; + + m_geopotential = m_diag_name=="geopotential"; + m_from_sea_level = m_diag_name=="z" or m_geopotential; - m_geopotential = m_diag_name.substr(0,12)=="geopotential"; - m_from_sea_level = m_diag_name[0]=='z' or m_geopotential; + if (m_diag_name!="dz") { + m_diag_name += m_is_interface_layout ? "_int" : "_mid"; + } } // ======================================================================================== void VerticalLayerDiagnostic:: @@ -88,7 +90,7 @@ initialize_impl (const RunType /*run_type*/) const auto VLEV = m_is_interface_layout ? ILEV : LEV; const auto nlevs = m_is_interface_layout ? m_num_levs+1 : m_num_levs; FieldLayout diag_layout ({COL,VLEV},{m_num_cols,nlevs}); - FieldIdentifier fid (name(), diag_layout, m_geopotential ? m2/s2 : m, grid_name); + FieldIdentifier fid (m_diag_name, diag_layout, m_geopotential ? m2/s2 : m, grid_name); m_diagnostic_output = Field(fid); auto& diag_fap = m_diagnostic_output.get_header().get_alloc_properties(); diff --git a/components/eamxx/src/diagnostics/vertical_layer.hpp b/components/eamxx/src/diagnostics/vertical_layer.hpp index 805fd70028f..a440bd6a8ee 100644 --- a/components/eamxx/src/diagnostics/vertical_layer.hpp +++ b/components/eamxx/src/diagnostics/vertical_layer.hpp @@ -24,7 +24,7 @@ class VerticalLayerDiagnostic : public AtmosphereDiagnostic VerticalLayerDiagnostic (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic. - std::string name () const { return m_diag_name; } + std::string name () const { return "VerticalLayer"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/diagnostics/water_path.cpp b/components/eamxx/src/diagnostics/water_path.cpp index 15fa5cdef38..bca771e6dab 100644 --- a/components/eamxx/src/diagnostics/water_path.cpp +++ b/components/eamxx/src/diagnostics/water_path.cpp @@ -32,11 +32,6 @@ WaterPathDiagnostic (const ekat::Comm& comm, const ekat::ParameterList& params) } } -std::string WaterPathDiagnostic::name() const -{ - return m_kind + "WaterPath"; -} - void WaterPathDiagnostic:: set_grids(const std::shared_ptr grids_manager) { @@ -57,7 +52,7 @@ set_grids(const std::shared_ptr grids_manager) add_field(m_qname, scalar3d, kg/kg, grid_name); // Construct and allocate the diagnostic field - FieldIdentifier fid (name(), scalar2d, kg/m2, grid_name); + FieldIdentifier fid (m_kind + "WaterPath", scalar2d, kg/m2, grid_name); m_diagnostic_output = Field(fid); m_diagnostic_output.allocate_view(); } diff --git a/components/eamxx/src/diagnostics/water_path.hpp b/components/eamxx/src/diagnostics/water_path.hpp index 0b9515e0b42..722a51a3133 100644 --- a/components/eamxx/src/diagnostics/water_path.hpp +++ b/components/eamxx/src/diagnostics/water_path.hpp @@ -17,7 +17,7 @@ class WaterPathDiagnostic : public AtmosphereDiagnostic WaterPathDiagnostic (const ekat::Comm& comm, const ekat::ParameterList& params); // The name of the diagnostic - std::string name () const; + std::string name () const override { return "WaterPath"; } // Set the grid void set_grids (const std::shared_ptr grids_manager); diff --git a/components/eamxx/src/share/io/CMakeLists.txt b/components/eamxx/src/share/io/CMakeLists.txt index 6c24d3bc51d..4908e4ae0c9 100644 --- a/components/eamxx/src/share/io/CMakeLists.txt +++ b/components/eamxx/src/share/io/CMakeLists.txt @@ -59,7 +59,7 @@ add_library(scream_io scream_io_utils.cpp ) -target_link_libraries(scream_io PUBLIC scream_share scream_scorpio_interface) +target_link_libraries(scream_io PUBLIC scream_share scream_scorpio_interface diagnostics) if (NOT SCREAM_LIB_ONLY) add_subdirectory(tests) diff --git a/components/eamxx/src/share/io/scorpio_output.cpp b/components/eamxx/src/share/io/scorpio_output.cpp index 47a5616aec5..4e9d5add800 100644 --- a/components/eamxx/src/share/io/scorpio_output.cpp +++ b/components/eamxx/src/share/io/scorpio_output.cpp @@ -6,6 +6,8 @@ #include "share/util/scream_timing.hpp" #include "share/field/field_utils.hpp" +#include "diagnostics/register_diagnostics.hpp" + #include "ekat/util/ekat_units.hpp" #include "ekat/util/ekat_string_utils.hpp" #include "ekat/std_meta/ekat_std_utils.hpp" @@ -1334,153 +1336,49 @@ void AtmosphereOutput::set_diagnostics() /* ---------------------------------------------------------- */ std::shared_ptr -AtmosphereOutput::create_diagnostic (const std::string& diag_field_name) { - auto& diag_factory = AtmosphereDiagnosticFactory::instance(); +AtmosphereOutput::create_diagnostic (const std::string& diag_field_name) +{ + // We need scream scope resolution, since this->create_diagnostic is hiding it + auto diag = scream::create_diagnostic(diag_field_name,get_field_manager("sim")->get_grid()); - // Construct a diagnostic by this name - ekat::ParameterList params; - std::string diag_name; + // Some diags need some extra setup or trigger extra behaviors std::string diag_avg_cnt_name = ""; - - if (diag_field_name.find("_at_")!=std::string::npos) { - // The diagnostic must be one of - // - ${field_name}_at_lev_${N} <- interface fields still use "_lev_" - // - ${field_name}_at_model_bot - // - ${field_name}_at_model_top - // - ${field_name}_at_${M}X - // where M/N are numbers (N integer), X=Pa, hPa, mb, or m - auto tokens = ekat::split(diag_field_name,"_at_"); - EKAT_REQUIRE_MSG (tokens.size()==2, - "Error! Unexpected diagnostic name: " + diag_field_name + "\n"); - - const auto& fname = tokens.front(); - params.set("field_name",fname); - params.set("grid_name",get_field_manager("sim")->get_grid()->name()); - - params.set("vertical_location", tokens[1]); + auto& params = diag->get_params(); + if (diag->name()=="FieldAtPressureLevel") { params.set("mask_value",m_fill_value); - - // Conventions on notation (N=any integer): - // FieldAtLevel : var_at_lev_N, var_at_model_top, var_at_model_bot - // FieldAtPressureLevel: var_at_Nx, with x=mb,Pa,hPa - // FieldAtHeight : var_at_Nm_above_Y (Y=sealevel or surface) - if (tokens[1].find_first_of("0123456789.")==0) { - auto units_start = tokens[1].find_first_not_of("0123456789."); - auto units = tokens[1].substr(units_start); - if (units.find("_above_") != std::string::npos) { - // The field is at a height above a specific reference. - // Currently we only support FieldAtHeight above "sealevel" or "surface" - auto subtokens = ekat::split(units,"_above_"); - params.set("surface_reference",subtokens[1]); - units = subtokens[0]; - // Need to reset the vertical location to strip the "_above_" part of the string. - params.set("vertical_location", tokens[1].substr(0,units_start)+subtokens[0]); - // If the slice is "above_sealevel" then we need to track the avg cnt uniquely. - // Note, "above_surface" is expected to never have masking and can thus use - // the typical 2d layout avg cnt. - if (subtokens[1]=="sealevel") { - diag_avg_cnt_name = "_" + tokens[1]; // Set avg_cnt tracking for this specific slice - // If we have 2D slices we need to be tracking the average count, - // if m_avg_type is not Instant - m_track_avg_cnt = m_track_avg_cnt || m_avg_type!=OutputAvgType::Instant; - } - } - if (units=="m") { - diag_name = "FieldAtHeight"; - EKAT_REQUIRE_MSG(params.isParameter("surface_reference"),"Error! Output field request for " + diag_field_name + " is missing a surface reference." - " Please add either '_above_sealevel' or '_above_surface' to the field name"); - } else if (units=="mb" or units=="Pa" or units=="hPa") { - diag_name = "FieldAtPressureLevel"; - diag_avg_cnt_name = "_" + tokens[1]; // Set avg_cnt tracking for this specific slice - // If we have 2D slices we need to be tracking the average count, - // if m_avg_type is not Instant - m_track_avg_cnt = m_track_avg_cnt || m_avg_type!=OutputAvgType::Instant; - } else { - EKAT_ERROR_MSG ("Error! Invalid units x for 'field_at_Nx' diagnostic.\n"); - } - } else { - diag_name = "FieldAtLevel"; + diag_avg_cnt_name = "_" + + params.get("pressure_value") + + params.get("pressure_units"); + m_track_avg_cnt = m_track_avg_cnt || m_avg_type!=OutputAvgType::Instant; + } else if (diag->name()=="FieldAtHeight") { + if (params.get("surface_reference")=="sealevel") { + diag_avg_cnt_name = "_" + + params.get("height_value") + + params.get("height_units") + "_above_sealevel"; + m_track_avg_cnt = m_track_avg_cnt || m_avg_type!=OutputAvgType::Instant; } - } else if (diag_field_name=="precip_liq_surf_mass_flux" or - diag_field_name=="precip_ice_surf_mass_flux" or - diag_field_name=="precip_total_surf_mass_flux") { - diag_name = "precip_surf_mass_flux"; - // split will return [X, ''], with X being whatever is before '_surf_mass_flux' - auto type = ekat::split(diag_field_name.substr(7),"_surf_mass_flux").front(); - params.set("precip_type",type); - } else if (diag_field_name=="IceWaterPath" or - diag_field_name=="LiqWaterPath" or - diag_field_name=="RainWaterPath" or - diag_field_name=="RimeWaterPath" or - diag_field_name=="VapWaterPath") { - diag_name = "WaterPath"; - // split will return the list [X, ''], with X being whatever is before 'WaterPath' - params.set("Water Kind",ekat::split(diag_field_name,"WaterPath").front()); - } else if (diag_field_name=="IceNumberPath" or - diag_field_name=="LiqNumberPath" or - diag_field_name=="RainNumberPath") { - diag_name = "NumberPath"; - // split will return the list [X, ''], with X being whatever is before 'NumberPath' - params.set("Number Kind",ekat::split(diag_field_name,"NumberPath").front()); - } else if (diag_field_name=="AeroComCldTop" or - diag_field_name=="AeroComCldBot") { - diag_name = "AeroComCld"; - // split will return the list ['', X], with X being whatever is after 'AeroComCld' - params.set("AeroComCld Kind",ekat::split(diag_field_name,"AeroComCld").back()); - } else if (diag_field_name=="MeridionalVapFlux" or - diag_field_name=="ZonalVapFlux") { - diag_name = "VaporFlux"; - // split will return the list [X, ''], with X being whatever is before 'VapFlux' - params.set("Wind Component",ekat::split(diag_field_name,"VapFlux").front()); - } else if (diag_field_name.find("_atm_backtend")!=std::string::npos) { - diag_name = "AtmBackTendDiag"; - // Set the grid_name - params.set("grid_name",get_field_manager("sim")->get_grid()->name()); - // split will return [X, ''], with X being whatever is before '_atm_tend' - params.set("Tendency Name",ekat::split(diag_field_name,"_atm_backtend").front()); - } else if (diag_field_name=="PotentialTemperature" or - diag_field_name=="LiqPotentialTemperature") { - diag_name = "PotentialTemperature"; - if (diag_field_name == "LiqPotentialTemperature") { - params.set("Temperature Kind", "Liq"); - } else { - params.set("Temperature Kind", "Tot"); - } - } else { - diag_name = diag_field_name; - } - - // These fields are special case of VerticalLayer diagnostic. - // The diagnostics requires the name to be given as param value. - if (diag_name == "z_int" or diag_name == "z_mid" or - diag_name == "geopotential_int" or diag_name == "geopotential_mid" or - diag_name == "height_int" or diag_name == "height_mid" or - diag_name == "dz") { - params.set("diag_name", diag_name); } - // Create the diagnostic - auto diag = diag_factory.create(diag_name,m_comm,params); - diag->set_grids(m_grids_manager); - // Ensure there's an entry in the map for this diag, so .at(diag_name) always works - auto& deps = m_diag_depends_on_diags[diag->name()]; + auto& deps = m_diag_depends_on_diags[diag_field_name]; // Initialize the diagnostic const auto sim_field_mgr = get_field_manager("sim"); for (const auto& freq : diag->get_required_field_requests()) { const auto& fname = freq.fid.name(); if (!sim_field_mgr->has_field(fname)) { + std::cout << diag_field_name << " depends on the diag " << fname << "\n"; // This diag depends on another diag. Create and init the dependency if (m_diagnostics.count(fname)==0) { m_diagnostics[fname] = create_diagnostic(fname); } - auto dep = m_diagnostics.at(fname); deps.push_back(fname); } diag->set_required_field (get_field(fname,"sim")); } + diag->initialize(util::TimeStamp(),RunType::Initial); + // If specified, set avg_cnt tracking for this diagnostic. if (m_track_avg_cnt) { const auto diag_field = diag->get_diagnostic(); diff --git a/components/eamxx/src/share/io/scream_io_utils.cpp b/components/eamxx/src/share/io/scream_io_utils.cpp index 9318728d657..40b8a97de4b 100644 --- a/components/eamxx/src/share/io/scream_io_utils.cpp +++ b/components/eamxx/src/share/io/scream_io_utils.cpp @@ -1,6 +1,7 @@ #include "share/io/scream_io_utils.hpp" #include "share/io/scream_scorpio_interface.hpp" +#include "share/grid/library_grids_manager.hpp" #include "share/util/scream_utils.hpp" #include "share/scream_config.hpp" @@ -117,4 +118,90 @@ util::TimeStamp read_timestamp (const std::string& filename, return ts; } +std::shared_ptr +create_diagnostic (const std::string& diag_field_name, + const std::shared_ptr& grid) +{ + // Note: use grouping (the (..) syntax), so you can later query the content + // of each group in the matches output var! + // Note: use raw string syntax R"()" to avoid having to escape the \ character + // Note: the number for field_at_p/h can match positive integer/floating-point numbers + std::regex field_at_l (R"(([A-Za-z0-9_]+)_at_(lev_(\d+)|model_(top|bot))$)"); + std::regex field_at_p (R"(([A-Za-z0-9_]+)_at_(\d+(\.\d+)?)(hPa|mb|Pa)$)"); + std::regex field_at_h (R"(([A-Za-z0-9_]+)_at_(\d+(\.\d+)?)(m)_above_(sealevel|surface)$)"); + std::regex surf_mass_flux ("precip_(liq|ice|total)_surf_mass_flux$"); + std::regex water_path ("(Ice|Liq|Rain|Rime|Vap)WaterPath$"); + std::regex number_path ("(Ice|Liq|Rain)NumberPath$"); + std::regex aerocom_cld ("AeroComCld(Top|Bot)$"); + std::regex vap_flux ("(Meridional|Zonal)VapFlux$"); + std::regex backtend ("([A-Za-z0-9_]+)_atm_backtend$"); + std::regex pot_temp ("(Liq)?PotentialTemperature$"); + std::regex vert_layer ("(z|geopotential|height)_(mid|int)$"); + + std::string diag_name; + std::smatch matches; + ekat::ParameterList params(diag_field_name); + + if (std::regex_search(diag_field_name,matches,field_at_l)) { + params.set("field_name",matches[1].str()); + params.set("grid_name",grid->name()); + params.set("vertical_location", matches[2].str()); + diag_name = "FieldAtLevel"; + } else if (std::regex_search(diag_field_name,matches,field_at_p)) { + params.set("field_name",matches[1].str()); + params.set("grid_name",grid->name()); + params.set("pressure_value",matches[2].str()); + params.set("pressure_units", matches[4].str()); + diag_name = "FieldAtPressureLevel"; + } else if (std::regex_search(diag_field_name,matches,field_at_h)) { + params.set("field_name",matches[1].str()); + params.set("grid_name",grid->name()); + params.set("height_value",matches[2].str()); + params.set("height_units",matches[4].str()); + params.set("surface_reference", matches[5].str()); + diag_name = "FieldAtHeight"; + } else if (std::regex_search(diag_field_name,matches,surf_mass_flux)) { + diag_name = "precip_surf_mass_flux"; + params.set("precip_type",matches[1].str()); + } else if (std::regex_search(diag_field_name,matches,water_path)) { + diag_name = "WaterPath"; + params.set("Water Kind",matches[1].str()); + } else if (std::regex_search(diag_field_name,matches,number_path)) { + diag_name = "NumberPath"; + params.set("Number Kind",matches[1].str()); + } else if (std::regex_search(diag_field_name,matches,aerocom_cld)) { + diag_name = "AeroComCld"; + params.set("AeroComCld Kind",matches[1].str()); + } else if (std::regex_search(diag_field_name,matches,vap_flux)) { + diag_name = "VaporFlux"; + params.set("Wind Component",matches[1].str()); + } else if (std::regex_search(diag_field_name,matches,backtend)) { + diag_name = "AtmBackTendDiag"; + // Set the grid_name + params.set("grid_name",grid->name()); + params.set("Tendency Name",matches[1].str()); + } else if (std::regex_search(diag_field_name,matches,pot_temp)) { + diag_name = "PotentialTemperature"; + params.set("Temperature Kind", matches[1].str()!="" ? matches[1].str() : std::string("Tot")); + } else if (std::regex_search(diag_field_name,matches,vert_layer)) { + diag_name = "VerticalLayer"; + params.set("diag_name",matches[1].str()); + params.set("vert_location",matches[2].str()); + } else if (diag_field_name=="dz") { + diag_name = "VerticalLayer"; + params.set("diag_name","dz"); + params.set("vert_location","mid"); + } else { + // No existing special regex matches, so we assume that the diag field name IS the diag name. + diag_name = diag_field_name; + } + + auto comm = grid->get_comm(); + auto diag = AtmosphereDiagnosticFactory::instance().create(diag_name,comm,params); + auto gm = std::make_shared(grid); + diag->set_grids(gm); + + return diag; +} + } // namespace scream diff --git a/components/eamxx/src/share/io/scream_io_utils.hpp b/components/eamxx/src/share/io/scream_io_utils.hpp index 9eda82e2bbd..f725b91b94c 100644 --- a/components/eamxx/src/share/io/scream_io_utils.hpp +++ b/components/eamxx/src/share/io/scream_io_utils.hpp @@ -3,11 +3,14 @@ #include "scream_io_control.hpp" #include "share/util/scream_time_stamp.hpp" +#include "share/atm_process/atmosphere_diagnostic.hpp" +#include "share/grid/abstract_grid.hpp" #include #include #include +#include namespace scream { @@ -184,5 +187,11 @@ util::TimeStamp read_timestamp (const std::string& filename, const std::string& ts_name, const bool read_nsteps = false); +// Create a diagnostic from a string representation of it. +// E.g., create the diag to compute fieldX_at_500hPa. +std::shared_ptr +create_diagnostic (const std::string& diag_name, + const std::shared_ptr& grid); + } // namespace scream #endif // SCREAM_IO_UTILS_HPP diff --git a/components/eamxx/src/share/io/tests/CMakeLists.txt b/components/eamxx/src/share/io/tests/CMakeLists.txt index 8c819f7896c..89d92075723 100644 --- a/components/eamxx/src/share/io/tests/CMakeLists.txt +++ b/components/eamxx/src/share/io/tests/CMakeLists.txt @@ -17,6 +17,12 @@ CreateUnitTest(io_utils "io_utils.cpp" PROPERTIES RESOURCE_LOCK rpointer_file ) +# Test creation of diagnostic from diag_field_name +CreateUnitTest(create_diag "create_diag.cpp" + LIBS diagnostics scream_io + LABELS io diagnostics +) + ## Test basic output (no packs, no diags, all avg types, all freq units) CreateUnitTest(io_basic "io_basic.cpp" LIBS scream_io LABELS io diff --git a/components/eamxx/src/share/io/tests/create_diag.cpp b/components/eamxx/src/share/io/tests/create_diag.cpp new file mode 100644 index 00000000000..bc509175971 --- /dev/null +++ b/components/eamxx/src/share/io/tests/create_diag.cpp @@ -0,0 +1,166 @@ +#include "catch2/catch.hpp" + +#include "diagnostics/register_diagnostics.hpp" + +#include "share/io/scream_io_utils.hpp" +#include "share/grid/point_grid.hpp" + +namespace scream { + +TEST_CASE("create_diag") +{ + ekat::Comm comm(MPI_COMM_WORLD); + + register_diagnostics(); + + // Create a grid + const int ncols = 3*comm.size(); + const int nlevs = 10; + auto grid = create_point_grid("Physics",ncols,nlevs,comm); + + SECTION ("field_at") { + // FieldAtLevel + auto d1 = create_diagnostic("BlaH_123_at_model_top",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + auto d2 = create_diagnostic("BlaH_123_at_model_bot",grid); + REQUIRE (std::dynamic_pointer_cast(d2)!=nullptr); + auto d3 = create_diagnostic("BlaH_123_at_lev_10",grid); + REQUIRE (std::dynamic_pointer_cast(d3)!=nullptr); + + REQUIRE_THROWS(create_diagnostic("BlaH_123_at_modeltop",grid)); // misspelled + + // FieldAtPressureLevel + auto d4 = create_diagnostic("BlaH_123_at_10mb",grid); + REQUIRE (std::dynamic_pointer_cast(d4)!=nullptr); + auto d5 = create_diagnostic("BlaH_123_at_10hPa",grid); + REQUIRE (std::dynamic_pointer_cast(d5)!=nullptr); + auto d6 = create_diagnostic("BlaH_123_at_10Pa",grid); + REQUIRE (std::dynamic_pointer_cast(d6)!=nullptr); + + REQUIRE_THROWS(create_diagnostic("BlaH_123_at_400KPa",grid)); // invalid units + + // FieldAtHeight + auto d7 = create_diagnostic("BlaH_123_at_10m_above_sealevel",grid); + REQUIRE (std::dynamic_pointer_cast(d7)!=nullptr); + auto d8 = create_diagnostic("BlaH_123_at_10m_above_surface",grid); + REQUIRE (std::dynamic_pointer_cast(d8)!=nullptr); + + REQUIRE_THROWS(create_diagnostic("BlaH_123_at_10.5m",grid)); // missing _above_X + REQUIRE_THROWS(create_diagnostic("BlaH_123_at_1km_above_sealevel",grid)); // invalid units + REQUIRE_THROWS(create_diagnostic("BlaH_123_at_1m_above_the_surface",grid)); // invalid reference + } + + SECTION ("precip_mass_flux") { + auto d1 = create_diagnostic("precip_liq_surf_mass_flux",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + REQUIRE (d1->get_params().get("precip_type")=="liq"); + + auto d2 = create_diagnostic("precip_ice_surf_mass_flux",grid); + REQUIRE (std::dynamic_pointer_cast(d2)!=nullptr); + REQUIRE (d2->get_params().get("precip_type")=="ice"); + + auto d3 = create_diagnostic("precip_total_surf_mass_flux",grid); + REQUIRE (std::dynamic_pointer_cast(d3)!=nullptr); + REQUIRE (d3->get_params().get("precip_type")=="total"); + } + + SECTION ("water_and_number_path") { + auto d1 = create_diagnostic("LiqWaterPath",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + REQUIRE (d1->get_params().get("Water Kind")=="Liq"); + + auto d2 = create_diagnostic("IceWaterPath",grid); + REQUIRE (std::dynamic_pointer_cast(d2)!=nullptr); + REQUIRE (d2->get_params().get("Water Kind")=="Ice"); + + auto d3 = create_diagnostic("RainWaterPath",grid); + REQUIRE (std::dynamic_pointer_cast(d3)!=nullptr); + REQUIRE (d3->get_params().get("Water Kind")=="Rain"); + + auto d4 = create_diagnostic("RimeWaterPath",grid); + REQUIRE (std::dynamic_pointer_cast(d4)!=nullptr); + REQUIRE (d4->get_params().get("Water Kind")=="Rime"); + + auto d5 = create_diagnostic("VapWaterPath",grid); + REQUIRE (std::dynamic_pointer_cast(d5)!=nullptr); + REQUIRE (d5->get_params().get("Water Kind")=="Vap"); + + auto d6 = create_diagnostic("LiqNumberPath",grid); + REQUIRE (std::dynamic_pointer_cast(d6)!=nullptr); + REQUIRE (d6->get_params().get("Number Kind")=="Liq"); + + auto d7 = create_diagnostic("IceNumberPath",grid); + REQUIRE (std::dynamic_pointer_cast(d7)!=nullptr); + REQUIRE (d7->get_params().get("Number Kind")=="Ice"); + + auto d8 = create_diagnostic("RainNumberPath",grid); + REQUIRE (std::dynamic_pointer_cast(d8)!=nullptr); + REQUIRE (d8->get_params().get("Number Kind")=="Rain"); + } + + SECTION ("aerocom_cld") { + auto d1 = create_diagnostic("AeroComCldTop",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + REQUIRE (d1->get_params().get("AeroComCld Kind")=="Top"); + + auto d2 = create_diagnostic("AeroComCldBot",grid); + REQUIRE (std::dynamic_pointer_cast(d2)!=nullptr); + REQUIRE (d2->get_params().get("AeroComCld Kind")=="Bot"); + } + + SECTION ("vapor_flux") { + auto d1 = create_diagnostic("MeridionalVapFlux",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + REQUIRE (d1->get_params().get("Wind Component")=="Meridional"); + + auto d2 = create_diagnostic("ZonalVapFlux",grid); + REQUIRE (std::dynamic_pointer_cast(d2)!=nullptr); + REQUIRE (d2->get_params().get("Wind Component")=="Zonal"); + } + + SECTION ("atm_tend") { + auto d1 = create_diagnostic("BlaH_123_atm_backtend",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + REQUIRE (d1->get_params().get("Tendency Name")=="BlaH_123"); + } + + SECTION ("pot_temp") { + auto d1 = create_diagnostic("LiqPotentialTemperature",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + REQUIRE (d1->get_params().get("Temperature Kind")=="Liq"); + + auto d2 = create_diagnostic("PotentialTemperature",grid); + REQUIRE (std::dynamic_pointer_cast(d2)!=nullptr); + REQUIRE (d2->get_params().get("Temperature Kind")=="Tot"); + } + + SECTION ("vert_layer") { + auto d1 = create_diagnostic("z_mid",grid); + REQUIRE (std::dynamic_pointer_cast(d1)!=nullptr); + REQUIRE (d1->get_params().get("vert_location")=="mid"); + auto d2 = create_diagnostic("z_int",grid); + REQUIRE (std::dynamic_pointer_cast(d2)!=nullptr); + REQUIRE (d2->get_params().get("vert_location")=="int"); + + auto d3 = create_diagnostic("height_mid",grid); + REQUIRE (std::dynamic_pointer_cast(d3)!=nullptr); + REQUIRE (d3->get_params().get("vert_location")=="mid"); + auto d4 = create_diagnostic("height_int",grid); + REQUIRE (std::dynamic_pointer_cast(d4)!=nullptr); + REQUIRE (d4->get_params().get("vert_location")=="int"); + + auto d5 = create_diagnostic("geopotential_mid",grid); + REQUIRE (std::dynamic_pointer_cast(d5)!=nullptr); + REQUIRE (d5->get_params().get("vert_location")=="mid"); + auto d6 = create_diagnostic("geopotential_int",grid); + REQUIRE (std::dynamic_pointer_cast(d6)!=nullptr); + REQUIRE (d6->get_params().get("vert_location")=="int"); + + auto d7 = create_diagnostic("dz",grid); + REQUIRE (std::dynamic_pointer_cast(d7)!=nullptr); + REQUIRE (d7->get_params().get("vert_location")=="mid"); + } + +} + +} // namespace scream From e294a1df3dffb076834e29dead598ad72f509e24 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Wed, 4 Dec 2024 10:39:10 -0600 Subject: [PATCH 401/529] Add perrWith=quiet for So_tf2d to avoid issues when it is not active --- components/mpas-ocean/driver/mpaso_cpl_indices.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-ocean/driver/mpaso_cpl_indices.F b/components/mpas-ocean/driver/mpaso_cpl_indices.F index c5e84d2509d..9802d526bc5 100644 --- a/components/mpas-ocean/driver/mpaso_cpl_indices.F +++ b/components/mpas-ocean/driver/mpaso_cpl_indices.F @@ -209,7 +209,7 @@ subroutine mpaso_cpl_indices_set( ) index_o2x_So_htv = mct_avect_indexra(o2x,'So_htv') index_o2x_So_stv = mct_avect_indexra(o2x,'So_stv') index_o2x_So_rhoeff = mct_avect_indexra(o2x,'So_rhoeff') - index_o2x_So_tf2d = mct_avect_indexra(o2x,'So_tf2d') + index_o2x_So_tf2d = mct_avect_indexra(o2x,'So_tf2d',perrWith='quiet') index_o2x_So_algae1 = mct_avect_indexra(o2x,'So_algae1',perrWith='quiet') index_o2x_So_algae2 = mct_avect_indexra(o2x,'So_algae2',perrWith='quiet') From 53e780782075d307f019e12823d4553cbc5a2fa5 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Wed, 4 Dec 2024 10:42:02 -0600 Subject: [PATCH 402/529] Get and use ocn_c2_glctf from infodata in ocn and glc drivers --- components/mpas-albany-landice/driver/glc_comp_mct.F | 7 ++++++- components/mpas-ocean/driver/ocn_comp_mct.F | 7 ++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index f2ca8c5e19a..aa96525661b 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -80,6 +80,8 @@ module glc_comp_mct integer :: glcLogUnit ! unit number for glc log + logical :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on + ! MPAS Datatypes !type (dm_info), pointer :: dminfo type (core_type), pointer :: corelist => null() @@ -522,6 +524,9 @@ end subroutine xml_stream_get_attributes ! Determine coupling type (not currently needed by MALI) call seq_infodata_GetData(infodata, cpl_seq_option=cpl_seq_option) + ! Determine if ocn to glc thermal forcing coupling is on + call seq_infodata_GetData(infodata, ocn_c2_glctf=ocn_c2_glctf) + ! Initialize the MALI core ierr = domain % core % core_init(domain, timeStamp) if ( ierr /= 0 ) then @@ -1410,7 +1415,7 @@ subroutine glc_import_mct(x2g_g, errorCode) n = n + 1 sfcMassBal(i) = x2g_g % rAttr(index_x2g_Flgl_qice, n) floatingBasalMassBal(i) = x2g_g % rAttr(index_x2g_Fogx_qiceli, n) - if (index_x2g_So_tf2d /= 0) & + if (ocn_c2_glctf) & ismip6_2dThermalForcing(i) = x2g_g % rAttr(index_x2g_So_tf2d, n) ! surfaceTemperature(i) = x2g_g % rAttr(index_x2g_Sl_tsrf, n) !JW basalOceanHeatflx(i) = x2g_g % rAttr(index_x2g_Fogo_qiceh, n) diff --git a/components/mpas-ocean/driver/ocn_comp_mct.F b/components/mpas-ocean/driver/ocn_comp_mct.F index 54cae42dab2..b03b8cf72a9 100644 --- a/components/mpas-ocean/driver/ocn_comp_mct.F +++ b/components/mpas-ocean/driver/ocn_comp_mct.F @@ -108,6 +108,8 @@ module ocn_comp_mct integer :: nsend, nrecv + logical :: ocn_c2_glctf ! .true. => ocn to glc thermal forcing coupling on + character(len=StrKIND) :: runtype, coupleTimeStamp type(seq_infodata_type), pointer :: infodata @@ -305,6 +307,9 @@ end subroutine xml_stream_get_attributes ! Determine coupling type call seq_infodata_GetData(infodata, cpl_seq_option=cpl_seq_option) + ! Determine if ocn to glc thermal forcing coupling is on + call seq_infodata_GetData(infodata, ocn_c2_glctf=ocn_c2_glctf) + !----------------------------------------------------------------------- ! ! initialize the model run @@ -2951,7 +2956,7 @@ subroutine ocn_export_mct(o2x_o, errorCode) !{{{ o2x_o % rAttr(index_o2x_So_stv, n) = landIceTracerTransferVelocities(indexSaltTrans,i) o2x_o % rAttr(index_o2x_So_rhoeff, n) = 0.0_RKIND endif - if (trim(config_glc_thermal_forcing_coupling_mode) == '2d') then + if (trim(config_glc_thermal_forcing_coupling_mode) == '2d' .and. ocn_c2_glctf) then o2x_o % rAttr(index_o2x_So_tf2d, n) = avgThermalForcingAtCritDepth(i) endif From 6463cb8f5dc527c99be4170de660d97134b26107 Mon Sep 17 00:00:00 2001 From: Peter Bogenschutz Date: Wed, 4 Dec 2024 08:54:20 -0800 Subject: [PATCH 403/529] change default value of lambda_high in SHOC to 0.08 --- components/eam/bld/namelist_files/namelist_defaults_eam.xml | 2 +- components/eam/src/physics/cam/shoc.F90 | 2 +- components/eamxx/cime_config/namelist_defaults_scream.xml | 2 +- .../eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp | 4 ++-- .../dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml | 2 +- .../dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml | 2 +- .../dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml | 2 +- .../homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml | 2 +- .../homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml | 2 +- .../input.yaml | 2 +- .../mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml | 2 +- .../mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml | 2 +- .../dynamics_physics/model_restart/input_baseline.yaml | 2 +- .../dynamics_physics/model_restart/input_initial.yaml | 2 +- .../dynamics_physics/model_restart/input_restarted.yaml | 2 +- .../multi-process/physics_only/atm_proc_subcycling/input.yaml | 2 +- .../physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml | 2 +- .../shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml | 2 +- .../mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml | 2 +- .../physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml | 2 +- .../multi-process/physics_only/mam/shoc_mam4_aci/input.yaml | 2 +- .../physics_only/mam/shoc_mam4_drydep/input.yaml | 2 +- .../multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml | 2 +- .../physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml | 2 +- .../physics_only/shoc_p3_nudging/input_nudging.yaml | 2 +- .../shoc_p3_nudging/input_nudging_glob_novert.yaml | 2 +- .../physics_only/shoc_p3_nudging/input_source_data.yaml | 2 +- components/eamxx/tests/single-process/shoc/input.yaml | 2 +- 28 files changed, 29 insertions(+), 29 deletions(-) diff --git a/components/eam/bld/namelist_files/namelist_defaults_eam.xml b/components/eam/bld/namelist_files/namelist_defaults_eam.xml index 1299949d77b..606d5f0ea1a 100755 --- a/components/eam/bld/namelist_files/namelist_defaults_eam.xml +++ b/components/eam/bld/namelist_files/namelist_defaults_eam.xml @@ -827,7 +827,7 @@ 0.5D0 7.0D0 0.001D0 - 0.04D0 + 0.08D0 2.65D0 0.02D0 0.1D0 diff --git a/components/eam/src/physics/cam/shoc.F90 b/components/eam/src/physics/cam/shoc.F90 index 415cf4ca6f1..e47bd921718 100644 --- a/components/eam/src/physics/cam/shoc.F90 +++ b/components/eam/src/physics/cam/shoc.F90 @@ -59,7 +59,7 @@ module shoc real(rtype) :: length_fac = 0.5_rtype ! Length scale factor real(rtype) :: c_diag_3rd_mom = 7.0_rtype ! w3 factor real(rtype) :: lambda_low = 0.001_rtype ! lowest value for stability correction -real(rtype) :: lambda_high = 0.04_rtype ! highest value for stability correction +real(rtype) :: lambda_high = 0.08_rtype ! highest value for stability correction real(rtype) :: lambda_slope = 2.65_rtype ! stability correction slope real(rtype) :: lambda_thresh = 0.02_rtype ! value to apply stability correction real(rtype) :: Ckh = 0.1_rtype ! Eddy diffusivity coefficient for heat diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index 6d4c36b81bd..9fa076d47dd 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -230,7 +230,7 @@ be lost if SCREAM_HACK_XML is not enabled. false false 0.001 - 0.04 + 0.08 2.65 0.02 1.0 diff --git a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp index f5c7b407425..2773c7ad220 100644 --- a/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp +++ b/components/eamxx/src/physics/shoc/tests/infra/shoc_test_data.cpp @@ -2140,7 +2140,7 @@ void isotropic_ts_host(Int nlev, Int shcol, Real* brunt_int, Real* tke, // Hard code these runtime options for F90 const Real lambda_low = 0.001; - const Real lambda_high = 0.04; + const Real lambda_high = 0.08; const Real lambda_slope = 2.65; const Real lambda_thresh = 0.02; SHF::isotropic_ts(team, nlev, lambda_low, lambda_high, lambda_slope, lambda_thresh, @@ -2950,7 +2950,7 @@ void shoc_tke_host(Int shcol, Int nlev, Int nlevi, Real dtime, Real* wthv_sec, R // Hardcode for F90 testing const Real lambda_low = 0.001; - const Real lambda_high = 0.04; + const Real lambda_high = 0.08; const Real lambda_slope = 2.65; const Real lambda_thresh = 0.02; const Real Ckh = 0.1; diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml index 316b43ffdf7..15b8f8572b8 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp/input.yaml @@ -41,7 +41,7 @@ atmosphere_processes: shoc: enable_column_conservation_checks: true lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml index 8e463b8be24..c9f0bdaa8b8 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_p3_rrtmgp_pg2/input.yaml @@ -46,7 +46,7 @@ atmosphere_processes: max_total_ni: 740.0e3 shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml index d2f51e9e1cc..d8dc6182ae4 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp/input.yaml @@ -37,7 +37,7 @@ atmosphere_processes: shoc: check_flux_state_consistency: true lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml index b92889cdcaa..3fd2b41cd31 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_128levels/input.yaml @@ -37,7 +37,7 @@ atmosphere_processes: max_total_ni: 740.0e3 shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml index 0950f6bfdbc..7a0526e82b3 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml @@ -55,7 +55,7 @@ atmosphere_processes: shoc: check_flux_state_consistency: true lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml index 3dbd99682fd..adae9b0688a 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep/input.yaml @@ -62,7 +62,7 @@ atmosphere_processes: shoc: enable_column_conservation_checks: true lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml index e6b94236488..21791e3391e 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_p3_mam_optics_rrtmgp/input.yaml @@ -43,7 +43,7 @@ atmosphere_processes: shoc: enable_column_conservation_checks: true lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml index 6778e18ad8d..a95d2677fe4 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav/input.yaml @@ -49,7 +49,7 @@ atmosphere_processes: shoc: check_flux_state_consistency: true lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml index c308625a6e1..b5d749bfeff 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_baseline.yaml @@ -41,7 +41,7 @@ atmosphere_processes: max_total_ni: 740.0e3 shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml index d5339747fdb..4ab3bdc369d 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_initial.yaml @@ -41,7 +41,7 @@ atmosphere_processes: do_prescribed_ccn: false shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml index f7d1075e334..345424605a7 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/model_restart/input_restarted.yaml @@ -28,7 +28,7 @@ atmosphere_processes: do_prescribed_ccn: false shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml b/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml index 4e9f9f79adb..b23046cf2d1 100644 --- a/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/atm_proc_subcycling/input.yaml @@ -16,7 +16,7 @@ atmosphere_processes: max_total_ni: 740.0e3 shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml index 9c0ed4d9798..1cc9eb6eb4d 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3/input.yaml @@ -21,7 +21,7 @@ atmosphere_processes: do_prescribed_ccn: false shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml index 20d6f142c52..9483f3790bf 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp/input.yaml @@ -24,7 +24,7 @@ atmosphere_processes: do_prescribed_ccn: false shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml index 7ec317eda92..2a571ba96f1 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_mam4_aci_p3_rrtmgp/input.yaml @@ -24,7 +24,7 @@ atmosphere_processes: do_prescribed_ccn: false shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml index 804939a2205..d970765d2bd 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_cldfrac_p3_wetscav/input.yaml @@ -21,7 +21,7 @@ atmosphere_processes: do_prescribed_ccn: false shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml index ae997bb3da5..c70f1b8085a 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_aci/input.yaml @@ -21,7 +21,7 @@ atmosphere_processes: top_level_mam4xx: 6 shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml index 24f610f041c..3f598140309 100644 --- a/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/mam/shoc_mam4_drydep/input.yaml @@ -18,7 +18,7 @@ atmosphere_processes: number_of_subcycles: ${MAC_MIC_SUBCYCLES} shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml index fc0a1b6bc8a..529a075b10d 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_cld_p3_rrtmgp/input.yaml @@ -21,7 +21,7 @@ atmosphere_processes: do_prescribed_ccn: false shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml index 542625798f5..a98cbe30e85 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_cld_spa_p3_rrtmgp/input.yaml @@ -22,7 +22,7 @@ atmosphere_processes: max_total_ni: 740.0e3 shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml index 6a4c0003376..12acd670ad9 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging.yaml @@ -23,7 +23,7 @@ atmosphere_processes: source_pressure_file: vertical_remap.nc ## Only used in the case of STATIC_1D_VERTICAL_PROFILE shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml index 35d75015e2a..68e8841586d 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_nudging_glob_novert.yaml @@ -24,7 +24,7 @@ atmosphere_processes: source_pressure_file: vertical_remap.nc ## Only used in the case of STATIC_1D_VERTICAL_PROFILE shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml index c0c3056312e..c6ec0e361c6 100644 --- a/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml +++ b/components/eamxx/tests/multi-process/physics_only/shoc_p3_nudging/input_source_data.yaml @@ -15,7 +15,7 @@ atmosphere_processes: max_total_ni: 720.0e3 shoc: lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 diff --git a/components/eamxx/tests/single-process/shoc/input.yaml b/components/eamxx/tests/single-process/shoc/input.yaml index befb43d98a0..179aa09c467 100644 --- a/components/eamxx/tests/single-process/shoc/input.yaml +++ b/components/eamxx/tests/single-process/shoc/input.yaml @@ -14,7 +14,7 @@ atmosphere_processes: number_of_subcycles: ${NUM_SUBCYCLES} compute_tendencies: [all] lambda_low: 0.001 - lambda_high: 0.04 + lambda_high: 0.08 lambda_slope: 2.65 lambda_thresh: 0.02 thl2tune: 1.0 From 2c68acfcf1914afda1c7e084cef6580ff3821392 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 4 Dec 2024 13:43:10 -0700 Subject: [PATCH 404/529] Fix conditional jump on uninitialized mem in SHOC The rino temp view only had the nlev-1 entry initialized. pblintd_height was accessing other entries. --- components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp index 34104e9a8fe..94cb763d8d2 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp @@ -78,7 +78,7 @@ void Functions::pblintd( // Initialize bool check = true; - s_rino(nlev-1) = 0; + Kokkos::deep_copy(rino, 0); pblh = s_z(nlev-1); // PBL height calculation From 36ce06ef005ab1b7f78df904d9193a9616e428d3 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 4 Dec 2024 15:30:49 -0700 Subject: [PATCH 405/529] Remove used var --- components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp | 1 - 1 file changed, 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp index 94cb763d8d2..ad47e450fd4 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp @@ -67,7 +67,6 @@ void Functions::pblintd( // Scalarize views for single entry access const auto s_z = ekat::scalarize(z); const auto s_thv = ekat::scalarize(thv); - const auto s_rino = ekat::scalarize(rino); const auto s_zi = ekat::scalarize(zi); const auto s_cldn = ekat::scalarize(cldn); From b252a201afc1162c9ede3cfab41bfc1a1eb07f42 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 4 Dec 2024 16:59:06 -0600 Subject: [PATCH 406/529] update PAM submodule --- components/eam/src/physics/crm/pam/external | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/crm/pam/external b/components/eam/src/physics/crm/pam/external index 9b3e543d8bd..5d9046ae254 160000 --- a/components/eam/src/physics/crm/pam/external +++ b/components/eam/src/physics/crm/pam/external @@ -1 +1 @@ -Subproject commit 9b3e543d8bda43371a10cc1748397e69da9823ee +Subproject commit 5d9046ae254f4db71f2c11202ebdc127c6ac27f4 From 992e4fc342e77640d0ab729c8f63a723cf692fe7 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 4 Dec 2024 15:59:17 -0700 Subject: [PATCH 407/529] Fix and add comment --- .../eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp index ad47e450fd4..cfde686ccf0 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp @@ -77,7 +77,12 @@ void Functions::pblintd( // Initialize bool check = true; - Kokkos::deep_copy(rino, 0); + // The loop below fixes valgrind uninitialized mem errs +#ifndef NDEBUG + for (size_t i=0; i Date: Wed, 4 Dec 2024 16:03:44 -0700 Subject: [PATCH 408/529] Restore old code if ndebug not on --- components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp index cfde686ccf0..4f7749463da 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp @@ -67,6 +67,7 @@ void Functions::pblintd( // Scalarize views for single entry access const auto s_z = ekat::scalarize(z); const auto s_thv = ekat::scalarize(thv); + const auto s_rino = ekat::scalarize(rino); const auto s_zi = ekat::scalarize(zi); const auto s_cldn = ekat::scalarize(cldn); @@ -82,6 +83,8 @@ void Functions::pblintd( for (size_t i=0; i Date: Wed, 4 Dec 2024 16:34:49 -0800 Subject: [PATCH 409/529] modify default lambda_high value in shoc tech doc file --- components/eamxx/docs/old/physics/shoc/shoc_doc.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/docs/old/physics/shoc/shoc_doc.tex b/components/eamxx/docs/old/physics/shoc/shoc_doc.tex index 66ae8b7baac..21adca9ec31 100644 --- a/components/eamxx/docs/old/physics/shoc/shoc_doc.tex +++ b/components/eamxx/docs/old/physics/shoc/shoc_doc.tex @@ -217,7 +217,7 @@ \subsubsection{Eddy Diffusivities} \end{equation} % -Where $\lambda_{min} = 0.001$, $\lambda_{slope}$ = 0.35, and $N_{low}$ = 0.037. Here, $\lambda_{slope}$ is an adjustable parameter. $\lambda_{0}$ has a minimum threshold of 0.001 and a maximum threshold of 0.04. +Where $\lambda_{min} = 0.001$, $\lambda_{slope}$ = 0.35, and $N_{low}$ = 0.037. Here, $\lambda_{slope}$ is an adjustable parameter. $\lambda_{0}$ has a minimum threshold of 0.001 and a maximum threshold of 0.08. \paragraph{Stable Boundary Layer} From 7b42c2e8ee1c0230da2578875ccda882353d7fe1 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Thu, 5 Dec 2024 10:31:06 -0600 Subject: [PATCH 410/529] Updates for the glc budget --- driver-mct/main/prep_glc_mod.F90 | 5 ++++- driver-mct/main/seq_diag_mct.F90 | 13 ++++++++++--- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/driver-mct/main/prep_glc_mod.F90 b/driver-mct/main/prep_glc_mod.F90 index d2b309e5374..f818a9c2a14 100644 --- a/driver-mct/main/prep_glc_mod.F90 +++ b/driver-mct/main/prep_glc_mod.F90 @@ -1200,8 +1200,9 @@ subroutine prep_glc_renormalize_smb(eli, fractions_lx, g2x_gx, mapper_Fg2l, area aream_l(:) = dom_l%data%rAttr(km,:) ! Export land fractions from fractions_lx to a local array + ! Note that for E3SM we are using lfrin instead of lfrac allocate(lfrac(lsize_l)) - call mct_aVect_exportRattr(fractions_lx, "lfrac", lfrac) + call mct_aVect_exportRattr(fractions_lx, "lfrin", lfrac) ! Map Sg_icemask from the glc grid to the land grid. ! This may not be necessary, if Sg_icemask_l has already been mapped from Sg_icemask_g. @@ -1384,6 +1385,8 @@ subroutine prep_glc_renormalize_smb(eli, fractions_lx, g2x_gx, mapper_Fg2l, area endif if (iamroot) then + write(logunit,*) 'global_accum_on_land_grid = ', global_accum_on_land_grid + write(logunit,*) 'global_accum_on_glc_grid = ', global_accum_on_glc_grid write(logunit,*) 'accum_renorm_factor = ', accum_renorm_factor write(logunit,*) 'ablat_renorm_factor = ', ablat_renorm_factor endif diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 26d21a2879a..6177ce5db19 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -270,6 +270,7 @@ module seq_diag_mct integer :: index_l2x_Flrl_irrig integer :: index_l2x_Flrl_wslake + integer :: index_x2l_Sg_icemask integer, allocatable :: index_l2x_Flgl_qice(:) integer, allocatable :: index_x2l_Sg_ice_covered(:) @@ -349,6 +350,7 @@ module seq_diag_mct integer :: index_g2x_Figg_rofi integer :: index_x2g_Flgl_qice + integer :: index_g2x_Sg_icemask integer :: index_x2o_Foxx_rofl_16O integer :: index_x2o_Foxx_rofi_16O @@ -890,6 +892,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) logical,save :: flds_wiso_lnd = .false. real(r8) :: l2x_Flgl_qice_col_sum ! for summing fluxes over no. of elev. classes + real(r8) :: effective_area character(len=64) :: name character(len= 2) :: cnum @@ -940,6 +943,7 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) index_l2x_Flrl_wslake = mct_aVect_indexRA(l2x_l,'Flrl_wslake') if (glc_nec.ge.1) then + index_x2l_Sg_icemask = mct_avect_indexRA(x2l_l,'Sg_icemask') do num=0,glc_nec write(cnum,'(i2.2)') num name = 'Flgl_qice' // cnum @@ -986,10 +990,12 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, infodata, do_l2x, do_x2l) l2x_Flgl_qice_col_sum = 0.0d0 if (glc_nec.ge.1) then + effective_area = min(frac_l%rAttr(kl,n),x2l_l%rAttr(index_x2l_Sg_icemask,n)) * dom_l%data%rAttr(kArea,n) do num=0,glc_nec ! sums the contributions from fluxes in each set of elevation classes ! RHS product is flux times fraction of area in specific elevation class times land cell area - l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) * ca_l + l2x_Flgl_qice_col_sum = l2x_Flgl_qice_col_sum + l2x_l%rAttr(index_l2x_Flgl_qice(num),n) * & + x2l_l%rAttr(index_x2l_Sg_ice_covered(num),n) * effective_area end do end if nf = f_wgsmb ; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) - l2x_Flgl_qice_col_sum @@ -1383,7 +1389,8 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) if (first_time) then - index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') + index_x2g_Flgl_qice = mct_aVect_indexRA(x2g_g,'Flgl_qice') + index_g2x_Sg_icemask = mct_avect_indexRA(g2x_g,'Sg_icemask') end if @@ -1393,7 +1400,7 @@ subroutine seq_diag_glc_mct( glc, frac_g, infodata, do_x2g, do_g2x ) lSize = mct_avect_lSize(x2g_g) do n=1,lSize - ca_g = dom_g%data%rAttr(kArea,n) + ca_g = dom_g%data%rAttr(kArea,n)*g2x_g%rAttr(index_g2x_Sg_icemask,n) nf = f_wgsmb; budg_dataL(nf,ic,ip) = budg_dataL(nf,ic,ip) + ca_g*x2g_g%rAttr(index_x2g_Flgl_qice,n) end do From 79fadbc439876e4118b6c8d946d85b966ed0a84e Mon Sep 17 00:00:00 2001 From: James Foucar Date: Thu, 5 Dec 2024 14:10:35 -0700 Subject: [PATCH 411/529] Fix bug in p3/shoc run_and_cmp The for loop the processes options was stopping too soon. I think maybe someone assumed that every option would have a value after it, but that is no longer true. Also, the -n (no-baseline) option conflicted with the nadv option for shoc, so I changed that to -l --- components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp | 5 +---- .../eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp | 6 +++--- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp index 1f28173df8e..a6bd3013ad1 100644 --- a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp @@ -260,7 +260,7 @@ int main (int argc, char** argv) { std::string predict_nc = "both"; std::string prescribed_ccn = "both"; std::string baseline_fn; - for (int i = 1; i < argc-1; ++i) { + for (int i = 1; i < argc; ++i) { if (ekat::argv_matches(argv[i], "-g", "--generate")) { generate = true; no_baseline = false; } if (ekat::argv_matches(argv[i], "-c", "--compare")) { no_baseline = false; } if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) { @@ -301,9 +301,6 @@ int main (int argc, char** argv) { expect_another_arg(i, argc); ++i; repeat = std::atoi(argv[i]); - if (repeat > 0) { - generate = true; - } } if (ekat::argv_matches(argv[i], "-pn", "--predict-nc")) { expect_another_arg(i, argc); diff --git a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp index e055c0d34d9..8c2313082e5 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp @@ -214,7 +214,7 @@ int main (int argc, char** argv) { " -i Number of columns(ncol). Default=8.\n" " -k Number of vertical levels. Default=72.\n" " -q Number of q tracers. Default=3.\n" - " -n Number of SHOC loops per timestep. Default=15.\n" + " -l Number of SHOC loops per timestep. Default=15.\n" " -r Number of repetitions, implies timing run (generate + no I/O). Default=0.\n"; return 1; @@ -231,7 +231,7 @@ int main (int argc, char** argv) { Int repeat = 0; std::string baseline_fn; std::string device; - for (int i = 1; i < argc-1; ++i) { + for (int i = 1; i < argc; ++i) { if (ekat::argv_matches(argv[i], "-g", "--generate")) { generate = true; no_baseline = false; } if (ekat::argv_matches(argv[i], "-c", "--compare")) { no_baseline = false; } if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) { @@ -269,7 +269,7 @@ int main (int argc, char** argv) { ++i; num_qtracers = std::atoi(argv[i]); } - if (ekat::argv_matches(argv[i], "-n", "--nadv")) { + if (ekat::argv_matches(argv[i], "-l", "--nadv")) { expect_another_arg(i, argc); ++i; nadv = std::atoi(argv[i]); From 48c9eec890fb9db50aac8bb6046e21c866b89698 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Fri, 6 Dec 2024 11:09:27 -0700 Subject: [PATCH 412/529] Init rino when short tests are on The mem tests are no longer guaranteed to have NDEBUG on. We use SCREAM_SHORT_TESTS as a proxy for knowing that mem checking is on. --- components/eamxx/scripts/machines_specs.py | 2 +- .../eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp | 6 ++++-- components/eamxx/src/share/scream_types.hpp | 3 ++- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/components/eamxx/scripts/machines_specs.py b/components/eamxx/scripts/machines_specs.py index 13b4bdca4b8..dbb9363381c 100644 --- a/components/eamxx/scripts/machines_specs.py +++ b/components/eamxx/scripts/machines_specs.py @@ -124,7 +124,7 @@ def setup_pm(cls,partition): cls.batch += "--time 00:30:00 --nodes=1 -q debug" else: cls.batch += "--time 02:00:00 --nodes=4 --gpus-per-node=4 --gpu-bind=none --exclusive -q regular" - + cls.baselines_dir = f"/global/cfs/cdirs/e3sm/baselines/{compiler}/scream/{cls.name}" ############################################################################### diff --git a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp index 4f7749463da..9c4cef44d1c 100644 --- a/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp +++ b/components/eamxx/src/physics/shoc/impl/shoc_pblintd_impl.hpp @@ -78,8 +78,10 @@ void Functions::pblintd( // Initialize bool check = true; - // The loop below fixes valgrind uninitialized mem errs -#ifndef NDEBUG + // The loop below fixes valgrind uninitialized mem errs. As in other + // places in eamxx, we use SCREAM_SHORT_TESTS as a proxy for knowing + // mem checking is on. +#if !defined(NDEBUG) || defined(SCREAM_SHORT_TESTS) for (size_t i=0; i Date: Fri, 6 Dec 2024 17:39:33 -0600 Subject: [PATCH 413/529] Minor cleanup Remove placeholder / commmented out code in glc_comp_mct Correct revision history comment in glc section of seq_diag_mct --- components/mpas-albany-landice/driver/glc_comp_mct.F | 5 +++-- driver-mct/main/seq_diag_mct.F90 | 3 ++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/driver/glc_comp_mct.F b/components/mpas-albany-landice/driver/glc_comp_mct.F index f6001a73e62..dd254de9807 100644 --- a/components/mpas-albany-landice/driver/glc_comp_mct.F +++ b/components/mpas-albany-landice/driver/glc_comp_mct.F @@ -1490,11 +1490,12 @@ subroutine glc_export_mct(g2x_g, errorCode) do i = 1, nCellsSolve n = n + 1 - !call route_ice_runoff(0.0_RKIND, & !Recuperate runoff routing switch code (originally in glc_route_ice_runoff module in earlier code), and attach to ice calving flux once present... + ! Recuperate runoff routing switch code (originally in glc_route_ice_runoff module in earlier code), + ! and attach to ice calving flux once present... + !call route_ice_runoff(0.0_RKIND, & ! rofi_to_ocn=Fogg_rofi, & ! rofi_to_ice=Figg_rofi) g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0!...and remove these placeholders - !g2x_g % rAttr(index_g2x_Fogg_rofi,n)=0.0001d0 ! dummy value to allow tracking through coupler g2x_g % rAttr(index_g2x_Figg_rofi,n)=0.0 !...and remove these placeholders g2x_g % rAttr(index_g2x_Fogg_rofl,n) = 0.0 !Attach to subglacial liquid flux once present diff --git a/driver-mct/main/seq_diag_mct.F90 b/driver-mct/main/seq_diag_mct.F90 index 6177ce5db19..be9c3a1426c 100644 --- a/driver-mct/main/seq_diag_mct.F90 +++ b/driver-mct/main/seq_diag_mct.F90 @@ -1315,7 +1315,8 @@ end subroutine seq_diag_rof_mct ! Compute global glc input/output flux diagnostics ! ! !REVISION HISTORY: - ! 2024-Sept. - S. Price - update + ! 2008-Jul-10 - T. Craig - update + ! 2024-Dec-06 - S. Price, J. Wolfe - update ! ! !INTERFACE: ------------------------------------------------------------------ From 254bba50e53b8b4933709f898055f0c3f0548346 Mon Sep 17 00:00:00 2001 From: tcclevenger Date: Fri, 1 Nov 2024 00:31:22 -0600 Subject: [PATCH 414/529] Create IOPForcing ATM process Moves IOP forcing from within HOMME interface to it's own physics process, called directly after dynamics process. Also, changes name of IntensiveObservationPeriod class to IOPDataManager. --- .../cime_config/namelist_defaults_scream.xml | 4 + .../eamxx/src/control/atmosphere_driver.cpp | 46 +- .../eamxx/src/control/atmosphere_driver.hpp | 8 +- .../atmosphere_surface_coupling_importer.cpp | 21 +- .../eamxx/src/dynamics/homme/CMakeLists.txt | 1 - .../src/dynamics/homme/eamxx_homme_iop.cpp | 610 ------------------ .../homme/eamxx_homme_process_interface.cpp | 9 - .../homme/eamxx_homme_process_interface.hpp | 38 -- .../eamxx/src/mct_coupling/CMakeLists.txt | 1 + components/eamxx/src/physics/CMakeLists.txt | 10 +- .../src/physics/iop_forcing/CMakeLists.txt | 5 + .../eamxx_iop_forcing_process_interface.cpp | 546 ++++++++++++++++ .../eamxx_iop_forcing_process_interface.hpp | 153 +++++ .../eamxx/src/physics/register_physics.hpp | 6 + .../rrtmgp/eamxx_rrtmgp_process_interface.cpp | 6 +- .../shoc/eamxx_shoc_process_interface.cpp | 2 +- .../spa/eamxx_spa_process_interface.cpp | 8 +- .../eamxx/src/physics/spa/spa_functions.hpp | 16 +- .../src/physics/spa/spa_functions_impl.hpp | 4 +- components/eamxx/src/share/CMakeLists.txt | 2 +- .../IOPDataManager.cpp} | 32 +- .../IOPDataManager.hpp} | 24 +- .../share/atm_process/atmosphere_process.hpp | 10 +- .../atm_process/atmosphere_process_group.hpp | 4 +- .../CMakeLists.txt | 2 +- .../input.yaml | 2 +- 26 files changed, 813 insertions(+), 757 deletions(-) delete mode 100644 components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp create mode 100644 components/eamxx/src/physics/iop_forcing/CMakeLists.txt create mode 100644 components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp create mode 100644 components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp rename components/eamxx/src/share/{iop/intensive_observation_period.cpp => atm_process/IOPDataManager.cpp} (98%) rename components/eamxx/src/share/{iop/intensive_observation_period.hpp => atm_process/IOPDataManager.hpp} (92%) diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index 6d4c36b81bd..5b50f703109 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -427,6 +427,9 @@ be lost if SCREAM_HACK_XML is not enabled. false + + + 1,2 @@ -556,6 +559,7 @@ be lost if SCREAM_HACK_XML is not enabled. mac_aero_mic,rrtmgp + iop_forcing,mac_aero_mic,rrtmgp diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index 0f1cb1e31ab..e935cff5cfc 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -180,24 +180,24 @@ init_time_stamps (const util::TimeStamp& run_t0, const util::TimeStamp& case_t0, } void AtmosphereDriver:: -setup_iop () +setup_iop_data_manager () { // At this point, must have comm, params, initialized timestamps created. check_ad_status(s_comm_set | s_params_set | s_ts_inited); // Check to make sure iop is not already initialized - EKAT_REQUIRE_MSG(not m_iop, "Error! setup_iop() is called, but IOP already set up.\n"); + EKAT_REQUIRE_MSG(not m_iop_data_manager, "Error! setup_iop_data_manager() is called, but IOP already set up.\n"); // This function should only be called if we are enabling IOP const bool enable_iop = m_atm_params.sublist("driver_options").get("enable_iop", false); - EKAT_REQUIRE_MSG(enable_iop, "Error! setup_iop() is called, but enable_iop=false " + EKAT_REQUIRE_MSG(enable_iop, "Error! setup_iop_data_manager() is called, but enable_iop=false " "in driver_options parameters.\n"); // Params must include iop_options sublist. const auto iop_sublist_exists = m_atm_params.isSublist("iop_options"); EKAT_REQUIRE_MSG(iop_sublist_exists, - "Error! setup_iop() is called, but no iop_options " + "Error! setup_iop_data_manager() is called, but no iop_options " "defined in parameters.\n"); const auto iop_params = m_atm_params.sublist("iop_options"); @@ -206,15 +206,15 @@ setup_iop () const auto hyam = phys_grid->get_geometry_data("hyam"); const auto hybm = phys_grid->get_geometry_data("hybm"); - m_iop = std::make_shared(m_atm_comm, - iop_params, - m_run_t0, - nlevs, - hyam, - hybm); + m_iop_data_manager = std::make_shared(m_atm_comm, + iop_params, + m_run_t0, + nlevs, + hyam, + hybm); // Set IOP object in atm processes - m_atm_process_group->set_iop(m_iop); + m_atm_process_group->set_iop_data_manager(m_iop_data_manager); } void AtmosphereDriver::create_atm_processes() @@ -295,7 +295,7 @@ void AtmosphereDriver::create_grids() const bool enable_iop = m_atm_params.sublist("driver_options").get("enable_iop", false); if (enable_iop) { - setup_iop (); + setup_iop_data_manager (); } // Set the grids in the processes. Do this by passing the grids manager. @@ -1203,7 +1203,7 @@ void AtmosphereDriver::set_initial_conditions () } } - if (m_iop) { + if (m_iop_data_manager) { // For runs with IOP, call to setup io grids and lat // lon information needed for reading from file // We use a single topo file for both GLL and PG2 runs. All @@ -1213,13 +1213,13 @@ void AtmosphereDriver::set_initial_conditions () for (const auto& it : m_field_mgrs) { const auto& grid_name = it.first; if (ic_fields_names[grid_name].size() > 0 or - topography_eamxx_fields_names[grid_name].size() > 0) { + topography_eamxx_fields_names[grid_name].size() > 0) { const auto& file_name = grid_name == "Physics GLL" ? ic_pl.get("Filename") : ic_pl.get("topography_filename"); - m_iop->setup_io_info(file_name, it.second->get_grid()); + m_iop_data_manager->setup_io_info(file_name, it.second->get_grid()); } } } @@ -1231,12 +1231,12 @@ void AtmosphereDriver::set_initial_conditions () m_atm_logger->info(" [EAMxx] IC filename: " + file_name); for (const auto& it : m_field_mgrs) { const auto& grid_name = it.first; - if (not m_iop) { + if (not m_iop_data_manager) { read_fields_from_file (ic_fields_names[grid_name],it.second->get_grid(),file_name,m_current_ts); } else { // For IOP enabled, we load from file and copy data from the closest // lat/lon column to every other column - m_iop->read_fields_from_file_for_iop(file_name, + m_iop_data_manager->read_fields_from_file_for_iop(file_name, ic_fields_names[grid_name], m_current_ts, it.second); @@ -1306,7 +1306,7 @@ void AtmosphereDriver::set_initial_conditions () m_atm_logger->info(" filename: " + file_name); for (const auto& it : m_field_mgrs) { const auto& grid_name = it.first; - if (not m_iop) { + if (not m_iop_data_manager) { // Topography files always use "ncol_d" for the GLL grid value of ncol. // To ensure we read in the correct value, we must change the name for that dimension auto io_grid = it.second->get_grid(); @@ -1322,7 +1322,7 @@ void AtmosphereDriver::set_initial_conditions () } else { // For IOP enabled, we load from file and copy data from the closest // lat/lon column to every other column - m_iop->read_fields_from_file_for_iop(file_name, + m_iop_data_manager->read_fields_from_file_for_iop(file_name, topography_file_fields_names[grid_name], topography_eamxx_fields_names[grid_name], m_current_ts, @@ -1347,16 +1347,16 @@ void AtmosphereDriver::set_initial_conditions () m_atm_params.sublist("provenance").set("topography_file","NONE"); } - if (m_iop) { + if (m_iop_data_manager) { // Load IOP data file data for initial time stamp - m_iop->read_iop_file_data(m_current_ts); + m_iop_data_manager->read_iop_file_data(m_current_ts); // Now that ICs are processed, set appropriate fields using IOP file data. // Since ICs are loaded on GLL grid, we set those fields only and dynamics // will take care of the rest (for PG2 case). if (m_field_mgrs.count("Physics GLL") > 0) { const auto& fm = m_field_mgrs.at("Physics GLL"); - m_iop->set_fields_from_iop_data(fm); + m_iop_data_manager->set_fields_from_iop_data(fm); } } @@ -1754,7 +1754,7 @@ void AtmosphereDriver::finalize ( /* inputs? */ ) { } // Destroy iop - m_iop = nullptr; + m_iop_data_manager = nullptr; // Destroy the buffer manager m_memory_buffer = nullptr; diff --git a/components/eamxx/src/control/atmosphere_driver.hpp b/components/eamxx/src/control/atmosphere_driver.hpp index a3acfba5d94..9b191371b36 100644 --- a/components/eamxx/src/control/atmosphere_driver.hpp +++ b/components/eamxx/src/control/atmosphere_driver.hpp @@ -2,7 +2,6 @@ #define SCREAM_ATMOSPHERE_DRIVER_HPP #include "control/surface_coupling_utils.hpp" -#include "share/iop/intensive_observation_period.hpp" #include "share/field/field_manager.hpp" #include "share/grid/grids_manager.hpp" #include "share/util/scream_time_stamp.hpp" @@ -11,6 +10,7 @@ #include "share/io/scorpio_input.hpp" #include "share/atm_process/ATMBufferManager.hpp" #include "share/atm_process/SCDataManager.hpp" +#include "share/atm_process/IOPDataManager.hpp" #include "ekat/logging/ekat_logger.hpp" #include "ekat/mpi/ekat_comm.hpp" @@ -72,8 +72,8 @@ class AtmosphereDriver // Set AD params void init_scorpio (const int atm_id = 0); - // Setup IntensiveObservationPeriod - void setup_iop (); + // Setup IOPDataManager + void setup_iop_data_manager (); // Create atm processes, without initializing them void create_atm_processes (); @@ -217,7 +217,7 @@ class AtmosphereDriver std::shared_ptr m_surface_coupling_import_data_manager; std::shared_ptr m_surface_coupling_export_data_manager; - std::shared_ptr m_iop; + std::shared_ptr m_iop_data_manager; // This is the time stamp at the beginning of the time step. util::TimeStamp m_current_ts; diff --git a/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp b/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp index 2c3360a3b4f..385e57cae55 100644 --- a/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp +++ b/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp @@ -208,8 +208,8 @@ void SurfaceCouplingImporter::do_import(const bool called_during_initialization) }); #endif - if (m_iop) { - if (m_iop->get_params().get("iop_srf_prop")) { + if (m_iop_data_manager) { + if (m_iop_data_manager->get_params().get("iop_srf_prop")) { // Overwrite imports with data from IOP file overwrite_iop_imports(called_during_initialization); } @@ -221,9 +221,12 @@ void SurfaceCouplingImporter::overwrite_iop_imports (const bool called_during_in using policy_type = KokkosTypes::RangePolicy; using C = physics::Constants; - const auto has_lhflx = m_iop->has_iop_field("lhflx"); - const auto has_shflx = m_iop->has_iop_field("shflx"); - const auto has_Tg = m_iop->has_iop_field("Tg"); + const auto has_lhflx = m_iop_data_manager->has_iop_field("lhflx"); + const auto has_shflx = m_iop_data_manager->has_iop_field("shflx"); + const auto has_Tg = m_iop_data_manager->has_iop_field("Tg"); + + // Read IOP file for current time step, if necessary + m_iop_data_manager->read_iop_file_data(timestamp()); static constexpr Real latvap = C::LatVap; static constexpr Real stebol = C::stebol; @@ -243,19 +246,19 @@ void SurfaceCouplingImporter::overwrite_iop_imports (const bool called_during_in // Store IOP surf data into col_val Real col_val(std::nan("")); if (fname == "surf_evap" && has_lhflx) { - const auto f = m_iop->get_iop_field("lhflx"); + const auto f = m_iop_data_manager->get_iop_field("lhflx"); f.sync_to_host(); col_val = f.get_view()()/latvap; } else if (fname == "surf_sens_flux" && has_shflx) { - const auto f = m_iop->get_iop_field("shflx"); + const auto f = m_iop_data_manager->get_iop_field("shflx"); f.sync_to_host(); col_val = f.get_view()(); } else if (fname == "surf_radiative_T" && has_Tg) { - const auto f = m_iop->get_iop_field("Tg"); + const auto f = m_iop_data_manager->get_iop_field("Tg"); f.sync_to_host(); col_val = f.get_view()(); } else if (fname == "surf_lw_flux_up" && has_Tg) { - const auto f = m_iop->get_iop_field("Tg"); + const auto f = m_iop_data_manager->get_iop_field("Tg"); f.sync_to_host(); col_val = stebol*std::pow(f.get_view()(), 4); } else { diff --git a/components/eamxx/src/dynamics/homme/CMakeLists.txt b/components/eamxx/src/dynamics/homme/CMakeLists.txt index b6a69a3605f..8e2b3577567 100644 --- a/components/eamxx/src/dynamics/homme/CMakeLists.txt +++ b/components/eamxx/src/dynamics/homme/CMakeLists.txt @@ -146,7 +146,6 @@ macro (CreateDynamicsLib HOMME_TARGET NP PLEV QSIZE) ${SCREAM_DYNAMICS_SRC_DIR}/eamxx_homme_process_interface.cpp ${SCREAM_DYNAMICS_SRC_DIR}/eamxx_homme_fv_phys.cpp ${SCREAM_DYNAMICS_SRC_DIR}/eamxx_homme_rayleigh_friction.cpp - ${SCREAM_DYNAMICS_SRC_DIR}/eamxx_homme_iop.cpp ${SCREAM_DYNAMICS_SRC_DIR}/physics_dynamics_remapper.cpp ${SCREAM_DYNAMICS_SRC_DIR}/homme_grids_manager.cpp ${SCREAM_DYNAMICS_SRC_DIR}/interface/homme_context_mod.F90 diff --git a/components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp b/components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp deleted file mode 100644 index 9c04a3f1ba6..00000000000 --- a/components/eamxx/src/dynamics/homme/eamxx_homme_iop.cpp +++ /dev/null @@ -1,610 +0,0 @@ -#include "eamxx_homme_process_interface.hpp" - -// EAMxx includes -#include "dynamics/homme/homme_dimensions.hpp" -#include "dynamics/homme/homme_dynamics_helpers.hpp" -#include "physics/share/physics_constants.hpp" -#include "share/iop/intensive_observation_period.hpp" -#include "share/util/scream_column_ops.hpp" - -// Homme includes -#include "Context.hpp" -#include "ColumnOps.hpp" -#include "HommexxEnums.hpp" -#include "HybridVCoord.hpp" -#include "SimulationParams.hpp" -#include "Types.hpp" - -// SCREAM includes -#include "share/util/scream_common_physics_functions.hpp" - -// EKAT includes -#include "ekat/ekat_workspace.hpp" -#include "ekat/kokkos/ekat_kokkos_types.hpp" - -namespace scream { - -// Compute effects of large scale subsidence on T, q, u, and v. -KOKKOS_FUNCTION -void HommeDynamics:: -advance_iop_subsidence(const KT::MemberType& team, - const int nlevs, - const Real dt, - const Real ps, - const view_1d& pmid, - const view_1d& pint, - const view_1d& pdel, - const view_1d& omega, - const Workspace& workspace, - const view_1d& u, - const view_1d& v, - const view_1d& T, - const view_2d& Q) -{ - using ColOps = ColumnOps; - using C = physics::Constants; - constexpr Real Rair = C::Rair; - constexpr Real Cpair = C::Cpair; - - const auto n_q_tracers = Q.extent_int(0); - const auto nlev_packs = ekat::npack(nlevs); - - // Get some temporary views from WS - uview_1d omega_int, delta_u, delta_v, delta_T, tmp; - workspace.take_many_contiguous_unsafe<4>({"omega_int", "delta_u", "delta_v", "delta_T"}, - {&omega_int, &delta_u, &delta_v, &delta_T}); - const auto delta_Q_slot = workspace.take_macro_block("delta_Q", n_q_tracers); - uview_2d delta_Q(delta_Q_slot.data(), n_q_tracers, nlev_packs); - - auto s_pmid = ekat::scalarize(pmid); - auto s_omega = ekat::scalarize(omega); - auto s_delta_u = ekat::scalarize(delta_u); - auto s_delta_v = ekat::scalarize(delta_v); - auto s_delta_T = ekat::scalarize(delta_T); - auto s_delta_Q = ekat::scalarize(delta_Q); - auto s_omega_int = ekat::scalarize(omega_int); - - // Compute omega on the interface grid by using a weighted average in pressure - const int pack_begin = 1/Pack::n, pack_end = (nlevs-1)/Pack::n; - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, pack_begin, pack_end+1), [&] (const int k){ - auto range_pack = ekat::range(k*Pack::n); - range_pack.set(range_pack<1, 1); - Pack pmid_k, pmid_km1, omega_k, omega_km1; - ekat::index_and_shift<-1>(s_pmid, range_pack, pmid_k, pmid_km1); - ekat::index_and_shift<-1>(s_omega, range_pack, omega_k, omega_km1); - - const auto weight = (pint(k) - pmid_km1)/(pmid_k - pmid_km1); - omega_int(k).set(range_pack>=1 and range_pack<=nlevs-1, - weight*omega_k + (1-weight)*omega_km1); - }); - omega_int(0)[0] = 0; - omega_int(nlevs/Pack::n)[nlevs%Pack::n] = 0; - - // Compute delta views for u, v, T, and Q (e.g., u(k+1) - u(k), k=0,...,nlevs-2) - ColOps::compute_midpoint_delta(team, nlevs-1, u, delta_u); - ColOps::compute_midpoint_delta(team, nlevs-1, v, delta_v); - ColOps::compute_midpoint_delta(team, nlevs-1, T, delta_T); - for (int iq=0; iq(k*Pack::n); - const auto at_top = range_pack==0; - const auto not_at_top = not at_top; - const auto at_bot = range_pack==nlevs-1; - const auto not_at_bot = not at_bot; - const bool any_at_top = at_top.any(); - const bool any_at_bot = at_bot.any(); - - // Get delta(k-1) packs. The range pack should not - // contain index 0 (so that we don't attempt to access - // k=-1 index) or index > nlevs-2 (since delta_* views - // are size nlevs-1). - auto range_pack_for_m1_shift = range_pack; - range_pack_for_m1_shift.set(range_pack<1, 1); - range_pack_for_m1_shift.set(range_pack>nlevs-2, nlevs-2); - Pack delta_u_k, delta_u_km1, - delta_v_k, delta_v_km1, - delta_T_k, delta_T_km1; - ekat::index_and_shift<-1>(s_delta_u, range_pack_for_m1_shift, delta_u_k, delta_u_km1); - ekat::index_and_shift<-1>(s_delta_v, range_pack_for_m1_shift, delta_v_k, delta_v_km1); - ekat::index_and_shift<-1>(s_delta_T, range_pack_for_m1_shift, delta_T_k, delta_T_km1); - - // At the top and bottom of the model, set the end points for - // delta_*_k and delta_*_km1 to be the first and last entries - // of delta_*, respectively. - if (any_at_top) { - delta_u_k.set(at_top, s_delta_u(0)); - delta_v_k.set(at_top, s_delta_v(0)); - delta_T_k.set(at_top, s_delta_T(0)); - } - if (any_at_bot) { - delta_u_km1.set(at_bot, s_delta_u(nlevs-2)); - delta_v_km1.set(at_bot, s_delta_v(nlevs-2)); - delta_T_km1.set(at_bot, s_delta_T(nlevs-2)); - } - - // Get omega_int(k+1) pack. The range pack should not - // contain index > nlevs-1 (since omega_int is size nlevs+1). - auto range_pack_for_p1_shift = range_pack; - range_pack_for_p1_shift.set(range_pack>nlevs-1, nlevs-1); - Pack omega_int_k, omega_int_kp1; - ekat::index_and_shift<1>(s_omega_int, range_pack, omega_int_k, omega_int_kp1); - - const auto fac = (dt/2)/pdel(k); - - // Update u - u(k).update(not_at_bot, fac*omega_int_kp1*delta_u_k, -1, 1); - u(k).update(not_at_top, fac*omega_int_k*delta_u_km1, -1, 1); - - // Update v - v(k).update(not_at_bot, fac*omega_int_kp1*delta_v_k, -1, 1); - v(k).update(not_at_top, fac*omega_int_k*delta_v_km1, -1, 1); - - // Before updating T, first scale using thermal - // expansion term due to LS vertical advection - T(k) *= 1 + (dt*Rair/Cpair)*omega(k)/pmid(k); - - // Update T - T(k).update(not_at_bot, fac*omega_int_kp1*delta_T_k, -1, 1); - T(k).update(not_at_top, fac*omega_int_k*delta_T_km1, -1, 1); - - // Update Q - Pack delta_tracer_k, delta_tracer_km1; - for (int iq=0; iq(s_delta_tracer, range_pack_for_m1_shift, delta_tracer_k, delta_tracer_km1); - if (any_at_top) delta_tracer_k.set(at_top, s_delta_tracer(0)); - if (any_at_bot) delta_tracer_km1.set(at_bot, s_delta_tracer(nlevs-2)); - - Q(iq, k).update(not_at_bot, fac*omega_int_kp1*delta_tracer_k, -1, 1); - Q(iq, k).update(not_at_top, fac*omega_int_k*delta_tracer_km1, -1, 1); - } - }); - - // Release WS views - workspace.release_macro_block(delta_Q_slot, n_q_tracers); - workspace.release_many_contiguous<4>({&omega_int, &delta_u, &delta_v, &delta_T}); -} - -// Apply large scale forcing for temperature and water vapor as provided by the IOP file -KOKKOS_FUNCTION -void HommeDynamics:: -advance_iop_forcing(const KT::MemberType& team, - const int nlevs, - const Real dt, - const view_1d& divT, - const view_1d& divq, - const view_1d& T, - const view_1d& qv) -{ - const auto nlev_packs = ekat::npack(nlevs); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&] (const int k) { - T(k).update(divT(k), dt, 1.0); - qv(k).update(divq(k), dt, 1.0); - }); -} - -// Provide coriolis forcing to u and v winds, using large scale winds specified in IOP forcing file. -KOKKOS_FUNCTION -void HommeDynamics:: -iop_apply_coriolis(const KT::MemberType& team, - const int nlevs, - const Real dt, - const Real lat, - const view_1d& u_ls, - const view_1d& v_ls, - const view_1d& u, - const view_1d& v) -{ - using C = physics::Constants; - constexpr Real pi = C::Pi; - constexpr Real earth_rotation = C::omega; - - // Compute coriolis force - const auto fcor = 2*earth_rotation*std::sin(lat*pi/180); - - const auto nlev_packs = ekat::npack(nlevs); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&] (const int k) { - const auto u_cor = v(k) - v_ls(k); - const auto v_cor = u(k) - u_ls(k); - u(k).update(u_cor, dt*fcor, 1.0); - v(k).update(v_cor, -dt*fcor, 1.0); - }); -} - -void HommeDynamics:: -apply_iop_forcing(const Real dt) -{ - using ESU = ekat::ExeSpaceUtils; - using PF = PhysicsFunctions; - using ColOps = ColumnOps; - - // Homme objects - const auto& c = Homme::Context::singleton(); - const auto& hvcoord = c.get(); - const auto& params = c.get(); - - // Dimensions - constexpr int NGP = HOMMEXX_NP; - constexpr int NLEV = HOMMEXX_NUM_LEV; - constexpr int NLEVI = HOMMEXX_NUM_LEV_P; - const auto nelem = m_dyn_grid->get_num_local_dofs()/(NGP*NGP); - const auto total_levels = m_dyn_grid->get_num_vertical_levels(); - const auto qsize = params.qsize; - - // Sanity checks since we will be switching between ekat::Pack - // and Homme::Scalar view types - EKAT_ASSERT_MSG(NLEV == ekat::npack(total_levels), - "Error! Dimension for vectorized Homme levels does not match level dimension " - "of the packed views used here. Check that Pack typedef is using a pack size " - "consistent with Homme's vector size.\n"); - EKAT_ASSERT_MSG(NLEVI == ekat::npack(total_levels+1), - "Error! Dimension for vectorized Homme levels does not match level dimension " - "of the packed views used here. Check that Pack typedef is using a pack size " - "consistent with Homme's vector size.\n"); - - // Hybrid coord values - const auto ps0 = hvcoord.ps0; - const auto hyam = m_dyn_grid->get_geometry_data("hyam").get_view(); - const auto hybm = m_dyn_grid->get_geometry_data("hybm").get_view(); - const auto hyai = m_dyn_grid->get_geometry_data("hyai").get_view(); - const auto hybi = m_dyn_grid->get_geometry_data("hybi").get_view(); - - // Homme element states - auto ps_dyn = get_internal_field("ps_dyn").get_view(); - auto dp3d_dyn = get_internal_field("dp3d_dyn").get_view(); - auto vtheta_dp_dyn = get_internal_field("vtheta_dp_dyn").get_view(); - auto phi_int_dyn = get_internal_field("phi_int_dyn").get_view(); - auto v_dyn = get_internal_field("v_dyn").get_view(); - auto Q_dyn = m_helper_fields.at("Q_dyn").get_view(); - auto Qdp_dyn = get_internal_field("Qdp_dyn").get_view(); - - // Load data from IOP files, if necessary - m_iop->read_iop_file_data(timestamp()); - - // Define local IOP param values - const auto iop_dosubsidence = m_iop->get_params().get("iop_dosubsidence"); - const auto iop_coriolis = m_iop->get_params().get("iop_coriolis"); - const auto iop_nudge_tq = m_iop->get_params().get("iop_nudge_tq"); - const auto iop_nudge_uv = m_iop->get_params().get("iop_nudge_uv"); - const auto use_large_scale_wind = m_iop->get_params().get("use_large_scale_wind"); - const auto use_3d_forcing = m_iop->get_params().get("use_3d_forcing"); - const auto lat = m_iop->get_params().get("target_latitude"); - const auto iop_nudge_tscale = m_iop->get_params().get("iop_nudge_tscale"); - const auto iop_nudge_tq_low = m_iop->get_params().get("iop_nudge_tq_low"); - const auto iop_nudge_tq_high = m_iop->get_params().get("iop_nudge_tq_high"); - - // Define local IOP field views - const Real ps_iop = m_iop->get_iop_field("Ps").get_view()(); - view_1d omega, divT, divq, u_ls, v_ls, qv_iop, t_iop, u_iop, v_iop; - divT = use_3d_forcing ? m_iop->get_iop_field("divT3d").get_view() - : m_iop->get_iop_field("divT").get_view(); - divq = use_3d_forcing ? m_iop->get_iop_field("divq3d").get_view() - : m_iop->get_iop_field("divq").get_view(); - if (iop_dosubsidence) { - omega = m_iop->get_iop_field("omega").get_view(); - } - if (iop_coriolis) { - u_ls = m_iop->get_iop_field("u_ls").get_view(); - v_ls = m_iop->get_iop_field("v_ls").get_view(); - } - if (iop_nudge_tq) { - qv_iop = m_iop->get_iop_field("q").get_view(); - t_iop = m_iop->get_iop_field("T").get_view(); - } - if (iop_nudge_uv) { - u_iop = use_large_scale_wind ? m_iop->get_iop_field("u_ls").get_view() - : m_iop->get_iop_field("u").get_view(); - v_iop = use_large_scale_wind ? m_iop->get_iop_field("v_ls").get_view() - : m_iop->get_iop_field("v").get_view(); - } - - // Team policy and workspace manager for eamxx - const auto policy_iop = ESU::get_default_team_policy(nelem*NGP*NGP, NLEV); - - // TODO: Create a memory buffer for this class - // and add the below WSM and views - WorkspaceMgr iop_wsm(NLEVI, 7+qsize, policy_iop); - view_Nd - temperature("temperature", nelem, NGP, NGP, NLEV); - - // Lambda for computing temperature - auto compute_temperature = [&] () { - Kokkos::parallel_for("compute_temperature_for_iop", policy_iop, KOKKOS_LAMBDA (const KT::MemberType& team) { - const int ie = team.league_rank()/(NGP*NGP); - const int igp = (team.league_rank()/NGP)%NGP; - const int jgp = team.league_rank()%NGP; - - // Get temp views from workspace - auto ws = iop_wsm.get_workspace(team); - uview_1d pmid; - ws.take_many_contiguous_unsafe<1>({"pmid"},{&pmid}); - - auto ps_i = ps_dyn(ie, igp, jgp); - auto dp3d_i = ekat::subview(dp3d_dyn, ie, igp, jgp); - auto vtheta_dp_i = ekat::subview(vtheta_dp_dyn, ie, igp, jgp); - auto qv_i = ekat::subview(Q_dyn, ie, 0, igp, jgp); - auto temperature_i = ekat::subview(temperature, ie, igp, jgp); - - // Compute reference pressures and layer thickness. - // TODO: Allow geometry data to allocate packsize - auto s_pmid = ekat::scalarize(pmid); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, total_levels), [&](const int& k) { - s_pmid(k) = hyam(k)*ps0 + hybm(k)*ps_i; - }); - team.team_barrier(); - - // Compute temperature from virtual potential temperature - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, NLEV), [&] (const int k) { - auto T_val = vtheta_dp_i(k); - T_val /= dp3d_i(k); - T_val = PF::calculate_temperature_from_virtual_temperature(T_val,qv_i(k)); - temperature_i(k) = PF::calculate_T_from_theta(T_val,pmid(k)); - }); - - // Release WS views - ws.release_many_contiguous<1>({&pmid}); - }); - }; - - // Preprocess some homme states to get temperature - compute_temperature(); - Kokkos::fence(); - - // Apply IOP forcing - Kokkos::parallel_for("apply_iop_forcing", policy_iop, KOKKOS_LAMBDA (const KT::MemberType& team) { - const int ie = team.league_rank()/(NGP*NGP); - const int igp = (team.league_rank()/NGP)%NGP; - const int jgp = team.league_rank()%NGP; - - // Get temp views from workspace - auto ws = iop_wsm.get_workspace(team); - uview_1d pmid, pint, pdel; - ws.take_many_contiguous_unsafe<3>({"pmid", "pint", "pdel"}, - {&pmid, &pint, &pdel}); - - auto ps_i = ps_dyn(ie, igp, jgp); - auto u_i = ekat::subview(v_dyn, ie, 0, igp, jgp); - auto v_i = ekat::subview(v_dyn, ie, 1, igp, jgp); - auto temperature_i = ekat::subview(temperature, ie, igp, jgp); - auto qv_i = ekat::subview(Q_dyn, ie, 0, igp, jgp); - auto Q_i = Kokkos::subview(Q_dyn, ie, Kokkos::ALL(), igp, jgp, Kokkos::ALL()); - - // Compute reference pressures and layer thickness. - // TODO: Allow geometry data to allocate packsize - auto s_pmid = ekat::scalarize(pmid); - auto s_pint = ekat::scalarize(pint); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, total_levels+1), [&](const int& k) { - s_pint(k) = hyai(k)*ps0 + hybi(k)*ps_i; - if (k < total_levels) { - s_pmid(k) = hyam(k)*ps0 + hybm(k)*ps_i; - } - }); - team.team_barrier(); - ColOps::compute_midpoint_delta(team, total_levels, pint, pdel); - team.team_barrier(); - - if (iop_dosubsidence) { - // Compute subsidence due to large-scale forcing - advance_iop_subsidence(team, total_levels, dt, ps_i, pmid, pint, pdel, omega, ws, u_i, v_i, temperature_i, Q_i); - } - - // Update T and qv according to large scale forcing as specified in IOP file. - advance_iop_forcing(team, total_levels, dt, divT, divq, temperature_i, qv_i); - - if (iop_coriolis) { - // Apply coriolis forcing to u and v winds - iop_apply_coriolis(team, total_levels, dt, lat, u_ls, v_ls, u_i, v_i); - } - - // Release WS views - ws.release_many_contiguous<3>({&pmid, &pint, &pdel}); - }); - Kokkos::fence(); - - // Postprocess homme states Qdp and vtheta_dp - Kokkos::parallel_for("compute_qdp_and_vtheta_dp", policy_iop, KOKKOS_LAMBDA (const KT::MemberType& team) { - const int ie = team.league_rank()/(NGP*NGP); - const int igp = (team.league_rank()/NGP)%NGP; - const int jgp = team.league_rank()%NGP; - - // Get temp views from workspace - auto ws = iop_wsm.get_workspace(team); - uview_1d pmid, pint, pdel; - ws.take_many_contiguous_unsafe<3>({"pmid", "pint", "pdel"}, - {&pmid, &pint, &pdel}); - - auto ps_i = ps_dyn(ie, igp, jgp); - auto dp3d_i = ekat::subview(dp3d_dyn, ie, igp, jgp); - auto vtheta_dp_i = ekat::subview(vtheta_dp_dyn, ie, igp, jgp); - auto qv_i = ekat::subview(Q_dyn, ie, 0, igp, jgp); - auto Q_i = Kokkos::subview(Q_dyn, ie, Kokkos::ALL(), igp, jgp, Kokkos::ALL()); - auto Qdp_i = Kokkos::subview(Qdp_dyn, ie, Kokkos::ALL(), igp, jgp, Kokkos::ALL()); - auto temperature_i = ekat::subview(temperature, ie, igp, jgp); - - // Compute reference pressures and layer thickness. - // TODO: Allow geometry data to allocate packsize - auto s_pmid = ekat::scalarize(pmid); - auto s_pint = ekat::scalarize(pint); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, total_levels+1), [&](const int& k) { - s_pint(k) = hyai(k)*ps0 + hybi(k)*ps_i; - if (k < total_levels) { - s_pmid(k) = hyam(k)*ps0 + hybm(k)*ps_i; - } - }); - - team.team_barrier(); - - // Compute Qdp from updated Q - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, NLEV*qsize), [&] (const int k) { - const int ilev = k/qsize; - const int q = k%qsize; - - Qdp_i(q, ilev) = Q_i(q, ilev)*dp3d_i(ilev); - // For BFB on restarts, Q needs to be updated after we compute Qdp - Q_i(q, ilev) = Qdp_i(q, ilev)/dp3d_i(ilev); - }); - team.team_barrier(); - - // Convert updated temperature back to psuedo density virtual potential temperature - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, NLEV), [&] (const int k) { - const auto th = PF::calculate_theta_from_T(temperature_i(k),pmid(k)); - vtheta_dp_i(k) = PF::calculate_virtual_temperature(th,qv_i(k))*dp3d_i(k); - }); - - // Release WS views - ws.release_many_contiguous<3>({&pmid, &pint, &pdel}); - }); - - if (iop_nudge_tq or iop_nudge_uv) { - // Nudge the domain based on the domain mean - // and observed quantities of T, Q, u, and - - if (iop_nudge_tq) { - // Compute temperature - compute_temperature(); - Kokkos::fence(); - } - - // Compute domain mean of qv, temperature, u, and v - - // TODO: add to local mem buffer - view_1d qv_mean, t_mean, u_mean, v_mean; - if (iop_nudge_tq) { - qv_mean = view_1d("u_mean", NLEV), - t_mean = view_1d("v_mean", NLEV); - } - if (iop_nudge_uv){ - u_mean = view_1d("u_mean", NLEV), - v_mean = view_1d("v_mean", NLEV); - } - - const auto qv_mean_h = Kokkos::create_mirror_view(qv_mean); - const auto t_mean_h = Kokkos::create_mirror_view(t_mean); - const auto u_mean_h = Kokkos::create_mirror_view(u_mean); - const auto v_mean_h = Kokkos::create_mirror_view(v_mean); - - for (int k=0; kget_num_global_dofs(); - t_mean_k /= m_dyn_grid->get_num_global_dofs(); - } - if (iop_nudge_uv){ - Real& u_mean_k = u_mean_h(k/Pack::n)[k%Pack::n]; - Real& v_mean_k = v_mean_h(k/Pack::n)[k%Pack::n]; - Kokkos::parallel_reduce("compute_domain_means_uv", - nelem*NGP*NGP, - KOKKOS_LAMBDA (const int idx, Real& u_sum, Real& v_sum) { - const int ie = idx/(NGP*NGP); - const int igp = (idx/NGP)%NGP; - const int jgp = idx%NGP; - - u_sum += v_dyn(ie, 0, igp, jgp, k/Pack::n)[k%Pack::n]; - v_sum += v_dyn(ie, 1, igp, jgp, k/Pack::n)[k%Pack::n]; - }, - u_mean_k, - v_mean_k); - - m_comm.all_reduce(&u_mean_k, 1, MPI_SUM); - m_comm.all_reduce(&v_mean_k, 1, MPI_SUM); - - u_mean_k /= m_dyn_grid->get_num_global_dofs(); - v_mean_k /= m_dyn_grid->get_num_global_dofs(); - } - } - Kokkos::deep_copy(qv_mean, qv_mean_h); - Kokkos::deep_copy(t_mean, t_mean_h); - Kokkos::deep_copy(u_mean, u_mean_h); - Kokkos::deep_copy(v_mean, v_mean_h); - - // Apply relaxation - const auto rtau = std::max(dt, iop_nudge_tscale); - Kokkos::parallel_for("apply_domain_relaxation", - policy_iop, - KOKKOS_LAMBDA (const KT::MemberType& team) { - - const int ie = team.league_rank()/(NGP*NGP); - const int igp = (team.league_rank()/NGP)%NGP; - const int jgp = team.league_rank()%NGP; - - // Get temp views from workspace - auto ws = iop_wsm.get_workspace(team); - uview_1d pmid; - ws.take_many_contiguous_unsafe<1>({"pmid"},{&pmid}); - - auto ps_i = ps_dyn(ie, igp, jgp); - auto dp3d_i = ekat::subview(dp3d_dyn, ie, igp, jgp); - auto vtheta_dp_i = ekat::subview(vtheta_dp_dyn, ie, igp, jgp); - auto qv_i = ekat::subview(Q_dyn, ie, 0, igp, jgp); - auto temperature_i = ekat::subview(temperature, ie, igp, jgp); - auto u_i = ekat::subview(v_dyn, ie, 0, igp, jgp); - auto v_i = ekat::subview(v_dyn, ie, 1, igp, jgp); - - // Compute reference pressures and layer thickness. - // TODO: Allow geometry data to allocate packsize - auto s_pmid = ekat::scalarize(pmid); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, total_levels), [&](const int& k) { - s_pmid(k) = hyam(k)*ps0 + hybm(k)*ps_i; - }); - team.team_barrier(); - - if (iop_nudge_tq or iop_nudge_uv) { - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, NLEV), [&](const int& k) { - if (iop_nudge_tq) { - // Restrict nudging of T and qv to certain levels if requested by user - // IOP pressure variable is in unitis of [Pa], while iop_nudge_tq_low/high - // is in units of [hPa], thus convert iop_nudge_tq_low/high - Mask nudge_level(false); - int max_size = hyam.size(); - for (int lev=k*Pack::n, p = 0; p < Pack::n && lev < max_size; ++lev, ++p) { - const auto pressure_from_iop = hyam(lev)*ps0 + hybm(lev)*ps_iop; - nudge_level.set(p, pressure_from_iop <= iop_nudge_tq_low*100 - and - pressure_from_iop >= iop_nudge_tq_high*100); - } - - qv_i(k).update(nudge_level, qv_mean(k) - qv_iop(k), -dt/rtau, 1.0); - temperature_i(k).update(nudge_level, t_mean(k) - t_iop(k), -dt/rtau, 1.0); - - // Convert updated temperature back to virtual potential temperature - const auto th = PF::calculate_theta_from_T(temperature_i(k),pmid(k)); - vtheta_dp_i(k) = PF::calculate_virtual_temperature(th,qv_i(k))*dp3d_i(k); - } - if (iop_nudge_uv) { - u_i(k).update(u_mean(k) - u_iop(k), -dt/rtau, 1.0); - v_i(k).update(v_mean(k) - v_iop(k), -dt/rtau, 1.0); - } - }); - } - - // Release WS views - ws.release_many_contiguous<1>({&pmid}); - }); - } -} - -} // namespace scream diff --git a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp index 8b7495ffd73..0ccbbbc4d02 100644 --- a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp +++ b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.cpp @@ -426,11 +426,6 @@ void HommeDynamics::initialize_impl (const RunType run_type) if (run_type==RunType::Initial) { initialize_homme_state (); } else { - if (m_iop) { - // We need to reload IOP data after restarting - m_iop->read_iop_file_data(timestamp()); - } - restart_homme_state (); } @@ -669,10 +664,6 @@ void HommeDynamics::homme_post_process (const double dt) { get_internal_field("w_int_dyn").get_header().get_alloc_properties().reset_subview_idx(tl.n0); } - if (m_iop) { - apply_iop_forcing(dt); - } - if (fv_phys_active()) { fv_phys_post_process(); // Apply Rayleigh friction to update temperature and horiz_winds diff --git a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.hpp b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.hpp index 93dff0cd72e..b3e01f8aa30 100644 --- a/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.hpp +++ b/components/eamxx/src/dynamics/homme/eamxx_homme_process_interface.hpp @@ -109,44 +109,6 @@ class HommeDynamics : public AtmosphereProcess void rayleigh_friction_init (); void rayleigh_friction_apply (const Real dt) const; - // IOP functions - void apply_iop_forcing(const Real dt); - - KOKKOS_FUNCTION - static void advance_iop_subsidence(const KT::MemberType& team, - const int nlevs, - const Real dt, - const Real ps, - const view_1d& pmid, - const view_1d& pint, - const view_1d& pdel, - const view_1d& omega, - const Workspace& workspace, - const view_1d& u, - const view_1d& v, - const view_1d& T, - const view_2d& Q); - - KOKKOS_FUNCTION - static void advance_iop_forcing(const KT::MemberType& team, - const int nlevs, - const Real dt, - const view_1d& divT, - const view_1d& divq, - const view_1d& T, - const view_1d& qv); - - - KOKKOS_FUNCTION - static void iop_apply_coriolis(const KT::MemberType& team, - const int nlevs, - const Real dt, - const Real lat, - const view_1d& u_ls, - const view_1d& v_ls, - const view_1d& u, - const view_1d& v); - public: // Fast boolean function returning whether Physics PGN is being used. bool fv_phys_active() const; diff --git a/components/eamxx/src/mct_coupling/CMakeLists.txt b/components/eamxx/src/mct_coupling/CMakeLists.txt index 308cd177623..39f864e728a 100644 --- a/components/eamxx/src/mct_coupling/CMakeLists.txt +++ b/components/eamxx/src/mct_coupling/CMakeLists.txt @@ -38,6 +38,7 @@ set (SCREAM_LIBS eamxx_cosp cld_fraction spa + iop_forcing nudging diagnostics tms diff --git a/components/eamxx/src/physics/CMakeLists.txt b/components/eamxx/src/physics/CMakeLists.txt index e0e89e60f80..f9beda35a20 100644 --- a/components/eamxx/src/physics/CMakeLists.txt +++ b/components/eamxx/src/physics/CMakeLists.txt @@ -8,8 +8,10 @@ add_subdirectory(p3) if (SCREAM_DOUBLE_PRECISION) add_subdirectory(rrtmgp) add_subdirectory(cosp) + add_subdirectory(tms) + add_subdirectory(iop_forcing) else() - message(STATUS "WARNING: RRTMGP and COSP only supported for double precision builds; skipping") + message(STATUS "WARNING: RRTMGP, COSP, TMS, and IOPForcing only supported for double precision builds; skipping") endif() add_subdirectory(shoc) add_subdirectory(cld_fraction) @@ -21,8 +23,4 @@ add_subdirectory(nudging) if (SCREAM_ENABLE_MAM) add_subdirectory(mam) endif() -if (SCREAM_DOUBLE_PRECISION) - add_subdirectory(tms) -else() - message(STATUS "WARNING: TMS only supported for double precision builds; skipping") -endif() + diff --git a/components/eamxx/src/physics/iop_forcing/CMakeLists.txt b/components/eamxx/src/physics/iop_forcing/CMakeLists.txt new file mode 100644 index 00000000000..093ceac73c9 --- /dev/null +++ b/components/eamxx/src/physics/iop_forcing/CMakeLists.txt @@ -0,0 +1,5 @@ +add_library(iop_forcing eamxx_iop_forcing_process_interface.cpp) +target_compile_definitions(iop_forcing PUBLIC EAMXX_HAS_IOP_FORCING) +target_link_libraries(iop_forcing physics_share scream_share) + +target_link_libraries(eamxx_physics INTERFACE iop_forcing) diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp new file mode 100644 index 00000000000..9aac3fdf03a --- /dev/null +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp @@ -0,0 +1,546 @@ +#include "physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp" + +#include "share/property_checks/field_within_interval_check.hpp" + +namespace scream +{ +// ========================================================================================= +void IOPForcing::set_grids(const std::shared_ptr grids_manager) +{ + using namespace ekat::units; + + m_grid = grids_manager->get_grid("Physics"); + const auto& grid_name = m_grid->name(); + + m_num_cols = m_grid->get_num_local_dofs(); // Number of columns on this rank + m_num_levs = m_grid->get_num_vertical_levels(); // Number of levels per column + + // Define the different field layouts that will be used for this process + FieldLayout scalar2d = m_grid->get_2d_scalar_layout(); + FieldLayout scalar3d_mid = m_grid->get_3d_scalar_layout(true); + FieldLayout vector3d_mid = m_grid->get_3d_vector_layout(true,2); + + constexpr int pack_size = Pack::n; + + add_field("ps", scalar2d, Pa, grid_name); + + add_field("horiz_winds", vector3d_mid, m/s, grid_name, pack_size); + add_field("T_mid", scalar3d_mid, K, grid_name, pack_size); + + add_tracer("qv", m_grid, kg/kg, pack_size); + add_group("tracers", grid_name, pack_size, Bundling::Required); + + // Sanity check that iop data manager is setup by driver + EKAT_REQUIRE_MSG(m_iop_data_manager, + "Error! IOPDataManager not setup by driver, but IOPForcing" + "being used as an ATM process.\n"); + + // Compute number of buffer views + const auto iop_nudge_tq = m_iop_data_manager->get_params().get("iop_nudge_tq"); + const auto iop_nudge_uv = m_iop_data_manager->get_params().get("iop_nudge_uv"); + if (iop_nudge_tq) m_buffer.num_1d_scalar_nlev += 2; + if (iop_nudge_uv) m_buffer.num_1d_scalar_nlev += 2; +} +// ========================================================================================= +void IOPForcing:: +set_computed_group_impl (const FieldGroup& group) +{ + EKAT_REQUIRE_MSG(group.m_info->size() >= 1, + "Error! IOPForcing requires at least qv as tracer input.\n"); + + const auto& name = group.m_info->m_group_name; + + EKAT_REQUIRE_MSG(name=="tracers", + "Error! IOPForcing was not expecting a field group called '" << name << "\n"); + + EKAT_REQUIRE_MSG(group.m_info->m_bundled, + "Error! IOPForcing expects bundled fields for tracers.\n"); + + m_num_tracers = group.m_info->size(); +} +// ========================================================================================= +size_t IOPForcing::requested_buffer_size_in_bytes() const +{ + const int nlev_packs = ekat::npack(m_num_levs); + const int nlevi_packs = ekat::npack(m_num_levs+1); + + const size_t temp_view_bytes = + m_buffer.num_1d_scalar_nlev*nlev_packs*sizeof(Pack); + + // Number of bytes needed by the WorkspaceManager passed to shoc_main + const auto policy = ESU::get_default_team_policy(m_num_cols, nlevi_packs); + const size_t wsm_bytes = WorkspaceMgr::get_total_bytes_needed(nlevi_packs, 7+m_num_tracers, policy); + + return temp_view_bytes + wsm_bytes; +} +// ========================================================================================= +void IOPForcing::init_buffers(const ATMBufferManager &buffer_manager) +{ + EKAT_REQUIRE_MSG(buffer_manager.allocated_bytes() >= requested_buffer_size_in_bytes(), + "Error! Buffers size not sufficient.\n"); + + const int nlev_packs = ekat::npack(m_num_levs); + const int nlevi_packs = ekat::npack(m_num_levs+1); + + Pack* mem = reinterpret_cast(buffer_manager.get_memory()); + + // Temp view data + using mean_view_t = decltype(m_buffer.qv_mean); + const auto iop_nudge_tq = m_iop_data_manager->get_params().get("iop_nudge_tq"); + const auto iop_nudge_uv = m_iop_data_manager->get_params().get("iop_nudge_uv"); + if (iop_nudge_tq) { + m_buffer.qv_mean = mean_view_t(mem, nlev_packs); + mem += m_buffer.qv_mean.size(); + m_buffer.t_mean = mean_view_t(mem, nlev_packs); + mem += m_buffer.t_mean.size(); + } + if (iop_nudge_uv) { + m_buffer.u_mean = mean_view_t(mem, nlev_packs); + mem += m_buffer.u_mean.size(); + m_buffer.v_mean = mean_view_t(mem, nlev_packs); + mem += m_buffer.v_mean.size(); + } + + // WSM data + m_buffer.wsm_data = mem; + + const auto policy = ESU::get_default_team_policy(m_num_cols, nlevi_packs); + const size_t wsm_npacks = WorkspaceMgr::get_total_bytes_needed(nlevi_packs, 7+m_num_tracers, policy)/sizeof(Pack); + mem += wsm_npacks; + + size_t used_mem = (reinterpret_cast(mem) - buffer_manager.get_memory())*sizeof(Real); + EKAT_REQUIRE_MSG(used_mem==requested_buffer_size_in_bytes(), "Error! Used memory != requested memory for IOPForcing.\n"); +} +// ========================================================================================= +void IOPForcing::initialize_impl (const RunType run_type) +{ + // Set field property checks for the fields in this process + using Interval = FieldWithinIntervalCheck; + add_postcondition_check(get_field_out("T_mid"),m_grid,100.0,500.0,false); + add_postcondition_check(get_field_out("horiz_winds"),m_grid,-400.0,400.0,false); + // For qv, ensure it doesn't get negative, by allowing repair of any neg value. + // TODO: use a repairable lb that clips only "small" negative values + add_postcondition_check(get_field_out("qv"),m_grid,0,0.2,true); + + // Setup WSM for internal local variables + const auto nlevi_packs = ekat::npack(m_num_levs+1); + const auto policy = ESU::get_default_team_policy(m_num_cols, nlevi_packs); + m_workspace_mgr.setup(m_buffer.wsm_data, nlevi_packs, 7+m_num_tracers, policy); +} +// ========================================================================================= +KOKKOS_FUNCTION +void IOPForcing:: +advance_iop_subsidence(const MemberType& team, + const int nlevs, + const Real dt, + const Real ps, + const view_1d& ref_p_mid, + const view_1d& ref_p_int, + const view_1d& ref_p_del, + const view_1d& omega, + const Workspace& workspace, + const view_1d& u, + const view_1d& v, + const view_1d& T, + const view_2d& Q) +{ + constexpr Real Rair = C::Rair; + constexpr Real Cpair = C::Cpair; + + const auto n_q_tracers = Q.extent_int(0); + const auto nlev_packs = ekat::npack(nlevs); + + // Get some temporary views from WS + uview_1d omega_int, delta_u, delta_v, delta_T, tmp; + workspace.take_many_contiguous_unsafe<4>({"omega_int", "delta_u", "delta_v", "delta_T"}, + {&omega_int, &delta_u, &delta_v, &delta_T}); + const auto delta_Q_slot = workspace.take_macro_block("delta_Q", n_q_tracers); + uview_2d delta_Q(delta_Q_slot.data(), n_q_tracers, nlev_packs); + + auto s_ref_p_mid = ekat::scalarize(ref_p_mid); + auto s_omega = ekat::scalarize(omega); + auto s_delta_u = ekat::scalarize(delta_u); + auto s_delta_v = ekat::scalarize(delta_v); + auto s_delta_T = ekat::scalarize(delta_T); + auto s_delta_Q = ekat::scalarize(delta_Q); + auto s_omega_int = ekat::scalarize(omega_int); + + // Compute omega on the interface grid by using a weighted average in pressure + const int pack_begin = 1/Pack::n, pack_end = (nlevs-1)/Pack::n; + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, pack_begin, pack_end+1), [&] (const int k){ + auto range_pack = ekat::range(k*Pack::n); + range_pack.set(range_pack<1, 1); + Pack ref_p_mid_k, ref_p_mid_km1, omega_k, omega_km1; + ekat::index_and_shift<-1>(s_ref_p_mid, range_pack, ref_p_mid_k, ref_p_mid_km1); + ekat::index_and_shift<-1>(s_omega, range_pack, omega_k, omega_km1); + + const auto weight = (ref_p_int(k) - ref_p_mid_km1)/(ref_p_mid_k - ref_p_mid_km1); + omega_int(k).set(range_pack>=1 and range_pack<=nlevs-1, + weight*omega_k + (1-weight)*omega_km1); + }); + omega_int(0)[0] = 0; + omega_int(nlevs/Pack::n)[nlevs%Pack::n] = 0; + + // Compute delta views for u, v, T, and Q (e.g., u(k+1) - u(k), k=0,...,nlevs-2) + ColOps::compute_midpoint_delta(team, nlevs-1, u, delta_u); + ColOps::compute_midpoint_delta(team, nlevs-1, v, delta_v); + ColOps::compute_midpoint_delta(team, nlevs-1, T, delta_T); + for (int iq=0; iq(k*Pack::n); + const auto at_top = range_pack==0; + const auto not_at_top = not at_top; + const auto at_bot = range_pack==nlevs-1; + const auto not_at_bot = not at_bot; + const bool any_at_top = at_top.any(); + const bool any_at_bot = at_bot.any(); + + // Get delta(k-1) packs. The range pack should not + // contain index 0 (so that we don't attempt to access + // k=-1 index) or index > nlevs-2 (since delta_* views + // are size nlevs-1). + auto range_pack_for_m1_shift = range_pack; + range_pack_for_m1_shift.set(range_pack<1, 1); + range_pack_for_m1_shift.set(range_pack>nlevs-2, nlevs-2); + Pack delta_u_k, delta_u_km1, + delta_v_k, delta_v_km1, + delta_T_k, delta_T_km1; + ekat::index_and_shift<-1>(s_delta_u, range_pack_for_m1_shift, delta_u_k, delta_u_km1); + ekat::index_and_shift<-1>(s_delta_v, range_pack_for_m1_shift, delta_v_k, delta_v_km1); + ekat::index_and_shift<-1>(s_delta_T, range_pack_for_m1_shift, delta_T_k, delta_T_km1); + + // At the top and bottom of the model, set the end points for + // delta_*_k and delta_*_km1 to be the first and last entries + // of delta_*, respectively. + if (any_at_top) { + delta_u_k.set(at_top, s_delta_u(0)); + delta_v_k.set(at_top, s_delta_v(0)); + delta_T_k.set(at_top, s_delta_T(0)); + } + if (any_at_bot) { + delta_u_km1.set(at_bot, s_delta_u(nlevs-2)); + delta_v_km1.set(at_bot, s_delta_v(nlevs-2)); + delta_T_km1.set(at_bot, s_delta_T(nlevs-2)); + } + + // Get omega_int(k+1) pack. The range pack should not + // contain index > nlevs-1 (since omega_int is size nlevs+1). + auto range_pack_for_p1_shift = range_pack; + range_pack_for_p1_shift.set(range_pack>nlevs-1, nlevs-1); + Pack omega_int_k, omega_int_kp1; + ekat::index_and_shift<1>(s_omega_int, range_pack, omega_int_k, omega_int_kp1); + + const auto fac = (dt/2)/ref_p_del(k); + + // Update u + u(k).update(not_at_bot, fac*omega_int_kp1*delta_u_k, -1, 1); + u(k).update(not_at_top, fac*omega_int_k*delta_u_km1, -1, 1); + + // Update v + v(k).update(not_at_bot, fac*omega_int_kp1*delta_v_k, -1, 1); + v(k).update(not_at_top, fac*omega_int_k*delta_v_km1, -1, 1); + + // Before updating T, first scale using thermal + // expansion term due to LS vertical advection + T(k) *= 1 + (dt*Rair/Cpair)*omega(k)/ref_p_mid(k); + + // Update T + T(k).update(not_at_bot, fac*omega_int_kp1*delta_T_k, -1, 1); + T(k).update(not_at_top, fac*omega_int_k*delta_T_km1, -1, 1); + + // Update Q + Pack delta_tracer_k, delta_tracer_km1; + for (int iq=0; iq(s_delta_tracer, range_pack_for_m1_shift, delta_tracer_k, delta_tracer_km1); + if (any_at_top) delta_tracer_k.set(at_top, s_delta_tracer(0)); + if (any_at_bot) delta_tracer_km1.set(at_bot, s_delta_tracer(nlevs-2)); + + Q(iq, k).update(not_at_bot, fac*omega_int_kp1*delta_tracer_k, -1, 1); + Q(iq, k).update(not_at_top, fac*omega_int_k*delta_tracer_km1, -1, 1); + } + }); + + // Release WS views + workspace.release_macro_block(delta_Q_slot, n_q_tracers); + workspace.release_many_contiguous<4>({&omega_int, &delta_u, &delta_v, &delta_T}); +} +// ========================================================================================= +KOKKOS_FUNCTION +void IOPForcing:: +advance_iop_forcing(const MemberType& team, + const int nlevs, + const Real dt, + const view_1d& divT, + const view_1d& divq, + const view_1d& T, + const view_1d& qv) +{ + const auto nlev_packs = ekat::npack(nlevs); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&] (const int k) { + T(k).update(divT(k), dt, 1.0); + qv(k).update(divq(k), dt, 1.0); + }); +} +// ========================================================================================= +KOKKOS_FUNCTION +void IOPForcing:: +iop_apply_coriolis(const MemberType& team, + const int nlevs, + const Real dt, + const Real lat, + const view_1d& u_ls, + const view_1d& v_ls, + const view_1d& u, + const view_1d& v) +{ + constexpr Real pi = C::Pi; + constexpr Real earth_rotation = C::omega; + + // Compute coriolis force + const auto fcor = 2*earth_rotation*std::sin(lat*pi/180); + + const auto nlev_packs = ekat::npack(nlevs); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&] (const int k) { + const auto u_cor = v(k) - v_ls(k); + const auto v_cor = u(k) - u_ls(k); + u(k).update(u_cor, dt*fcor, 1.0); + v(k).update(v_cor, -dt*fcor, 1.0); + }); +} +// ========================================================================================= +void IOPForcing::run_impl (const double dt) +{ + // Pack dimensions + const auto nlev_packs = ekat::npack(m_num_levs); + + // Hybrid coord values + const auto ps0 = C::P0; + const auto hyam = m_grid->get_geometry_data("hyam").get_view(); + const auto hybm = m_grid->get_geometry_data("hybm").get_view(); + const auto hyai = m_grid->get_geometry_data("hyai").get_view(); + const auto hybi = m_grid->get_geometry_data("hybi").get_view(); + + // Get FM fields + const auto ps = get_field_in("ps").get_view(); + const auto horiz_winds = get_field_out("horiz_winds").get_view(); + const auto T_mid = get_field_out("T_mid").get_view(); + const auto qv = get_field_out("qv").get_view(); + const auto Q = get_group_out("tracers").m_bundle->get_view(); + + // Load data from IOP files, if necessary + m_iop_data_manager->read_iop_file_data(timestamp()); + + // Define local IOP param values + const auto iop_dosubsidence = m_iop_data_manager->get_params().get("iop_dosubsidence"); + const auto iop_coriolis = m_iop_data_manager->get_params().get("iop_coriolis"); + const auto iop_nudge_tq = m_iop_data_manager->get_params().get("iop_nudge_tq"); + const auto iop_nudge_uv = m_iop_data_manager->get_params().get("iop_nudge_uv"); + const auto use_large_scale_wind = m_iop_data_manager->get_params().get("use_large_scale_wind"); + const auto use_3d_forcing = m_iop_data_manager->get_params().get("use_3d_forcing"); + const auto target_lat = m_iop_data_manager->get_params().get("target_latitude"); + const auto iop_nudge_tscale = m_iop_data_manager->get_params().get("iop_nudge_tscale"); + const auto iop_nudge_tq_low = m_iop_data_manager->get_params().get("iop_nudge_tq_low"); + const auto iop_nudge_tq_high = m_iop_data_manager->get_params().get("iop_nudge_tq_high"); + + // Define local IOP field views + const Real ps_iop = m_iop_data_manager->get_iop_field("Ps").get_view()(); + view_1d omega, divT, divq, u_ls, v_ls, qv_iop, t_iop, u_iop, v_iop; + divT = use_3d_forcing ? m_iop_data_manager->get_iop_field("divT3d").get_view() + : m_iop_data_manager->get_iop_field("divT").get_view(); + divq = use_3d_forcing ? m_iop_data_manager->get_iop_field("divq3d").get_view() + : m_iop_data_manager->get_iop_field("divq").get_view(); + if (iop_dosubsidence) { + omega = m_iop_data_manager->get_iop_field("omega").get_view(); + } + if (iop_coriolis) { + u_ls = m_iop_data_manager->get_iop_field("u_ls").get_view(); + v_ls = m_iop_data_manager->get_iop_field("v_ls").get_view(); + } + if (iop_nudge_tq) { + qv_iop = m_iop_data_manager->get_iop_field("q").get_view(); + t_iop = m_iop_data_manager->get_iop_field("T").get_view(); + } + if (iop_nudge_uv) { + u_iop = use_large_scale_wind ? m_iop_data_manager->get_iop_field("u_ls").get_view() + : m_iop_data_manager->get_iop_field("u").get_view(); + v_iop = use_large_scale_wind ? m_iop_data_manager->get_iop_field("v_ls").get_view() + : m_iop_data_manager->get_iop_field("v").get_view(); + } + + // Team policy and workspace manager for eamxx + const auto policy_iop = ESU::get_default_team_policy(m_num_cols, nlev_packs); + + // Reset internal WSM variables. + m_workspace_mgr.reset_internals(); + + // Avoid implicit capture of this + auto wsm = m_workspace_mgr; + auto num_levs = m_num_levs; + + // Apply IOP forcing + Kokkos::parallel_for("apply_iop_forcing", policy_iop, KOKKOS_LAMBDA (const MemberType& team) { + const int icol = team.league_rank(); + + auto ps_i = ps(icol); + auto u_i = Kokkos::subview(horiz_winds, icol, 0, Kokkos::ALL()); + auto v_i = Kokkos::subview(horiz_winds, icol, 1, Kokkos::ALL()); + auto T_mid_i = ekat::subview(T_mid, icol); + auto qv_i = ekat::subview(qv, icol); + auto Q_i = Kokkos::subview(Q, icol, Kokkos::ALL(), Kokkos::ALL()); + + auto ws = wsm.get_workspace(team); + uview_1d ref_p_mid, ref_p_int, ref_p_del; + ws.take_many_contiguous_unsafe<3>({"ref_p_mid", "ref_p_int", "ref_p_del"}, + {&ref_p_mid, &ref_p_int, &ref_p_del}); + + // Compute reference pressures and layer thickness. + // TODO: Allow geometry data to allocate packsize + auto s_ref_p_mid = ekat::scalarize(ref_p_mid); + auto s_ref_p_int = ekat::scalarize(ref_p_int); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, num_levs+1), [&](const int& k) { + s_ref_p_int(k) = hyai(k)*ps0 + hybi(k)*ps_i; + if (k < num_levs) { + s_ref_p_mid(k) = hyam(k)*ps0 + hybm(k)*ps_i; + } + }); + team.team_barrier(); + ColOps::compute_midpoint_delta(team, num_levs, ref_p_int, ref_p_del); + team.team_barrier(); + + if (iop_dosubsidence) { + // Compute subsidence due to large-scale forcing + advance_iop_subsidence(team, num_levs, dt, ps_i, ref_p_mid, ref_p_int, ref_p_del, omega, ws, u_i, v_i, T_mid_i, Q_i); + } + + // Update T and qv according to large scale forcing as specified in IOP file. + advance_iop_forcing(team, num_levs, dt, divT, divq, T_mid_i, qv_i); + + if (iop_coriolis) { + // Apply coriolis forcing to u and v winds + iop_apply_coriolis(team, num_levs, dt, target_lat, u_ls, v_ls, u_i, v_i); + } + + // Release WS views + ws.release_many_contiguous<3>({&ref_p_mid, &ref_p_int, &ref_p_del}); + }); + Kokkos::fence(); + + // Nudge the domain based on the domain mean + // and observed quantities of T, Q, u, and v + if (iop_nudge_tq or iop_nudge_uv) { + // Compute domain mean of qv, T_mid, u, and v + const auto qv_mean = m_buffer.qv_mean; + const auto t_mean = m_buffer.t_mean; + const auto u_mean = m_buffer.u_mean; + const auto v_mean = m_buffer.v_mean; + + const auto qv_mean_h = Kokkos::create_mirror_view(qv_mean); + const auto t_mean_h = Kokkos::create_mirror_view(t_mean); + const auto u_mean_h = Kokkos::create_mirror_view(u_mean); + const auto v_mean_h = Kokkos::create_mirror_view(v_mean); + + const auto num_global_cols = m_grid->get_num_global_dofs(); + for (int k=0; k ref_p_mid; + ws.take_many_contiguous_unsafe<1>({"ref_p_mid"},{&ref_p_mid}); + + // Compute reference pressures and layer thickness. + // TODO: Allow geometry data to allocate packsize + auto s_ref_p_mid = ekat::scalarize(ref_p_mid); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, num_levs), [&](const int& k) { + s_ref_p_mid(k) = hyam(k)*ps0 + hybm(k)*ps_i; + }); + team.team_barrier(); + + if (iop_nudge_tq or iop_nudge_uv) { + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&](const int& k) { + if (iop_nudge_tq) { + // Restrict nudging of T and qv to certain levels if requested by user + // IOP pressure variable is in unitis of [Pa], while iop_nudge_tq_low/high + // is in units of [hPa], thus convert iop_nudge_tq_low/high + Mask nudge_level(false); + int max_size = hyam.size(); + for (int lev=k*Pack::n, p = 0; p < Pack::n && lev < max_size; ++lev, ++p) { + const auto pressure_from_iop = hyam(lev)*ps0 + hybm(lev)*ps_iop; + nudge_level.set(p, pressure_from_iop <= iop_nudge_tq_low*100 + and + pressure_from_iop >= iop_nudge_tq_high*100); + } + + qv_i(k).update(nudge_level, qv_mean(k) - qv_iop(k), -dt/rtau, 1.0); + T_mid_i(k).update(nudge_level, t_mean(k) - t_iop(k), -dt/rtau, 1.0); + } + if (iop_nudge_uv) { + u_i(k).update(u_mean(k) - u_iop(k), -dt/rtau, 1.0); + v_i(k).update(v_mean(k) - v_iop(k), -dt/rtau, 1.0); + } + }); + } + + // Release WS views + ws.release_many_contiguous<1>({&ref_p_mid}); + }); + } +} +// ========================================================================================= +} // namespace scream diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp new file mode 100644 index 00000000000..535043f401e --- /dev/null +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp @@ -0,0 +1,153 @@ +#ifndef SCREAM_IOP_FORCING_HPP +#define SCREAM_IOP_FORCING_HPP + +#include "ekat/ekat_parameter_list.hpp" +#include "ekat/ekat_workspace.hpp" + +#include "share/atm_process/atmosphere_process.hpp" +#include "share/atm_process/ATMBufferManager.hpp" +#include "share/util/scream_column_ops.hpp" + +#include "physics/share/physics_constants.hpp" + +#include + +namespace scream +{ +/* + * The class responsible for running EAMxx with an intensive + * observation period (IOP). + * + * The AD should store exactly ONE instance of this class stored + * in its list of subcomponents (the AD should make sure of this). + * + * Currently the only use case is the doubly + * periodic model (DP-SCREAM). + */ + +class IOPForcing : public scream::AtmosphereProcess +{ + // Typedefs for process + using KT = ekat::KokkosTypes; + using ESU = ekat::ExeSpaceUtils; + using Pack = ekat::Pack; + using IntPack = ekat::Pack; + using Mask = ekat::Mask; + using WorkspaceMgr = ekat::WorkspaceManager; + using Workspace = WorkspaceMgr::Workspace; + + using MemberType = KT::MemberType; + template + using view_1d = KT::view_1d; + template + using view_2d = KT::view_2d; + template + using uview_1d = ekat::Unmanaged>; + template + using uview_2d = ekat::Unmanaged>; + + using ColOps = ColumnOps; + using C = physics::Constants; + + + +public: + + // Constructors + IOPForcing (const ekat::Comm& comm, const ekat::ParameterList& params) + : AtmosphereProcess(comm, params) {} + + // The type of subcomponent + AtmosphereProcessType type () const { return AtmosphereProcessType::Physics; } + + // The name of the subcomponent + std::string name () const { return "iop"; } + + // Set the grid + void set_grids (const std::shared_ptr grids_manager); + +#ifndef KOKKOS_ENABLE_CUDA + // Cuda requires methods enclosing __device__ lambda's to be public +protected: +#endif + + void initialize_impl (const RunType run_type); + + // Compute effects of large scale subsidence on T, q, u, and v. + KOKKOS_FUNCTION + static void advance_iop_subsidence(const KT::MemberType& team, + const int nlevs, + const Real dt, + const Real ps, + const view_1d& pmid, + const view_1d& pint, + const view_1d& pdel, + const view_1d& omega, + const Workspace& workspace, + const view_1d& u, + const view_1d& v, + const view_1d& T, + const view_2d& Q); + + // Apply large scale forcing for temperature and water vapor as provided by the IOP file + KOKKOS_FUNCTION + static void advance_iop_forcing(const KT::MemberType& team, + const int nlevs, + const Real dt, + const view_1d& divT, + const view_1d& divq, + const view_1d& T, + const view_1d& qv); + + // Provide coriolis forcing to u and v winds, using large scale winds specified in IOP forcing file. + KOKKOS_FUNCTION + static void iop_apply_coriolis(const KT::MemberType& team, + const int nlevs, + const Real dt, + const Real lat, + const view_1d& u_ls, + const view_1d& v_ls, + const view_1d& u, + const view_1d& v); + + void run_impl (const double dt); + +protected: + + void finalize_impl () {} + + void set_computed_group_impl (const FieldGroup& group); + + // Computes total number of bytes needed for local variables + size_t requested_buffer_size_in_bytes() const; + + // Set local variables using memory provided by + // the ATMBufferManager + void init_buffers(const ATMBufferManager &buffer_manager); + + // Keep track of field dimensions and other scalar values + // needed in IOP + Int m_num_cols; + Int m_num_levs; + Int m_num_tracers; + + struct Buffer { + int num_1d_scalar_nlev = 0; + + uview_1d qv_mean, t_mean, u_mean, v_mean; + + Pack* wsm_data; + }; + + // Struct which contains local variables + Buffer m_buffer; + + // WSM for internal local variables + WorkspaceMgr m_workspace_mgr; + + std::shared_ptr m_grid; +}; // class IOPForcing + +} // namespace scream + +#endif // SCREAM_IOP_FORCING_HPP diff --git a/components/eamxx/src/physics/register_physics.hpp b/components/eamxx/src/physics/register_physics.hpp index 99956bb75f5..dc1ce5745d3 100644 --- a/components/eamxx/src/physics/register_physics.hpp +++ b/components/eamxx/src/physics/register_physics.hpp @@ -41,6 +41,9 @@ #ifdef EAMXX_HAS_ML_CORRECTION #include "physics/ml_correction/eamxx_ml_correction_process_interface.hpp" #endif +#ifdef EAMXX_HAS_IOP_FORCING +#include "physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp" +#endif namespace scream { @@ -82,6 +85,9 @@ inline void register_physics () { #ifdef EAMXX_HAS_ML_CORRECTION proc_factory.register_product("MLCorrection",&create_atmosphere_process); #endif +#ifdef EAMXX_HAS_IOP_FORCING + proc_factory.register_product("iop_forcing",&create_atmosphere_process); +#endif // If no physics was enabled, silence compile warning about unused var (void) proc_factory; diff --git a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp index 0709bb1a37f..0121741963d 100644 --- a/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp +++ b/components/eamxx/src/physics/rrtmgp/eamxx_rrtmgp_process_interface.cpp @@ -99,16 +99,16 @@ void RRTMGPRadiation::set_grids(const std::shared_ptr grids_ m_ncol = m_grid->get_num_local_dofs(); m_nlay = m_grid->get_num_vertical_levels(); - if (m_iop) { + if (m_iop_data_manager) { // For IOP runs, we need to use the lat/lon from the // IOP files instead of the geometry data. Deep copy // to device and sync to host since both will be used. m_lat = m_grid->get_geometry_data("lat").clone(); - m_lat.deep_copy(m_iop->get_params().get("target_latitude")); + m_lat.deep_copy(m_iop_data_manager->get_params().get("target_latitude")); m_lat.sync_to_host(); m_lon = m_grid->get_geometry_data("lon").clone(); - m_lon.deep_copy(m_iop->get_params().get("target_longitude")); + m_lon.deep_copy(m_iop_data_manager->get_params().get("target_longitude")); m_lon.sync_to_host(); } else { m_lat = m_grid->get_geometry_data("lat"); diff --git a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp index ac620e19add..1bbb17f8480 100644 --- a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp +++ b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp @@ -449,7 +449,7 @@ void SHOCMacrophysics::initialize_impl (const RunType run_type) const auto ncols = m_num_cols; view_1d cell_length("cell_length", ncols); if (m_grid->has_geometry_data("dx_short")) { - // We must be running with IntensiveObservationPeriod on, with a planar geometry + // In this case IOP is running with a planar geometry auto dx = m_grid->get_geometry_data("dx_short").get_view()(); Kokkos::deep_copy(cell_length, dx*1000); // convert km -> m } else { diff --git a/components/eamxx/src/physics/spa/eamxx_spa_process_interface.cpp b/components/eamxx/src/physics/spa/eamxx_spa_process_interface.cpp index 61c61b878c2..c27af18f85b 100644 --- a/components/eamxx/src/physics/spa/eamxx_spa_process_interface.cpp +++ b/components/eamxx/src/physics/spa/eamxx_spa_process_interface.cpp @@ -64,11 +64,11 @@ void SPA::set_grids(const std::shared_ptr grids_manager) // where a single column of data corresponding to the closest lat/lon pair to // the IOP lat/lon parameters is read from file, and that column data is mapped // to all columns of the IdentityRemapper source fields. - EKAT_REQUIRE_MSG(spa_map_file == "" or spa_map_file == "None" or not m_iop, + EKAT_REQUIRE_MSG(spa_map_file == "" or spa_map_file == "None" or not m_iop_data_manager, "Error! Cannot define spa_remap_file for cases with an Intensive Observation Period defined. " "The IOP class defines it's own remap from file data -> model data.\n"); - SPAHorizInterp = SPAFunc::create_horiz_remapper (m_grid,spa_data_file,spa_map_file, m_iop!=nullptr); + SPAHorizInterp = SPAFunc::create_horiz_remapper (m_grid,spa_data_file,spa_map_file, m_iop_data_manager!=nullptr); // Grab a sw and lw field from the horiz interp, and check sw/lw dim against what we hardcoded in this class auto nswbands_data = SPAHorizInterp->get_src_field(4).get_header().get_identifier().get_layout().dim("swband"); @@ -128,8 +128,8 @@ void SPA::set_grids(const std::shared_ptr grids_manager) // AtmosphereInput object (for reading into standard // grids) or a SpaFunctions::IOPReader (for reading into // an IOP grid). - if (m_iop) { - SPAIOPDataReader = SPAFunc::create_spa_data_reader(m_iop,SPAHorizInterp,spa_data_file); + if (m_iop_data_manager) { + SPAIOPDataReader = SPAFunc::create_spa_data_reader(m_iop_data_manager,SPAHorizInterp,spa_data_file); } else { SPADataReader = SPAFunc::create_spa_data_reader(SPAHorizInterp,spa_data_file); } diff --git a/components/eamxx/src/physics/spa/spa_functions.hpp b/components/eamxx/src/physics/spa/spa_functions.hpp index 6bdba702e70..444b2d9992e 100644 --- a/components/eamxx/src/physics/spa/spa_functions.hpp +++ b/components/eamxx/src/physics/spa/spa_functions.hpp @@ -4,7 +4,7 @@ #include "share/grid/abstract_grid.hpp" #include "share/grid/remap/abstract_remapper.hpp" #include "share/io/scorpio_input.hpp" -#include "share/iop/intensive_observation_period.hpp" +#include "share/atm_process/IOPDataManager.hpp" #include "share/util/scream_time_stamp.hpp" #include "share/scream_types.hpp" @@ -30,7 +30,7 @@ struct SPAFunctions using gid_type = AbstractGrid::gid_type; - using iop_ptr_type = std::shared_ptr; + using iop_data_ptr_type = std::shared_ptr; template using view_1d = typename KT::template view_1d; @@ -128,11 +128,11 @@ struct SPAFunctions }; // SPAInput struct IOPReader { - IOPReader (iop_ptr_type& iop_, + IOPReader (iop_data_ptr_type& iop_, const std::string file_name_, const std::vector& io_fields_, const std::shared_ptr& io_grid_) - : iop(iop_), file_name(file_name_) + : iop_data_manager(iop_), file_name(file_name_) { field_mgr = std::make_shared(io_grid_); for (auto& f : io_fields_) { @@ -141,14 +141,14 @@ struct SPAFunctions } // Set IO info for this grid and file in IOP object - iop->setup_io_info(file_name, io_grid_); + iop_data_manager->setup_io_info(file_name, io_grid_); } void read_variables(const int time_index, const util::TimeStamp& ts) { - iop->read_fields_from_file_for_iop(file_name, field_names, ts, field_mgr, time_index); + iop_data_manager->read_fields_from_file_for_iop(file_name, field_names, ts, field_mgr, time_index); } - iop_ptr_type iop; + iop_data_ptr_type iop_data_manager; std::string file_name; std::vector field_names; std::shared_ptr field_mgr; @@ -175,7 +175,7 @@ struct SPAFunctions static std::shared_ptr create_spa_data_reader ( - iop_ptr_type& iop, + iop_data_ptr_type& iop_data_manager, const std::shared_ptr& horiz_remapper, const std::string& spa_data_file); diff --git a/components/eamxx/src/physics/spa/spa_functions_impl.hpp b/components/eamxx/src/physics/spa/spa_functions_impl.hpp index 287f69a9889..e566d0c985c 100644 --- a/components/eamxx/src/physics/spa/spa_functions_impl.hpp +++ b/components/eamxx/src/physics/spa/spa_functions_impl.hpp @@ -162,7 +162,7 @@ template std::shared_ptr::IOPReader> SPAFunctions:: create_spa_data_reader ( - iop_ptr_type& iop, + iop_data_ptr_type& iop_data_manager, const std::shared_ptr& horiz_remapper, const std::string& spa_data_file) { @@ -171,7 +171,7 @@ create_spa_data_reader ( io_fields.push_back(horiz_remapper->get_src_field(i)); } const auto io_grid = horiz_remapper->get_src_grid(); - return std::make_shared(iop, spa_data_file, io_fields, io_grid); + return std::make_shared(iop_data_manager, spa_data_file, io_fields, io_grid); } /*-----------------------------------------------------------------*/ diff --git a/components/eamxx/src/share/CMakeLists.txt b/components/eamxx/src/share/CMakeLists.txt index 105b39a9808..dd290dfb364 100644 --- a/components/eamxx/src/share/CMakeLists.txt +++ b/components/eamxx/src/share/CMakeLists.txt @@ -8,6 +8,7 @@ set(SHARE_SRC atm_process/atmosphere_process_group.cpp atm_process/atmosphere_process_dag.cpp atm_process/atmosphere_diagnostic.cpp + atm_process/IOPDataManager.cpp field/field_alloc_prop.cpp field/field_identifier.cpp field/field_header.cpp @@ -27,7 +28,6 @@ set(SHARE_SRC grid/remap/horiz_interp_remapper_data.cpp grid/remap/refining_remapper_p2p.cpp grid/remap/vertical_remapper.cpp - iop/intensive_observation_period.cpp property_checks/property_check.cpp property_checks/field_nan_check.cpp property_checks/field_within_interval_check.cpp diff --git a/components/eamxx/src/share/iop/intensive_observation_period.cpp b/components/eamxx/src/share/atm_process/IOPDataManager.cpp similarity index 98% rename from components/eamxx/src/share/iop/intensive_observation_period.cpp rename to components/eamxx/src/share/atm_process/IOPDataManager.cpp index 1d5f7c7ba33..2e2c3552d8e 100644 --- a/components/eamxx/src/share/iop/intensive_observation_period.cpp +++ b/components/eamxx/src/share/atm_process/IOPDataManager.cpp @@ -1,7 +1,7 @@ #include "share/grid/point_grid.hpp" #include "share/io/scorpio_input.hpp" #include "share/io/scream_scorpio_interface.hpp" -#include "share/iop/intensive_observation_period.hpp" +#include "share/atm_process/IOPDataManager.hpp" #include "ekat/ekat_assert.hpp" #include "ekat/util/ekat_lin_interp.hpp" @@ -27,13 +27,13 @@ namespace ekat { namespace scream { namespace control { -IntensiveObservationPeriod:: -IntensiveObservationPeriod(const ekat::Comm& comm, - const ekat::ParameterList& params, - const util::TimeStamp& run_t0, - const int model_nlevs, - const Field& hyam, - const Field& hybm) +IOPDataManager:: +IOPDataManager(const ekat::Comm& comm, + const ekat::ParameterList& params, + const util::TimeStamp& run_t0, + const int model_nlevs, + const Field& hyam, + const Field& hybm) { m_comm = comm; m_params = params; @@ -72,14 +72,14 @@ IntensiveObservationPeriod(const ekat::Comm& comm, initialize_iop_file(run_t0, model_nlevs); } -IntensiveObservationPeriod:: -~IntensiveObservationPeriod () +IOPDataManager:: +~IOPDataManager () { const auto iop_file = m_params.get("iop_file"); scorpio::release_file(iop_file); } -void IntensiveObservationPeriod:: +void IOPDataManager:: initialize_iop_file(const util::TimeStamp& run_t0, int model_nlevs) { @@ -310,7 +310,7 @@ initialize_iop_file(const util::TimeStamp& run_t0, m_helper_fields.insert({"model_pressure", model_pressure}); } -void IntensiveObservationPeriod:: +void IOPDataManager:: setup_io_info(const std::string& file_name, const grid_ptr& grid) { @@ -397,7 +397,7 @@ setup_io_info(const std::string& file_name, } } -void IntensiveObservationPeriod:: +void IOPDataManager:: read_fields_from_file_for_iop (const std::string& file_name, const vos& field_names_nc, const vos& field_names_eamxx, @@ -501,7 +501,7 @@ read_fields_from_file_for_iop (const std::string& file_name, } } -void IntensiveObservationPeriod:: +void IOPDataManager:: read_iop_file_data (const util::TimeStamp& current_ts) { // Query to see if we need to load data from IOP file. @@ -749,7 +749,7 @@ read_iop_file_data (const util::TimeStamp& current_ts) m_time_info.time_idx_of_current_data = iop_file_time_idx; } -void IntensiveObservationPeriod:: +void IOPDataManager:: set_fields_from_iop_data(const field_mgr_ptr field_mgr) { if (m_params.get("zero_non_iop_tracers") && field_mgr->has_group("tracers")) { @@ -858,7 +858,7 @@ set_fields_from_iop_data(const field_mgr_ptr field_mgr) }); } -void IntensiveObservationPeriod:: +void IOPDataManager:: correct_temperature_and_water_vapor(const field_mgr_ptr field_mgr) { // Find the first valid level index for t_iop, i.e., first non-zero entry diff --git a/components/eamxx/src/share/iop/intensive_observation_period.hpp b/components/eamxx/src/share/atm_process/IOPDataManager.hpp similarity index 92% rename from components/eamxx/src/share/iop/intensive_observation_period.hpp rename to components/eamxx/src/share/atm_process/IOPDataManager.hpp index 860eb082c42..0ca5e2ef6d1 100644 --- a/components/eamxx/src/share/iop/intensive_observation_period.hpp +++ b/components/eamxx/src/share/atm_process/IOPDataManager.hpp @@ -14,11 +14,9 @@ namespace scream { namespace control { /* - * Class which provides functionality for running EAMxx with an intensive - * observation period (IOP). Currently the only use case is the doubly - * periodic model (DP-SCREAM). + * Class which data for an intensive observation period (IOP). */ -class IntensiveObservationPeriod +class IOPDataManager { using vos = std::vector; using field_mgr_ptr = std::shared_ptr; @@ -47,15 +45,15 @@ class IntensiveObservationPeriod // - run_t0: Initial timestamp for the simulation // - model_nlevs: Number of vertical levels in the simulation. Needed since // the iop file contains a (potentially) different number of levels - IntensiveObservationPeriod(const ekat::Comm& comm, - const ekat::ParameterList& params, - const util::TimeStamp& run_t0, - const int model_nlevs, - const Field& hyam, - const Field& hybm); + IOPDataManager(const ekat::Comm& comm, + const ekat::ParameterList& params, + const util::TimeStamp& run_t0, + const int model_nlevs, + const Field& hyam, + const Field& hybm); - // Default destructor - ~IntensiveObservationPeriod(); + // Destructor + ~IOPDataManager(); // Read data from IOP file and store internally. void read_iop_file_data(const util::TimeStamp& current_ts); @@ -197,7 +195,7 @@ class IntensiveObservationPeriod std::map m_iop_file_varnames; std::map m_iop_field_surface_varnames; std::map m_iop_field_type; -}; // class IntensiveObservationPeriod +}; // class IOPDataManager } // namespace control } // namespace scream diff --git a/components/eamxx/src/share/atm_process/atmosphere_process.hpp b/components/eamxx/src/share/atm_process/atmosphere_process.hpp index 43fc35a3318..016321ea506 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process.hpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process.hpp @@ -1,10 +1,10 @@ #ifndef SCREAM_ATMOSPHERE_PROCESS_HPP #define SCREAM_ATMOSPHERE_PROCESS_HPP -#include "share/iop/intensive_observation_period.hpp" #include "share/atm_process/atmosphere_process_utils.hpp" #include "share/atm_process/ATMBufferManager.hpp" #include "share/atm_process/SCDataManager.hpp" +#include "share/atm_process/IOPDataManager.hpp" #include "share/field/field_identifier.hpp" #include "share/field/field_manager.hpp" #include "share/property_checks/property_check.hpp" @@ -83,7 +83,7 @@ class AtmosphereProcess : public ekat::enable_shared_from_this; - using iop_ptr = std::shared_ptr; + using iop_data_ptr = std::shared_ptr; // Base constructor to set MPI communicator and params AtmosphereProcess (const ekat::Comm& comm, const ekat::ParameterList& params); @@ -280,8 +280,8 @@ class AtmosphereProcess : public ekat::enable_shared_from_this get_logger () const { @@ -597,7 +597,7 @@ class AtmosphereProcess : public ekat::enable_shared_from_thisset_iop(iop); + atm_proc->set_iop_data_manager(iop_data_manager); } } diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/CMakeLists.txt b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/CMakeLists.txt index f56d8beefa6..db5c8585943 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/CMakeLists.txt +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/CMakeLists.txt @@ -11,7 +11,7 @@ CreateDynamicsLib("theta-l_kokkos" 4 72 10) set (TEST_LABELS "dynamics;driver;tms;shoc;cld;spa;p3;rrtmgp;physics;dp") CreateUnitTest(homme_shoc_cld_spa_p3_rrtmgp_pg2_dp "homme_shoc_cld_spa_p3_rrtmgp_pg2_dp.cpp" LABELS ${TEST_LABELS} - LIBS cld_fraction tms shoc spa p3 scream_rrtmgp ${dynLibName} scream_control diagnostics + LIBS cld_fraction tms shoc spa iop_forcing p3 scream_rrtmgp ${dynLibName} scream_control diagnostics MPI_RANKS ${TEST_RANK_START} ${TEST_RANK_END} FIXTURES_SETUP_INDIVIDUAL ${FIXTURES_BASE_NAME} ) diff --git a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml index 0950f6bfdbc..47d0ed11086 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml +++ b/components/eamxx/tests/multi-process/dynamics_physics/homme_shoc_cld_spa_p3_rrtmgp_pg2_dp/input.yaml @@ -40,7 +40,7 @@ atmosphere_processes: homme: Moisture: moist physics: - atm_procs_list: [mac_aero_mic,rrtmgp] + atm_procs_list: [iop_forcing,mac_aero_mic,rrtmgp] schedule_type: Sequential Type: Group mac_aero_mic: From 10892147ab4810f1ad4216e2f7745ee9d56f83e6 Mon Sep 17 00:00:00 2001 From: tcclevenger Date: Thu, 5 Dec 2024 12:33:21 -0500 Subject: [PATCH 415/529] Remove unnecessary if-block if (iop_nudge_tq or iop_nudge_uv) { ... if (iop_nudge_tq or iop_nudge_uv) { ... } } --- .../physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp | 2 -- 1 file changed, 2 deletions(-) diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp index 9aac3fdf03a..ee662cd81b8 100644 --- a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp @@ -512,7 +512,6 @@ void IOPForcing::run_impl (const double dt) }); team.team_barrier(); - if (iop_nudge_tq or iop_nudge_uv) { Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&](const int& k) { if (iop_nudge_tq) { // Restrict nudging of T and qv to certain levels if requested by user @@ -535,7 +534,6 @@ void IOPForcing::run_impl (const double dt) v_i(k).update(v_mean(k) - v_iop(k), -dt/rtau, 1.0); } }); - } // Release WS views ws.release_many_contiguous<1>({&ref_p_mid}); From 37e22bdb86ab1db3d3f199c20d212f51e4f0a6fa Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 4 Dec 2024 15:07:51 -0700 Subject: [PATCH 416/529] EAMxx: fix valgrind tests --- components/eamxx/tests/generic/fail_check/valg_fail.cpp | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/components/eamxx/tests/generic/fail_check/valg_fail.cpp b/components/eamxx/tests/generic/fail_check/valg_fail.cpp index ba0ba6f59b3..5bbd694dad3 100644 --- a/components/eamxx/tests/generic/fail_check/valg_fail.cpp +++ b/components/eamxx/tests/generic/fail_check/valg_fail.cpp @@ -6,15 +6,18 @@ namespace scream { TEST_CASE("force_valgrind_err") { - bool uninit; + bool* uninit = new bool[1]; int i = 0; - if (uninit) { + if (uninit[0]) { ++i; } else { i += 4; } - REQUIRE(i < 10); + if (i<4) { + printf("less than four\n"); + } + delete uninit; } } // empty namespace From 6ec6f3fa9306a599a91f8885d4f84ef83a4c2039 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Sat, 30 Nov 2024 09:39:18 -0800 Subject: [PATCH 417/529] EAMxx: add horizontal average diagnostic field --- .../eamxx/src/diagnostics/CMakeLists.txt | 1 + .../eamxx/src/diagnostics/horiz_avg.cpp | 65 ++++++ .../eamxx/src/diagnostics/horiz_avg.hpp | 43 ++++ .../src/diagnostics/register_diagnostics.hpp | 2 + .../src/diagnostics/tests/CMakeLists.txt | 3 + .../src/diagnostics/tests/horiz_avg_test.cpp | 197 ++++++++++++++++++ .../eamxx/src/share/io/scream_io_utils.cpp | 11 +- 7 files changed, 321 insertions(+), 1 deletion(-) create mode 100644 components/eamxx/src/diagnostics/horiz_avg.cpp create mode 100644 components/eamxx/src/diagnostics/horiz_avg.hpp create mode 100644 components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp diff --git a/components/eamxx/src/diagnostics/CMakeLists.txt b/components/eamxx/src/diagnostics/CMakeLists.txt index 8a8dfca560d..0795f9e5469 100644 --- a/components/eamxx/src/diagnostics/CMakeLists.txt +++ b/components/eamxx/src/diagnostics/CMakeLists.txt @@ -8,6 +8,7 @@ set(DIAGNOSTIC_SRCS field_at_height.cpp field_at_level.cpp field_at_pressure_level.cpp + horiz_avg.cpp longwave_cloud_forcing.cpp number_path.cpp potential_temperature.cpp diff --git a/components/eamxx/src/diagnostics/horiz_avg.cpp b/components/eamxx/src/diagnostics/horiz_avg.cpp new file mode 100644 index 00000000000..8bfe068c635 --- /dev/null +++ b/components/eamxx/src/diagnostics/horiz_avg.cpp @@ -0,0 +1,65 @@ +#include "diagnostics/horiz_avg.hpp" + +#include "share/field/field_utils.hpp" + +namespace scream { + +HorizAvgDiag::HorizAvgDiag(const ekat::Comm &comm, + const ekat::ParameterList ¶ms) + : AtmosphereDiagnostic(comm, params) { + const auto &fname = m_params.get("field_name"); + m_diag_name = fname + "_horiz_avg"; +} + +void HorizAvgDiag::set_grids( + const std::shared_ptr grids_manager) { + const auto &fn = m_params.get("field_name"); + const auto &gn = m_params.get("grid_name"); + const auto g = grids_manager->get_grid("Physics"); + + add_field(fn, gn); + + // first clone the area unscaled, we will scale it later in initialize_impl + m_scaled_area = g->get_geometry_data("area").clone(); +} + +void HorizAvgDiag::initialize_impl(const RunType /*run_type*/) { + using namespace ShortFieldTagsNames; + const auto &f = get_fields_in().front(); + const auto &fid = f.get_header().get_identifier(); + const auto &layout = fid.get_layout(); + + EKAT_REQUIRE_MSG(layout.rank() >= 1 && layout.rank() <= 3, + "Error! Field rank not supported by HorizAvgDiag.\n" + " - field name: " + + fid.name() + + "\n" + " - field layout: " + + layout.to_string() + "\n"); + EKAT_REQUIRE_MSG(layout.tags()[0] == COL, + "Error! HorizAvgDiag diagnostic expects a layout starting " + "with the 'COL' tag.\n" + " - field name : " + + fid.name() + + "\n" + " - field layout: " + + layout.to_string() + "\n"); + + FieldIdentifier d_fid(m_diag_name, layout.clone().strip_dim(COL), + fid.get_units(), fid.get_grid_name()); + m_diagnostic_output = Field(d_fid); + m_diagnostic_output.allocate_view(); + + // scale the area field + auto total_area = field_sum(m_scaled_area, &m_comm); + m_scaled_area.scale(sp(1.0) / total_area); +} + +void HorizAvgDiag::compute_diagnostic_impl() { + const auto &f = get_fields_in().front(); + const auto &d = m_diagnostic_output; + // Call the horiz_contraction impl that will take care of everything + horiz_contraction(d, f, m_scaled_area, &m_comm); +} + +} // namespace scream diff --git a/components/eamxx/src/diagnostics/horiz_avg.hpp b/components/eamxx/src/diagnostics/horiz_avg.hpp new file mode 100644 index 00000000000..6ceac09103b --- /dev/null +++ b/components/eamxx/src/diagnostics/horiz_avg.hpp @@ -0,0 +1,43 @@ +#ifndef EAMXX_HORIZ_AVERAGE_HPP +#define EAMXX_HORIZ_AVERAGE_HPP + +#include "share/atm_process/atmosphere_diagnostic.hpp" + +namespace scream { + +/* + * This diagnostic will calculate the area-weighted average of a field + * across the COL tag dimension, producing an N-1 dimensional field + * that is area-weighted average of the input field. + */ + +class HorizAvgDiag : public AtmosphereDiagnostic { + public: + // Constructors + HorizAvgDiag(const ekat::Comm &comm, const ekat::ParameterList ¶ms); + + // The name of the diagnostic + std::string name() const { return m_diag_name; } + + // Set the grid + void set_grids(const std::shared_ptr grids_manager); + + protected: +#ifdef KOKKOS_ENABLE_CUDA + public: +#endif + void compute_diagnostic_impl(); + + protected: + void initialize_impl(const RunType /*run_type*/); + + // Name of each field (because the diagnostic impl is generic) + std::string m_diag_name; + + // Need area field, let's store it scaled by its norm + Field m_scaled_area; +}; + +} // namespace scream + +#endif // EAMXX_HORIZ_AVERAGE_HPP diff --git a/components/eamxx/src/diagnostics/register_diagnostics.hpp b/components/eamxx/src/diagnostics/register_diagnostics.hpp index b4830c39e92..67119416705 100644 --- a/components/eamxx/src/diagnostics/register_diagnostics.hpp +++ b/components/eamxx/src/diagnostics/register_diagnostics.hpp @@ -24,6 +24,7 @@ #include "diagnostics/number_path.hpp" #include "diagnostics/aerocom_cld.hpp" #include "diagnostics/atm_backtend.hpp" +#include "diagnostics/horiz_avg.hpp" namespace scream { @@ -51,6 +52,7 @@ inline void register_diagnostics () { diag_factory.register_product("NumberPath",&create_atmosphere_diagnostic); diag_factory.register_product("AeroComCld",&create_atmosphere_diagnostic); diag_factory.register_product("AtmBackTendDiag",&create_atmosphere_diagnostic); + diag_factory.register_product("HorizAvgDiag",&create_atmosphere_diagnostic); } } // namespace scream diff --git a/components/eamxx/src/diagnostics/tests/CMakeLists.txt b/components/eamxx/src/diagnostics/tests/CMakeLists.txt index 5b318a04922..736253f9bee 100644 --- a/components/eamxx/src/diagnostics/tests/CMakeLists.txt +++ b/components/eamxx/src/diagnostics/tests/CMakeLists.txt @@ -71,3 +71,6 @@ CreateDiagTest(aerocom_cld "aerocom_cld_test.cpp") # Test atm_tend CreateDiagTest(atm_backtend "atm_backtend_test.cpp") + +# Test horizontal averaging +CreateDiagTest(horiz_avg "horiz_avg_test.cpp") diff --git a/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp b/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp new file mode 100644 index 00000000000..81bc10c6a2c --- /dev/null +++ b/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp @@ -0,0 +1,197 @@ +#include "catch2/catch.hpp" +#include "diagnostics/register_diagnostics.hpp" +#include "share/field/field_utils.hpp" +#include "share/grid/mesh_free_grids_manager.hpp" +#include "share/util/scream_setup_random_test.hpp" +#include "share/util/scream_universal_constants.hpp" + +namespace scream { + +std::shared_ptr create_gm(const ekat::Comm &comm, const int ncols, + const int nlevs) { + const int num_global_cols = ncols * comm.size(); + + using vos_t = std::vector; + ekat::ParameterList gm_params; + gm_params.set("grids_names", vos_t{"Point Grid"}); + auto &pl = gm_params.sublist("Point Grid"); + pl.set("type", "point_grid"); + pl.set("aliases", vos_t{"Physics"}); + pl.set("number_of_global_columns", num_global_cols); + pl.set("number_of_vertical_levels", nlevs); + + auto gm = create_mesh_free_grids_manager(comm, gm_params); + gm->build_grids(); + + return gm; +} + +TEST_CASE("horiz_avg") { + using namespace ShortFieldTagsNames; + using namespace ekat::units; + using TeamPolicy = Kokkos::TeamPolicy; + using TeamMember = typename TeamPolicy::member_type; + using KT = ekat::KokkosTypes; + using ESU = ekat::ExeSpaceUtils; + + // A numerical tolerance + auto tol = std::numeric_limits::epsilon() * 100; + + // A world comm + ekat::Comm comm(MPI_COMM_WORLD); + + // A time stamp + util::TimeStamp t0({2024, 1, 1}, {0, 0, 0}); + + // Create a grids manager - single column for these tests + constexpr int nlevs = 3; + constexpr int dim3 = 4; + const int ngcols = 6 * comm.size(); + + auto gm = create_gm(comm, ngcols, nlevs); + auto grid = gm->get_grid("Physics"); + + // Input (randomized) qc + FieldLayout scalar1d_layout{{COL}, {ngcols}}; + FieldLayout scalar2d_layout{{COL, LEV}, {ngcols, nlevs}}; + FieldLayout scalar3d_layout{{COL, CMP, LEV}, {ngcols, dim3, nlevs}}; + + FieldIdentifier qc1_fid("qc", scalar1d_layout, kg / kg, grid->name()); + FieldIdentifier qc2_fid("qc", scalar2d_layout, kg / kg, grid->name()); + FieldIdentifier qc3_fid("qc", scalar3d_layout, kg / kg, grid->name()); + + Field qc1(qc1_fid); + Field qc2(qc2_fid); + Field qc3(qc3_fid); + + qc1.allocate_view(); + qc2.allocate_view(); + qc3.allocate_view(); + + // Construct random number generator stuff + using RPDF = std::uniform_real_distribution; + RPDF pdf(sp(0.0), sp(200.0)); + + auto engine = scream::setup_random_test(); + + // Construct the Diagnostics + std::map> diags; + auto &diag_factory = AtmosphereDiagnosticFactory::instance(); + register_diagnostics(); + + ekat::ParameterList params; + REQUIRE_THROWS(diag_factory.create("HorizAvgDiag", comm, + params)); // No 'field_name' parameter + + // Set time for qc and randomize its values + qc1.get_header().get_tracking().update_time_stamp(t0); + qc2.get_header().get_tracking().update_time_stamp(t0); + qc3.get_header().get_tracking().update_time_stamp(t0); + randomize(qc1, engine, pdf); + randomize(qc2, engine, pdf); + randomize(qc3, engine, pdf); + + // Create and set up the diagnostic + params.set("grid_name", grid->name()); + params.set("field_name", "qc"); + auto diag1 = diag_factory.create("HorizAvgDiag", comm, params); + auto diag2 = diag_factory.create("HorizAvgDiag", comm, params); + auto diag3 = diag_factory.create("HorizAvgDiag", comm, params); + diag1->set_grids(gm); + diag2->set_grids(gm); + diag3->set_grids(gm); + + auto area = grid->get_geometry_data("area"); + + diag1->set_required_field(qc1); + diag1->initialize(t0, RunType::Initial); + + diag1->compute_diagnostic(); + auto diag1_f = diag1->get_diagnostic(); + + FieldIdentifier diag0_fid("qc_horiz_avg_manual", + scalar1d_layout.clone().strip_dim(COL), kg / kg, + grid->name()); + Field diag0(diag0_fid); + diag0.allocate_view(); + auto diag0_v = diag0.get_view(); + + auto qc1_v = qc1.get_view(); + auto area_v = area.get_view(); + + // calculate total area + Real atot = field_sum(area, &comm); + // calculate weighted avg + Real wavg = sp(0.0); + Kokkos::parallel_reduce( + "HorizAvgDiag::compute_diagnostic_impl::weighted_sum", ngcols, + KOKKOS_LAMBDA(const int icol, Real &local_wavg) { + local_wavg += (area_v[icol] / atot) * qc1_v[icol]; + }, + wavg); + Kokkos::deep_copy(diag0_v, wavg); + + diag1_f.sync_to_host(); + auto diag1_v_h = diag1_f.get_view(); + REQUIRE(diag1_v_h() == wavg); + + // Try known cases + // Set qc1_v to 1.0 to get weighted average of 1.0 + wavg = sp(1.0); + Kokkos::deep_copy(qc1_v, wavg); + diag1->compute_diagnostic(); + auto diag1_v2_host = diag1_f.get_view(); + REQUIRE_THAT(diag1_v2_host(), + Catch::Matchers::WithinRel( + wavg, tol)); // Catch2's floating point comparison + + // other diags + // Set qc2_v to 5.0 to get weighted average of 5.0 + wavg = sp(5.0); + auto qc2_v = qc2.get_view(); + Kokkos::deep_copy(qc2_v, wavg); + + diag2->set_required_field(qc2); + diag2->initialize(t0, RunType::Initial); + diag2->compute_diagnostic(); + auto diag2_f = diag2->get_diagnostic(); + + auto diag2_v_host = diag2_f.get_view(); + + for(int i = 0; i < nlevs; ++i) { + REQUIRE_THAT(diag2_v_host(i), Catch::Matchers::WithinRel(wavg, tol)); + } + + auto qc3_v = qc3.get_view(); + FieldIdentifier diag3_manual_fid("qc_horiz_avg_manual", + scalar3d_layout.clone().strip_dim(COL), + kg / kg, grid->name()); + Field diag3_manual(diag3_manual_fid); + diag3_manual.allocate_view(); + auto diag3_manual_v = diag3_manual.get_view(); + // calculate diag3_manual by hand + auto p = ESU::get_default_team_policy(dim3 * nlevs, ngcols); + Kokkos::parallel_for( + "HorizAvgDiag::compute_diagnostic_impl::manual_diag3", p, + KOKKOS_LAMBDA(const TeamMember &m) { + const int idx = m.league_rank(); + const int j = idx / nlevs; + const int k = idx % nlevs; + Real sum = sp(0.0); + Kokkos::parallel_reduce( + Kokkos::TeamThreadRange(m, ngcols), + [&](const int icol, Real &accum) { + accum += (area_v(icol) / atot) * qc3_v(icol, j, k); + }, + sum); + Kokkos::single(Kokkos::PerTeam(m), + [&]() { diag3_manual_v(j, k) = sum; }); + }); + diag3->set_required_field(qc3); + diag3->initialize(t0, RunType::Initial); + diag3->compute_diagnostic(); + auto diag3_f = diag3->get_diagnostic(); + REQUIRE(views_are_equal(diag3_f, diag3_manual)); +} + +} // namespace scream diff --git a/components/eamxx/src/share/io/scream_io_utils.cpp b/components/eamxx/src/share/io/scream_io_utils.cpp index 40b8a97de4b..cacb153b929 100644 --- a/components/eamxx/src/share/io/scream_io_utils.cpp +++ b/components/eamxx/src/share/io/scream_io_utils.cpp @@ -137,6 +137,7 @@ create_diagnostic (const std::string& diag_field_name, std::regex backtend ("([A-Za-z0-9_]+)_atm_backtend$"); std::regex pot_temp ("(Liq)?PotentialTemperature$"); std::regex vert_layer ("(z|geopotential|height)_(mid|int)$"); + std::regex horiz_avg ("([A-Za-z0-9_]+)_horiz_avg$"); std::string diag_name; std::smatch matches; @@ -191,7 +192,15 @@ create_diagnostic (const std::string& diag_field_name, diag_name = "VerticalLayer"; params.set("diag_name","dz"); params.set("vert_location","mid"); - } else { + } + else if (std::regex_search(diag_field_name,matches,horiz_avg)) { + diag_name = "HorizAvgDiag"; + // Set the grid_name + params.set("grid_name",grid->name()); + params.set("field_name",matches[1].str()); + } + else + { // No existing special regex matches, so we assume that the diag field name IS the diag name. diag_name = diag_field_name; } From f7267be17a32d5e1c832df06b78f9cbdbd15f9bb Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 9 Dec 2024 11:20:03 -0800 Subject: [PATCH 418/529] increase character length for fates harvest mode --- components/elm/bld/namelist_files/namelist_definition.xml | 2 +- components/elm/src/main/elm_varctl.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/components/elm/bld/namelist_files/namelist_definition.xml b/components/elm/bld/namelist_files/namelist_definition.xml index c76271b7baf..87a6da722af 100644 --- a/components/elm/bld/namelist_files/namelist_definition.xml +++ b/components/elm/bld/namelist_files/namelist_definition.xml @@ -314,7 +314,7 @@ Allowed values are: 5 : use gross domestic production and population datasets to simulate anthropogenic fire supression - Set FATES harvesting mode by setting fates_harvest_mode diff --git a/components/elm/src/main/elm_varctl.F90 b/components/elm/src/main/elm_varctl.F90 index fb9ca0dbd24..69a3209e52f 100644 --- a/components/elm/src/main/elm_varctl.F90 +++ b/components/elm/src/main/elm_varctl.F90 @@ -221,7 +221,7 @@ module elm_varctl logical, public :: use_fates = .false. ! true => use ED integer, public :: fates_spitfire_mode = 0 ! 0 for no fire; 1 for constant ignitions - character(len=13), public :: fates_harvest_mode = '' ! five different harvest modes; see namelist_definitions + character(len=256), public :: fates_harvest_mode = '' ! five different harvest modes; see namelist_definitions logical, public :: use_fates_fixed_biogeog = .false. ! true => use fixed biogeography mode logical, public :: use_fates_planthydro = .false. ! true => turn on fates hydro logical, public :: use_fates_cohort_age_tracking = .false. ! true => turn on cohort age tracking From 466f90e25d8abdf73668fc1d3d20e3f6563a4b5b Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Mon, 9 Dec 2024 12:50:14 -0700 Subject: [PATCH 419/529] HOMME: fix some valgrind errors in namelist parsing module --- components/homme/src/share/namelist_mod.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/components/homme/src/share/namelist_mod.F90 b/components/homme/src/share/namelist_mod.F90 index 1d47090182b..c8825b3e554 100644 --- a/components/homme/src/share/namelist_mod.F90 +++ b/components/homme/src/share/namelist_mod.F90 @@ -426,6 +426,13 @@ subroutine readnl(par) se_ftype = ftype ! MNL: For non-CAM runs, ftype=0 in control_mod nsplit = 1 pertlim = 0.0_real_kind +#else + se_partmethod = SFCURVE + se_ne = 0 + se_ne_x = 0 + se_ne_y = 0 + se_lx = 0 + se_ly = 0 #endif sub_case = 1 numnodes = -1 From 9348923cfe54e21dadde1025a7fba49e26588257 Mon Sep 17 00:00:00 2001 From: tcclevenger Date: Thu, 5 Dec 2024 12:34:04 -0500 Subject: [PATCH 420/529] Use field util horiz_contraction to compute means --- .../eamxx_iop_forcing_process_interface.cpp | 172 ++++++++---------- .../eamxx_iop_forcing_process_interface.hpp | 12 +- 2 files changed, 82 insertions(+), 102 deletions(-) diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp index ee662cd81b8..1543f5de63e 100644 --- a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp @@ -1,5 +1,6 @@ #include "physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp" +#include "share/field/field_utils.hpp" #include "share/property_checks/field_within_interval_check.hpp" namespace scream @@ -35,11 +36,21 @@ void IOPForcing::set_grids(const std::shared_ptr grids_manag "Error! IOPDataManager not setup by driver, but IOPForcing" "being used as an ATM process.\n"); - // Compute number of buffer views + // Create helper fields for finding horizontal means + auto level_only_scalar_layout = scalar3d_mid.clone().strip_dim(0); + auto level_only_vector_layout = vector3d_mid.clone().strip_dim(0); const auto iop_nudge_tq = m_iop_data_manager->get_params().get("iop_nudge_tq"); const auto iop_nudge_uv = m_iop_data_manager->get_params().get("iop_nudge_uv"); - if (iop_nudge_tq) m_buffer.num_1d_scalar_nlev += 2; - if (iop_nudge_uv) m_buffer.num_1d_scalar_nlev += 2; + if (iop_nudge_tq or iop_nudge_uv) { + create_helper_field("horiz_mean_weights", scalar2d, grid_name); + } + if (iop_nudge_tq) { + create_helper_field("qv_mean", level_only_scalar_layout, grid_name); + create_helper_field("t_mean", level_only_scalar_layout, grid_name); + } + if (iop_nudge_uv) { + create_helper_field("horiz_winds_mean", level_only_vector_layout, grid_name); + } } // ========================================================================================= void IOPForcing:: @@ -61,17 +72,12 @@ set_computed_group_impl (const FieldGroup& group) // ========================================================================================= size_t IOPForcing::requested_buffer_size_in_bytes() const { - const int nlev_packs = ekat::npack(m_num_levs); - const int nlevi_packs = ekat::npack(m_num_levs+1); - - const size_t temp_view_bytes = - m_buffer.num_1d_scalar_nlev*nlev_packs*sizeof(Pack); - // Number of bytes needed by the WorkspaceManager passed to shoc_main + const int nlevi_packs = ekat::npack(m_num_levs+1); const auto policy = ESU::get_default_team_policy(m_num_cols, nlevi_packs); const size_t wsm_bytes = WorkspaceMgr::get_total_bytes_needed(nlevi_packs, 7+m_num_tracers, policy); - return temp_view_bytes + wsm_bytes; + return wsm_bytes; } // ========================================================================================= void IOPForcing::init_buffers(const ATMBufferManager &buffer_manager) @@ -79,28 +85,9 @@ void IOPForcing::init_buffers(const ATMBufferManager &buffer_manager) EKAT_REQUIRE_MSG(buffer_manager.allocated_bytes() >= requested_buffer_size_in_bytes(), "Error! Buffers size not sufficient.\n"); - const int nlev_packs = ekat::npack(m_num_levs); const int nlevi_packs = ekat::npack(m_num_levs+1); - Pack* mem = reinterpret_cast(buffer_manager.get_memory()); - // Temp view data - using mean_view_t = decltype(m_buffer.qv_mean); - const auto iop_nudge_tq = m_iop_data_manager->get_params().get("iop_nudge_tq"); - const auto iop_nudge_uv = m_iop_data_manager->get_params().get("iop_nudge_uv"); - if (iop_nudge_tq) { - m_buffer.qv_mean = mean_view_t(mem, nlev_packs); - mem += m_buffer.qv_mean.size(); - m_buffer.t_mean = mean_view_t(mem, nlev_packs); - mem += m_buffer.t_mean.size(); - } - if (iop_nudge_uv) { - m_buffer.u_mean = mean_view_t(mem, nlev_packs); - mem += m_buffer.u_mean.size(); - m_buffer.v_mean = mean_view_t(mem, nlev_packs); - mem += m_buffer.v_mean.size(); - } - // WSM data m_buffer.wsm_data = mem; @@ -112,6 +99,22 @@ void IOPForcing::init_buffers(const ATMBufferManager &buffer_manager) EKAT_REQUIRE_MSG(used_mem==requested_buffer_size_in_bytes(), "Error! Used memory != requested memory for IOPForcing.\n"); } // ========================================================================================= +void IOPForcing::create_helper_field (const std::string& name, + const FieldLayout& layout, + const std::string& grid_name) +{ + using namespace ekat::units; + FieldIdentifier id(name,layout,Units::nondimensional(),grid_name); + + // Create the field. Init with NaN's, so we spot instances of uninited memory usage + Field f(id); + f.get_header().get_alloc_properties().request_allocation(); + f.allocate_view(); + f.deep_copy(ekat::ScalarTraits::invalid()); + + m_helper_fields[name] = f; +} +// ========================================================================================= void IOPForcing::initialize_impl (const RunType run_type) { // Set field property checks for the fields in this process @@ -126,6 +129,12 @@ void IOPForcing::initialize_impl (const RunType run_type) const auto nlevi_packs = ekat::npack(m_num_levs+1); const auto policy = ESU::get_default_team_policy(m_num_cols, nlevi_packs); m_workspace_mgr.setup(m_buffer.wsm_data, nlevi_packs, 7+m_num_tracers, policy); + + // Compute field for horizontal contraction weights (1/num_global_dofs) + const auto iop_nudge_tq = m_iop_data_manager->get_params().get("iop_nudge_tq"); + const auto iop_nudge_uv = m_iop_data_manager->get_params().get("iop_nudge_uv"); + const Real one_over_num_dofs = 1.0/m_grid->get_num_global_dofs(); + if (iop_nudge_tq or iop_nudge_uv) m_helper_fields.at("horiz_mean_weights").deep_copy(one_over_num_dofs); } // ========================================================================================= KOKKOS_FUNCTION @@ -437,55 +446,22 @@ void IOPForcing::run_impl (const double dt) // and observed quantities of T, Q, u, and v if (iop_nudge_tq or iop_nudge_uv) { // Compute domain mean of qv, T_mid, u, and v - const auto qv_mean = m_buffer.qv_mean; - const auto t_mean = m_buffer.t_mean; - const auto u_mean = m_buffer.u_mean; - const auto v_mean = m_buffer.v_mean; - - const auto qv_mean_h = Kokkos::create_mirror_view(qv_mean); - const auto t_mean_h = Kokkos::create_mirror_view(t_mean); - const auto u_mean_h = Kokkos::create_mirror_view(u_mean); - const auto v_mean_h = Kokkos::create_mirror_view(v_mean); - - const auto num_global_cols = m_grid->get_num_global_dofs(); - for (int k=0; k qv_mean, t_mean; + view_2d horiz_winds_mean; + if (iop_nudge_tq){ + horiz_contraction(m_helper_fields.at("qv_mean"), get_field_out("qv"), + m_helper_fields.at("horiz_mean_weights"), &m_comm); + qv_mean = m_helper_fields.at("qv_mean").get_view(); + + horiz_contraction(m_helper_fields.at("t_mean"), get_field_out("T_mid"), + m_helper_fields.at("horiz_mean_weights"), &m_comm); + t_mean = m_helper_fields.at("t_mean").get_view(); + } + if (iop_nudge_uv){ + horiz_contraction(m_helper_fields.at("horiz_winds_mean"), get_field_out("horiz_winds"), + m_helper_fields.at("horiz_mean_weights"), &m_comm); + horiz_winds_mean = m_helper_fields.at("horiz_winds_mean").get_view(); } - Kokkos::deep_copy(qv_mean, qv_mean_h); - Kokkos::deep_copy(t_mean, t_mean_h); - Kokkos::deep_copy(u_mean, u_mean_h); - Kokkos::deep_copy(v_mean, v_mean_h); // Apply relaxation const auto rtau = std::max(dt, iop_nudge_tscale); @@ -512,28 +488,28 @@ void IOPForcing::run_impl (const double dt) }); team.team_barrier(); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&](const int& k) { - if (iop_nudge_tq) { - // Restrict nudging of T and qv to certain levels if requested by user - // IOP pressure variable is in unitis of [Pa], while iop_nudge_tq_low/high - // is in units of [hPa], thus convert iop_nudge_tq_low/high - Mask nudge_level(false); - int max_size = hyam.size(); - for (int lev=k*Pack::n, p = 0; p < Pack::n && lev < max_size; ++lev, ++p) { - const auto pressure_from_iop = hyam(lev)*ps0 + hybm(lev)*ps_iop; - nudge_level.set(p, pressure_from_iop <= iop_nudge_tq_low*100 - and - pressure_from_iop >= iop_nudge_tq_high*100); - } - - qv_i(k).update(nudge_level, qv_mean(k) - qv_iop(k), -dt/rtau, 1.0); - T_mid_i(k).update(nudge_level, t_mean(k) - t_iop(k), -dt/rtau, 1.0); - } - if (iop_nudge_uv) { - u_i(k).update(u_mean(k) - u_iop(k), -dt/rtau, 1.0); - v_i(k).update(v_mean(k) - v_iop(k), -dt/rtau, 1.0); + Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlev_packs), [&](const int& k) { + if (iop_nudge_tq) { + // Restrict nudging of T and qv to certain levels if requested by user + // IOP pressure variable is in unitis of [Pa], while iop_nudge_tq_low/high + // is in units of [hPa], thus convert iop_nudge_tq_low/high + Mask nudge_level(false); + int max_size = hyam.size(); + for (int lev=k*Pack::n, p = 0; p < Pack::n && lev < max_size; ++lev, ++p) { + const auto pressure_from_iop = hyam(lev)*ps0 + hybm(lev)*ps_iop; + nudge_level.set(p, pressure_from_iop <= iop_nudge_tq_low*100 + and + pressure_from_iop >= iop_nudge_tq_high*100); } - }); + + qv_i(k).update(nudge_level, qv_mean(k) - qv_iop(k), -dt/rtau, 1.0); + T_mid_i(k).update(nudge_level, t_mean(k) - t_iop(k), -dt/rtau, 1.0); + } + if (iop_nudge_uv) { + u_i(k).update(horiz_winds_mean(0, k) - u_iop(k), -dt/rtau, 1.0); + v_i(k).update(horiz_winds_mean(1, k) - v_iop(k), -dt/rtau, 1.0); + } + }); // Release WS views ws.release_many_contiguous<1>({&ref_p_mid}); diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp index 535043f401e..0af010ec8ec 100644 --- a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp @@ -116,6 +116,11 @@ class IOPForcing : public scream::AtmosphereProcess void finalize_impl () {} + // Creates an helper field, not to be shared with the AD's FieldManager + void create_helper_field (const std::string& name, + const FieldLayout& layout, + const std::string& grid_name); + void set_computed_group_impl (const FieldGroup& group); // Computes total number of bytes needed for local variables @@ -132,13 +137,12 @@ class IOPForcing : public scream::AtmosphereProcess Int m_num_tracers; struct Buffer { - int num_1d_scalar_nlev = 0; - - uview_1d qv_mean, t_mean, u_mean, v_mean; - Pack* wsm_data; }; + // Some helper fields. + std::map m_helper_fields; + // Struct which contains local variables Buffer m_buffer; From 8b76d0f1d469b9fb97f740c837258eccce2798aa Mon Sep 17 00:00:00 2001 From: tcclevenger Date: Mon, 9 Dec 2024 08:42:16 -0500 Subject: [PATCH 421/529] EAMxx: Unrelated: remove left over debug print from scorpio_output.cpp --- components/eamxx/src/share/io/scorpio_output.cpp | 1 - 1 file changed, 1 deletion(-) diff --git a/components/eamxx/src/share/io/scorpio_output.cpp b/components/eamxx/src/share/io/scorpio_output.cpp index 4e9d5add800..d51df07fde6 100644 --- a/components/eamxx/src/share/io/scorpio_output.cpp +++ b/components/eamxx/src/share/io/scorpio_output.cpp @@ -1367,7 +1367,6 @@ AtmosphereOutput::create_diagnostic (const std::string& diag_field_name) for (const auto& freq : diag->get_required_field_requests()) { const auto& fname = freq.fid.name(); if (!sim_field_mgr->has_field(fname)) { - std::cout << diag_field_name << " depends on the diag " << fname << "\n"; // This diag depends on another diag. Create and init the dependency if (m_diagnostics.count(fname)==0) { m_diagnostics[fname] = create_diagnostic(fname); From 4f339535e3a7799c17c773a27faaf34cc6b47339 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Mon, 9 Dec 2024 14:37:12 -0700 Subject: [PATCH 422/529] EAMxx: use pack size 1 in valg build, to avoid false-positives from padding Similar to what we do for FPE builds --- components/eamxx/scripts/test_factory.py | 1 + 1 file changed, 1 insertion(+) diff --git a/components/eamxx/scripts/test_factory.py b/components/eamxx/scripts/test_factory.py index a81e9dbdd48..47ae4736721 100644 --- a/components/eamxx/scripts/test_factory.py +++ b/components/eamxx/scripts/test_factory.py @@ -156,6 +156,7 @@ def __init__(self, tas): "Release build where tests run through valgrind", [("CMAKE_BUILD_TYPE", "RelWithDebInfo"), ("EKAT_ENABLE_VALGRIND", "True"), + ("SCREAM_PACK_SIZE", "1"), ("SCREAM_TEST_MAX_THREADS", "2")], uses_baselines=False, on_by_default=False, From 903b4536868f47599f0b5bff7122e31ba0f36731 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Tue, 10 Dec 2024 18:47:17 -0800 Subject: [PATCH 423/529] EAMxx: clarify error in field_at_ diagnostics --- components/eamxx/src/diagnostics/field_at_height.cpp | 4 +++- components/eamxx/src/diagnostics/field_at_level.cpp | 6 ++++-- .../eamxx/src/diagnostics/field_at_pressure_level.cpp | 4 +++- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/components/eamxx/src/diagnostics/field_at_height.cpp b/components/eamxx/src/diagnostics/field_at_height.cpp index 317bbffaf62..db780f5a79f 100644 --- a/components/eamxx/src/diagnostics/field_at_height.cpp +++ b/components/eamxx/src/diagnostics/field_at_height.cpp @@ -84,7 +84,9 @@ initialize_impl (const RunType /*run_type*/) EKAT_REQUIRE_MSG (layout.rank()>=2 && layout.rank()<=3, "Error! Field rank not supported by FieldAtHeight.\n" " - field name: " + fid.name() + "\n" - " - field layout: " + layout.to_string() + "\n"); + " - field layout: " + layout.to_string() + "\n" + "NOTE: if you requested something like 'field_horiz_avg_at_Y',\n" + " you can avoid this error by requesting 'fieldX_at_Y_horiz_avg' instead.\n"); const auto tag = layout.tags().back(); EKAT_REQUIRE_MSG (tag==LEV || tag==ILEV, "Error! FieldAtHeight diagnostic expects a layout ending with 'LEV'/'ILEV' tag.\n" diff --git a/components/eamxx/src/diagnostics/field_at_level.cpp b/components/eamxx/src/diagnostics/field_at_level.cpp index 87ecf7ad910..b842429a8d6 100644 --- a/components/eamxx/src/diagnostics/field_at_level.cpp +++ b/components/eamxx/src/diagnostics/field_at_level.cpp @@ -30,10 +30,12 @@ initialize_impl (const RunType /*run_type*/) using namespace ShortFieldTagsNames; const auto& fid = f.get_header().get_identifier(); const auto& layout = fid.get_layout(); - EKAT_REQUIRE_MSG (layout.rank()>1 && layout.rank()<=6, + EKAT_REQUIRE_MSG (layout.rank()>=2 && layout.rank()<=6, "Error! Field rank not supported by FieldAtLevel.\n" " - field name: " + fid.name() + "\n" - " - field layout: " + layout.to_string() + "\n"); + " - field layout: " + layout.to_string() + "\n" + "NOTE: if you requested something like 'field_horiz_avg_at_Y',\n" + " you can avoid this error by requesting 'fieldX_at_Y_horiz_avg' instead.\n"); const auto tag = layout.tags().back(); EKAT_REQUIRE_MSG (tag==LEV || tag==ILEV, "Error! FieldAtLevel diagnostic expects a layout ending with 'LEV'/'ILEV' tag.\n" diff --git a/components/eamxx/src/diagnostics/field_at_pressure_level.cpp b/components/eamxx/src/diagnostics/field_at_pressure_level.cpp index 716c8f563af..78ed921e758 100644 --- a/components/eamxx/src/diagnostics/field_at_pressure_level.cpp +++ b/components/eamxx/src/diagnostics/field_at_pressure_level.cpp @@ -56,7 +56,9 @@ initialize_impl (const RunType /*run_type*/) EKAT_REQUIRE_MSG (layout.rank()>=2 && layout.rank()<=3, "Error! Field rank not supported by FieldAtPressureLevel.\n" " - field name: " + fid.name() + "\n" - " - field layout: " + layout.to_string() + "\n"); + " - field layout: " + layout.to_string() + "\n" + "NOTE: if you requested something like 'field_horiz_avg_at_Y',\n" + " you can avoid this error by requesting 'fieldX_at_Y_horiz_avg' instead.\n"); const auto tag = layout.tags().back(); EKAT_REQUIRE_MSG (tag==LEV || tag==ILEV, "Error! FieldAtPressureLevel diagnostic expects a layout ending with 'LEV'/'ILEV' tag.\n" From 88153c6f7004106a76ae4e24e387e7c5777b8918 Mon Sep 17 00:00:00 2001 From: tcclevenger Date: Tue, 10 Dec 2024 20:28:24 -0500 Subject: [PATCH 424/529] Use packs for *_mean views Fixes a bug where real views were being used as if they were packed. --- .../eamxx_iop_forcing_process_interface.cpp | 23 ++++++++++--------- .../eamxx_iop_forcing_process_interface.hpp | 3 ++- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp index 1543f5de63e..930dd963636 100644 --- a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp @@ -42,14 +42,14 @@ void IOPForcing::set_grids(const std::shared_ptr grids_manag const auto iop_nudge_tq = m_iop_data_manager->get_params().get("iop_nudge_tq"); const auto iop_nudge_uv = m_iop_data_manager->get_params().get("iop_nudge_uv"); if (iop_nudge_tq or iop_nudge_uv) { - create_helper_field("horiz_mean_weights", scalar2d, grid_name); + create_helper_field("horiz_mean_weights", scalar2d, grid_name, pack_size); } if (iop_nudge_tq) { - create_helper_field("qv_mean", level_only_scalar_layout, grid_name); - create_helper_field("t_mean", level_only_scalar_layout, grid_name); + create_helper_field("qv_mean", level_only_scalar_layout, grid_name, pack_size); + create_helper_field("t_mean", level_only_scalar_layout, grid_name, pack_size); } if (iop_nudge_uv) { - create_helper_field("horiz_winds_mean", level_only_vector_layout, grid_name); + create_helper_field("horiz_winds_mean", level_only_vector_layout, grid_name, pack_size); } } // ========================================================================================= @@ -101,14 +101,15 @@ void IOPForcing::init_buffers(const ATMBufferManager &buffer_manager) // ========================================================================================= void IOPForcing::create_helper_field (const std::string& name, const FieldLayout& layout, - const std::string& grid_name) + const std::string& grid_name, + const int ps) { using namespace ekat::units; FieldIdentifier id(name,layout,Units::nondimensional(),grid_name); // Create the field. Init with NaN's, so we spot instances of uninited memory usage Field f(id); - f.get_header().get_alloc_properties().request_allocation(); + f.get_header().get_alloc_properties().request_allocation(ps); f.allocate_view(); f.deep_copy(ekat::ScalarTraits::invalid()); @@ -446,21 +447,21 @@ void IOPForcing::run_impl (const double dt) // and observed quantities of T, Q, u, and v if (iop_nudge_tq or iop_nudge_uv) { // Compute domain mean of qv, T_mid, u, and v - view_1d qv_mean, t_mean; - view_2d horiz_winds_mean; + view_1d qv_mean, t_mean; + view_2d horiz_winds_mean; if (iop_nudge_tq){ horiz_contraction(m_helper_fields.at("qv_mean"), get_field_out("qv"), m_helper_fields.at("horiz_mean_weights"), &m_comm); - qv_mean = m_helper_fields.at("qv_mean").get_view(); + qv_mean = m_helper_fields.at("qv_mean").get_view(); horiz_contraction(m_helper_fields.at("t_mean"), get_field_out("T_mid"), m_helper_fields.at("horiz_mean_weights"), &m_comm); - t_mean = m_helper_fields.at("t_mean").get_view(); + t_mean = m_helper_fields.at("t_mean").get_view(); } if (iop_nudge_uv){ horiz_contraction(m_helper_fields.at("horiz_winds_mean"), get_field_out("horiz_winds"), m_helper_fields.at("horiz_mean_weights"), &m_comm); - horiz_winds_mean = m_helper_fields.at("horiz_winds_mean").get_view(); + horiz_winds_mean = m_helper_fields.at("horiz_winds_mean").get_view(); } // Apply relaxation diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp index 0af010ec8ec..7cec311a231 100644 --- a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.hpp @@ -119,7 +119,8 @@ class IOPForcing : public scream::AtmosphereProcess // Creates an helper field, not to be shared with the AD's FieldManager void create_helper_field (const std::string& name, const FieldLayout& layout, - const std::string& grid_name); + const std::string& grid_name, + const int ps = 1); void set_computed_group_impl (const FieldGroup& group); From 82dc94d4a570b63ee142e0f2c10d88758078b9fd Mon Sep 17 00:00:00 2001 From: mahf708 Date: Tue, 10 Dec 2024 18:59:45 -0800 Subject: [PATCH 425/529] EAMxx: simplify the testing of horiz_contraction --- .../src/diagnostics/tests/horiz_avg_test.cpp | 65 ++++++------------- 1 file changed, 19 insertions(+), 46 deletions(-) diff --git a/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp b/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp index 81bc10c6a2c..bca67f120ad 100644 --- a/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp +++ b/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp @@ -71,7 +71,6 @@ TEST_CASE("horiz_avg") { // Construct random number generator stuff using RPDF = std::uniform_real_distribution; RPDF pdf(sp(0.0), sp(200.0)); - auto engine = scream::setup_random_test(); // Construct the Diagnostics @@ -101,44 +100,37 @@ TEST_CASE("horiz_avg") { diag2->set_grids(gm); diag3->set_grids(gm); - auto area = grid->get_geometry_data("area"); + // Clone the area field + auto area = grid->get_geometry_data("area").clone(); + // Test the horiz contraction of qc1 + // Get the diagnostic field diag1->set_required_field(qc1); diag1->initialize(t0, RunType::Initial); - diag1->compute_diagnostic(); auto diag1_f = diag1->get_diagnostic(); + // Manual calculation FieldIdentifier diag0_fid("qc_horiz_avg_manual", scalar1d_layout.clone().strip_dim(COL), kg / kg, grid->name()); Field diag0(diag0_fid); diag0.allocate_view(); - auto diag0_v = diag0.get_view(); - - auto qc1_v = qc1.get_view(); - auto area_v = area.get_view(); // calculate total area Real atot = field_sum(area, &comm); + // scale the area field + area.scale(1 / atot); + // calculate weighted avg - Real wavg = sp(0.0); - Kokkos::parallel_reduce( - "HorizAvgDiag::compute_diagnostic_impl::weighted_sum", ngcols, - KOKKOS_LAMBDA(const int icol, Real &local_wavg) { - local_wavg += (area_v[icol] / atot) * qc1_v[icol]; - }, - wavg); - Kokkos::deep_copy(diag0_v, wavg); - - diag1_f.sync_to_host(); - auto diag1_v_h = diag1_f.get_view(); - REQUIRE(diag1_v_h() == wavg); - - // Try known cases + horiz_contraction(diag0, qc1, area, &comm); + // Compare + REQUIRE(views_are_equal(diag1_f, diag0)); + + // Try other known cases // Set qc1_v to 1.0 to get weighted average of 1.0 - wavg = sp(1.0); - Kokkos::deep_copy(qc1_v, wavg); + Real wavg = 1; + qc1.deep_copy(wavg); diag1->compute_diagnostic(); auto diag1_v2_host = diag1_f.get_view(); REQUIRE_THAT(diag1_v2_host(), @@ -147,10 +139,8 @@ TEST_CASE("horiz_avg") { // other diags // Set qc2_v to 5.0 to get weighted average of 5.0 - wavg = sp(5.0); - auto qc2_v = qc2.get_view(); - Kokkos::deep_copy(qc2_v, wavg); - + wavg = sp(5.0); + qc2.deep_copy(wavg); diag2->set_required_field(qc2); diag2->initialize(t0, RunType::Initial); diag2->compute_diagnostic(); @@ -162,31 +152,14 @@ TEST_CASE("horiz_avg") { REQUIRE_THAT(diag2_v_host(i), Catch::Matchers::WithinRel(wavg, tol)); } + // Try a random case with qc3 auto qc3_v = qc3.get_view(); FieldIdentifier diag3_manual_fid("qc_horiz_avg_manual", scalar3d_layout.clone().strip_dim(COL), kg / kg, grid->name()); Field diag3_manual(diag3_manual_fid); diag3_manual.allocate_view(); - auto diag3_manual_v = diag3_manual.get_view(); - // calculate diag3_manual by hand - auto p = ESU::get_default_team_policy(dim3 * nlevs, ngcols); - Kokkos::parallel_for( - "HorizAvgDiag::compute_diagnostic_impl::manual_diag3", p, - KOKKOS_LAMBDA(const TeamMember &m) { - const int idx = m.league_rank(); - const int j = idx / nlevs; - const int k = idx % nlevs; - Real sum = sp(0.0); - Kokkos::parallel_reduce( - Kokkos::TeamThreadRange(m, ngcols), - [&](const int icol, Real &accum) { - accum += (area_v(icol) / atot) * qc3_v(icol, j, k); - }, - sum); - Kokkos::single(Kokkos::PerTeam(m), - [&]() { diag3_manual_v(j, k) = sum; }); - }); + horiz_contraction(diag3_manual, qc3, area, &comm); diag3->set_required_field(qc3); diag3->initialize(t0, RunType::Initial); diag3->compute_diagnostic(); From 24b58ef759fabf5fb157d012e278972a654a39a8 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 3 Dec 2024 16:21:12 -0700 Subject: [PATCH 426/529] Convert p3_init from f90 to CXX This removes the last f90 from P3. Change list: * Move table read/write implementation to CXX in p3_init_impl.hpp * p3_init now returns a P3LookupTables object with all the views inside containing the tables. * Rename init_kokkos_tables to get_global_tables * Rename init_kokkos_ice_lookup_tables to get_global_ice_lookup_tables * Remove all f90 bridge code * p3_tables_setup is now built by default and ran when baseline gen is on. This gives us the ability to generate these tables through GH actions which will be needed for this PR. * Move p3_tables_setup to tests dir, cleans up top p3 directory * Fix p3_tables_setup implementation; it got broken in recent PRs but we didn't notice because it didn't get built by default * Remove P3GlobalForFortran test struct, just call p3_init! * Remove P3InitAP3Data test struct Debatable change: I really wanted to have `P3LookupTables lookup_tables` be static in p3_init so they would not have to be re-created on every p3_init call. Unfortunately, Kokkos does not allow static views to be active on program shutdown, since this occurs after Kokkos::finalize, so we would need add a p3_finalize method and ensure it was called at the end of p3. This seems burdensome and error prone, so I just decided to re-read all the tables every time p3_init is called. [non-BFB] --- .../eamxx/src/physics/p3/CMakeLists.txt | 6 - .../physics/p3/eamxx_p3_process_interface.cpp | 10 +- .../src/physics/p3/impl/p3_init_impl.hpp | 328 +++++++++++++++++- .../src/physics/p3/impl/p3_table3_impl.hpp | 70 +--- .../src/physics/p3/impl/p3_table_ice_impl.hpp | 64 +--- .../eamxx/src/physics/p3/p3_functions.hpp | 17 +- components/eamxx/src/physics/p3/p3_iso_c.f90 | 158 --------- .../eamxx/src/physics/p3/p3_tables_setup.cpp | 8 - .../eamxx/src/physics/p3/tests/CMakeLists.txt | 7 + .../physics/p3/tests/infra/p3_main_wrap.cpp | 2 - .../physics/p3/tests/infra/p3_test_data.cpp | 72 +--- .../physics/p3/tests/infra/p3_test_data.hpp | 67 ---- .../p3/tests/infra/p3_unit_tests_common.hpp | 5 +- ...lc_liq_relaxation_timescale_unit_tests.cpp | 5 +- .../physics/p3/tests/p3_dsd2_unit_tests.cpp | 2 +- .../p3/tests/p3_ice_collection_unit_tests.cpp | 2 +- .../p3/tests/p3_ice_tables_unit_tests.cpp | 40 +-- .../p3/tests/p3_rain_sed_unit_tests.cpp | 2 +- .../src/physics/p3/tests/p3_run_and_cmp.cpp | 1 - .../physics/p3/tests/p3_table3_unit_tests.cpp | 2 +- .../src/physics/p3/tests/p3_tables_setup.cpp | 14 + .../eamxx/src/physics/share/CMakeLists.txt | 5 - .../src/physics/share/physics_share_f2c.F90 | 2 +- 23 files changed, 373 insertions(+), 516 deletions(-) delete mode 100644 components/eamxx/src/physics/p3/p3_iso_c.f90 delete mode 100644 components/eamxx/src/physics/p3/p3_tables_setup.cpp create mode 100644 components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp diff --git a/components/eamxx/src/physics/p3/CMakeLists.txt b/components/eamxx/src/physics/p3/CMakeLists.txt index 58a026e1601..291462c7e30 100644 --- a/components/eamxx/src/physics/p3/CMakeLists.txt +++ b/components/eamxx/src/physics/p3/CMakeLists.txt @@ -1,6 +1,4 @@ set(P3_SRCS - p3_iso_c.f90 - ${SCREAM_BASE_DIR}/../eam/src/physics/p3/scream/micro_p3.F90 eamxx_p3_process_interface.cpp eamxx_p3_run.cpp ) @@ -113,10 +111,6 @@ foreach (file IN ITEMS ${P3_TABLES}) GetInputFile(${file}) endforeach() -# This executable can be used to re-generate tables in ${SCREAM_DATA_DIR} -add_executable(p3_tables_setup EXCLUDE_FROM_ALL p3_tables_setup.cpp) -target_link_libraries(p3_tables_setup p3) - if (NOT SCREAM_LIB_ONLY) add_subdirectory(tests) endif() diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp index f6771d6bf17..b377432bebd 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp @@ -241,8 +241,8 @@ void P3Microphysics::initialize_impl (const RunType /* run_type */) add_postcondition_check(get_field_out("eff_radius_qr"),m_grid,0.0,5.0e3,false); // Initialize p3 - P3F::p3_init(/* write_tables = */ false, - this->get_comm().am_i_root()); + lookup_tables = P3F::p3_init(/* write_tables = */ false, + this->get_comm().am_i_root()); // Initialize all of the structures that are passed to p3_main in run_impl. // Note: Some variables in the structures are not stored in the field manager. For these @@ -411,12 +411,6 @@ void P3Microphysics::initialize_impl (const RunType /* run_type */) p3_postproc.set_mass_and_energy_fluxes(vapor_flux, water_flux, ice_flux, heat_flux); } - // Load tables - P3F::init_kokkos_ice_lookup_tables(lookup_tables.ice_table_vals, lookup_tables.collect_table_vals); - P3F::init_kokkos_tables(lookup_tables.vn_table_vals, lookup_tables.vm_table_vals, - lookup_tables.revap_table_vals, lookup_tables.mu_r_table_vals, - lookup_tables.dnu_table_vals); - // Setup WSM for internal local variables const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(m_num_cols, nk_pack); workspace_mgr.setup(m_buffer.wsm_data, nk_pack_p1, 52, policy); diff --git a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp index 9b4b999bce0..7cdf653531f 100644 --- a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp @@ -3,35 +3,327 @@ #include "p3_functions.hpp" // for ETI only but harmless for GPU -extern "C" { - void micro_p3_utils_init_c(scream::Real Cpair, scream::Real Rair, scream::Real RH2O, scream::Real RHO_H2O, - scream::Real MWH2O, scream::Real MWdry, scream::Real gravit, scream::Real LatVap, scream::Real LatIce, - scream::Real CpLiq, scream::Real Tmelt, scream::Real Pi, bool masterproc); - void p3_init_c(const char** lookup_file_dir, int* info, const bool& write_tables); -} +#include "ekat/util/ekat_file_utils.hpp" + +#include namespace scream { namespace p3 { +namespace { + +template +void read_ice_lookup_tables(const bool masterproc, const char* p3_lookup_base, const char* p3_version, IceT& ice_table_vals, CollT& collect_table_vals, int densize, int rimsize, int isize, int rcollsize) +{ + using DeviceIcetable = typename IceT::non_const_type; + using DeviceColtable = typename CollT::non_const_type; + + const auto ice_table_vals_d = DeviceIcetable("ice_table_vals"); + const auto collect_table_vals_d = DeviceColtable("collect_table_vals"); + + const auto ice_table_vals_h = Kokkos::create_mirror_view(ice_table_vals_d); + const auto collect_table_vals_h = Kokkos::create_mirror_view(collect_table_vals_d); + + // + // read in ice microphysics table into host views. We always read these as doubles. + // + + std::string filename = std::string(p3_lookup_base) + std::string(p3_version); + + if (masterproc) { + std::cout << "Reading ice lookup tables in file: " << filename << std::endl; + } + + std::ifstream in(filename); + + // read header + std::string version, version_val; + in >> version >> version_val; + EKAT_REQUIRE_MSG(version == "VERSION", "Bad " << filename << ", expected VERSION X.Y.Z header"); + EKAT_REQUIRE_MSG(version_val == p3_version, "Bad " << filename << ", expected version " << p3_version << ", but got " << version_val); + + // read tables + double dum_s; int dum_i; // dum_s needs to be double to stream correctly + for (int jj = 0; jj < densize; ++jj) { + for (int ii = 0; ii < rimsize; ++ii) { + for (int i = 0; i < isize; ++i) { + in >> dum_i >> dum_i; + int j_idx = 0; + for (int j = 0; j < 15; ++j) { + in >> dum_s; + if (j > 1 && j != 10) { + ice_table_vals_h(jj, ii, i, j_idx++) = dum_s; + } + } + } + + for (int i = 0; i < isize; ++i) { + for (int j = 0; j < rcollsize; ++j) { + in >> dum_i >> dum_i; + int k_idx = 0; + for (int k = 0; k < 6; ++k) { + in >> dum_s; + if (k == 3 || k == 4) { + collect_table_vals_h(jj, ii, i, j, k_idx++) = std::log10(dum_s); + } + } + } + } + } + } + + // deep copy to device + Kokkos::deep_copy(ice_table_vals_d, ice_table_vals_h); + Kokkos::deep_copy(collect_table_vals_d, collect_table_vals_h); + ice_table_vals = ice_table_vals_d; + collect_table_vals = collect_table_vals_d; +} + +template +void compute_tables(const bool masterproc, MuRT& mu_r_table_vals, VNT& vn_table_vals, VMT& vm_table_vals, RevapT& revap_table_vals) +{ + using c = scream::physics::Constants; + + int ii,jj,kk; + S lamr,mu_r,dm,dum1,dum2,dum3,dum4,dum5,dd,amg,vt,dia; + + using MuRT_NC = typename MuRT::non_const_type; + using VNT_NC = typename VNT::non_const_type; + using VMT_NC = typename VMT::non_const_type; + using RevapT_NC = typename RevapT::non_const_type; + + MuRT_NC mu_r_table_vals_nc("mu_r_table_vals"); + VNT_NC vn_table_vals_nc("vn_table_vals"); + VMT_NC vm_table_vals_nc("vm_table_vals"); + RevapT_NC revap_table_vals_nc("revap_table_vals"); + + if (masterproc) { + std::cout << "Recomputing lookup (non-ice) tables" << std::endl; + } + + // ------------------------------------------------------------------------------------------ + + // Generate lookup table for rain shape parameter mu_r + // this is very fast so it can be generated at the start of each run + // make a 150x1 1D lookup table, this is done in parameter + // space of a scaled mean size proportional qr/Nr -- initlamr + + // write(iulog,*) ' Generating rain lookup-table ...' + + // AaronDonahue: Switching to table ver 4 means switching to a constand mu_r, + // so this section is commented out. + Kokkos::deep_copy(mu_r_table_vals_nc, 1); // mu_r_constant =1. In other places, this is runtime_options.constant_mu_rain + + static constexpr S thrd = 1./3; + + //....................................................................... + // Generate lookup table for rain fallspeed and ventilation parameters + // the lookup table is two dimensional as a function of number-weighted mean size + // proportional to qr/Nr and shape parameter mu_r + for (ii = 1; ii <= 10; ++ii) { + mu_r = 1; // mu_r_constant = 1 + + // loop over number-weighted mean size + for (jj = 1; jj <= 300; ++jj) { + if (jj <= 20) { + dm = (jj*10 - 5)*1.e-6; // mean size [m] + } + else { + dm = ((jj-20)*30 + 195)*1.e-6; // mean size [m] + } + + lamr = (mu_r + 1)/dm; + + // do numerical integration over PSD + + dum1 = 0; // numerator, number-weighted fallspeed + dum2 = 0; // denominator, number-weighted fallspeed + dum3 = 0; // numerator, mass-weighted fallspeed + dum4 = 0; // denominator, mass-weighted fallspeed + dum5 = 0; // term for ventilation factor in evap + dd = 2; + + // loop over PSD to numerically integrate number and mass-weighted mean fallspeeds + for (kk = 1; kk <= 10000; ++kk) { + + dia = (kk*dd - dd*0.5)*1.e-6; // size bin [m] + amg = c::PIOV6*997 * std::pow(dia, 3); // mass [kg] + amg = amg*1000; // convert [kg] to [g] + + // get fallspeed as a function of size [m s-1] + if (dia*1.e+6 <= 134.43) { + vt = 4.5795e+3 * std::pow(amg, 2*thrd); + } + else if (dia*1.e+6 < 1511.64) { + vt = 4.962e+1 * std::pow(amg, thrd); + } + else if (dia*1.e+6 < 3477.84) { + vt = 1.732e+1 * std::pow(amg, c::SXTH); + } + else { + vt = 9.17; + } + + // note: factor of 4.*mu_r is non-answer changing and only needed to + // prevent underflow/overflow errors, same with 3.*mu_r for dum5 + dum1 += vt * std::pow(10, mu_r*std::log10(dia) + 4*mu_r) * std::exp(-lamr*dia) * dd * 1.e-6; + dum2 += std::pow(10, mu_r*std::log10(dia) + 4*mu_r) * std::exp(-lamr*dia) * dd * 1.e-6; + dum3 += vt * std::pow(10, (mu_r+3)*std::log10(dia) + 4*mu_r) * std::exp(-lamr*dia) * dd * 1.e-6; + dum4 += std::pow(10, (mu_r+3)*std::log10(dia) + 4*mu_r) * std::exp(-lamr*dia) * dd * 1.e-6; + dum5 += std::pow(vt*dia, 0.5) * std::pow(10, (mu_r+1)*std::log10(dia) + 3*mu_r) * std::exp(-lamr*dia) * dd * 1.e-6; + } + + dum2 = std::max(dum2, 1.e-30); // to prevent divide-by-zero below + dum4 = std::max(dum4, 1.e-30); // to prevent divide-by-zero below + dum5 = std::max(dum5, 1.e-30); // to prevent log10-of-zero below + + vn_table_vals_nc(jj-1,ii-1) = dum1/dum2; + vm_table_vals_nc(jj-1,ii-1) = dum3/dum4; + revap_table_vals_nc(jj-1,ii-1) = std::pow(10, std::log10(dum5) + (mu_r+1)*std::log10(lamr) - (3*mu_r)); + } + } + + mu_r_table_vals = mu_r_table_vals_nc; + vn_table_vals = vn_table_vals_nc; + vm_table_vals = vm_table_vals_nc; + revap_table_vals = revap_table_vals_nc; +} + +template +struct IoAction +{ + template + static void action(const ekat::FILEPtr& fid, S* data, const size_t size) + { + ekat::read(data, size, fid); + } +}; + +template <> +struct IoAction +{ + template + static void action(const ekat::FILEPtr& fid, S* data, const size_t size) + { + ekat::write(data, size, fid); + } +}; + +template +void io_impl(const bool masterproc, const char* dir, MuRT& mu_r_table_vals, VNT& vn_table_vals, VMT& vm_table_vals, RevapT& revap_table_vals) +{ + using Action = IoAction; + + if (masterproc) { + std::cout << (IsRead ? "Reading" : "Writing") << " lookup (non-ice) tables in dir " << dir << std::endl; + } + + std::string extension = +#ifdef SCREAM_DOUBLE_PRECISION + "8" +#else + "4" +#endif + ; + + const char* rw_flag = IsRead ? "r" : "w"; + + std::string mu_r_filename = std::string(dir) + "/mu_r_table_vals.dat" + extension; + std::string revap_filename = std::string(dir) + "/revap_table_vals.dat" + extension; + std::string vn_filename = std::string(dir) + "/vn_table_vals.dat" + extension; + std::string vm_filename = std::string(dir) + "/vm_table_vals.dat" + extension; + + ekat::FILEPtr mu_r_file(fopen(mu_r_filename.c_str(), rw_flag)); + ekat::FILEPtr revap_file(fopen(revap_filename.c_str(), rw_flag)); + ekat::FILEPtr vn_file(fopen(vn_filename.c_str(), rw_flag)); + ekat::FILEPtr vm_file(fopen(vm_filename.c_str(), rw_flag)); + + // Read files + Action::action(mu_r_file, mu_r_table_vals.data(), mu_r_table_vals.size()); + Action::action(revap_file, revap_table_vals.data(), revap_table_vals.size()); + Action::action(vn_file, vn_table_vals.data(), vn_table_vals.size()); + Action::action(vm_file, vm_table_vals.data(), vm_table_vals.size()); +} + +template +void read_computed_tables(const bool masterproc, const char* dir, MuRT& mu_r_table_vals, VNT& vn_table_vals, VMT& vm_table_vals, RevapT& revap_table_vals) +{ + using MuRT_NC = typename MuRT::non_const_type; + using VNT_NC = typename VNT::non_const_type; + using VMT_NC = typename VMT::non_const_type; + using RevapT_NC = typename RevapT::non_const_type; + + MuRT_NC mu_r_table_vals_nc("mu_r_table_vals"); + VNT_NC vn_table_vals_nc("vn_table_vals"); + VMT_NC vm_table_vals_nc("vm_table_vals"); + RevapT_NC revap_table_vals_nc("revap_table_vals"); + + io_impl(masterproc, dir, mu_r_table_vals_nc, vn_table_vals_nc, vm_table_vals_nc, revap_table_vals_nc); + + mu_r_table_vals = mu_r_table_vals_nc; + vn_table_vals = vn_table_vals_nc; + vm_table_vals = vm_table_vals_nc; + revap_table_vals = revap_table_vals_nc; +} + +template +void write_computed_tables(const bool masterproc, const char* dir, const MuRT& mu_r_table_vals, const VNT& vn_table_vals, const VMT& vm_table_vals, const RevapT& revap_table_vals) +{ + io_impl(masterproc, dir, mu_r_table_vals, vn_table_vals, vm_table_vals, revap_table_vals); +} + +template +void compute_dnu(DnuT& dnu_table_vals) +{ + typename DnuT::non_const_type dnu_table_vals_non_const("dnu_table_vals"); + const auto dnu_table_h = Kokkos::create_mirror_view(dnu_table_vals_non_const); + dnu_table_h(0) = 0.000; + dnu_table_h(1) = -0.557; + dnu_table_h(2) = -0.430; + dnu_table_h(3) = -0.307; + dnu_table_h(4) = -0.186; + dnu_table_h(5) = -0.067; + dnu_table_h(6) = -0.050; + dnu_table_h(7) = -0.167; + dnu_table_h(8) = -0.282; + dnu_table_h(9) = -0.397; + dnu_table_h(10) = -0.512; + dnu_table_h(11) = -0.626; + dnu_table_h(12) = -0.739; + dnu_table_h(13) = -0.853; + dnu_table_h(14) = -0.966; + dnu_table_h(15) = -0.966; + Kokkos::deep_copy(dnu_table_vals_non_const, dnu_table_h); + dnu_table_vals = DnuT(dnu_table_vals_non_const); +} + +} + /* * Implementation of p3 init. Clients should NOT #include * this file, #include p3_functions.hpp instead. */ template -void Functions +typename Functions::P3LookupTables Functions ::p3_init (const bool write_tables, const bool masterproc) { - static bool is_init = false; - if (!is_init) { - using c = scream::physics::Constants; - micro_p3_utils_init_c(c::Cpair, c::Rair, c::RH2O, c::RHO_H2O, - c::MWH2O, c::MWdry, c::gravit, c::LatVap, c::LatIce, - c::CpLiq, c::Tmelt, c::Pi, masterproc); - static const char* dir = SCREAM_DATA_DIR "/tables"; - Int info; - p3_init_c(&dir, &info, write_tables); - EKAT_REQUIRE_MSG(info == 0, "p3_init_c returned info " << info); - is_init = true; + P3LookupTables lookup_tables; // This struct could be our global singleton + auto version = P3C::p3_version; + auto p3_lookup_base = P3C::p3_lookup_base; + static const char* dir = SCREAM_DATA_DIR "/tables"; + // p3_init_a (reads ice_table, collect_table) + read_ice_lookup_tables(masterproc, p3_lookup_base, version, lookup_tables.ice_table_vals, lookup_tables.collect_table_vals, P3C::densize, P3C::rimsize, P3C::isize, P3C::rcollsize); + if (write_tables) { + //p3_init_b (computes tables mu_r_table, revap_table, vn_table, vm_table) + compute_tables(masterproc, lookup_tables.mu_r_table_vals, lookup_tables.vn_table_vals, lookup_tables.vm_table_vals, lookup_tables.revap_table_vals); + write_computed_tables(masterproc, dir, lookup_tables.mu_r_table_vals, lookup_tables.vn_table_vals, lookup_tables.vm_table_vals, lookup_tables.revap_table_vals); } + else { + read_computed_tables(masterproc, dir, lookup_tables.mu_r_table_vals, lookup_tables.vn_table_vals, lookup_tables.vm_table_vals, lookup_tables.revap_table_vals); + } + // dnu is always computed/hardcoded + compute_dnu(lookup_tables.dnu_table_vals); + + return lookup_tables; } } // namespace p3 diff --git a/components/eamxx/src/physics/p3/impl/p3_table3_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_table3_impl.hpp index d099cd7c731..dbd7ea5726a 100644 --- a/components/eamxx/src/physics/p3/impl/p3_table3_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_table3_impl.hpp @@ -84,67 +84,15 @@ ::apply_table (const view_2d_table& table, template void Functions -::init_kokkos_tables (view_2d_table& vn_table_vals, view_2d_table& vm_table_vals, - view_2d_table& revap_table_vals, view_1d_table& mu_r_table_vals, - view_dnu_table& dnu) { - // initialize on host - - using DeviceTable1 = typename view_1d_table::non_const_type; - using DeviceTable2 = typename view_2d_table::non_const_type; - using DeviceDnuTable = typename view_dnu_table::non_const_type; - - const auto vn_table_vals_d = DeviceTable2("vn_table_vals"); - const auto vm_table_vals_d = DeviceTable2("vm_table_vals"); - const auto revap_table_vals_d = DeviceTable2("revap_table_vals"); - const auto mu_r_table_vals_d = DeviceTable1("mu_r_table_vals"); - const auto dnu_table_d = DeviceDnuTable("dnu"); - const auto vn_table_vals_h = Kokkos::create_mirror_view(vn_table_vals_d); - const auto vm_table_vals_h = Kokkos::create_mirror_view(vm_table_vals_d); - const auto revap_table_vals_h = Kokkos::create_mirror_view(revap_table_vals_d); - const auto mu_table_h = Kokkos::create_mirror_view(mu_r_table_vals_d); - const auto dnu_table_h = Kokkos::create_mirror_view(dnu_table_d); - - // Need 2d-tables with fortran-style layout - using P3F = Functions; - using LHostTable2 = typename P3F::KT::template lview; - LHostTable2 vn_table_vals_lh("vn_table_vals_lh"), vm_table_vals_lh("vm_table_vals_lh"), revap_table_vals_lh("revap_table_vals_lh"); - init_tables_from_f90_c(vn_table_vals_lh.data(), vm_table_vals_lh.data(), revap_table_vals_lh.data(), mu_table_h.data()); - for (int i = 0; i < C::VTABLE_DIM0; ++i) { - for (int j = 0; j < C::VTABLE_DIM1; ++j) { - vn_table_vals_h(i, j) = vn_table_vals_lh(i, j); - vm_table_vals_h(i, j) = vm_table_vals_lh(i, j); - revap_table_vals_h(i, j) = revap_table_vals_lh(i, j); - } - } - - dnu_table_h(0) = 0.000; - dnu_table_h(1) = -0.557; - dnu_table_h(2) = -0.430; - dnu_table_h(3) = -0.307; - dnu_table_h(4) = -0.186; - dnu_table_h(5) = -0.067; - dnu_table_h(6) = -0.050; - dnu_table_h(7) = -0.167; - dnu_table_h(8) = -0.282; - dnu_table_h(9) = -0.397; - dnu_table_h(10) = -0.512; - dnu_table_h(11) = -0.626; - dnu_table_h(12) = -0.739; - dnu_table_h(13) = -0.853; - dnu_table_h(14) = -0.966; - dnu_table_h(15) = -0.966; - - // deep copy to device - Kokkos::deep_copy(vn_table_vals_d, vn_table_vals_h); - Kokkos::deep_copy(vm_table_vals_d, vm_table_vals_h); - Kokkos::deep_copy(revap_table_vals_d, revap_table_vals_h); - Kokkos::deep_copy(mu_r_table_vals_d, mu_table_h); - Kokkos::deep_copy(dnu_table_d, dnu_table_h); - vn_table_vals = vn_table_vals_d; - vm_table_vals = vm_table_vals_d; - revap_table_vals = revap_table_vals_d; - mu_r_table_vals = mu_r_table_vals_d; - dnu = dnu_table_d; +::get_global_tables (view_2d_table& vn_table_vals, view_2d_table& vm_table_vals, + view_2d_table& revap_table_vals, view_1d_table& mu_r_table_vals, + view_dnu_table& dnu) { + auto tables = p3_init(); + vn_table_vals = tables.vn_table_vals; + vm_table_vals = tables.vm_table_vals; + revap_table_vals = tables.revap_table_vals; + mu_r_table_vals = tables.mu_r_table_vals; + dnu = tables.dnu_table_vals; } } // namespace p3 diff --git a/components/eamxx/src/physics/p3/impl/p3_table_ice_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_table_ice_impl.hpp index 4c2a43603da..9b28a4988bc 100644 --- a/components/eamxx/src/physics/p3/impl/p3_table_ice_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_table_ice_impl.hpp @@ -15,66 +15,10 @@ namespace p3 { template void Functions -::init_kokkos_ice_lookup_tables(view_ice_table& ice_table_vals, view_collect_table& collect_table_vals) { - - using DeviceIcetable = typename view_ice_table::non_const_type; - using DeviceColtable = typename view_collect_table::non_const_type; - - const auto ice_table_vals_d = DeviceIcetable("ice_table_vals"); - const auto collect_table_vals_d = DeviceColtable("collect_table_vals"); - - const auto ice_table_vals_h = Kokkos::create_mirror_view(ice_table_vals_d); - const auto collect_table_vals_h = Kokkos::create_mirror_view(collect_table_vals_d); - - // - // read in ice microphysics table into host views - // - - std::string filename = std::string(P3C::p3_lookup_base) + std::string(P3C::p3_version); - - std::ifstream in(filename); - - // read header - std::string version, version_val; - in >> version >> version_val; - EKAT_REQUIRE_MSG(version == "VERSION", "Bad " << filename << ", expected VERSION X.Y.Z header"); - EKAT_REQUIRE_MSG(version_val == P3C::p3_version, "Bad " << filename << ", expected version " << P3C::p3_version << ", but got " << version_val); - - // read tables - double dum_s; int dum_i; // dum_s needs to be double to stream correctly - for (int jj = 0; jj < P3C::densize; ++jj) { - for (int ii = 0; ii < P3C::rimsize; ++ii) { - for (int i = 0; i < P3C::isize; ++i) { - in >> dum_i >> dum_i; - int j_idx = 0; - for (int j = 0; j < 15; ++j) { - in >> dum_s; - if (j > 1 && j != 10) { - ice_table_vals_h(jj, ii, i, j_idx++) = dum_s; - } - } - } - - for (int i = 0; i < P3C::isize; ++i) { - for (int j = 0; j < P3C::rcollsize; ++j) { - in >> dum_i >> dum_i; - int k_idx = 0; - for (int k = 0; k < 6; ++k) { - in >> dum_s; - if (k == 3 || k == 4) { - collect_table_vals_h(jj, ii, i, j, k_idx++) = std::log10(dum_s); - } - } - } - } - } - } - - // deep copy to device - Kokkos::deep_copy(ice_table_vals_d, ice_table_vals_h); - Kokkos::deep_copy(collect_table_vals_d, collect_table_vals_h); - ice_table_vals = ice_table_vals_d; - collect_table_vals = collect_table_vals_d; +::get_global_ice_lookup_tables(view_ice_table& ice_table_vals, view_collect_table& collect_table_vals) { + auto tables = p3_init(); + ice_table_vals = tables.ice_table_vals; + collect_table_vals = tables.collect_table_vals; } template diff --git a/components/eamxx/src/physics/p3/p3_functions.hpp b/components/eamxx/src/physics/p3/p3_functions.hpp index eef5a8ec73e..66b81838496 100644 --- a/components/eamxx/src/physics/p3/p3_functions.hpp +++ b/components/eamxx/src/physics/p3/p3_functions.hpp @@ -349,16 +349,16 @@ struct Functions // --------- Functions --------- // - // Call from host to initialize the static table entries. - static void init_kokkos_tables( + // Call to get global tables + static void get_global_tables( view_2d_table& vn_table_vals, view_2d_table& vm_table_vals, view_2d_table& revap_table_vals, view_1d_table& mu_r_table_vals, view_dnu_table& dnu); - static void init_kokkos_ice_lookup_tables( + static void get_global_ice_lookup_tables( view_ice_table& ice_table_vals, view_collect_table& collect_table_vals); - static void p3_init(const bool write_tables = false, - const bool masterproc = false); + static P3LookupTables p3_init(const bool write_tables = false, + const bool masterproc = false); // Map (mu_r, lamr) to Table3 data. KOKKOS_FUNCTION @@ -1417,13 +1417,6 @@ struct Functions template constexpr ScalarT Functions::P3C::lookup_table_1a_dum1_c; -extern "C" { -// decl of fortran function for loading tables from fortran p3. This will -// continue to be a bit awkward until we have fully ported all of p3. -void init_tables_from_f90_c(Real* vn_table_vals_data, Real* vm_table_vals_data, - Real* revap_table_vals_data, Real* mu_table_data); -} - } // namespace p3 } // namespace scream diff --git a/components/eamxx/src/physics/p3/p3_iso_c.f90 b/components/eamxx/src/physics/p3/p3_iso_c.f90 deleted file mode 100644 index 71c846b7167..00000000000 --- a/components/eamxx/src/physics/p3/p3_iso_c.f90 +++ /dev/null @@ -1,158 +0,0 @@ -module p3_iso_c - use iso_c_binding - implicit none - -#include "scream_config.f" -#ifdef SCREAM_DOUBLE_PRECISION -# define c_real c_double -#else -# define c_real c_float -#endif - -! -! This file contains bridges from scream c++ to micro_p3 fortran. -! - -contains - subroutine init_tables_from_f90_c(vn_table_vals_c, vm_table_vals_c, revap_table_vals_c, mu_table_c) bind(C) - use micro_p3, only: p3_get_tables - - real(kind=c_real), intent(inout), dimension(300,10) :: vn_table_vals_c, vm_table_vals_c, revap_table_vals_c - real(kind=c_real), intent(inout), dimension(150) :: mu_table_c - - real(kind=c_real), dimension(150), target :: mu_table_f - real(kind=c_real), dimension(300,10), target :: vn_table_vals_f, vm_table_vals_f, revap_table_vals_f - - call p3_get_tables(mu_table_f, revap_table_vals_f, vn_table_vals_f, vm_table_vals_f) - vn_table_vals_c(:,:) = vn_table_vals_f(:,:) - vm_table_vals_c(:,:) = vm_table_vals_f(:,:) - revap_table_vals_c(:,:) = revap_table_vals_f(:,:) - mu_table_c(:) = mu_table_f(:) - - end subroutine init_tables_from_f90_c - - subroutine p3_init_c(lookup_file_dir_c, info, write_tables) bind(c) - use ekat_array_io_mod, only: array_io_file_exists -#ifdef SCREAM_DOUBLE_PRECISION - use ekat_array_io_mod, only: array_io_read=>array_io_read_double, array_io_write=>array_io_write_double -#else - use ekat_array_io_mod, only: array_io_read=>array_io_read_float, array_io_write=>array_io_write_float -#endif - use micro_p3, only: p3_init_a, p3_init_b, p3_set_tables, p3_get_tables - - type(c_ptr), intent(in) :: lookup_file_dir_c - integer(kind=c_int), intent(out) :: info - logical(kind=c_bool), intent(in) :: write_tables - - real(kind=c_real), dimension(150), target :: mu_r_table_vals - real(kind=c_real), dimension(300,10), target :: vn_table_vals, vm_table_vals, revap_table_vals - - character(len=256), pointer :: lookup_file_dir - character(kind=c_char, len=512) :: mu_r_filename, revap_filename, vn_filename, vm_filename - integer :: len - logical :: ok - character(len=16) :: p3_version="4.1.1" ! TODO: Change to be dependent on table version and path specified in p3_functions.hpp - - call c_f_pointer(lookup_file_dir_c, lookup_file_dir) - len = index(lookup_file_dir, C_NULL_CHAR) - 1 - call p3_init_a(lookup_file_dir(1:len),p3_version) - - info = 0 - ok = .false. - -#ifdef SCREAM_DOUBLE_PRECISION - mu_r_filename = lookup_file_dir(1:len)//'/mu_r_table_vals.dat8'//C_NULL_CHAR - revap_filename = lookup_file_dir(1:len)//'/revap_table_vals.dat8'//C_NULL_CHAR - vn_filename = lookup_file_dir(1:len)//'/vn_table_vals.dat8'//C_NULL_CHAR - vm_filename = lookup_file_dir(1:len)//'/vm_table_vals.dat8'//C_NULL_CHAR -#else - mu_r_filename = lookup_file_dir(1:len)//'/mu_r_table_vals.dat4'//C_NULL_CHAR - revap_filename = lookup_file_dir(1:len)//'/revap_table_vals.dat4'//C_NULL_CHAR - vn_filename = lookup_file_dir(1:len)//'/vn_table_vals.dat4'//C_NULL_CHAR - vm_filename = lookup_file_dir(1:len)//'/vm_table_vals.dat4'//C_NULL_CHAR -#endif - - if (write_tables) then - call p3_init_b() - call p3_get_tables(mu_r_table_vals, revap_table_vals, vn_table_vals, vm_table_vals) - ok = array_io_write(mu_r_filename, c_loc(mu_r_table_vals), size(mu_r_table_vals)) .and. & - array_io_write(revap_filename, c_loc(revap_table_vals), size(revap_table_vals)) .and. & - array_io_write(vn_filename, c_loc(vn_table_vals), size(vn_table_vals)) .and. & - array_io_write(vm_filename, c_loc(vm_table_vals), size(vm_table_vals)) - if (.not. ok) then - print *, 'p3_iso_c::p3_init: Error when writing table files.' - info = -1 - end if - else - ! Check table files exist - ok = array_io_file_exists(mu_r_filename) .and. & - array_io_file_exists(revap_filename) .and. & - array_io_file_exists(vn_filename) .and. & - array_io_file_exists(vm_filename) - if (.not. ok) then - print *, 'p3_iso_c::p3_init: One or more table files does not exist' - info = -2 - return - endif - - ! Read files - if (.not. array_io_read(mu_r_filename, c_loc(mu_r_table_vals), size(mu_r_table_vals))) then - print *, "p3_iso_c::p3_init: error reading mu_r table from file "//mu_r_filename - info = -3 - return - elseif (.not. array_io_read(revap_filename, c_loc(revap_table_vals), size(revap_table_vals))) then - print *, "p3_iso_c::p3_init: error reading revap table from file "//revap_filename - info = -4 - return - - elseif (.not. array_io_read(vn_filename, c_loc(vn_table_vals), size(vn_table_vals))) then - print *, "p3_iso_c::p3_init: error reading vn table from file "//vn_filename - info = -5 - return - elseif (.not. array_io_read(vm_filename, c_loc(vm_table_vals), size(vm_table_vals))) then - print *, "p3_iso_c::p3_init: error reading vm table from file "//vm_filename - info = -6 - return - endif - - call p3_set_tables(mu_r_table_vals, revap_table_vals, vn_table_vals, vm_table_vals) - end if - - end subroutine p3_init_c - - subroutine micro_p3_utils_init_c(Cpair, Rair, RH2O, RHO_H2O, & - MWH2O, MWdry, gravit, LatVap, LatIce, & - CpLiq, Tmelt, Pi, masterproc) bind(C) - - use micro_p3_utils, only: micro_p3_utils_init - use iso_fortran_env, only: OUTPUT_UNIT - real(kind=c_real), value, intent(in) :: Cpair - real(kind=c_real), value, intent(in) :: Rair - real(kind=c_real), value, intent(in) :: RH2O - real(kind=c_real), value, intent(in) :: RHO_H2O - real(kind=c_real), value, intent(in) :: MWH2O - real(kind=c_real), value, intent(in) :: MWdry - real(kind=c_real), value, intent(in) :: gravit - real(kind=c_real), value, intent(in) :: LatVap - real(kind=c_real), value, intent(in) :: LatIce - real(kind=c_real), value, intent(in) :: CpLiq - real(kind=c_real), value, intent(in) :: Tmelt - real(kind=c_real), value, intent(in) :: Pi - logical(kind=c_bool), value, intent(in) :: masterproc - - call micro_p3_utils_init(Cpair,Rair,RH2O,RHO_H2O,MWH2O,MWdry,gravit,LatVap,LatIce, & - CpLiq,Tmelt,Pi,OUTPUT_UNIT,masterproc) - end subroutine micro_p3_utils_init_c - - subroutine p3_init_a_c(ice_table_vals_c, collect_table_vals_c) bind(C) - use micro_p3, only: ice_table_vals, collect_table_vals - use micro_p3_utils, only: densize,rimsize,isize,ice_table_size,rcollsize,collect_table_size - - real(kind=c_real), intent(out), dimension(densize,rimsize,isize,ice_table_size) :: ice_table_vals_c - real(kind=c_real), intent(out), dimension(densize,rimsize,isize,rcollsize,collect_table_size) :: collect_table_vals_c - - ice_table_vals_c(:,:,:,:) = ice_table_vals(:,:,:,:) - collect_table_vals_c(:,:,:,:,:) = collect_table_vals(:,:,:,:,:) - end subroutine p3_init_a_c - -end module p3_iso_c diff --git a/components/eamxx/src/physics/p3/p3_tables_setup.cpp b/components/eamxx/src/physics/p3/p3_tables_setup.cpp deleted file mode 100644 index ec3f5ccbb43..00000000000 --- a/components/eamxx/src/physics/p3/p3_tables_setup.cpp +++ /dev/null @@ -1,8 +0,0 @@ -// This is a tiny program that calls p3_init() to generate tables used by p3 - -#include "physics/p3/p3_data.hpp" - -int main(int /* argc */, char** /* argv */) { - scream::p3::p3_init(/* write_tables = */ true); - return 0; -} diff --git a/components/eamxx/src/physics/p3/tests/CMakeLists.txt b/components/eamxx/src/physics/p3/tests/CMakeLists.txt index 9c1f41120e6..d66d734d127 100644 --- a/components/eamxx/src/physics/p3/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/p3/tests/CMakeLists.txt @@ -101,6 +101,13 @@ CreateUnitTest(p3_run_and_cmp "p3_run_and_cmp.cpp" EXE_ARGS "${BASELINE_FILE_ARG}" LABELS "p3;physics;baseline_gen;baseline_cmp") +if (SCREAM_ONLY_GENERATE_BASELINES) + # This test can be used to re-generate tables in ${SCREAM_DATA_DIR} + CreateUnitTest(p3_tables_setup "p3_tables_setup.cpp" + LIBS p3 + LABELS "p3;physics;baseline_gen") +endif() + # Make sure that a diff from baselines triggers a failed test (in debug only) if (SCREAM_ENABLE_BASELINE_TESTS) CreateUnitTest(p3_run_and_cmp_fail "p3_run_and_cmp.cpp" diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_main_wrap.cpp b/components/eamxx/src/physics/p3/tests/infra/p3_main_wrap.cpp index 2b758a513ec..d4faa4c7052 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_main_wrap.cpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_main_wrap.cpp @@ -31,7 +31,6 @@ int test_p3_init () { using P3F = Functions; P3F::p3_init(); - P3GlobalForFortran::deinit(); return 0; } @@ -43,7 +42,6 @@ int test_p3_ic () { d->dt = 300.0; P3F::p3_init(); p3_main_wrap(*d); - P3GlobalForFortran::deinit(); return 0; } diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp index 9e7ecab0f92..2dff7183ec6 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.cpp @@ -12,23 +12,9 @@ using scream::Real; using scream::Int; -extern "C" { - -void p3_init_a_c(Real* ice_table_vals, Real* collect_table_vals); - -} // extern "C" : end _c decls - namespace scream { namespace p3 { -void p3_init_a(P3InitAP3Data& d) -{ - using P3F = Functions; - - P3F::p3_init(); // need to initialize p3 first so that tables are loaded - p3_init_a_c(d.ice_table_vals.data(), d.collect_table_vals.data()); -} - void BackToCellAverageData::randomize(std::mt19937_64& engine) { // Populate the struct with numbers between 0 and 1. @@ -329,24 +315,6 @@ void PreventLiqSupersaturationData::randomize(std::mt19937_64& engine) /////////////////////////////////////////////////////////////////////////////// -std::shared_ptr P3GlobalForFortran::s_views; - -const P3GlobalForFortran::Views& P3GlobalForFortran::get() -{ - if (!P3GlobalForFortran::s_views) { - P3GlobalForFortran::s_views = std::make_shared(); - P3F::init_kokkos_ice_lookup_tables(s_views->m_ice_table_vals, s_views->m_collect_table_vals); - P3F::init_kokkos_tables(s_views->m_vn_table_vals, s_views->m_vm_table_vals, - s_views->m_revap_table_vals, s_views->m_mu_r_table_vals, s_views->m_dnu); - } - return *P3GlobalForFortran::s_views; -} - -void P3GlobalForFortran::deinit() -{ - P3GlobalForFortran::s_views = nullptr; -} - // // _host function definitions // @@ -581,7 +549,7 @@ void cloud_sedimentation_host( const Int nk_pack = ekat::npack(nk); // Set up views - const auto dnu = P3GlobalForFortran::dnu(); + const auto dnu = P3F::p3_init().dnu_table_vals; std::vector temp_d(CloudSedData::NUM_ARRAYS); @@ -672,7 +640,7 @@ void ice_sedimentation_host( ni_tend_d (temp_d[14]); // Call core function from kernel - auto ice_table_vals = P3GlobalForFortran::ice_table_vals(); + auto ice_table_vals = P3F::p3_init().ice_table_vals; auto policy = ekat::ExeSpaceUtils::get_default_team_policy(1, nk_pack); ekat::WorkspaceManager wsm(rho_d.extent(0), 6, policy); Real my_precip_ice_surf = 0; @@ -745,8 +713,9 @@ void rain_sedimentation_host( precip_liq_flux_d(temp_d[13]); // Call core function from kernel - auto vn_table_vals = P3GlobalForFortran::vn_table_vals(); - auto vm_table_vals = P3GlobalForFortran::vm_table_vals(); + auto tables = P3F::p3_init(); + auto vn_table_vals = tables.vn_table_vals; + auto vm_table_vals = tables.vm_table_vals; auto policy = ekat::ExeSpaceUtils::get_default_team_policy(1, nk_pack); ekat::WorkspaceManager wsm(rho_d.extent(0), 4, policy); Real my_precip_liq_surf = 0; @@ -1085,10 +1054,11 @@ void p3_main_part2_host( t_prev_d (temp_d[current_index++]); // Call core function from kernel - const auto dnu = P3GlobalForFortran::dnu(); - const auto ice_table_vals = P3GlobalForFortran::ice_table_vals(); - const auto collect_table_vals = P3GlobalForFortran::collect_table_vals(); - const auto revap_table_vals = P3GlobalForFortran::revap_table_vals(); + auto tables = P3F::p3_init(); + const auto dnu = tables.dnu_table_vals; + const auto ice_table_vals = tables.ice_table_vals; + const auto collect_table_vals = tables.collect_table_vals; + const auto revap_table_vals = tables.revap_table_vals; bview_1d bools_d("bools", 1); auto policy = ekat::ExeSpaceUtils::get_default_team_policy(1, nk_pack); Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { @@ -1208,8 +1178,9 @@ void p3_main_part3_host( diag_eff_radius_qr_d (temp_d[current_index++]); // Call core function from kernel - const auto dnu = P3GlobalForFortran::dnu(); - const auto ice_table_vals = P3GlobalForFortran::ice_table_vals(); + auto tables = P3F::p3_init(); + const auto dnu = tables.dnu_table_vals; + const auto ice_table_vals = tables.ice_table_vals; auto policy = ekat::ExeSpaceUtils::get_default_team_policy(1, nk_pack); Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const MemberType& team) { @@ -1257,12 +1228,6 @@ Int p3_main_host( using sview_1d = typename P3F::view_1d; using sview_2d = typename P3F::view_2d; - using view_1d_table = typename P3F::view_1d_table; - using view_2d_table = typename P3F::view_2d_table; - using view_ice_table = typename P3F::view_ice_table; - using view_collect_table = typename P3F::view_collect_table; - using view_dnu_table = typename P3F::view_dnu_table; - EKAT_REQUIRE_MSG(its == 1, "its must be 1, got " << its); EKAT_REQUIRE_MSG(kts == 1, "kts must be 1, got " << kts); @@ -1403,16 +1368,7 @@ Int p3_main_host( #endif // load tables - view_1d_table mu_r_table_vals; - view_2d_table vn_table_vals, vm_table_vals, revap_table_vals; - view_ice_table ice_table_vals; - view_collect_table collect_table_vals; - view_dnu_table dnu_table_vals; - P3F::init_kokkos_ice_lookup_tables(ice_table_vals, collect_table_vals); - P3F::init_kokkos_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu_table_vals); - - P3F::P3LookupTables lookup_tables{mu_r_table_vals, vn_table_vals, vm_table_vals, revap_table_vals, - ice_table_vals, collect_table_vals, dnu_table_vals}; + auto lookup_tables = P3F::p3_init(); P3F::P3Runtime runtime_options{740.0e3}; // Create local workspace diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp index a1bbe864f4c..775120e080d 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_test_data.hpp @@ -15,71 +15,6 @@ namespace p3 { /////////////////////////////////////////////////////////////////////////////// -struct P3InitAP3Data -{ - // Must use Host as device, f90 code might not be able to use Device memory - using P3F = Functions; - using P3C = typename P3F::P3C; - - using view_ice_table = typename P3F::KT::template lview; - using view_collect_table = typename P3F::KT::template lview; - - // Need to be LayoutLeft to be fortran compatible - view_ice_table ice_table_vals; - view_collect_table collect_table_vals; - - P3InitAP3Data() : - ice_table_vals("P3InitAP3Data::ice_table_vals"), - collect_table_vals("P3InitAP3Data::collect_table_vals") - {} -}; - -/////////////////////////////////////////////////////////////////////////////// - -// Singleton for holding the same global data that are maintained in -// micro_p3, but for use in C++. -struct P3GlobalForFortran -{ - using P3F = Functions; - - using view_1d_table = typename P3F::view_1d_table; - using view_2d_table = typename P3F::view_2d_table; - using view_ice_table = typename P3F::view_ice_table; - using view_collect_table = typename P3F::view_collect_table; - using view_dnu_table = typename P3F::view_dnu_table; - using P3Runtime = P3F::P3Runtime; - - // All kokkos views must be destructed before Kokkos::finalize - static void deinit(); - - static const view_1d_table& mu_r_table_vals() { return get().m_mu_r_table_vals; } - static const view_2d_table& vn_table_vals() { return get().m_vn_table_vals; } - static const view_2d_table& vm_table_vals() { return get().m_vm_table_vals; } - static const view_2d_table& revap_table_vals() { return get().m_revap_table_vals; } - static const view_ice_table& ice_table_vals() { return get().m_ice_table_vals; } - static const view_collect_table& collect_table_vals() { return get().m_collect_table_vals; } - static const view_dnu_table& dnu() { return get().m_dnu; } - - P3GlobalForFortran() = delete; - ~P3GlobalForFortran() = delete; - P3GlobalForFortran(const P3GlobalForFortran&) = delete; - P3GlobalForFortran& operator=(const P3GlobalForFortran&) = delete; - - private: - struct Views { - view_1d_table m_mu_r_table_vals; - view_2d_table m_vn_table_vals, m_vm_table_vals, m_revap_table_vals; - view_ice_table m_ice_table_vals; - view_collect_table m_collect_table_vals; - view_dnu_table m_dnu; - }; - - static const Views& get(); - static std::shared_ptr s_views; -}; - -/////////////////////////////////////////////////////////////////////////////// - /** * Structs for holding data related to specific P3 calls; these are used for * the BFB unit tests. @@ -882,8 +817,6 @@ struct PreventLiqSupersaturationData { PTD_RW_SCALARS_ONLY(2, qi2qv_sublim_tend, qr2qv_evap_tend); }; -void p3_init_a(P3InitAP3Data& d); - /** * Convenience functions for calling p3 routines from the host with scalar data. * These function will pack your data, sync it to device, call the p3 function, diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp b/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp index 9dd7dee95b3..d76fda60e20 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp @@ -108,10 +108,7 @@ struct UnitWrap { } } - ~Base() - { - scream::p3::P3GlobalForFortran::deinit(); - } + ~Base() {} std::mt19937_64 get_engine() { diff --git a/components/eamxx/src/physics/p3/tests/p3_calc_liq_relaxation_timescale_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_calc_liq_relaxation_timescale_unit_tests.cpp index 2752746b792..cf302d78166 100644 --- a/components/eamxx/src/physics/p3/tests/p3_calc_liq_relaxation_timescale_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_calc_liq_relaxation_timescale_unit_tests.cpp @@ -31,10 +31,7 @@ struct UnitWrap::UnitTest::TestCalcLiqRelaxationTimescale : public UnitWrap:: auto engine = Base::get_engine(); // Read in tables - view_2d_table vn_table_vals, vm_table_vals, revap_table_vals; - view_1d_table mu_r_table_vals; - view_dnu_table dnu; - Functions::init_kokkos_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); + auto revap_table_vals = Functions::p3_init().revap_table_vals; using KTH = KokkosTypes; diff --git a/components/eamxx/src/physics/p3/tests/p3_dsd2_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_dsd2_unit_tests.cpp index 268607645f0..9eb783b0eb6 100644 --- a/components/eamxx/src/physics/p3/tests/p3_dsd2_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_dsd2_unit_tests.cpp @@ -29,7 +29,7 @@ struct UnitWrap::UnitTest::TestDsd2 : public UnitWrap::UnitTest::Base { // Read in tables view_2d_table vn_table_vals; view_2d_table vm_table_vals; view_2d_table revap_table_vals; view_1d_table mu_r_table_vals; view_dnu_table dnu; - Functions::init_kokkos_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); + Functions::get_global_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); // Load some lookup inputs, need at least one per pack value GetCloudDsd2Data gcdd[max_pack_size] = { diff --git a/components/eamxx/src/physics/p3/tests/p3_ice_collection_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_ice_collection_unit_tests.cpp index 2561114b519..5d36ee79d54 100644 --- a/components/eamxx/src/physics/p3/tests/p3_ice_collection_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_ice_collection_unit_tests.cpp @@ -31,7 +31,7 @@ struct UnitWrap::UnitTest::TestIceCollection : public UnitWrap::UnitTest:: view_2d_table vm_table_vals; view_2d_table revap_table_vals; view_1d_table mu_r_table_vals; view_dnu_table dnu; - Functions::init_kokkos_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); + Functions::get_global_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); // Load some lookup inputs, need at least one per pack value IceCldliqCollectionData cldliq[max_pack_size] = { diff --git a/components/eamxx/src/physics/p3/tests/p3_ice_tables_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_ice_tables_unit_tests.cpp index ea3fdaccf7e..0c75d81ab6e 100644 --- a/components/eamxx/src/physics/p3/tests/p3_ice_tables_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_ice_tables_unit_tests.cpp @@ -24,43 +24,6 @@ namespace unit_test { template struct UnitWrap::UnitTest::TestTableIce : public UnitWrap::UnitTest::Base { - void test_read_lookup_tables_bfb() - { - // Read in ice tables - view_ice_table ice_table_vals; - view_collect_table collect_table_vals; - Functions::init_kokkos_ice_lookup_tables(ice_table_vals, collect_table_vals); - - // Get data from fortran - P3InitAP3Data d; - p3_init_a(d); - - // Copy device data to host - const auto ice_table_vals_host = Kokkos::create_mirror_view(ice_table_vals); - const auto collect_table_vals_host = Kokkos::create_mirror_view(collect_table_vals); - Kokkos::deep_copy(ice_table_vals_host, ice_table_vals); - Kokkos::deep_copy(collect_table_vals_host, collect_table_vals); - - // Compare (on host) - for (size_t i = 0; i < ice_table_vals_host.extent(0); ++i) { - for (size_t j = 0; j < ice_table_vals_host.extent(1); ++j) { - for (size_t k = 0; k < ice_table_vals_host.extent(2); ++k) { - - for (size_t l = 0; l < ice_table_vals_host.extent(3); ++l) { - REQUIRE(ice_table_vals_host(i, j, k, l) == d.ice_table_vals(i, j, k, l)); - } - - for (size_t l = 0; l < collect_table_vals_host.extent(3); ++l) { - for (size_t m = 0; m < collect_table_vals_host.extent(4); ++m) { - REQUIRE(collect_table_vals_host(i, j, k, l, m) == d.collect_table_vals(i, j, k, l, m)); - } - } - - } - } - } - } - template void init_table_linear_dimension(View& table, int linear_dimension) { @@ -103,7 +66,7 @@ struct UnitWrap::UnitTest::TestTableIce : public UnitWrap::UnitTest::Base // Read in ice tables view_ice_table ice_table_vals; view_collect_table collect_table_vals; - Functions::init_kokkos_ice_lookup_tables(ice_table_vals, collect_table_vals); + Functions::get_global_ice_lookup_tables(ice_table_vals, collect_table_vals); constexpr Scalar qsmall = C::QSMALL; @@ -373,7 +336,6 @@ TEST_CASE("p3_ice_tables", "[p3_functions]") using T = scream::p3::unit_test::UnitWrap::UnitTest::TestTableIce; T t; - t.test_read_lookup_tables_bfb(); t.run_phys(); t.run_bfb(); } diff --git a/components/eamxx/src/physics/p3/tests/p3_rain_sed_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_rain_sed_unit_tests.cpp index cd4d1955aed..ac34856eea6 100644 --- a/components/eamxx/src/physics/p3/tests/p3_rain_sed_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_rain_sed_unit_tests.cpp @@ -42,7 +42,7 @@ void run_bfb_rain_vel() // Read in tables view_2d_table vn_table_vals; view_2d_table vm_table_vals; view_2d_table revap_table_vals; view_1d_table mu_r_table_vals; view_dnu_table dnu; - Functions::init_kokkos_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); + Functions::get_global_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); // Load some lookup inputs, need at least one per pack value ComputeRainFallVelocityData crfv_baseline[max_pack_size] = { diff --git a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp index a6bd3013ad1..f596b0910eb 100644 --- a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp @@ -335,7 +335,6 @@ int main (int argc, char** argv) { printf("Comparing with %s at tol %1.1e\n", baseline_fn.c_str(), tol); nerr += bln.run_and_cmp(baseline_fn, tol, no_baseline); } - P3GlobalForFortran::deinit(); } scream::finalize_scream_session(); diff --git a/components/eamxx/src/physics/p3/tests/p3_table3_unit_tests.cpp b/components/eamxx/src/physics/p3/tests/p3_table3_unit_tests.cpp index 57197fea6c8..001a875c7e8 100644 --- a/components/eamxx/src/physics/p3/tests/p3_table3_unit_tests.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_table3_unit_tests.cpp @@ -76,7 +76,7 @@ struct UnitWrap::UnitTest::TestTable3 : public UnitWrap::UnitTest::Base { view_1d_table mu_r_table_vals; view_2d_table vn_table_vals, vm_table_vals, revap_table_vals; view_dnu_table dnu; - Functions::init_kokkos_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); + Functions::get_global_tables(vn_table_vals, vm_table_vals, revap_table_vals, mu_r_table_vals, dnu); // Estimate two maximum slope magnitudes for two meshes, the second 10x // refined w.r.t. the first. diff --git a/components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp b/components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp new file mode 100644 index 00000000000..91386db9c56 --- /dev/null +++ b/components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp @@ -0,0 +1,14 @@ +// This is a tiny program that calls p3_init() to generate tables used by p3 + +#include "physics/p3/p3_functions.hpp" +#include "share/scream_session.hpp" + +int main(int argc, char** argv) { + using P3F = scream::p3::Functions; + + scream::initialize_scream_session(argc, argv); + P3F::p3_init(/* write_tables = */ true); + scream::finalize_scream_session(); + + return 0; +} diff --git a/components/eamxx/src/physics/share/CMakeLists.txt b/components/eamxx/src/physics/share/CMakeLists.txt index d3c64a4a0b9..44ce0aba57b 100644 --- a/components/eamxx/src/physics/share/CMakeLists.txt +++ b/components/eamxx/src/physics/share/CMakeLists.txt @@ -3,11 +3,6 @@ set(PHYSICS_SHARE_SRCS physics_share.cpp physics_test_data.cpp scream_trcmix.cpp - ${SCREAM_BASE_DIR}/../eam/src/physics/cam/physics_utils.F90 - ${SCREAM_BASE_DIR}/../eam/src/physics/cam/scream_abortutils.F90 - ${SCREAM_BASE_DIR}/../eam/src/physics/cam/wv_sat_scream.F90 - ${SCREAM_BASE_DIR}/../eam/src/physics/p3/scream/micro_p3_utils.F90 - ${SCREAM_BASE_DIR}/../eam/src/physics/cam/debug_info.F90 ) # Add ETI source files if not on CUDA/HIP diff --git a/components/eamxx/src/physics/share/physics_share_f2c.F90 b/components/eamxx/src/physics/share/physics_share_f2c.F90 index 1bd3a7d21d7..885b026eac7 100644 --- a/components/eamxx/src/physics/share/physics_share_f2c.F90 +++ b/components/eamxx/src/physics/share/physics_share_f2c.F90 @@ -101,7 +101,7 @@ function scream_expm1(input) bind(C) ! return real(kind=c_real) :: scream_expm1 end function scream_expm1 - + function scream_tanh(input) bind(C) use iso_c_binding From 827be38045217ba53da2064374c08f13cc1f760f Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Wed, 11 Dec 2024 11:59:30 -0600 Subject: [PATCH 427/529] Clean-up ocn_c2_glc variables so they are correctly set by mpaso --- driver-mct/main/cime_comp_mod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/driver-mct/main/cime_comp_mod.F90 b/driver-mct/main/cime_comp_mod.F90 index f582f7bd5aa..edc34f66b76 100644 --- a/driver-mct/main/cime_comp_mod.F90 +++ b/driver-mct/main/cime_comp_mod.F90 @@ -1669,6 +1669,7 @@ subroutine cime_init() ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & ocn_c2_glcshelf=ocn_c2_glcshelf, & + ocn_c2_glctf=ocn_c2_glctf, & glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & rofocn_prognostic=rofocn_prognostic, & @@ -1733,8 +1734,6 @@ subroutine cime_init() lnd_c2_glc = .false. ocn_c2_atm = .false. ocn_c2_ice = .false. - ocn_c2_glctf = .false. - ocn_c2_glcshelf = .false. ocn_c2_wav = .false. ocn_c2_rof = .false. ice_c2_atm = .false. @@ -1870,9 +1869,9 @@ subroutine cime_init() write(logunit,F0L)'lnd_c2_rof = ',lnd_c2_rof write(logunit,F0L)'lnd_c2_glc = ',lnd_c2_glc write(logunit,F0L)'ocn_c2_atm = ',ocn_c2_atm + write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_glctf = ',ocn_c2_glctf write(logunit,F0L)'ocn_c2_ice = ',ocn_c2_ice - write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_wav = ',ocn_c2_wav write(logunit,F0L)'ocn_c2_rof = ',ocn_c2_rof write(logunit,F0L)'ice_c2_atm = ',ice_c2_atm From fe0188a2f98bd0ef02dcbcacad45ca0e16c9824c Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 11 Dec 2024 11:14:29 -0700 Subject: [PATCH 428/529] Github feedback Simplify io action using if constexpr. Remove fortran module stuff from cmake Remove fortran from comment --- .../eamxx/src/physics/p3/CMakeLists.txt | 4 --- .../src/physics/p3/impl/p3_init_impl.hpp | 29 ++++++------------- .../p3/tests/infra/p3_unit_tests_common.hpp | 2 +- 3 files changed, 10 insertions(+), 25 deletions(-) diff --git a/components/eamxx/src/physics/p3/CMakeLists.txt b/components/eamxx/src/physics/p3/CMakeLists.txt index 291462c7e30..9a56c185541 100644 --- a/components/eamxx/src/physics/p3/CMakeLists.txt +++ b/components/eamxx/src/physics/p3/CMakeLists.txt @@ -80,11 +80,7 @@ endif() target_compile_definitions(p3 PUBLIC EAMXX_HAS_P3) foreach (P3_LIB IN LISTS P3_LIBS) - set_target_properties(${P3_LIB} PROPERTIES - Fortran_MODULE_DIRECTORY ${P3_LIB}/modules - ) target_include_directories(${P3_LIB} PUBLIC - ${CMAKE_CURRENT_BINARY_DIR}/${P3_LIB}/modules ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_SOURCE_DIR}/impl ${SCREAM_BASE_DIR}/../eam/src/physics/cam diff --git a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp index 7cdf653531f..463c32dd8b8 100644 --- a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp @@ -189,31 +189,20 @@ void compute_tables(const bool masterproc, MuRT& mu_r_table_vals, VNT& vn_table_ revap_table_vals = revap_table_vals_nc; } -template -struct IoAction +template +static void action(const ekat::FILEPtr& fid, S* data, const size_t size) { - template - static void action(const ekat::FILEPtr& fid, S* data, const size_t size) - { + if constexpr (IsRead) { ekat::read(data, size, fid); } -}; - -template <> -struct IoAction -{ - template - static void action(const ekat::FILEPtr& fid, S* data, const size_t size) - { + else { ekat::write(data, size, fid); } -}; +} template void io_impl(const bool masterproc, const char* dir, MuRT& mu_r_table_vals, VNT& vn_table_vals, VMT& vm_table_vals, RevapT& revap_table_vals) { - using Action = IoAction; - if (masterproc) { std::cout << (IsRead ? "Reading" : "Writing") << " lookup (non-ice) tables in dir " << dir << std::endl; } @@ -239,10 +228,10 @@ void io_impl(const bool masterproc, const char* dir, MuRT& mu_r_table_vals, VNT& ekat::FILEPtr vm_file(fopen(vm_filename.c_str(), rw_flag)); // Read files - Action::action(mu_r_file, mu_r_table_vals.data(), mu_r_table_vals.size()); - Action::action(revap_file, revap_table_vals.data(), revap_table_vals.size()); - Action::action(vn_file, vn_table_vals.data(), vn_table_vals.size()); - Action::action(vm_file, vm_table_vals.data(), vm_table_vals.size()); + action(mu_r_file, mu_r_table_vals.data(), mu_r_table_vals.size()); + action(revap_file, revap_table_vals.data(), revap_table_vals.size()); + action(vn_file, vn_table_vals.data(), vn_table_vals.size()); + action(vm_file, vm_table_vals.data(), vm_table_vals.size()); } template diff --git a/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp b/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp index d76fda60e20..232963ca780 100644 --- a/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp +++ b/components/eamxx/src/physics/p3/tests/infra/p3_unit_tests_common.hpp @@ -83,7 +83,7 @@ struct UnitWrap { m_baseline_action(NONE), m_fid() { - Functions::p3_init(); // many tests will need fortran table data + Functions::p3_init(); // many tests will need table data auto& ts = ekat::TestSession::get(); if (ts.flags["c"]) { m_baseline_action = COMPARE; From 6324b715fa1ab1712cd40ec1ca4e40e3a53ba617 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 11 Dec 2024 11:45:51 -0700 Subject: [PATCH 429/529] Update ekat submodule Pull in a better way of dumping ParameterList to yaml files --- externals/ekat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/ekat b/externals/ekat index 1d441b22df3..42313831a53 160000 --- a/externals/ekat +++ b/externals/ekat @@ -1 +1 @@ -Subproject commit 1d441b22df3e4f8f8b3ea96099b0e848eb74afd7 +Subproject commit 42313831a530730875e1ada147a9375a3b100129 From eb916d35759a2ac77503ac98415b7ddc8d3f1aaf Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Mon, 9 Dec 2024 17:34:36 -0700 Subject: [PATCH 430/529] EAMxx: move DefaultMetadata dictionary to share/util --- .../eamxx/src/share/io/scorpio_output.hpp | 3 +- .../eamxx/src/share/io/scream_io_utils.hpp | 105 ----------------- .../eamxx/src/share/util/scream_utils.hpp | 106 ++++++++++++++++++ 3 files changed, 108 insertions(+), 106 deletions(-) diff --git a/components/eamxx/src/share/io/scorpio_output.hpp b/components/eamxx/src/share/io/scorpio_output.hpp index 696e08c9982..b1dd6b36cf3 100644 --- a/components/eamxx/src/share/io/scorpio_output.hpp +++ b/components/eamxx/src/share/io/scorpio_output.hpp @@ -6,7 +6,8 @@ #include "share/field/field_manager.hpp" #include "share/grid/abstract_grid.hpp" #include "share/grid/grids_manager.hpp" -#include "share/util//scream_time_stamp.hpp" +#include "share/util/scream_time_stamp.hpp" +#include "share/util/scream_utils.hpp" #include "share/atm_process/atmosphere_diagnostic.hpp" #include "ekat/ekat_parameter_list.hpp" diff --git a/components/eamxx/src/share/io/scream_io_utils.hpp b/components/eamxx/src/share/io/scream_io_utils.hpp index f725b91b94c..0bea91dc3fa 100644 --- a/components/eamxx/src/share/io/scream_io_utils.hpp +++ b/components/eamxx/src/share/io/scream_io_utils.hpp @@ -75,111 +75,6 @@ std::string find_filename_in_rpointer ( const OutputAvgType avg_type = OutputAvgType::Instant, const IOControl& control = {}); -struct DefaultMetadata { - - std::string get_longname (const std::string& name) { - if (name_2_longname.count(name)>0) { - return name_2_longname.at(name); - } else { - // TODO: Do we want to print a Warning message? I'm not sure if its needed. - return name; - } - } - - std::string get_standardname (const std::string& name) { - if (name_2_standardname.count(name)>0) { - return name_2_standardname.at(name); - } else { - // TODO: Do we want to print a Warning message? I'm not sure if its needed. - return name; - } - } - - // Create map of longnames, can be added to as developers see fit. - std::map name_2_longname = { - {"lev","hybrid level at midpoints (1000*(A+B))"}, - {"ilev","hybrid level at interfaces (1000*(A+B))"}, - {"hyai","hybrid A coefficient at layer interfaces"}, - {"hybi","hybrid B coefficient at layer interfaces"}, - {"hyam","hybrid A coefficient at layer midpoints"}, - {"hybm","hybrid B coefficient at layer midpoints"} - }; - - // Create map of longnames, can be added to as developers see fit. - std::map name_2_standardname = { - {"p_mid" , "air_pressure"}, - {"p_mid_at_cldtop" , "air_pressure_at_cloud_top"}, - {"T_2m" , "air_temperature"}, - {"T_mid" , "air_temperature"}, - {"T_mid_at_cldtop" , "air_temperature_at_cloud_top"}, - {"aero_g_sw" , "asymmetry_factor_of_ambient_aerosol_particles"}, - {"pbl_height" , "atmosphere_boundary_layer_thickness"}, - {"precip_liq_surf_mass" , "atmosphere_mass_content_of_liquid_precipitation"}, - {"cldlow" , "low_type_cloud_area_fraction"}, - {"cldmed" , "medium_type_cloud_area_fraction"}, - {"cldhgh" , "high_type_cloud_area_fraction"}, - {"cldtot" , "cloud_area_fraction"}, - {"cldfrac_tot_at_cldtop" , "cloud_area_fraction"}, - {"cldfrac_tot" , "cloud_area_fraction_in_atmosphere_layer"}, - {"cldfrac_tot_for_analysis" , "cloud_area_fraction_in_atmosphere_layer"}, - {"cldfrac_rad" , "cloud_area_fraction_in_atmosphere_layer"}, - {"qi" , "cloud_ice_mixing_ratio"}, - {"qc" , "cloud_liquid_water_mixing_ratio"}, - {"U" , "eastward_wind"}, - {"eff_radius_qi" , "effective_radius_of_cloud_ice_particles"}, - {"eff_radius_qc" , "effective_radius_of_cloud_liquid_water_particles"}, - {"eff_radius_qc_at_cldtop" , "effective_radius_of_cloud_liquid_water_particles_at_liquid_water_cloud_top"}, - {"eff_radius_qr" , "effective_radius_of_cloud_rain_particles"}, - {"qv" , "humidity_mixing_ratio"}, - {"cldfrac_ice_at_cldtop" , "ice_cloud_area_fraction"}, - {"cldfrac_ice" , "ice_cloud_area_fraction_in_atmosphere_layer"}, - {"omega" , "lagrangian_tendency_of_air_pressure"}, - {"landfrac" , "land_area_fraction"}, - {"latitude" , "latitude"}, - {"cldfrac_liq_at_cldtop" , "liquid_water_cloud_area_fraction"}, - {"cldfrac_liq" , "liquid_water_cloud_area_fraction_in_atmosphere_layer"}, - {"longitude" , "longitude"}, - {"rainfrac" , "mass_fraction_of_liquid_precipitation_in_air"}, - {"V" , "northward_wind"}, - {"nc" , "number_concentration_of_cloud_liquid_water_particles_in_air"}, - {"cdnc_at_cldtop" , "number_concentration_of_cloud_liquid_water_particles_in_air_at_liquid_water_cloud_top"}, - {"ni" , "number_concentration_of_ice_crystals_in_air"}, - {"aero_tau_sw" , "optical_thickness_of_atmosphere_layer_due_to_ambient_aerosol_particles"}, - {"aero_tau_lw" , "optical_thickness_of_atmosphere_layer_due_to_ambient_aerosol_particles"}, - {"aero_ssa_sw" , "single_scattering_albedo_in_air_due_to_ambient_aerosol_particles"}, - {"sunlit" , "sunlit_binary_mask"}, - {"ps" , "surface_air_pressure"}, - {"LW_flux_dn_at_model_bot" , "surface_downwelling_longwave_flux_in_air"}, - {"SW_flux_dn_at_model_bot" , "surface_downwelling_shortwave_flux_in_air"}, - {"SW_clrsky_flux_dn_at_model_bot" , "surface_downwelling_shortwave_flux_in_air_assuming_clear_sky"}, - {"phis" , "surface_geopotential"}, - {"surf_radiative_T" , "surface_temperature"}, - {"surf_sens_flux" , "surface_upward_sensible_heat_flux"}, - {"SW_flux_dn_at_model_top" , "toa_incoming_shortwave_flux"}, - {"LW_flux_up_at_model_top" , "toa_outgoing_longwave_flux"}, - {"LW_clrsky_flux_up_at_model_top" , "toa_outgoing_longwave_flux_assuming_clear_sky"}, - {"surf_evap" , "water_evapotranspiration_flux"}, - {"AtmosphereDensity" , "air_density"}, - {"PotentialTemperature" , "air_potential_temperature"}, - {"SeaLevelPressure" , "air_pressure_at_mean_sea_level"}, - {"IceWaterPath" , "atmosphere_mass_content_of_cloud_ice"}, - {"LiqWaterPath" , "atmosphere_mass_content_of_cloud_liquid_water"}, - {"VapWaterPath" , "atmosphere_mass_content_of_water_vapor"}, - {"AerosolOpticalDepth550nm" , "atmosphere_optical_thickness_due_to_ambient_aerosol_particles"}, - {"Exner" , "dimensionless_exner_function"}, - {"z_mid" , "geopotential_height"}, - {"geopotential_mid" , "geopotential_height"}, - {"RelativeHumidity" , "relative_humidity"}, - {"surface_upward_latent_heat_flux" , "surface_upward_latent_heat_flux"}, - {"LongwaveCloudForcing" , "toa_longwave_cloud_radiative_effect"}, - {"ShortwaveCloudForcing" , "toa_shortwave_cloud_radiative_effect"}, - {"VirtualTemperature" , "virtual_temperature"}, - {"VaporFlux" , "water_evapotranspiration_flux"}, - {"wind_speed" , "wind_speed"} - }; - -}; - // Shortcut to write/read to/from YYYYMMDD/HHMMSS attributes in the NC file void write_timestamp (const std::string& filename, const std::string& ts_name, const util::TimeStamp& ts, const bool write_nsteps = false); diff --git a/components/eamxx/src/share/util/scream_utils.hpp b/components/eamxx/src/share/util/scream_utils.hpp index dbb315fc4b9..9577b5597bf 100644 --- a/components/eamxx/src/share/util/scream_utils.hpp +++ b/components/eamxx/src/share/util/scream_utils.hpp @@ -368,6 +368,112 @@ constexpr int eamxx_vis_swband_idx() { return 10; } +struct DefaultMetadata { + + std::string get_longname (const std::string& name) { + if (name_2_longname.count(name)>0) { + return name_2_longname.at(name); + } else { + // TODO: Do we want to print a Warning message? I'm not sure if its needed. + return name; + } + } + + std::string get_standardname (const std::string& name) { + if (name_2_standardname.count(name)>0) { + return name_2_standardname.at(name); + } else { + // TODO: Do we want to print a Warning message? I'm not sure if its needed. + return name; + } + } + + // Create map of longnames, can be added to as developers see fit. + std::map name_2_longname = { + {"lev","hybrid level at midpoints (1000*(A+B))"}, + {"ilev","hybrid level at interfaces (1000*(A+B))"}, + {"hyai","hybrid A coefficient at layer interfaces"}, + {"hybi","hybrid B coefficient at layer interfaces"}, + {"hyam","hybrid A coefficient at layer midpoints"}, + {"hybm","hybrid B coefficient at layer midpoints"} + }; + + // Create map of longnames, can be added to as developers see fit. + std::map name_2_standardname = { + {"p_mid" , "air_pressure"}, + {"p_mid_at_cldtop" , "air_pressure_at_cloud_top"}, + {"T_2m" , "air_temperature"}, + {"T_mid" , "air_temperature"}, + {"T_mid_at_cldtop" , "air_temperature_at_cloud_top"}, + {"aero_g_sw" , "asymmetry_factor_of_ambient_aerosol_particles"}, + {"pbl_height" , "atmosphere_boundary_layer_thickness"}, + {"precip_liq_surf_mass" , "atmosphere_mass_content_of_liquid_precipitation"}, + {"cldlow" , "low_type_cloud_area_fraction"}, + {"cldmed" , "medium_type_cloud_area_fraction"}, + {"cldhgh" , "high_type_cloud_area_fraction"}, + {"cldtot" , "cloud_area_fraction"}, + {"cldfrac_tot_at_cldtop" , "cloud_area_fraction"}, + {"cldfrac_tot" , "cloud_area_fraction_in_atmosphere_layer"}, + {"cldfrac_tot_for_analysis" , "cloud_area_fraction_in_atmosphere_layer"}, + {"cldfrac_rad" , "cloud_area_fraction_in_atmosphere_layer"}, + {"qi" , "cloud_ice_mixing_ratio"}, + {"qc" , "cloud_liquid_water_mixing_ratio"}, + {"U" , "eastward_wind"}, + {"eff_radius_qi" , "effective_radius_of_cloud_ice_particles"}, + {"eff_radius_qc" , "effective_radius_of_cloud_liquid_water_particles"}, + {"eff_radius_qc_at_cldtop" , "effective_radius_of_cloud_liquid_water_particles_at_liquid_water_cloud_top"}, + {"eff_radius_qr" , "effective_radius_of_cloud_rain_particles"}, + {"qv" , "humidity_mixing_ratio"}, + {"cldfrac_ice_at_cldtop" , "ice_cloud_area_fraction"}, + {"cldfrac_ice" , "ice_cloud_area_fraction_in_atmosphere_layer"}, + {"omega" , "lagrangian_tendency_of_air_pressure"}, + {"landfrac" , "land_area_fraction"}, + {"latitude" , "latitude"}, + {"cldfrac_liq_at_cldtop" , "liquid_water_cloud_area_fraction"}, + {"cldfrac_liq" , "liquid_water_cloud_area_fraction_in_atmosphere_layer"}, + {"longitude" , "longitude"}, + {"rainfrac" , "mass_fraction_of_liquid_precipitation_in_air"}, + {"V" , "northward_wind"}, + {"nc" , "number_concentration_of_cloud_liquid_water_particles_in_air"}, + {"cdnc_at_cldtop" , "number_concentration_of_cloud_liquid_water_particles_in_air_at_liquid_water_cloud_top"}, + {"ni" , "number_concentration_of_ice_crystals_in_air"}, + {"aero_tau_sw" , "optical_thickness_of_atmosphere_layer_due_to_ambient_aerosol_particles"}, + {"aero_tau_lw" , "optical_thickness_of_atmosphere_layer_due_to_ambient_aerosol_particles"}, + {"aero_ssa_sw" , "single_scattering_albedo_in_air_due_to_ambient_aerosol_particles"}, + {"sunlit" , "sunlit_binary_mask"}, + {"ps" , "surface_air_pressure"}, + {"LW_flux_dn_at_model_bot" , "surface_downwelling_longwave_flux_in_air"}, + {"SW_flux_dn_at_model_bot" , "surface_downwelling_shortwave_flux_in_air"}, + {"SW_clrsky_flux_dn_at_model_bot" , "surface_downwelling_shortwave_flux_in_air_assuming_clear_sky"}, + {"phis" , "surface_geopotential"}, + {"surf_radiative_T" , "surface_temperature"}, + {"surf_sens_flux" , "surface_upward_sensible_heat_flux"}, + {"SW_flux_dn_at_model_top" , "toa_incoming_shortwave_flux"}, + {"LW_flux_up_at_model_top" , "toa_outgoing_longwave_flux"}, + {"LW_clrsky_flux_up_at_model_top" , "toa_outgoing_longwave_flux_assuming_clear_sky"}, + {"surf_evap" , "water_evapotranspiration_flux"}, + {"AtmosphereDensity" , "air_density"}, + {"PotentialTemperature" , "air_potential_temperature"}, + {"SeaLevelPressure" , "air_pressure_at_mean_sea_level"}, + {"IceWaterPath" , "atmosphere_mass_content_of_cloud_ice"}, + {"LiqWaterPath" , "atmosphere_mass_content_of_cloud_liquid_water"}, + {"VapWaterPath" , "atmosphere_mass_content_of_water_vapor"}, + {"AerosolOpticalDepth550nm" , "atmosphere_optical_thickness_due_to_ambient_aerosol_particles"}, + {"Exner" , "dimensionless_exner_function"}, + {"z_mid" , "geopotential_height"}, + {"geopotential_mid" , "geopotential_height"}, + {"RelativeHumidity" , "relative_humidity"}, + {"surface_upward_latent_heat_flux" , "surface_upward_latent_heat_flux"}, + {"LongwaveCloudForcing" , "toa_longwave_cloud_radiative_effect"}, + {"ShortwaveCloudForcing" , "toa_shortwave_cloud_radiative_effect"}, + {"VirtualTemperature" , "virtual_temperature"}, + {"VaporFlux" , "water_evapotranspiration_flux"}, + {"wind_speed" , "wind_speed"} + }; + +}; + + } // namespace scream #endif // SCREAM_UTILS_HPP From 217627424d35d6c9ad922fc5d3a17e6e56f88292 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Mon, 9 Dec 2024 17:35:08 -0700 Subject: [PATCH 431/529] EAMxx: add possibility to dump the content of the FieldManager to a yaml file --- .../cime_config/namelist_defaults_scream.xml | 1 + .../eamxx/src/control/atmosphere_driver.cpp | 41 +++++++++++++++++++ 2 files changed, 42 insertions(+) diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index 6d4c36b81bd..728649e2cf3 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -717,6 +717,7 @@ be lost if SCREAM_HACK_XML is not enabled. 0 + false diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index 0f1cb1e31ab..f29c686eadb 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -687,6 +687,47 @@ void AtmosphereDriver::create_fields() m_ad_status |= s_fields_created; + // If the user requested it, we can save a dictionary of the FM fields to file + auto& driver_options_pl = m_atm_params.sublist("driver_options"); + if (driver_options_pl.get("save_field_manager_content",false)) { + auto pg = m_grids_manager->get_grid("Physics"); + const auto& fm = m_field_mgrs.at(pg->name()); + ekat::ParameterList pl_out("field_manager_content"); + pl_out.sublist("provenance") = m_atm_params.sublist("provenance"); + DefaultMetadata std_names; + std::string desc; + desc = "content of the EAMxx FieldManager corresponding to the 'Physics' grid.\n" + "The dict keys are the field names as used in EAMxx.\n" + "For each field, we add the following entries:\n" + " - standard_name: the name commonly used to refer to this field in atm sciences (if applicable)\n" + " - units: the units for this field used in EAMxx\n" + " - layout: the names of the dimensions for this field (time excluded)\n" + " - providers: the atm processes that update/compute this field\n" + " - customers: the atm processes that require this field as an input\n"; + pl_out.set("description", desc); + auto& dict = pl_out.sublist("fields"); + for (const auto& it : *fm) { + const auto& fid = it.second->get_header().get_identifier(); + auto& pl = dict.sublist(fid.name()); + + pl.set("units",fid.get_units().to_string()); + pl.set("layout",fid.get_layout().names()); + pl.set("standard_name",std_names.get_standardname(fid.name())); + std::vector providers,customers; + const auto& track = it.second->get_header().get_tracking(); + for (auto ap : track.get_providers()) { + providers.push_back(ap.lock()->name()); + } + for (auto ap : track.get_customers()) { + customers.push_back(ap.lock()->name()); + } + pl.set("providers",providers); + pl.set("customers",customers); + } + + ekat::write_yaml_file("eamxx_field_manager_content.yaml",pl_out); + } + stop_timer("EAMxx::create_fields"); stop_timer("EAMxx::init"); m_atm_logger->info("[EAMxx] create_fields ... done!"); From 7eb5d2cd19b7d9ee3cdddabe3cae22ce57d21708 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 11 Dec 2024 17:32:30 -0700 Subject: [PATCH 432/529] EAMxx: fix several compiler warnings --- .../share/atm_process/atmosphere_process.cpp | 20 +++++++++++++++++++ components/eamxx/src/share/field/field.hpp | 1 + .../eamxx/src/share/field/field_impl.hpp | 1 + .../src/share/grid/library_grids_manager.hpp | 1 + .../share/grid/remap/vertical_remapper.cpp | 1 + .../eamxx/src/share/io/scorpio_output.cpp | 2 ++ .../src/share/io/scream_io_file_specs.hpp | 1 + .../src/share/io/scream_scorpio_interface.cpp | 1 + .../share/property_checks/field_nan_check.cpp | 1 + .../field_within_interval_check.cpp | 1 + .../eamxx/src/share/util/scream_data_type.hpp | 2 ++ 11 files changed, 32 insertions(+) diff --git a/components/eamxx/src/share/atm_process/atmosphere_process.cpp b/components/eamxx/src/share/atm_process/atmosphere_process.cpp index ab6d34310ce..6a85097539a 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process.cpp @@ -896,6 +896,8 @@ get_field_in_impl(const std::string& field_name, const std::string& grid_name) c " field name: " + field_name + "\n" " grid name: " + grid_name + "\n"); } + static Field f; + return f; } Field& AtmosphereProcess:: @@ -917,6 +919,8 @@ get_field_in_impl(const std::string& field_name) const { " atm proc name: " + this->name() + "\n" " field name: " + field_name + "\n"); } + static Field f; + return f; } Field& AtmosphereProcess:: @@ -932,6 +936,8 @@ get_field_out_impl(const std::string& field_name, const std::string& grid_name) " field name: " + field_name + "\n" " grid name: " + grid_name + "\n"); } + static Field f; + return f; } Field& AtmosphereProcess:: @@ -953,6 +959,8 @@ get_field_out_impl(const std::string& field_name) const { " atm proc name: " + this->name() + "\n" " field name: " + field_name + "\n"); } + static Field f; + return f; } FieldGroup& AtmosphereProcess:: @@ -968,6 +976,8 @@ get_group_in_impl(const std::string& group_name, const std::string& grid_name) c " group name: " + group_name + "\n" " grid name: " + grid_name + "\n"); } + static FieldGroup g(""); + return g; } FieldGroup& AtmosphereProcess:: @@ -989,6 +999,8 @@ get_group_in_impl(const std::string& group_name) const { " atm proc name: " + this->name() + "\n" " group name: " + group_name + "\n"); } + static FieldGroup g(""); + return g; } FieldGroup& AtmosphereProcess:: @@ -1004,6 +1016,8 @@ get_group_out_impl(const std::string& group_name, const std::string& grid_name) " group name: " + group_name + "\n" " grid name: " + grid_name + "\n"); } + static FieldGroup g(""); + return g; } FieldGroup& AtmosphereProcess:: @@ -1025,6 +1039,8 @@ get_group_out_impl(const std::string& group_name) const { " atm proc name: " + this->name() + "\n" " group name: " + group_name + "\n"); } + static FieldGroup g(""); + return g; } Field& AtmosphereProcess:: @@ -1040,6 +1056,8 @@ get_internal_field_impl(const std::string& field_name, const std::string& grid_n " field name: " + field_name + "\n" " grid name: " + grid_name + "\n"); } + static Field f; + return f; } Field& AtmosphereProcess:: @@ -1061,6 +1079,8 @@ get_internal_field_impl(const std::string& field_name) const { " atm proc name: " + this->name() + "\n" " field name: " + field_name + "\n"); } + static Field f; + return f; } void AtmosphereProcess diff --git a/components/eamxx/src/share/field/field.hpp b/components/eamxx/src/share/field/field.hpp index a338199f2ef..3fd15aa03ac 100644 --- a/components/eamxx/src/share/field/field.hpp +++ b/components/eamxx/src/share/field/field.hpp @@ -349,6 +349,7 @@ class Field { get_subview_1 (const get_view_type,HD>&, const int) const { EKAT_ERROR_MSG ("Error! Cannot subview a rank2 view along the second " "dimension without losing LayoutRight.\n"); + return get_view_type,HD>(); } template diff --git a/components/eamxx/src/share/field/field_impl.hpp b/components/eamxx/src/share/field/field_impl.hpp index 3d37853f478..e1d8c182d0e 100644 --- a/components/eamxx/src/share/field/field_impl.hpp +++ b/components/eamxx/src/share/field/field_impl.hpp @@ -966,6 +966,7 @@ auto Field::get_ND_view () const "MaxRank = 6.\n" "This should never be called at run time.\n" "Please contact developer if this functionality is required\n"); + return get_view_type,HD>(); } } // namespace scream diff --git a/components/eamxx/src/share/grid/library_grids_manager.hpp b/components/eamxx/src/share/grid/library_grids_manager.hpp index fd5d3caaef2..3e25ea60381 100644 --- a/components/eamxx/src/share/grid/library_grids_manager.hpp +++ b/components/eamxx/src/share/grid/library_grids_manager.hpp @@ -41,6 +41,7 @@ class LibraryGridsManager : public GridsManager "Error! LibraryGridsManager is not capable of creating remappers.\n" " - from_grid: " + from_grid->name() + "\n" " - to_grid: " + to_grid->name() + "\n"); + return nullptr; } }; diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp index 67c72e045a7..8e3b44d0e1f 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp @@ -81,6 +81,7 @@ create_src_layout (const FieldLayout& tgt_layout) const // we cannot infer what the corresponding src layout was. // This function should never be used for this remapper. EKAT_ERROR_MSG ("Error! VerticalRemapper does not support creating a src layout from a tgt layout.\n"); + return FieldLayout(); } FieldLayout VerticalRemapper:: diff --git a/components/eamxx/src/share/io/scorpio_output.cpp b/components/eamxx/src/share/io/scorpio_output.cpp index 4e9d5add800..fbdc665e75b 100644 --- a/components/eamxx/src/share/io/scorpio_output.cpp +++ b/components/eamxx/src/share/io/scorpio_output.cpp @@ -1314,6 +1314,8 @@ get_field(const std::string& name, const std::string& mode) const } else { EKAT_ERROR_MSG ("ERROR::AtmosphereOutput::get_field Field " + name + " not found in " + mode + " field manager or diagnostics list."); } + static Field f; + return f; } /* ---------------------------------------------------------- */ void AtmosphereOutput::set_diagnostics() diff --git a/components/eamxx/src/share/io/scream_io_file_specs.hpp b/components/eamxx/src/share/io/scream_io_file_specs.hpp index 4b0054b372a..ae5a00ff55b 100644 --- a/components/eamxx/src/share/io/scream_io_file_specs.hpp +++ b/components/eamxx/src/share/io/scream_io_file_specs.hpp @@ -56,6 +56,7 @@ struct StorageSpecs { default: EKAT_ERROR_MSG ("Error! Unrecognized/unsupported file storage type.\n"); } + return false; } void update_storage (const util::TimeStamp& t) { diff --git a/components/eamxx/src/share/io/scream_scorpio_interface.cpp b/components/eamxx/src/share/io/scream_scorpio_interface.cpp index 8d2f64994dd..c19740dbcc1 100644 --- a/components/eamxx/src/share/io/scream_scorpio_interface.cpp +++ b/components/eamxx/src/share/io/scream_scorpio_interface.cpp @@ -141,6 +141,7 @@ int nctype (const std::string& type) { } else { EKAT_ERROR_MSG ("Error! Unrecognized/unsupported data type '" + type + "'.\n"); } + return -1; } template diff --git a/components/eamxx/src/share/property_checks/field_nan_check.cpp b/components/eamxx/src/share/property_checks/field_nan_check.cpp index eef52adfbf7..5b709ff916d 100644 --- a/components/eamxx/src/share/property_checks/field_nan_check.cpp +++ b/components/eamxx/src/share/property_checks/field_nan_check.cpp @@ -186,6 +186,7 @@ PropertyCheck::ResultAndMsg FieldNaNCheck::check() const { "Internal error in FieldNaNCheck: unsupported field data type.\n" "You should not have reached this line. Please, contact developers.\n"); } + return ResultAndMsg{}; } } // namespace scream diff --git a/components/eamxx/src/share/property_checks/field_within_interval_check.cpp b/components/eamxx/src/share/property_checks/field_within_interval_check.cpp index bd436bb192a..eee5f96855d 100644 --- a/components/eamxx/src/share/property_checks/field_within_interval_check.cpp +++ b/components/eamxx/src/share/property_checks/field_within_interval_check.cpp @@ -332,6 +332,7 @@ PropertyCheck::ResultAndMsg FieldWithinIntervalCheck::check() const { "Internal error in FieldWithinIntervalCheck: unsupported field data type.\n" "You should not have reached this line. Please, contact developers.\n"); } + return ResultAndMsg{}; } template diff --git a/components/eamxx/src/share/util/scream_data_type.hpp b/components/eamxx/src/share/util/scream_data_type.hpp index 31ce6b9f8ef..8c45cd734b6 100644 --- a/components/eamxx/src/share/util/scream_data_type.hpp +++ b/components/eamxx/src/share/util/scream_data_type.hpp @@ -52,6 +52,7 @@ inline std::string e2str (const DataType data_type) { default: EKAT_ERROR_MSG("Error! Unsupported DataType value.\n"); } + return ""; } inline int get_type_size (const DataType data_type) { @@ -62,6 +63,7 @@ inline int get_type_size (const DataType data_type) { default: EKAT_ERROR_MSG("Error! Unsupported DataType value.\n"); } + return -1; } } // namespace scream From e8f869e044d964dedf191cbd819cb786e941b11c Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 13 Dec 2024 09:28:35 -0800 Subject: [PATCH 433/529] add namelist vars for disabling P3 subgrid cldfrac "disabling" might be misleading because these flags "maximize" cloud fraction by setting them to 1 everywhere --- .../eamxx/cime_config/namelist_defaults_scream.xml | 4 ++++ components/eamxx/src/physics/p3/eamxx_p3_run.cpp | 14 ++++++++++++++ 2 files changed, 18 insertions(+) diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index 9fa076d47dd..5af337f1afa 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -223,6 +223,10 @@ be lost if SCREAM_HACK_XML is not enabled. 0.304 1.0 true + + false + false + false diff --git a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp index 3de8184319a..22d83fdcb9b 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp @@ -15,6 +15,20 @@ void P3Microphysics::run_impl (const double dt) ); // Kokkos::parallel_for(p3_main_local_vals) Kokkos::fence(); + // allow namelist flags to override sub-grid cloud fraction (set it to 1 everywhere) + if (m_params.get("fix_cld_frac_l", false)) { + auto& cld_frac_l = p3_preproc.cld_frac_l; + Kokkos::deep_copy(cld_frac_l,1.0); + } + if (m_params.get("fix_cld_frac_r", false)) { + auto& cld_frac_r = p3_preproc.cld_frac_r; + Kokkos::deep_copy(cld_frac_r,1.0); + } + if (m_params.get("fix_cld_frac_i", false)) { + auto& cld_frac_i = p3_preproc.cld_frac_i; + Kokkos::deep_copy(cld_frac_i,1.0); + } + // Update the variables in the p3 input structures with local values. infrastructure.dt = dt; From 8503556202f48070a21f0c9625cfe11d24d36c1e Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 13 Dec 2024 09:56:19 -0800 Subject: [PATCH 434/529] make P3 cld frac flags more verbose --- components/eamxx/cime_config/namelist_defaults_scream.xml | 6 +++--- components/eamxx/src/physics/p3/eamxx_p3_run.cpp | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index 5af337f1afa..bff0c21f0c2 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -224,9 +224,9 @@ be lost if SCREAM_HACK_XML is not enabled. 1.0 true - false - false - false + false + false + false diff --git a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp index 22d83fdcb9b..1e3218d7e4a 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp @@ -16,15 +16,15 @@ void P3Microphysics::run_impl (const double dt) Kokkos::fence(); // allow namelist flags to override sub-grid cloud fraction (set it to 1 everywhere) - if (m_params.get("fix_cld_frac_l", false)) { + if (m_params.get("set_cld_frac_l_to_one", false)) { auto& cld_frac_l = p3_preproc.cld_frac_l; Kokkos::deep_copy(cld_frac_l,1.0); } - if (m_params.get("fix_cld_frac_r", false)) { + if (m_params.get("set_cld_frac_r_to_one", false)) { auto& cld_frac_r = p3_preproc.cld_frac_r; Kokkos::deep_copy(cld_frac_r,1.0); } - if (m_params.get("fix_cld_frac_i", false)) { + if (m_params.get("set_cld_frac_i_to_one", false)) { auto& cld_frac_i = p3_preproc.cld_frac_i; Kokkos::deep_copy(cld_frac_i,1.0); } From 19ea8c782119e6f33ab75d7bf18c47ff12f046f7 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 13 Dec 2024 10:40:01 -0800 Subject: [PATCH 435/529] add type and doc for namelist flags --- components/eamxx/cime_config/namelist_defaults_scream.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index bff0c21f0c2..03c1631c4b6 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -224,9 +224,9 @@ be lost if SCREAM_HACK_XML is not enabled. 1.0 true - false - false - false + false + false + false From 86ad5ff82b1f22b32543dea573fc967d32208cb9 Mon Sep 17 00:00:00 2001 From: Iulian Grindeanu Date: Sat, 14 Dec 2024 16:37:09 -0600 Subject: [PATCH 436/529] number of ghost layers needs to be set for bilinear maps need a new version of moab master, anyway --- driver-moab/main/prep_ocn_mod.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/driver-moab/main/prep_ocn_mod.F90 b/driver-moab/main/prep_ocn_mod.F90 index d3e97c74b56..84c5631bfec 100644 --- a/driver-moab/main/prep_ocn_mod.F90 +++ b/driver-moab/main/prep_ocn_mod.F90 @@ -203,7 +203,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc use iMOAB, only: iMOAB_ComputeMeshIntersectionOnSphere, iMOAB_RegisterApplication, & iMOAB_WriteMesh, iMOAB_DefineTagStorage, iMOAB_ComputeCommGraph, iMOAB_ComputeScalarProjectionWeights, & iMOAB_MigrateMapMesh, iMOAB_WriteLocalMesh, iMOAB_GetMeshInfo, iMOAB_SetDoubleTagStorage, & - iMOAB_WriteMappingWeightsToFile + iMOAB_WriteMappingWeightsToFile, iMOAB_SetGhostLayers !--------------------------------------------------------------- ! Description ! Initialize module attribute vectors and all other non-mapping @@ -269,6 +269,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc integer ent_type ! for setting tags integer noflds ! used for number of fields in allocating moab accumulated array x2oacc_om real (kind=R8) , allocatable :: tmparray (:) ! used to set the r2x fields to 0 + integer nghlay ! used to set the number of ghost layers, needed for bilinear map !--------------------------------------------------------------- @@ -426,6 +427,13 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc ! next, let us compute the ATM and OCN data transfer if (.not. samegrid_ao) then ! not a data OCN model + ! for bilinear maps, we need to have a layer of ghosts on source + nghlay = 1 ! number of ghost layers + ierr = iMOAB_SetGhostLayers( mbaxid, nghlay ) + if (ierr .ne. 0) then + write(logunit,*) subname,' error in setting the number of layers' + call shr_sys_abort(subname//' error in setting the number of layers') + endif ! first compute the overlap mesh between mbaxid (ATM) and mboxid (OCN) on coupler PEs ierr = iMOAB_ComputeMeshIntersectionOnSphere (mbaxid, mboxid, mbintxao) if (ierr .ne. 0) then From 7ad0a262b6fd9ac069461e37a471b1861a4bcc4d Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Mon, 16 Dec 2024 08:43:01 -0700 Subject: [PATCH 437/529] Workflows: test MMF in eamxx v1 workflow --- .github/workflows/eamxx-v1-testing.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/eamxx-v1-testing.yml b/.github/workflows/eamxx-v1-testing.yml index 9145961bdfe..88930a2c024 100644 --- a/.github/workflows/eamxx-v1-testing.yml +++ b/.github/workflows/eamxx-v1-testing.yml @@ -71,6 +71,8 @@ jobs: short_name: ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-small_kernels--scream-output-preset-5 - full_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.ghci-snl-cpu_gnu.scream-mam4xx-all_mam4xx_procs short_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-all_mam4xx_procs + - full_name: SMS_Ln3_P4.ne4pg2_oQU480.F2010-MMF2.ghci-snl-cpu_gnu + short_name: SMS_Ln3_P4.ne4pg2_oQU480.F2010-MMF2 fail-fast: false name: cpu-gcc / ${{ matrix.test.short_name }} steps: From 8a9ea3213ad5b946c2f84e1ac1f0fa4ed93252fe Mon Sep 17 00:00:00 2001 From: tcclevenger Date: Mon, 16 Dec 2024 23:05:21 -0500 Subject: [PATCH 438/529] Remove unnecessary fence --- .../iop_forcing/eamxx_iop_forcing_process_interface.cpp | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp index 930dd963636..c9a3714e1dc 100644 --- a/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp +++ b/components/eamxx/src/physics/iop_forcing/eamxx_iop_forcing_process_interface.cpp @@ -441,7 +441,6 @@ void IOPForcing::run_impl (const double dt) // Release WS views ws.release_many_contiguous<3>({&ref_p_mid, &ref_p_int, &ref_p_del}); }); - Kokkos::fence(); // Nudge the domain based on the domain mean // and observed quantities of T, Q, u, and v @@ -450,16 +449,16 @@ void IOPForcing::run_impl (const double dt) view_1d qv_mean, t_mean; view_2d horiz_winds_mean; if (iop_nudge_tq){ - horiz_contraction(m_helper_fields.at("qv_mean"), get_field_out("qv"), + horiz_contraction(m_helper_fields.at("qv_mean"), get_field_out("qv"), m_helper_fields.at("horiz_mean_weights"), &m_comm); qv_mean = m_helper_fields.at("qv_mean").get_view(); - - horiz_contraction(m_helper_fields.at("t_mean"), get_field_out("T_mid"), + + horiz_contraction(m_helper_fields.at("t_mean"), get_field_out("T_mid"), m_helper_fields.at("horiz_mean_weights"), &m_comm); t_mean = m_helper_fields.at("t_mean").get_view(); } if (iop_nudge_uv){ - horiz_contraction(m_helper_fields.at("horiz_winds_mean"), get_field_out("horiz_winds"), + horiz_contraction(m_helper_fields.at("horiz_winds_mean"), get_field_out("horiz_winds"), m_helper_fields.at("horiz_mean_weights"), &m_comm); horiz_winds_mean = m_helper_fields.at("horiz_winds_mean").get_view(); } From 61a10bd536a540d2c875f17d4946c4d668bb4e80 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 4 Dec 2024 11:49:42 -0800 Subject: [PATCH 439/529] initial implementation of relaxed slab ocean mode --- .../docn/cime_config/config_component.xml | 6 +- .../cime_config/namelist_definition_docn.xml | 18 ++- .../data_comps/docn/src/docn_comp_mod.F90 | 105 ++++++++++++++++-- .../data_comps/docn/src/docn_shr_mod.F90 | 11 +- .../eam/cime_config/config_compsets.xml | 9 ++ 5 files changed, 130 insertions(+), 19 deletions(-) diff --git a/components/data_comps/docn/cime_config/config_component.xml b/components/data_comps/docn/cime_config/config_component.xml index 431d358f995..68ec6a18c9f 100644 --- a/components/data_comps/docn/cime_config/config_component.xml +++ b/components/data_comps/docn/cime_config/config_component.xml @@ -13,10 +13,11 @@ This file may have ocn desc entries. --> - DOCN + DOCN null mode prescribed ocean mode slab ocean mode + relaxed slab ocean mode aquaplanet slab ocean mode interannual mode aquaplanet mode: @@ -45,12 +46,13 @@ char - prescribed,sst_aquap1,sst_aquap2,sst_aquap3,sst_aquap4,sst_aquap5,sst_aquap6,sst_aquap7,sst_aquap8,sst_aquap9,sst_aquap10,sst_aquap11,sst_aquap12,sst_aquap13,sst_aquap14,sst_aquap15,sst_aquapfile,som,som_aquap,sst_aquap_constant,interannual,null + prescribed,sst_aquap1,sst_aquap2,sst_aquap3,sst_aquap4,sst_aquap5,sst_aquap6,sst_aquap7,sst_aquap8,sst_aquap9,sst_aquap10,sst_aquap11,sst_aquap12,sst_aquap13,sst_aquap14,sst_aquap15,sst_aquapfile,som,rso,som_aquap,sst_aquap_constant,interannual,null prescribed null prescribed som + rso som_aquap interannual sst_aquap1 diff --git a/components/data_comps/docn/cime_config/namelist_definition_docn.xml b/components/data_comps/docn/cime_config/namelist_definition_docn.xml index a191d088d7f..dc415e95970 100644 --- a/components/data_comps/docn/cime_config/namelist_definition_docn.xml +++ b/components/data_comps/docn/cime_config/namelist_definition_docn.xml @@ -32,6 +32,7 @@ Currently the following datamods are supported prescribed SSTDATA (Run with prescribed SST, ICE_COV) som SOM (Slab ocean model) + rso RSO (Relaxed slab ocean model) null NULL (NULL mode) --> @@ -59,6 +60,7 @@ aquapfile '' som + rso som interannual @@ -93,6 +95,7 @@ null $DIN_LOC_ROOT/ocn/docn7/AQUAPLANET/ $DIN_LOC_ROOT/ocn/docn7/SOM + $DIN_LOC_ROOT/ocn/docn7/RSO $DIN_LOC_ROOT/atm/cam/sst @@ -106,6 +109,8 @@ null $DOCN_AQP_FILENAME $DOCN_SOM_FILENAME + + pop_frc.1x1d.090130.nc sst_HadOIBl_bc_1x1_1850_2014_c150416.nc @@ -145,6 +150,7 @@ null $DIN_LOC_ROOT/ocn/docn7/AQUAPLANET $DIN_LOC_ROOT/ocn/docn7/SOM + $DIN_LOC_ROOT/ocn/docn7/RSO $DIN_LOC_ROOT/atm/cam/sst @@ -158,6 +164,8 @@ null $DOCN_AQP_FILENAME $DOCN_SOM_FILENAME + + pop_frc.1x1d.090130.nc sst_HadOIBl_bc_1x1_1850_2014_c150416.nc @@ -181,6 +189,10 @@ hblt h qdp qbot + + T t + hblt h + SST_cpl t @@ -213,6 +225,7 @@ $SSTICE_YEAR_ALIGN 0 1 + 1 1 @@ -227,6 +240,7 @@ $SSTICE_YEAR_START 0 1 + 1 1850 @@ -241,6 +255,7 @@ $SSTICE_YEAR_END 0 1 + 1 2014 @@ -257,7 +272,7 @@ char streams shr_strdata_nml - SSTDATA,SST_AQUAP1,SST_AQUAP2,SST_AQUAP3,SST_AQUAP4,SST_AQUAP5,SST_AQUAP6,SST_AQUAP7,SST_AQUAP8,SST_AQUAP9,SST_AQUAP10,SST_AQUAP11,SST_AQUAP12,SST_AQUAP13,SST_AQUAP14,SST_AQUAP15,SST_AQUAPFILE,SST_AQUAP_CONSTANT,SOM,SOM_AQUAP,IAF,NULL,COPYALL + SSTDATA,SST_AQUAP1,SST_AQUAP2,SST_AQUAP3,SST_AQUAP4,SST_AQUAP5,SST_AQUAP6,SST_AQUAP7,SST_AQUAP8,SST_AQUAP9,SST_AQUAP10,SST_AQUAP11,SST_AQUAP12,SST_AQUAP13,SST_AQUAP14,SST_AQUAP15,SST_AQUAPFILE,SST_AQUAP_CONSTANT,SOM,RSO,SOM_AQUAP,IAF,NULL,COPYALL General method that operates on the data. This is generally implemented in the data models but is set in the strdata method for @@ -331,6 +346,7 @@ SST_AQUAPFILE SST_AQUAP_CONSTANT SOM + RSO SOM_AQUAP IAF diff --git a/components/data_comps/docn/src/docn_comp_mod.F90 b/components/data_comps/docn/src/docn_comp_mod.F90 index 43bac32bff7..6f15381d2b7 100644 --- a/components/data_comps/docn/src/docn_comp_mod.F90 +++ b/components/data_comps/docn/src/docn_comp_mod.F90 @@ -70,6 +70,8 @@ module docn_comp_mod integer(IN) :: kt,ks,ku,kv,kdhdx,kdhdy,kq,kswp ! field indices integer(IN) :: kswnet,klwup,klwdn,ksen,klat,kmelth,ksnow,krofi integer(IN) :: kh,kqbot + integer(IN) :: k10uu ! index for u10 + integer(IN) :: kRSO_bckgrd_sst ! index for background SST (relaxed slab ocean) integer(IN) :: index_lat, index_lon integer(IN) :: kmask, kfrac ! frac and mask field indices of docn domain integer(IN) :: ksomask ! So_omask field index @@ -93,7 +95,7 @@ module docn_comp_mod character(12) , parameter :: avofld(1:ktrans) = & (/ "So_t ","So_u ","So_v ","So_dhdx ",& "So_dhdy ","So_s ","strm_h ","strm_qbot "/) - character(len=*), parameter :: flds_strm = 'strm_h:strm_qbot' + character(len=*),parameter :: flds_strm = 'strm_h:strm_qbot:So_t' !-------------------------------------------------------------------------- !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -281,7 +283,7 @@ subroutine docn_comp_init(Eclock, x2o, o2x, & kdhdx = mct_aVect_indexRA(o2x,'So_dhdx') kdhdy = mct_aVect_indexRA(o2x,'So_dhdy') kswp = mct_aVect_indexRA(o2x,'So_fswpen', perrwith='quiet') - kq = mct_aVect_indexRA(o2x,'Fioo_q') + kq = mct_aVect_indexRA(o2x,'Fioo_q') ! ocn freezing melting potential call mct_aVect_init(x2o, rList=seq_flds_x2o_fields, lsize=lsize) call mct_aVect_zero(x2o) @@ -294,12 +296,14 @@ subroutine docn_comp_init(Eclock, x2o, o2x, & klwdn = mct_aVect_indexRA(x2o,'Faxa_lwdn') ksnow = mct_aVect_indexRA(x2o,'Faxa_snow') kmelth = mct_aVect_indexRA(x2o,'Fioi_melth') + k10uu = mct_aVect_indexRA(x2o,'So_duu10n') call mct_aVect_init(avstrm, rList=flds_strm, lsize=lsize) call mct_aVect_zero(avstrm) kh = mct_aVect_indexRA(avstrm,'strm_h') kqbot = mct_aVect_indexRA(avstrm,'strm_qbot') + kRSO_bckgrd_sst = mct_aVect_indexRA(avstrm,'So_t') allocate(somtp(lsize)) allocate(tfreeze(lsize)) @@ -472,14 +476,17 @@ subroutine docn_comp_init(Eclock, x2o, o2x, & call shr_mpi_bcast(exists,mpicom,'exists') call shr_mpi_bcast(exists1,mpicom,'exists1') - if (trim(datamode) == 'SOM' .or. trim(datamode) == 'SOM_AQUAP') then - if (exists1) then - if (my_task == master_task) write(logunit,F00) ' reading ',trim(rest_file) - call shr_pcdf_readwrite('read',SDOCN%pio_subsystem, SDOCN%io_type, & - trim(rest_file), mpicom, gsmap=gsmap, rf1=somtp, rf1n='somtp', io_format=SDOCN%io_format) - else - if (my_task == master_task) write(logunit,F00) ' file not found, skipping ',trim(rest_file) - endif + if ( trim(datamode) == 'SOM' & ! Traditional slab ocean + .or. trim(datamode) == 'RSO' & ! Relaxed slab ocean + .or. trim(datamode) == 'SOM_AQUAP' & ! Aquaplanet slab ocean + ) then + if (exists1) then + if (my_task == master_task) write(logunit,F00) ' reading ',trim(rest_file) + call shr_pcdf_readwrite('read',SDOCN%pio_subsystem, SDOCN%io_type, & + trim(rest_file), mpicom, gsmap=gsmap, rf1=somtp, rf1n='somtp', io_format=SDOCN%io_format) + else + if (my_task == master_task) write(logunit,F00) ' file not found, skipping ',trim(rest_file) + endif endif if (exists) then @@ -563,6 +570,16 @@ subroutine docn_comp_run(EClock, x2o, o2x, & real(R8) :: dt ! timestep integer(IN) :: nu ! unit number real(R8) :: hn ! h field + ! fields for relaxed slab ocean mode + integer :: RSO_slab_option ! Option for setting RSO_X_cool + real(R8) :: RSO_bckgrd_sst ! background SST + real(R8) :: RSO_relax_tau ! relaxation timescale [sec] + real(R8) :: RSO_X_cool ! logistics function weight + real(R8) :: RSO_R_cool ! base cooling rate [K/s] + real(R8) :: RSO_Tdeep ! deep water temperature [K] + real(R8) :: RSO_dT_o ! scaling temperature gradient + real(R8) :: RSO_h_o ! scaling mixed layer depth + real(R8) :: u10 ! 10 m wind character(len=18) :: date_str character(len=CL) :: local_case_name real(R8), parameter :: & @@ -768,6 +785,69 @@ subroutine docn_comp_run(EClock, x2o, o2x, & enddo endif ! firstcall + ! Relaxed Slab Ocean based on Zarzycki(2016) + ! Zarzycki, C. M., 2016: Tropical Cyclone Intensity Errors Associated with Lack of Two-Way Ocean Coupling in High-Resolution Global Simulations. J. Climate, 29, 8589–8610. + ! https://journals.ametsoc.org/view/journals/clim/29/23/jcli-d-16-0273.1.xml + case('RSO') + lsize = mct_avect_lsize(o2x) + do n = 1,SDOCN%nstreams + call shr_dmodel_translateAV(SDOCN%avs(n),avstrm,avifld,avofld,rearr) + enddo + if (firstcall) then + do n = 1,lsize + if (.not. read_restart) then + somtp(n) = o2x%rAttr(kt,n) + TkFrz + endif + o2x%rAttr(kt,n) = somtp(n) + o2x%rAttr(kq,n) = 0.0_R8 + enddo + else ! firstcall + tfreeze = shr_frz_freezetemp(o2x%rAttr(ks,:)) + TkFrz + do n = 1,lsize + if (imask(n) /= 0) then + !******************************************************************* + hn = avstrm%rAttr(kh,n) + ! Get "background" temperature for relaxation + RSO_bckgrd_sst = avstrm%rAttr(kRSO_bckgrd_sst,n) + TkFrz + u10 = SQRT(x2o%rAttr(k10uu,n)) + !******************************************************************* + ! Set parameter values + RSO_slab_option = 0 ! Option for setting RSO_X_cool + RSO_relax_tau = 8.0*86400 ! relaxation timescale [sec] + RSO_R_cool = 11.75/86400 ! base cooling rate [K/s] + RSO_Tdeep = 271.00 ! deep water temperature [K] + RSO_dT_o = 27.0 ! scaling temperature gradient + RSO_h_o = 30.0 ! scaling mixed layer depth + !******************************************************************* + ! Calculate scaling function - see Eq 3 in Zarzycki (2016) + if (RSO_slab_option==0) RSO_X_cool = 1/(1+EXP(-0.5*(u10-30)) ) ! SLAB1 + if (RSO_slab_option==1) RSO_X_cool =(1/(1+EXP(-0.2*(u10-30)) ))*(u10*2.4/80) ! SLAB2 + if (RSO_slab_option==2) RSO_X_cool = 0.0 ! THERMO + !******************************************************************* + ! compute new ocean surface temperature + o2x%rAttr(kt,n) = somtp(n) & + ! Thermodynamic terms + +( x2o%rAttr(kswnet,n) & ! shortwave net + +x2o%rAttr(klwup ,n) & ! longwave up + +x2o%rAttr(klwdn ,n) & ! longwave down + +x2o%rAttr(ksen ,n) & ! sfc sensible heat flux + +x2o%rAttr(klat ,n) & ! sfc latent heat flux + -x2o%rAttr(ksnow ,n)*latice & ! latent heat from snow + -x2o%rAttr(krofi ,n)*latice & ! latent heat from runoff + ) * dt/(cpsw*rhosw*hn) & + - RSO_X_cool*RSO_R_cool*((somtp(n)-RSO_Tdeep)/RSO_dT_o)*(RSO_h_o/hn)*dt & ! Turb mixing + + (1/RSO_relax_tau)*(RSO_bckgrd_sst - somtp(n))*dt ! Newtonian Relaxation + !******************************************************************* + ! Ignore ice formed or melt potential + o2x%rAttr(kq,n) = 0.0 + ! Cap SSTs to freezing + o2x%rAttr(kt,n) = max( TkFrzSw, o2x%rAttr(kt,n) ) + ! Save temperature to send back to coupler + somtp(n) = o2x%rAttr(kt,n) + endif ! imask /= 0 + enddo ! lsize + endif ! firstcall + case('SOM_AQUAP') lsize = mct_avect_lsize(o2x) do n = 1,SDOCN%nstreams @@ -912,7 +992,10 @@ subroutine docn_comp_run(EClock, x2o, o2x, & close(nu) call shr_file_freeUnit(nu) endif - if (trim(datamode) == 'SOM' .or. trim(datamode) == 'SOM_AQUAP') then + if ( trim(datamode) == 'SOM' & ! Traditional slab ocean + .or. trim(datamode) == 'RSO' & ! Relaxed slab ocean + .or. trim(datamode) == 'SOM_AQUAP' & ! Aquaplanet slab ocean + ) then if (my_task == master_task) write(logunit,F04) ' writing ',trim(rest_file),target_ymd,target_tod call shr_pcdf_readwrite('write', SDOCN%pio_subsystem, SDOCN%io_type,& trim(rest_file), mpicom, gsmap, clobber=.true., rf1=somtp,rf1n='somtp') diff --git a/components/data_comps/docn/src/docn_shr_mod.F90 b/components/data_comps/docn/src/docn_shr_mod.F90 index cf59dbc7f62..e2ad86e1ac8 100644 --- a/components/data_comps/docn/src/docn_shr_mod.F90 +++ b/components/data_comps/docn/src/docn_shr_mod.F90 @@ -152,8 +152,9 @@ subroutine docn_shr_read_namelists(mpicom, my_task, master_task, & trim(datamode) == 'SST_AQUAP_CONSTANT' .or. & trim(datamode) == 'COPYALL' .or. & trim(datamode) == 'IAF' .or. & - trim(datamode) == 'SOM' .or. & - trim(datamode) == 'SOM_AQUAP') then + trim(datamode) == 'SOM' .or. & ! Traditional slab ocean + trim(datamode) == 'RSO' .or. & ! Relaxed slab ocean + trim(datamode) == 'SOM_AQUAP') then ! Aquaplanet slab ocean if (my_task == master_task) then write(logunit,F00) ' docn datamode = ',trim(datamode) end if @@ -181,9 +182,9 @@ subroutine docn_shr_read_namelists(mpicom, my_task, master_task, & ocn_prognostic = .true. ocnrof_prognostic = .true. endif - if (trim(datamode) == 'SOM' .or. trim(datamode) == 'SOM_AQUAP') then - ocn_prognostic = .true. - endif + if (trim(datamode) == 'SOM') ocn_prognostic = .true. ! Traditional slab ocean + if (trim(datamode) == 'RSO') ocn_prognostic = .true. ! Relaxed slab ocean + if (trim(datamode) == 'SOM_AQUAP') ocn_prognostic = .true. ! Aquaplanet slab ocean end subroutine docn_shr_read_namelists diff --git a/components/eam/cime_config/config_compsets.xml b/components/eam/cime_config/config_compsets.xml index 6b3c41321ee..f68d2f45e22 100644 --- a/components/eam/cime_config/config_compsets.xml +++ b/components/eam/cime_config/config_compsets.xml @@ -139,6 +139,15 @@ FAQP-MMF2 2000_EAM%AQP-MMF2_SLND_SICE_DOCN%AQP1_SROF_SGLC_SWAV + + + + + + + F2010-RSO + 2010_EAM%CMIP6_ELM%CNPRDCTCBCTOP_MPASSI%PRES_DOCN%RSO_MOSART_SGLC_SWAV + From 5a79da2ac2a1b89fed51cc7ec340215c908a63d7 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Tue, 17 Dec 2024 12:10:13 -0800 Subject: [PATCH 440/529] update RSO config and namelist variables --- .../cime_config/namelist_definition_docn.xml | 47 ++++++++++++++----- .../data_comps/docn/src/docn_comp_mod.F90 | 16 +++++-- .../data_comps/docn/src/docn_shr_mod.F90 | 9 +++- 3 files changed, 54 insertions(+), 18 deletions(-) diff --git a/components/data_comps/docn/cime_config/namelist_definition_docn.xml b/components/data_comps/docn/cime_config/namelist_definition_docn.xml index dc415e95970..fb28b7471c5 100644 --- a/components/data_comps/docn/cime_config/namelist_definition_docn.xml +++ b/components/data_comps/docn/cime_config/namelist_definition_docn.xml @@ -95,7 +95,7 @@ null $DIN_LOC_ROOT/ocn/docn7/AQUAPLANET/ $DIN_LOC_ROOT/ocn/docn7/SOM - $DIN_LOC_ROOT/ocn/docn7/RSO + / $DIN_LOC_ROOT/atm/cam/sst @@ -109,8 +109,7 @@ null $DOCN_AQP_FILENAME $DOCN_SOM_FILENAME - - pop_frc.1x1d.090130.nc + $SSTICE_GRID_FILENAME sst_HadOIBl_bc_1x1_1850_2014_c150416.nc @@ -150,7 +149,7 @@ null $DIN_LOC_ROOT/ocn/docn7/AQUAPLANET $DIN_LOC_ROOT/ocn/docn7/SOM - $DIN_LOC_ROOT/ocn/docn7/RSO + / $DIN_LOC_ROOT/atm/cam/sst @@ -164,8 +163,7 @@ null $DOCN_AQP_FILENAME $DOCN_SOM_FILENAME - - pop_frc.1x1d.090130.nc + $SSTICE_DATA_FILENAME sst_HadOIBl_bc_1x1_1850_2014_c150416.nc @@ -189,9 +187,9 @@ hblt h qdp qbot - - T t - hblt h + + SST_cpl t + hblt h SST_cpl t @@ -225,7 +223,7 @@ $SSTICE_YEAR_ALIGN 0 1 - 1 + $SSTICE_YEAR_ALIGN 1 @@ -240,7 +238,7 @@ $SSTICE_YEAR_START 0 1 - 1 + $SSTICE_YEAR_START 1850 @@ -255,7 +253,7 @@ $SSTICE_YEAR_END 0 1 - 1 + $SSTICE_YEAR_END 2014 @@ -678,4 +676,29 @@ + + real(30) + docn + docn_nml + + Relaxation timescale for relaxed slab ocean (RSO) mode + + + 691200 + + + + + real(30) + docn + docn_nml + + globally fixed mixed layer depth (MLD) for relaxed slab ocean (RSO) mode + use -1 to disable - input data file should have hblt field to override this + + + 50 + + + diff --git a/components/data_comps/docn/src/docn_comp_mod.F90 b/components/data_comps/docn/src/docn_comp_mod.F90 index 6f15381d2b7..fa3d684eca3 100644 --- a/components/data_comps/docn/src/docn_comp_mod.F90 +++ b/components/data_comps/docn/src/docn_comp_mod.F90 @@ -29,6 +29,8 @@ module docn_comp_mod use docn_shr_mod , only: rest_file ! namelist input use docn_shr_mod , only: rest_file_strm ! namelist input use docn_shr_mod , only: sst_constant_value ! namelist input + use docn_shr_mod , only: RSO_relax_tau ! namelist input for relaxed slab ocean (RSO) + use docn_shr_mod , only: RSO_fixed_MLD ! namelist input for relaxed slab ocean (RSO) use docn_shr_mod , only: nullstr #ifdef HAVE_MOAB @@ -569,16 +571,17 @@ subroutine docn_comp_run(EClock, x2o, o2x, & integer(IN) :: idt ! integer timestep real(R8) :: dt ! timestep integer(IN) :: nu ! unit number - real(R8) :: hn ! h field + real(R8) :: hn ! h field - mixed layer depth (MLD) ! fields for relaxed slab ocean mode integer :: RSO_slab_option ! Option for setting RSO_X_cool real(R8) :: RSO_bckgrd_sst ! background SST - real(R8) :: RSO_relax_tau ! relaxation timescale [sec] real(R8) :: RSO_X_cool ! logistics function weight real(R8) :: RSO_R_cool ! base cooling rate [K/s] real(R8) :: RSO_Tdeep ! deep water temperature [K] real(R8) :: RSO_dT_o ! scaling temperature gradient real(R8) :: RSO_h_o ! scaling mixed layer depth + ! real(R8) :: RSO_relax_tau ! relaxation timescale [sec] + ! real(R8) :: RSO_fixed_MLD ! globally fixed mixed layer depth (MLD) real(R8) :: u10 ! 10 m wind character(len=18) :: date_str character(len=CL) :: local_case_name @@ -806,14 +809,17 @@ subroutine docn_comp_run(EClock, x2o, o2x, & do n = 1,lsize if (imask(n) /= 0) then !******************************************************************* - hn = avstrm%rAttr(kh,n) + if (RSO_fixed_MLD>=0) then + hn = RSO_fixed_MLD + else + hn = avstrm%rAttr(kh,n) + endif ! Get "background" temperature for relaxation RSO_bckgrd_sst = avstrm%rAttr(kRSO_bckgrd_sst,n) + TkFrz u10 = SQRT(x2o%rAttr(k10uu,n)) !******************************************************************* - ! Set parameter values + ! RSO parameter values RSO_slab_option = 0 ! Option for setting RSO_X_cool - RSO_relax_tau = 8.0*86400 ! relaxation timescale [sec] RSO_R_cool = 11.75/86400 ! base cooling rate [K/s] RSO_Tdeep = 271.00 ! deep water temperature [K] RSO_dT_o = 27.0 ! scaling temperature gradient diff --git a/components/data_comps/docn/src/docn_shr_mod.F90 b/components/data_comps/docn/src/docn_shr_mod.F90 index e2ad86e1ac8..fef714c83b4 100644 --- a/components/data_comps/docn/src/docn_shr_mod.F90 +++ b/components/data_comps/docn/src/docn_shr_mod.F90 @@ -35,6 +35,8 @@ module docn_shr_mod character(CL) , public :: datamode ! mode integer(IN) , public :: aquap_option real(R8) , public :: sst_constant_value + real(R8) , public :: RSO_relax_tau ! relaxed slab ocean relaxation timescale [sec] + real(R8) , public :: RSO_fixed_MLD ! relaxed slab ocean globally fixed mixed layer depth (MLD) character(len=*), public, parameter :: nullstr = 'undefined' !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CONTAINS @@ -77,7 +79,8 @@ subroutine docn_shr_read_namelists(mpicom, my_task, master_task, & !----- define namelist ----- namelist / docn_nml / & - decomp, restfilm, restfils, force_prognostic_true, sst_constant_value + decomp, restfilm, restfils, force_prognostic_true, sst_constant_value, & + RSO_fixed_MLD, RSO_relax_tau !---------------------------------------------------------------------------- ! Determine input filenamname @@ -110,12 +113,16 @@ subroutine docn_shr_read_namelists(mpicom, my_task, master_task, & write(logunit,F00)' restfils = ',trim(restfils) write(logunit,F0L)' force_prognostic_true = ',force_prognostic_true write(logunit,*) ' sst_constant_value = ',sst_constant_value + write(logunit,*) ' RSO_fixed_MLD = ',RSO_fixed_MLD + write(logunit,*) ' RSO_relax_tau = ',RSO_relax_tau endif call shr_mpi_bcast(decomp ,mpicom,'decomp') call shr_mpi_bcast(restfilm,mpicom,'restfilm') call shr_mpi_bcast(restfils,mpicom,'restfils') call shr_mpi_bcast(force_prognostic_true,mpicom,'force_prognostic_true') call shr_mpi_bcast(sst_constant_value ,mpicom,'sst_constant_value') + call shr_mpi_bcast(RSO_fixed_MLD ,mpicom,'RSO_fixed_MLD') + call shr_mpi_bcast(RSO_relax_tau ,mpicom,'RSO_relax_tau') rest_file = trim(restfilm) rest_file_strm = trim(restfils) From dd0afd90a3bbd9b36332d9bc701f7759833ce81b Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Tue, 17 Dec 2024 12:57:14 -0800 Subject: [PATCH 441/529] refactor p3 cloud fraction flags --- .../physics/p3/eamxx_p3_process_interface.cpp | 9 +++- .../physics/p3/eamxx_p3_process_interface.hpp | 43 ++++++++++++------- 2 files changed, 36 insertions(+), 16 deletions(-) diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp index f6771d6bf17..9736d7ae598 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp @@ -275,9 +275,16 @@ void P3Microphysics::initialize_impl (const RunType /* run_type */) auto cld_frac_l = m_buffer.cld_frac_l; auto cld_frac_i = m_buffer.cld_frac_i; auto dz = m_buffer.dz; + auto set_cld_frac_l_to_one = m_params.get("set_cld_frac_l_to_one", false); + auto set_cld_frac_i_to_one = m_params.get("set_cld_frac_i_to_one", false); + auto set_cld_frac_r_to_one = m_params.get("set_cld_frac_r_to_one", false); // -- Set values for the pre-amble structure - p3_preproc.set_variables(m_num_cols,nk_pack,pmid,pmid_dry,pseudo_density,pseudo_density_dry, + p3_preproc.set_variables(m_num_cols,nk_pack, + set_cld_frac_l_to_one, + set_cld_frac_i_to_one, + set_cld_frac_r_to_one, + pmid,pmid_dry,pseudo_density,pseudo_density_dry, T_atm,cld_frac_t, qv, qc, nc, qr, nr, qi, qm, ni, bm, qv_prev, inv_exner, th_atm, cld_frac_l, cld_frac_i, cld_frac_r, dz); diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp index 7aedd97b5a8..d8016d9e4c3 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp @@ -105,23 +105,26 @@ class P3Microphysics : public AtmosphereProcess th_atm(icol,ipack) = PF::calculate_theta_from_T(T_atm_pack,pmid_pack); // Cloud fraction // Set minimum cloud fraction - avoids division by zero - cld_frac_l(icol,ipack) = ekat::max(cld_frac_t_pack,mincld); - cld_frac_i(icol,ipack) = ekat::max(cld_frac_t_pack,mincld); - cld_frac_r(icol,ipack) = ekat::max(cld_frac_t_pack,mincld); + // Alternatively set fraction to 1 everywhere to disable subgrid effects + cld_frac_l(icol,ipack) = m_set_cld_frac_l_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); + cld_frac_i(icol,ipack) = m_set_cld_frac_i_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); + cld_frac_r(icol,ipack) = m_set_cld_frac_r_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); // update rain cloud fraction given neighboring levels using max-overlap approach. - for (int ivec=0;iveccld_frac_r(icol,ipack)[ivec] ? - cld_frac_t(icol,ipack_m1)[ivec_m1] : - cld_frac_r(icol,ipack)[ivec]; + if ( !m_set_cld_frac_r_to_one ) { + for (int ivec=0;iveccld_frac_r(icol,ipack)[ivec] ? + cld_frac_t(icol,ipack_m1)[ivec_m1] : + cld_frac_r(icol,ipack)[ivec]; + } } } // @@ -129,6 +132,7 @@ class P3Microphysics : public AtmosphereProcess } // operator // Local variables int m_ncol, m_npack; + bool m_set_cld_frac_l_to_one, m_set_cld_frac_i_to_one, m_set_cld_frac_r_to_one; Real mincld = 0.0001; // TODO: These should be stored somewhere as more universal constants. Or maybe in the P3 class hpp view_2d_const pmid; view_2d_const pmid_dry; @@ -154,6 +158,9 @@ class P3Microphysics : public AtmosphereProcess view_2d dz; // Assigning local variables void set_variables(const int ncol, const int npack, + const bool set_cld_frac_l_to_one, + const bool set_cld_frac_i_to_one, + const bool set_cld_frac_r_to_one, const view_2d_const& pmid_, const view_2d_const& pmid_dry_, const view_2d_const& pseudo_density_, const view_2d_const& pseudo_density_dry_, const view_2d& T_atm_, @@ -166,6 +173,9 @@ class P3Microphysics : public AtmosphereProcess { m_ncol = ncol; m_npack = npack; + m_set_cld_frac_l_to_one = set_cld_frac_l_to_one; + m_set_cld_frac_i_to_one = set_cld_frac_i_to_one; + m_set_cld_frac_r_to_one = set_cld_frac_r_to_one; // IN pmid = pmid_; pmid_dry = pmid_dry_; @@ -262,6 +272,9 @@ class P3Microphysics : public AtmosphereProcess } // operator // Local variables int m_ncol, m_npack; + bool m_set_cld_frac_l_to_one; + bool m_set_cld_frac_i_to_one; + bool m_set_cld_frac_r_to_one; double m_dt; view_2d T_atm; view_2d_const pmid; From 2b04f9281e682226c1727bd1bfe9db6fcc29136d Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Tue, 17 Dec 2024 15:53:26 -0600 Subject: [PATCH 442/529] Move runningMeanRemovedIceRunoff from restart_contents to streams --- components/mpas-seaice/src/Registry.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/mpas-seaice/src/Registry.xml b/components/mpas-seaice/src/Registry.xml index d7b198b7574..26559e4aa49 100644 --- a/components/mpas-seaice/src/Registry.xml +++ b/components/mpas-seaice/src/Registry.xml @@ -2106,7 +2106,6 @@ - + + Date: Tue, 17 Dec 2024 14:15:48 -0800 Subject: [PATCH 443/529] remove old method --- components/eamxx/src/physics/p3/eamxx_p3_run.cpp | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp index 1e3218d7e4a..3de8184319a 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_run.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_run.cpp @@ -15,20 +15,6 @@ void P3Microphysics::run_impl (const double dt) ); // Kokkos::parallel_for(p3_main_local_vals) Kokkos::fence(); - // allow namelist flags to override sub-grid cloud fraction (set it to 1 everywhere) - if (m_params.get("set_cld_frac_l_to_one", false)) { - auto& cld_frac_l = p3_preproc.cld_frac_l; - Kokkos::deep_copy(cld_frac_l,1.0); - } - if (m_params.get("set_cld_frac_r_to_one", false)) { - auto& cld_frac_r = p3_preproc.cld_frac_r; - Kokkos::deep_copy(cld_frac_r,1.0); - } - if (m_params.get("set_cld_frac_i_to_one", false)) { - auto& cld_frac_i = p3_preproc.cld_frac_i; - Kokkos::deep_copy(cld_frac_i,1.0); - } - // Update the variables in the p3 input structures with local values. infrastructure.dt = dt; From e4eda03c324967fd442075e6cfe2abaccda011c0 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 18 Dec 2024 12:54:18 -0700 Subject: [PATCH 444/529] add refs for data model documentation --- docs/refs/eam.bib | 61 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/docs/refs/eam.bib b/docs/refs/eam.bib index c8b8ffded40..53f2ab7fee8 100644 --- a/docs/refs/eam.bib +++ b/docs/refs/eam.bib @@ -1101,3 +1101,64 @@ @article{holtslag_preface_2006 journal = {Boundary-Layer Meterology}, year = {2006}, } + +@article{blackburn_APE_context_2013, + title = {Context and {Aims} of the {Aqua}-{Planet} {Experiment}}, + volume = {91A}, + issn = {2186-9057}, + doi = {10.2151/jmsj.2013-A01}, + journal = {Journal of the Meteorological Society of Japan. Ser. II}, + author = {BLACKBURN, Michael and HOSKINS, Brian J.}, + month = oct, + year = {2013}, + keywords = {precipitation, circulation models, comparison of atmospheric general, gcms, intertropical convergence zone, itcz, modelling hierarchy, tropical circulation}, + pages = {1--15}, +} + +@article{wing_rcemip1_2018, + title = {Radiative–convective equilibrium model intercomparison project}, + volume = {11}, + issn = {1991-959X}, + doi = {10.5194/gmd-11-793-2018}, + abstract = {RCEMIP, an intercomparison of multiple types of models configured in radiative–convective equilibrium (RCE), is proposed. RCE is an idealization of the climate system in which there is a balance between radiative cooling of the atmosphere and heating by convection. The scientific objectives of RCEMIP are three-fold. First, clouds and climate sensitivity will be investigated in the RCE setting. This includes determining how cloud fraction changes with warming and the role of self-aggregation of convection in climate sensitivity. Second, RCEMIP will quantify the dependence of the degree of convective aggregation and tropical circulation regimes on temperature. Finally, by providing a common baseline, RCEMIP will allow the robustness of the RCE state across the spectrum of models to be assessed, which is essential for interpreting the results found regarding clouds, climate sensitivity, and aggregation, and more generally, determining which features of tropical climate a RCE framework is useful for. A novel aspect and major advantage of RCEMIP is the accessibility of the RCE framework to a variety of models, including cloud-resolving models, general circulation models, global cloud-resolving models, single-column models, and large-eddy simulation models.}, + language = {English}, + number = {2}, + journal = {Geoscientific Model Development}, + author = {Wing, Allison A. and Reed, Kevin A. and Satoh, Masaki and Stevens, Bjorn and Bony, Sandrine and Ohno, Tomoki}, + month = mar, + year = {2018}, + note = {Publisher: Copernicus GmbH}, + pages = {793--813}, + file = {Full Text PDF:/Users/hannah6/Zotero/storage/KHKQVU33/Wing et al. - 2018 - Radiative–convective equilibrium model intercomparison project.pdf:application/pdf}, +} + +@article{wing_rcemip2_2024, + title = {{RCEMIP}-{II}: mock-{Walker} simulations as phase {II} of the radiative–convective equilibrium model intercomparison project}, + volume = {17}, + issn = {1991-959X}, + shorttitle = {{RCEMIP}-{II}}, + doi = {10.5194/gmd-17-6195-2024}, + abstract = {The radiative–convective equilibrium (RCE) model intercomparison project (RCEMIP) leveraged the simplicity of RCE to focus attention on moist convective processes and their interactions with radiation and circulation across a wide range of model types including cloud-resolving models (CRMs), general circulation models (GCMs), single-column models, global cloud-resolving models, and large-eddy simulations. While several robust results emerged across the spectrum of models that participated in the first phase of RCEMIP (RCEMIP-I), two points that stand out are (1) the strikingly large diversity in simulated climate states and (2) the strong imprint of convective self-aggregation on the climate state. However, the lack of consensus in the structure of self-aggregation and its response to warming is a barrier to understanding. Gaining a deeper understanding of convective aggregation and tropical climate will require reducing the degrees of freedom with which convection can vary. Therefore, we propose phase II of RCEMIP (RCEMIP-II) that utilizes a prescribed sinusoidal sea surface temperature (SST) pattern to provide a constraint on the structure of convection and move one critical step up the model hierarchy. This so-called “mock-Walker” configuration generates features that resemble observed tropical circulations. The specification of the mock-Walker protocol for RCEMIP-II is described, along with example results from one CRM and one GCM. RCEMIP-II will consist of five required simulations: three simulations with the same three mean SSTs as in RCEMIP-I but with an SST gradient and two additional simulations at one of the mean SSTs with different values of the SST gradients. We also test the sensitivity to the imposed SST gradient and the domain size. Under weak SST gradients, unforced self-aggregation emerges across the entire domain, similar to what was found in RCEMIP. As the SST gradient increases, the convective region narrows and is more confined to the warmest SSTs. At warmer mean SSTs and stronger SST gradients, low-frequency variability in the convective aggregation emerges, suggesting that simulations of at least 200 d may be needed to achieve robust equilibrium statistics in this configuration. Simulations with different domain sizes generally have similar mean statistics and convective structures, depending on the value of the SST gradient. The prescribed SST boundary condition is the only difference in the set-up between RCEMIP-II and RCEMIP-I, which enables comparison between the two; however, we also welcome participation in RCEMIP-II from models that did not participate in RCEMIP-I.}, + language = {English}, + number = {16}, + journal = {Geoscientific Model Development}, + author = {Wing, Allison A. and Silvers, Levi G. and Reed, Kevin A.}, + month = aug, + year = {2024}, + note = {Publisher: Copernicus GmbH}, + pages = {6195--6225}, + file = {Full Text PDF:/Users/hannah6/Zotero/storage/IY2SP66J/Wing et al. - 2024 - RCEMIP-II mock-Walker simulations as phase II of the radiative–convective equilibrium model interco.pdf:application/pdf}, +} + +@article { Zarzycki_TC-ocn-cpl_2016, + author = "Colin M. Zarzycki", + title = "Tropical Cyclone Intensity Errors Associated with Lack of Two-Way Ocean Coupling in High-Resolution Global Simulations", + journal = "Journal of Climate", + year = "2016", + publisher = "American Meteorological Society", + address = "Boston MA, USA", + volume = "29", + number = "23", + doi = "10.1175/JCLI-D-16-0273.1", + pages = "8589 - 8610", +} From 6ba55b7cfb98e2b2bf66a934a0053f5f304fc24e Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 18 Dec 2024 12:58:12 -0700 Subject: [PATCH 445/529] add data model documentation --- components/data_comps/docs/index.md | 13 ++++ .../docs/user-guide/data-atmos-main.md | 4 ++ .../docs/user-guide/data-land-main.md | 4 ++ .../docs/user-guide/data-ocean-RSO.md | 24 ++++++++ .../docs/user-guide/data-ocean-SOM.md | 5 ++ .../docs/user-guide/data-ocean-amip.md | 17 ++++++ .../docs/user-guide/data-ocean-idealized.md | 60 +++++++++++++++++++ .../docs/user-guide/data-ocean-main.md | 10 ++++ components/data_comps/mkdocs.yml | 7 +++ docs/index.md | 1 + 10 files changed, 145 insertions(+) create mode 100644 components/data_comps/docs/index.md create mode 100644 components/data_comps/docs/user-guide/data-atmos-main.md create mode 100644 components/data_comps/docs/user-guide/data-land-main.md create mode 100644 components/data_comps/docs/user-guide/data-ocean-RSO.md create mode 100644 components/data_comps/docs/user-guide/data-ocean-SOM.md create mode 100644 components/data_comps/docs/user-guide/data-ocean-amip.md create mode 100644 components/data_comps/docs/user-guide/data-ocean-idealized.md create mode 100644 components/data_comps/docs/user-guide/data-ocean-main.md create mode 100644 components/data_comps/mkdocs.yml diff --git a/components/data_comps/docs/index.md b/components/data_comps/docs/index.md new file mode 100644 index 00000000000..76d7b746a55 --- /dev/null +++ b/components/data_comps/docs/index.md @@ -0,0 +1,13 @@ +# Data Models + +The E3SM data models are key components to support many different scenarios: + +- AMIP style experiments with observed sea surface temperatures +- component model spin-up, such as land forced by atmospheric reanalysis +- idealized experiments, such as aquaplanet or radiative-convective equilibrium + +More details can be found for each component below. + +* [Data Atmosphere](user-guide/data-atmos-main.md) +* [Data Land](user-guide/data-land-main.md) +* [Data Ocean](user-guide/data-ocean-main.md) diff --git a/components/data_comps/docs/user-guide/data-atmos-main.md b/components/data_comps/docs/user-guide/data-atmos-main.md new file mode 100644 index 00000000000..d74710598ee --- /dev/null +++ b/components/data_comps/docs/user-guide/data-atmos-main.md @@ -0,0 +1,4 @@ +# The E3SM Data Atmosphere Model + +!!!WARNING + This page is still under construction diff --git a/components/data_comps/docs/user-guide/data-land-main.md b/components/data_comps/docs/user-guide/data-land-main.md new file mode 100644 index 00000000000..3b07f59793e --- /dev/null +++ b/components/data_comps/docs/user-guide/data-land-main.md @@ -0,0 +1,4 @@ +# The E3SM Data Land Model + +!!!WARNING + This page is still under construction diff --git a/components/data_comps/docs/user-guide/data-ocean-RSO.md b/components/data_comps/docs/user-guide/data-ocean-RSO.md new file mode 100644 index 00000000000..4c2393609c1 --- /dev/null +++ b/components/data_comps/docs/user-guide/data-ocean-RSO.md @@ -0,0 +1,24 @@ +# Data Ocean - Relaxed Slab Ocean (RSO) + +The relaxed slab ocean (RSO) is similar in many ways to the [traditional slab ocean model](data-ocean-SOM.md), but uses a specified relaxation time scale to avoid the need for specified "Q-flux" data to represent the effects of ocean transport. The RSO implementation in E3SM was inspired by Zarzycki (2016)[@Zarzycki_TC-ocn-cpl_2016]. + +A key consideration for the user is whether they need to use a realistic distribution of mixed layer depths (MLD), or whether their use case can benefit from the simplicity of a globally uniform MLD. + +The RSO mode has the following namelist variables to influence the ocean behavior: + +``` +RSO_relax_tau SST relaxation timescale +RSO_fixed_MLD globally uniform MLD value (use -1 for realistic MLD) +``` + +Other RSO parameter values are hardcoded in `components/data_comps/docn/src/docn_comp_mod.F90`. + +``` +RSO_slab_option = 0 ! Option for setting RSO_X_cool +RSO_R_cool = 11.75/86400 ! base cooling rate [K/s] +RSO_Tdeep = 271.00 ! deep water temperature [K] +RSO_dT_o = 27.0 ! scaling temperature gradient +RSO_h_o = 30.0 ! scaling mixed layer depth +``` + +The RSO mode uses the `SSTICE_DATA_FILENAME` in `env_run.xml` for its data stream. For a globally uniform MLD this file only need to contain a `SST_cpl` variable for the SST that will act as the target SST value for relaxation. If a realistic MLD pattern is desired then the `hblt` variable must also be present. This data can be derived a number of ways, but we currently do not have a dedicated tool or workflow. diff --git a/components/data_comps/docs/user-guide/data-ocean-SOM.md b/components/data_comps/docs/user-guide/data-ocean-SOM.md new file mode 100644 index 00000000000..f22f3486ba7 --- /dev/null +++ b/components/data_comps/docs/user-guide/data-ocean-SOM.md @@ -0,0 +1,5 @@ +# Data Ocean - Traditional Slab Ocean Model (SOM) + +A slab ocean model (SOM) allows responsive SSTs to address the "infinite heat source" problem associated with prescribed SSTs, but is much cheaper than running with a full ocean model. The traditional SOM appraoch requires special inputs, such as a specified mixed layer depth pattern that can vary in time and a prescribed heat flux to account for the missing effects of ocean dynamics often referred to as "Q-flux". The Q-flux data is often estimated from a fully coupled simulation with active ocean and sea-ice so that the SOM simulation will resemble the full model. + +Currently, we do not have Q-flux data to drive the SOM in E3SM. An alternative appraoch is to use a "relaxed" slab ocean (RSO) in which a specified relaxation time scale is used to bring the SST field back to a target SST field. The RSO mode is much simpler to use, but carries caveats that the user should be aware of before using. See [Data Ocean - Relaxed Slab Ocean](data-ocean-RSO.md) for more information. diff --git a/components/data_comps/docs/user-guide/data-ocean-amip.md b/components/data_comps/docs/user-guide/data-ocean-amip.md new file mode 100644 index 00000000000..dd1036a9ff4 --- /dev/null +++ b/components/data_comps/docs/user-guide/data-ocean-amip.md @@ -0,0 +1,17 @@ +# Data Ocean - SST from Observations + +Using SST data derived from observations is the most common use of the data ocean model, often for AMIP style experiments to reproduce historical periods. + +Example compsets that use this capability are `F2010` and `F20TR`. These compsets use the `_DOCN%DOM_` compset modifier, which sets the `DOCN_MODE` variable in `env_run.xml` to "prescribed". + +Several additional XML variables need to be set in order to use this capability, which are set to defaults for common configurations, such as `F2010` at `ne30pg2` atmospheric resolution. + +``` +SSTICE_DATA_FILENAME Prescribed SST and ice coverage data file name +SSTICE_GRID_FILENAME Grid file in "domain" format corresponding to SSTICE_DATA_FILENAME +SSTICE_YEAR_ALIGN The model year that corresponds to SSTICE_YEAR_START on the data file +SSTICE_YEAR_START The first year of data to use from SSTICE_DATA_FILENAME +SSTICE_YEAR_END The last year of data to use from SSTICE_DATA_FILENAME +``` + +Most users will not need to edit these values from their defaults, but many scenarios require non-standard SST data, such as tropical cyclone hindcasts where the daily evolution of high-resolution SST data may be desireable. \ No newline at end of file diff --git a/components/data_comps/docs/user-guide/data-ocean-idealized.md b/components/data_comps/docs/user-guide/data-ocean-idealized.md new file mode 100644 index 00000000000..e2f95446ac0 --- /dev/null +++ b/components/data_comps/docs/user-guide/data-ocean-idealized.md @@ -0,0 +1,60 @@ +# Data Ocean - Idealized + +The two main uses of idealized SST modes are aquaplanet (AQP) and radiative-convective equilibrium (RCE). The latter is just a special case of an aquaplanet where the SST is [usually] a constant value everywhere, traditionally used in conjunction with special modifications to homogenize radiation and disable rotation. There are several analytically specified SST patterns established by model intercomparison projects such as the Aqua-Planet Experiment (APE)[@blackburn_APE_context_2013] and RCEMIP[@wing_rcemip1_2018,@wing_rcemip2_2024]. + +## Idealized SST compsets + +The following list shows the currently defined E3SM compsets that utilize idealized SST. + +``` +FAQP +FAQP-MMF1 +FAQP-MMF2 +F-SCREAM-LR-AQP1 +F-SCREAM-HR-AQP1 +FRCE +FRCE-MMF1 +FRCE-MMF2 +FRCE-MW_295dT1p25 +FRCE-MW_300dT0p625 +FRCE-MW_300dT1p25 +FRCE-MW_300dT2p5 +FRCE-MW_305dT1p25 +FRCE-MW-MMF1_295dT1p25 +FRCE-MW-MMF1_300dT0p625 +FRCE-MW-MMF1_300dT1p25 +FRCE-MW-MMF1_300dT2p5 +FRCE-MW-MMF1_305dT1p25 +``` + +These all use "analytic" SST patterns that are specified via the `docn_comp_run()` subroutine in `components/data_comps/docn/src/docn_comp_mod.F90`. The `AQP` compsets currently only use the basic aquaplanet pattern that is symmetric about the equator. Other APE patterns introduce different meridional gradients and/or asymmetries. The various analytic SST patterns can be selected by changing the data ocean specifier: `_DOCN%AQP1_`. + +The first 10 analytic aquaplanet SST patterns correspond to the aqua-planet experiment (APE) protocol as follows + +``` +AQP1 = control symmetric SST pattern +AQP2 = Flat +AQP3 = Qobs = average of AQP1 and AQP2 +AQP4 = Peaked +AQP5 = Control+5N +AQP6 = 1KEQ - small warm pool +AQP7 = 3KEQ - small warm pool +AQP8 = 3KW1 - large warm pool +AQP9 = Control+10N +AQP10 = Control+15N +``` + +!!!NOTE + When using aquaplanet mode the orbital parameters will take on the idealized values shown below such that there are no seasonal variations, but there is still a diurnal cycle. + ``` + orb_eccen = 0 + orb_obliq = 0 + orb_mvelp = 0 + orb_mode = "fixed_parameters" + ``` + +The basic RCE compsets use the `_DOCN%AQPCONST_` modifier to produce a globally constant SST value, which is set by the `DOCN_AQPCONST_VALUE` variable in `env_run.xml`. The "FRCE-MW" compsets were designed for RCEMIP-II to produce a "mock walker-cell" configuration, in which sinusoidal SST variations are applied to promote a coherent large-scale circulation. + +## SST Data File + +In addition to the analytic SST modes the user can also specify an idealized aquaplanet SST pattern via the `_DOCN%AQPFILE_` option. The `aquapfile` namelist variable is used to specify the SST pattern in this mode. Note that this option has not been used or tested recently, so the user may experience difficulty trying to use this feature. diff --git a/components/data_comps/docs/user-guide/data-ocean-main.md b/components/data_comps/docs/user-guide/data-ocean-main.md new file mode 100644 index 00000000000..db93833d237 --- /dev/null +++ b/components/data_comps/docs/user-guide/data-ocean-main.md @@ -0,0 +1,10 @@ +# The E3SM Data Ocean Model + +The E3SM data ocean has several different modes to support various realistic and idealized experiments. Sea surface temperatures (SST) can be either prescribed or prognostic. Prescribed SSTs are specified either through a data stream or analytically. Prognostic modes allow the SST field to evolve and respond to atmospheric conditions. The guides below provide more details on how to use these capabilities. + +* Prescribed + * [SST from Observations](data-ocean-amip.md) + * [Idealized SST](data-ocean-idealized.md) +* Prognostic + * [Traditional Slab Ocean Model (SOM)](data-ocean-SOM.md) + * [Relaxed Slab Ocean (RSO)](data-ocean-RSO.md) \ No newline at end of file diff --git a/components/data_comps/mkdocs.yml b/components/data_comps/mkdocs.yml new file mode 100644 index 00000000000..226144e6bb8 --- /dev/null +++ b/components/data_comps/mkdocs.yml @@ -0,0 +1,7 @@ +site_name: Data-Models + +nav: + - Introduction: 'index.md' + - Atmosphere: user-guide/data-atmos-main.md + - Land: user-guide/data-land-main.md + - Ocean: user-guide/data-ocean-main.md diff --git a/docs/index.md b/docs/index.md index 4d979cf0afe..6a30bcf5545 100644 --- a/docs/index.md +++ b/docs/index.md @@ -24,6 +24,7 @@ research problems and Department of Energy mission needs while efficiently using - [MPAS-Ocean](./MPAS-Ocean/index.md) - [MPAS-seaice](./MPAS-seaice/index.md) - [Omega](https://docs.e3sm.org/Omega/omega/) — not yet supported. +- [Data Models](./Data-Models/index.md) ## Tools From c9c835b66850bd8c1c34d3945b2427286104c6ba Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 18 Dec 2024 13:06:07 -0700 Subject: [PATCH 446/529] linter fixes --- components/data_comps/docs/index.md | 6 +++--- .../data_comps/docs/user-guide/data-ocean-RSO.md | 4 ++-- .../data_comps/docs/user-guide/data-ocean-amip.md | 4 ++-- .../docs/user-guide/data-ocean-idealized.md | 8 ++++---- .../data_comps/docs/user-guide/data-ocean-main.md | 12 ++++++------ 5 files changed, 17 insertions(+), 17 deletions(-) diff --git a/components/data_comps/docs/index.md b/components/data_comps/docs/index.md index 76d7b746a55..c75eee169a5 100644 --- a/components/data_comps/docs/index.md +++ b/components/data_comps/docs/index.md @@ -8,6 +8,6 @@ The E3SM data models are key components to support many different scenarios: More details can be found for each component below. -* [Data Atmosphere](user-guide/data-atmos-main.md) -* [Data Land](user-guide/data-land-main.md) -* [Data Ocean](user-guide/data-ocean-main.md) +- [Data Atmosphere](user-guide/data-atmos-main.md) +- [Data Land](user-guide/data-land-main.md) +- [Data Ocean](user-guide/data-ocean-main.md) diff --git a/components/data_comps/docs/user-guide/data-ocean-RSO.md b/components/data_comps/docs/user-guide/data-ocean-RSO.md index 4c2393609c1..5107c261411 100644 --- a/components/data_comps/docs/user-guide/data-ocean-RSO.md +++ b/components/data_comps/docs/user-guide/data-ocean-RSO.md @@ -6,14 +6,14 @@ A key consideration for the user is whether they need to use a realistic distrib The RSO mode has the following namelist variables to influence the ocean behavior: -``` +```text RSO_relax_tau SST relaxation timescale RSO_fixed_MLD globally uniform MLD value (use -1 for realistic MLD) ``` Other RSO parameter values are hardcoded in `components/data_comps/docn/src/docn_comp_mod.F90`. -``` +```text RSO_slab_option = 0 ! Option for setting RSO_X_cool RSO_R_cool = 11.75/86400 ! base cooling rate [K/s] RSO_Tdeep = 271.00 ! deep water temperature [K] diff --git a/components/data_comps/docs/user-guide/data-ocean-amip.md b/components/data_comps/docs/user-guide/data-ocean-amip.md index dd1036a9ff4..b97cc2dcbb0 100644 --- a/components/data_comps/docs/user-guide/data-ocean-amip.md +++ b/components/data_comps/docs/user-guide/data-ocean-amip.md @@ -6,7 +6,7 @@ Example compsets that use this capability are `F2010` and `F20TR`. These compset Several additional XML variables need to be set in order to use this capability, which are set to defaults for common configurations, such as `F2010` at `ne30pg2` atmospheric resolution. -``` +```text SSTICE_DATA_FILENAME Prescribed SST and ice coverage data file name SSTICE_GRID_FILENAME Grid file in "domain" format corresponding to SSTICE_DATA_FILENAME SSTICE_YEAR_ALIGN The model year that corresponds to SSTICE_YEAR_START on the data file @@ -14,4 +14,4 @@ SSTICE_YEAR_START The first year of data to use from SSTICE_DATA_FILENAME SSTICE_YEAR_END The last year of data to use from SSTICE_DATA_FILENAME ``` -Most users will not need to edit these values from their defaults, but many scenarios require non-standard SST data, such as tropical cyclone hindcasts where the daily evolution of high-resolution SST data may be desireable. \ No newline at end of file +Most users will not need to edit these values from their defaults, but many scenarios require non-standard SST data, such as tropical cyclone hindcasts where the daily evolution of high-resolution SST data may be desireable. diff --git a/components/data_comps/docs/user-guide/data-ocean-idealized.md b/components/data_comps/docs/user-guide/data-ocean-idealized.md index e2f95446ac0..ea980589479 100644 --- a/components/data_comps/docs/user-guide/data-ocean-idealized.md +++ b/components/data_comps/docs/user-guide/data-ocean-idealized.md @@ -6,7 +6,7 @@ The two main uses of idealized SST modes are aquaplanet (AQP) and radiative-conv The following list shows the currently defined E3SM compsets that utilize idealized SST. -``` +```text FAQP FAQP-MMF1 FAQP-MMF2 @@ -27,11 +27,11 @@ FRCE-MW-MMF1_300dT2p5 FRCE-MW-MMF1_305dT1p25 ``` -These all use "analytic" SST patterns that are specified via the `docn_comp_run()` subroutine in `components/data_comps/docn/src/docn_comp_mod.F90`. The `AQP` compsets currently only use the basic aquaplanet pattern that is symmetric about the equator. Other APE patterns introduce different meridional gradients and/or asymmetries. The various analytic SST patterns can be selected by changing the data ocean specifier: `_DOCN%AQP1_`. +These all use "analytic" SST patterns that are specified via the `docn_comp_run()` subroutine in `components/data_comps/docn/src/docn_comp_mod.F90`. The `AQP` compsets currently only use the basic aquaplanet pattern that is symmetric about the equator. Other APE patterns introduce different meridional gradients and/or asymmetries. The various analytic SST patterns can be selected by changing the data ocean specifier: `_DOCN%AQP1_`. The first 10 analytic aquaplanet SST patterns correspond to the aqua-planet experiment (APE) protocol as follows -``` +```text AQP1 = control symmetric SST pattern AQP2 = Flat AQP3 = Qobs = average of AQP1 and AQP2 @@ -46,7 +46,7 @@ AQP10 = Control+15N !!!NOTE When using aquaplanet mode the orbital parameters will take on the idealized values shown below such that there are no seasonal variations, but there is still a diurnal cycle. - ``` + ```text orb_eccen = 0 orb_obliq = 0 orb_mvelp = 0 diff --git a/components/data_comps/docs/user-guide/data-ocean-main.md b/components/data_comps/docs/user-guide/data-ocean-main.md index db93833d237..e6312116ebc 100644 --- a/components/data_comps/docs/user-guide/data-ocean-main.md +++ b/components/data_comps/docs/user-guide/data-ocean-main.md @@ -2,9 +2,9 @@ The E3SM data ocean has several different modes to support various realistic and idealized experiments. Sea surface temperatures (SST) can be either prescribed or prognostic. Prescribed SSTs are specified either through a data stream or analytically. Prognostic modes allow the SST field to evolve and respond to atmospheric conditions. The guides below provide more details on how to use these capabilities. -* Prescribed - * [SST from Observations](data-ocean-amip.md) - * [Idealized SST](data-ocean-idealized.md) -* Prognostic - * [Traditional Slab Ocean Model (SOM)](data-ocean-SOM.md) - * [Relaxed Slab Ocean (RSO)](data-ocean-RSO.md) \ No newline at end of file +- Prescribed + - [SST from Observations](data-ocean-amip.md) + - [Idealized SST](data-ocean-idealized.md) +- Prognostic + - [Traditional Slab Ocean Model (SOM)](data-ocean-SOM.md) + - [Relaxed Slab Ocean (RSO)](data-ocean-RSO.md) From b04c17fec172e595cb8829120fc492b80fd86a1a Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Thu, 19 Dec 2024 08:30:27 -0700 Subject: [PATCH 447/529] delete bibtex abstracts --- docs/refs/eam.bib | 2 -- 1 file changed, 2 deletions(-) diff --git a/docs/refs/eam.bib b/docs/refs/eam.bib index 53f2ab7fee8..84bdd2499ce 100644 --- a/docs/refs/eam.bib +++ b/docs/refs/eam.bib @@ -1120,7 +1120,6 @@ @article{wing_rcemip1_2018 volume = {11}, issn = {1991-959X}, doi = {10.5194/gmd-11-793-2018}, - abstract = {RCEMIP, an intercomparison of multiple types of models configured in radiative–convective equilibrium (RCE), is proposed. RCE is an idealization of the climate system in which there is a balance between radiative cooling of the atmosphere and heating by convection. The scientific objectives of RCEMIP are three-fold. First, clouds and climate sensitivity will be investigated in the RCE setting. This includes determining how cloud fraction changes with warming and the role of self-aggregation of convection in climate sensitivity. Second, RCEMIP will quantify the dependence of the degree of convective aggregation and tropical circulation regimes on temperature. Finally, by providing a common baseline, RCEMIP will allow the robustness of the RCE state across the spectrum of models to be assessed, which is essential for interpreting the results found regarding clouds, climate sensitivity, and aggregation, and more generally, determining which features of tropical climate a RCE framework is useful for. A novel aspect and major advantage of RCEMIP is the accessibility of the RCE framework to a variety of models, including cloud-resolving models, general circulation models, global cloud-resolving models, single-column models, and large-eddy simulation models.}, language = {English}, number = {2}, journal = {Geoscientific Model Development}, @@ -1138,7 +1137,6 @@ @article{wing_rcemip2_2024 issn = {1991-959X}, shorttitle = {{RCEMIP}-{II}}, doi = {10.5194/gmd-17-6195-2024}, - abstract = {The radiative–convective equilibrium (RCE) model intercomparison project (RCEMIP) leveraged the simplicity of RCE to focus attention on moist convective processes and their interactions with radiation and circulation across a wide range of model types including cloud-resolving models (CRMs), general circulation models (GCMs), single-column models, global cloud-resolving models, and large-eddy simulations. While several robust results emerged across the spectrum of models that participated in the first phase of RCEMIP (RCEMIP-I), two points that stand out are (1) the strikingly large diversity in simulated climate states and (2) the strong imprint of convective self-aggregation on the climate state. However, the lack of consensus in the structure of self-aggregation and its response to warming is a barrier to understanding. Gaining a deeper understanding of convective aggregation and tropical climate will require reducing the degrees of freedom with which convection can vary. Therefore, we propose phase II of RCEMIP (RCEMIP-II) that utilizes a prescribed sinusoidal sea surface temperature (SST) pattern to provide a constraint on the structure of convection and move one critical step up the model hierarchy. This so-called “mock-Walker” configuration generates features that resemble observed tropical circulations. The specification of the mock-Walker protocol for RCEMIP-II is described, along with example results from one CRM and one GCM. RCEMIP-II will consist of five required simulations: three simulations with the same three mean SSTs as in RCEMIP-I but with an SST gradient and two additional simulations at one of the mean SSTs with different values of the SST gradients. We also test the sensitivity to the imposed SST gradient and the domain size. Under weak SST gradients, unforced self-aggregation emerges across the entire domain, similar to what was found in RCEMIP. As the SST gradient increases, the convective region narrows and is more confined to the warmest SSTs. At warmer mean SSTs and stronger SST gradients, low-frequency variability in the convective aggregation emerges, suggesting that simulations of at least 200 d may be needed to achieve robust equilibrium statistics in this configuration. Simulations with different domain sizes generally have similar mean statistics and convective structures, depending on the value of the SST gradient. The prescribed SST boundary condition is the only difference in the set-up between RCEMIP-II and RCEMIP-I, which enables comparison between the two; however, we also welcome participation in RCEMIP-II from models that did not participate in RCEMIP-I.}, language = {English}, number = {16}, journal = {Geoscientific Model Development}, From 995d87a2589a87db7917a6ec2c5c1a481d01ddf2 Mon Sep 17 00:00:00 2001 From: Carolyn Begeman Date: Tue, 17 Sep 2024 11:12:25 -0500 Subject: [PATCH 448/529] Add del2,del4 source terms to manufactured soln --- .../src/shared/mpas_ocn_manufactured_solution.F | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F index 742a2e51f74..9157200ede7 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F @@ -58,6 +58,7 @@ module ocn_manufactured_solution real (kind=RKIND) :: kx, ky real (kind=RKIND) :: ang_freq real (kind=RKIND) :: eta0 + real (kind=RKIND) :: viscDel2, viscDel4 real (kind=RKIND) :: H0 !*********************************************************************** @@ -201,6 +202,19 @@ subroutine ocn_manufactured_solution_tend_vel(forcingPool, tend, err)!{{{ + ang_freq*sin(phase) & - 0.5_RKIND*eta0*(kx + ky)*sin(2.0_RKIND*(phase))) + if (.not. config_disable_vel_hmix) then + if (config_use_mom_del2) then + viscDel2 = config_mom_del2 + u = u + viscDel2 * eta0 * kx**2 * cos(phase) + v = v + viscDel2 * eta0 * ky**2 * cos(phase) + endif + if (config_use_mom_del4) then + viscDel4 = config_mom_del4 + u = u - viscDel4 * eta0 * (kx**4 * cos(phase) + kx**2 * ky**2 * cos(phase)) + v = v - viscDel4 * eta0 * (ky**4 * cos(phase) + kx**2 * ky**2 * cos(phase)) + endif + endif + tend(k,iEdge) = tend(k,iEdge) + u*cos(angleEdge(iEdge)) + v*sin(angleEdge(iEdge)) enddo From 47cbcca8cf40bcf749cedbe85fb5c57e7e86225b Mon Sep 17 00:00:00 2001 From: Carolyn Begeman Date: Tue, 3 Dec 2024 14:37:32 -0700 Subject: [PATCH 449/529] Bug fixes from Hyun's code review Co-authored-by: Hyun (Hyun-Gyu) Kang <47987430+hyungyukang@users.noreply.github.com> --- .../src/shared/mpas_ocn_manufactured_solution.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F index 9157200ede7..c114fbf921e 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F @@ -205,13 +205,13 @@ subroutine ocn_manufactured_solution_tend_vel(forcingPool, tend, err)!{{{ if (.not. config_disable_vel_hmix) then if (config_use_mom_del2) then viscDel2 = config_mom_del2 - u = u + viscDel2 * eta0 * kx**2 * cos(phase) - v = v + viscDel2 * eta0 * ky**2 * cos(phase) + u = u + viscDel2 * eta0 * (kx**2 + ky**2) * cos(phase) + v = v + viscDel2 * eta0 * (kx**2 + ky**2) * cos(phase) endif if (config_use_mom_del4) then viscDel4 = config_mom_del4 - u = u - viscDel4 * eta0 * (kx**4 * cos(phase) + kx**2 * ky**2 * cos(phase)) - v = v - viscDel4 * eta0 * (ky**4 * cos(phase) + kx**2 * ky**2 * cos(phase)) + u = u - viscDel4 * eta0 * ((kx**4 + ky**4 + kx**2 * ky**2) * cos(phase)) + v = v - viscDel4 * eta0 * ((kx**4 + ky**4 + kx**2 * ky**2) * cos(phase)) endif endif From 30fb3a6d8809b8c26269cdd58d1a853935ec7ed9 Mon Sep 17 00:00:00 2001 From: Carolyn Begeman Date: Thu, 19 Dec 2024 12:03:28 -0600 Subject: [PATCH 450/529] Move manufactured soln parameter setting to init routine --- .../mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F index c114fbf921e..6dd1e1d6e31 100644 --- a/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F +++ b/components/mpas-ocean/src/shared/mpas_ocn_manufactured_solution.F @@ -204,12 +204,10 @@ subroutine ocn_manufactured_solution_tend_vel(forcingPool, tend, err)!{{{ if (.not. config_disable_vel_hmix) then if (config_use_mom_del2) then - viscDel2 = config_mom_del2 u = u + viscDel2 * eta0 * (kx**2 + ky**2) * cos(phase) v = v + viscDel2 * eta0 * (kx**2 + ky**2) * cos(phase) endif if (config_use_mom_del4) then - viscDel4 = config_mom_del4 u = u - viscDel4 * eta0 * ((kx**4 + ky**4 + kx**2 * ky**2) * cos(phase)) v = v - viscDel4 * eta0 * ((kx**4 + ky**4 + kx**2 * ky**2) * cos(phase)) endif @@ -249,6 +247,9 @@ subroutine ocn_manufactured_solution_init(domain, err)!{{{ if (.not. config_use_manufactured_solution) return + viscDel2 = config_mom_del2 + viscDel4 = config_mom_del4 + kx = 2.0_RKIND*pi / config_manufactured_solution_wavelength_x ky = 2.0_RKIND*pi / config_manufactured_solution_wavelength_y From e5e8caf7e3eeea1df1b251f529d6f9a3a7d820f4 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Thu, 19 Dec 2024 10:07:16 -0800 Subject: [PATCH 451/529] EAMxx: move cld_frac overrides to P3Runtime --- .../physics/p3/eamxx_p3_process_interface.cpp | 11 ++------- .../physics/p3/eamxx_p3_process_interface.hpp | 24 +++++++------------ .../eamxx/src/physics/p3/p3_functions.hpp | 6 +++++ 3 files changed, 17 insertions(+), 24 deletions(-) diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp index 9736d7ae598..1ea5cbe0f05 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.cpp @@ -275,19 +275,12 @@ void P3Microphysics::initialize_impl (const RunType /* run_type */) auto cld_frac_l = m_buffer.cld_frac_l; auto cld_frac_i = m_buffer.cld_frac_i; auto dz = m_buffer.dz; - auto set_cld_frac_l_to_one = m_params.get("set_cld_frac_l_to_one", false); - auto set_cld_frac_i_to_one = m_params.get("set_cld_frac_i_to_one", false); - auto set_cld_frac_r_to_one = m_params.get("set_cld_frac_r_to_one", false); // -- Set values for the pre-amble structure - p3_preproc.set_variables(m_num_cols,nk_pack, - set_cld_frac_l_to_one, - set_cld_frac_i_to_one, - set_cld_frac_r_to_one, - pmid,pmid_dry,pseudo_density,pseudo_density_dry, + p3_preproc.set_variables(m_num_cols,nk_pack,pmid,pmid_dry,pseudo_density,pseudo_density_dry, T_atm,cld_frac_t, qv, qc, nc, qr, nr, qi, qm, ni, bm, qv_prev, - inv_exner, th_atm, cld_frac_l, cld_frac_i, cld_frac_r, dz); + inv_exner, th_atm, cld_frac_l, cld_frac_i, cld_frac_r, dz, runtime_options); // --Prognostic State Variables: prog_state.qc = p3_preproc.qc; prog_state.nc = p3_preproc.nc; diff --git a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp index d8016d9e4c3..839458c91c3 100644 --- a/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp +++ b/components/eamxx/src/physics/p3/eamxx_p3_process_interface.hpp @@ -106,12 +106,12 @@ class P3Microphysics : public AtmosphereProcess // Cloud fraction // Set minimum cloud fraction - avoids division by zero // Alternatively set fraction to 1 everywhere to disable subgrid effects - cld_frac_l(icol,ipack) = m_set_cld_frac_l_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); - cld_frac_i(icol,ipack) = m_set_cld_frac_i_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); - cld_frac_r(icol,ipack) = m_set_cld_frac_r_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); + cld_frac_l(icol,ipack) = runtime_opts.set_cld_frac_l_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); + cld_frac_i(icol,ipack) = runtime_opts.set_cld_frac_i_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); + cld_frac_r(icol,ipack) = runtime_opts.set_cld_frac_r_to_one ? 1 : ekat::max(cld_frac_t_pack,mincld); // update rain cloud fraction given neighboring levels using max-overlap approach. - if ( !m_set_cld_frac_r_to_one ) { + if ( !runtime_opts.set_cld_frac_r_to_one ) { for (int ivec=0;ivec("max_total_ni", max_total_ni); @@ -153,6 +156,9 @@ struct Functions deposition_nucleation_exponent = params.get("deposition_nucleation_exponent", deposition_nucleation_exponent); ice_sedimentation_factor = params.get("ice_sedimentation_factor", ice_sedimentation_factor); do_ice_production = params.get("do_ice_production", do_ice_production); + set_cld_frac_l_to_one = params.get("set_cld_frac_l_to_one", set_cld_frac_l_to_one); + set_cld_frac_i_to_one = params.get("set_cld_frac_i_to_one", set_cld_frac_i_to_one); + set_cld_frac_r_to_one = params.get("set_cld_frac_r_to_one", set_cld_frac_r_to_one); } }; From cd6a6b9dc64156d6df5913bdeed57d47e6be01fe Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 19 Dec 2024 12:51:33 -0700 Subject: [PATCH 452/529] EAMxx: reorg query-cf-database utility * Moved to its own folder * Do not add scripts subdir when building EAMxx * Move data/*yaml in query-cf-database folder --- components/eamxx/CMakeLists.txt | 3 --- components/eamxx/scripts/README.md | 2 +- .../eamxx/scripts/{ => query-cf-database}/CMakeLists.txt | 7 ++++--- .../query-cf-database}/cf-scream-name-table.yaml | 0 .../query-cf-database}/cf-standard-name-table.yaml | 0 .../eamxx/scripts/{ => query-cf-database}/cf-xml-to-yaml | 0 .../scripts/{ => query-cf-database}/query-cf-database.cpp | 0 7 files changed, 5 insertions(+), 7 deletions(-) rename components/eamxx/scripts/{ => query-cf-database}/CMakeLists.txt (67%) rename components/eamxx/{data => scripts/query-cf-database}/cf-scream-name-table.yaml (100%) rename components/eamxx/{data => scripts/query-cf-database}/cf-standard-name-table.yaml (100%) rename components/eamxx/scripts/{ => query-cf-database}/cf-xml-to-yaml (100%) rename components/eamxx/scripts/{ => query-cf-database}/query-cf-database.cpp (100%) diff --git a/components/eamxx/CMakeLists.txt b/components/eamxx/CMakeLists.txt index 693b8ae8a09..1119a3f031f 100644 --- a/components/eamxx/CMakeLists.txt +++ b/components/eamxx/CMakeLists.txt @@ -584,9 +584,6 @@ if (NOT DEFINED ENV{SCREAM_FAKE_ONLY}) ${CMAKE_CURRENT_BINARY_DIR}/src/scream_config.h F90_FILE ${CMAKE_CURRENT_BINARY_DIR}/src/scream_config.f) - # Build any tools in the scripts/ dir. - add_subdirectory(scripts) - # Generate scream_config.h and scream_config.f include (EkatUtils) EkatConfigFile(${CMAKE_CURRENT_SOURCE_DIR}/src/scream_config.h.in diff --git a/components/eamxx/scripts/README.md b/components/eamxx/scripts/README.md index 0bcb8d79e6a..d139ca7fcf4 100644 --- a/components/eamxx/scripts/README.md +++ b/components/eamxx/scripts/README.md @@ -80,7 +80,7 @@ This tool is not used in our core testing tools and goes through long periods of (IE there are no active ongoing porting efforts). It is likely this tool will not work exactly as expected if it has not been run in a while or is being used on a package on which it has not been used before. -## cf-xml-to-yaml +## query-cf-database/cf-xml-to-yaml Given an XML file containing the CF conventions for standardized field names (https://cfconventions.org/standard-names.html), this tool generates a YAML diff --git a/components/eamxx/scripts/CMakeLists.txt b/components/eamxx/scripts/query-cf-database/CMakeLists.txt similarity index 67% rename from components/eamxx/scripts/CMakeLists.txt rename to components/eamxx/scripts/query-cf-database/CMakeLists.txt index 377452229b9..91200760602 100644 --- a/components/eamxx/scripts/CMakeLists.txt +++ b/components/eamxx/scripts/query-cf-database/CMakeLists.txt @@ -1,8 +1,8 @@ -# Generate the source file for the CF validator and build it. +# Build the CF validator tool -set (CF_STANDARD_NAME_FILE "${PROJECT_SOURCE_DIR}/data/cf-standard-name-table.yaml" +set (CF_STANDARD_NAME_FILE "${CMAKE_CURRENT_SOURCE_DIR}/cf-standard-name-table.yaml" CACHE STRING "Location of the cf standard name yaml table") -set (CF_SCREAM_NAME_FILE "${PROJECT_SOURCE_DIR}/data/cf-scream-name-table.yaml" +set (CF_SCREAM_NAME_FILE "${CMAKE_CURRENT_SOURCE_DIR}/cf-scream-name-table.yaml" CACHE STRING "Location of the scream-specific cf name yaml table") add_executable(query-cf-database query-cf-database.cpp) @@ -10,5 +10,6 @@ target_compile_definitions(query-cf-database PUBLIC CF_STANDARD_NAME_FILE=${CF_STANDARD_NAME_FILE} CF_SCREAM_NAME_FILE=${CF_SCREAM_NAME_FILE}) +find_package (ekat HINTS ${EKAT_ROOT}) find_package (yaml-cpp HINTS ${YAML_CPP_ROOT}) target_link_libraries(query-cf-database ekat yaml-cpp) diff --git a/components/eamxx/data/cf-scream-name-table.yaml b/components/eamxx/scripts/query-cf-database/cf-scream-name-table.yaml similarity index 100% rename from components/eamxx/data/cf-scream-name-table.yaml rename to components/eamxx/scripts/query-cf-database/cf-scream-name-table.yaml diff --git a/components/eamxx/data/cf-standard-name-table.yaml b/components/eamxx/scripts/query-cf-database/cf-standard-name-table.yaml similarity index 100% rename from components/eamxx/data/cf-standard-name-table.yaml rename to components/eamxx/scripts/query-cf-database/cf-standard-name-table.yaml diff --git a/components/eamxx/scripts/cf-xml-to-yaml b/components/eamxx/scripts/query-cf-database/cf-xml-to-yaml similarity index 100% rename from components/eamxx/scripts/cf-xml-to-yaml rename to components/eamxx/scripts/query-cf-database/cf-xml-to-yaml diff --git a/components/eamxx/scripts/query-cf-database.cpp b/components/eamxx/scripts/query-cf-database/query-cf-database.cpp similarity index 100% rename from components/eamxx/scripts/query-cf-database.cpp rename to components/eamxx/scripts/query-cf-database/query-cf-database.cpp From 3fe9539e0c79e05e3f3f815ce31b02f77ba1ead7 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 19 Dec 2024 13:20:06 -0700 Subject: [PATCH 453/529] EAM: removed stale code in buildnml The folder eamxx/data no longer exists, and did not contain any input data for EAM in the first place --- components/eam/cime_config/buildnml | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/components/eam/cime_config/buildnml b/components/eam/cime_config/buildnml index a86cd0fc17d..beea61fd215 100755 --- a/components/eam/cime_config/buildnml +++ b/components/eam/cime_config/buildnml @@ -233,29 +233,6 @@ def buildnml(case, caseroot, compname): safe_copy(os.path.join(eamconf_dir, "atm_in"), os.path.join(rundir, "atm_in{}".format(inst_string))) safe_copy(os.path.join(eamconf_dir, "drv_flds_in"), os.path.join(rundir, "drv_flds_in")) - # ----------------------------------------------------- - # copy scream input data - # ----------------------------------------------------- - - with SharedArea(): - scream_data_dir = os.path.join(case.get_value("SRCROOT"), "components/eamxx/data") - for item in os.listdir(scream_data_dir): - tgt_dir = os.path.join(din_loc_root, "atm/cam/physprops") - tgt_path = os.path.join(tgt_dir, item) - if not os.path.isdir(tgt_dir): - try: - os.makedirs(tgt_dir) - except OSError: - pass # lost the race - - try: - fd = os.open(tgt_path, os.O_CREAT | os.O_EXCL) - # If we get to this line, we won the race - os.close(fd) - safe_copy(os.path.join(scream_data_dir, item), tgt_path) - except OSError: - pass # lost the race - ############################################################################### def _main_func(): ############################################################################### From a166b4579f05ecbb7fe2264d9719f06eddf315f0 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 20 Dec 2024 09:10:53 -0700 Subject: [PATCH 454/529] EAMxx: fix md linting of README --- components/eamxx/scripts/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/scripts/README.md b/components/eamxx/scripts/README.md index d139ca7fcf4..bcff04a11cd 100644 --- a/components/eamxx/scripts/README.md +++ b/components/eamxx/scripts/README.md @@ -83,7 +83,7 @@ has not been run in a while or is being used on a package on which it has not be ## query-cf-database/cf-xml-to-yaml Given an XML file containing the CF conventions for standardized field names -(https://cfconventions.org/standard-names.html), this tool generates a YAML +(which can be found [here](https://cfconventions.org/standard-names.html)), this tool generates a YAML file with the same information. This tool is not used in our core testing tools, but it is extremely simple and not coupled to anything else in the repo, From 2da2a4740a0e491e85da6b0b840c88c5f982acce Mon Sep 17 00:00:00 2001 From: Naser Mahfouz Date: Fri, 20 Dec 2024 12:35:36 -0500 Subject: [PATCH 455/529] docs: only run docs when docs are touched --- .github/workflows/e3sm-gh-pages.yml | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/.github/workflows/e3sm-gh-pages.yml b/.github/workflows/e3sm-gh-pages.yml index dec9bc696bf..543295a9030 100644 --- a/.github/workflows/e3sm-gh-pages.yml +++ b/.github/workflows/e3sm-gh-pages.yml @@ -4,9 +4,27 @@ on: # Runs every time master branch is updated push: branches: ["master"] + # But only if docs-related files are touched + paths: + - .github/workflows/e3sm-gh-pages.yml + - ./mkdocs.yml + - ./tools/*/mkdocs.yml + - ./tools/docs/** + - components/*/mkdocs.yaml + - components/*/docs/** + - components/eamxx/cime_config/namelist_defaults_scream.xml # Runs every time a PR is open against master pull_request: branches: ["master"] + # But only if docs-related files are touched + paths: + - .github/workflows/e3sm-gh-pages.yml + - ./mkdocs.yml + - ./tools/*/mkdocs.yml + - ./tools/docs/** + - components/*/mkdocs.yaml + - components/*/docs/** + - components/eamxx/cime_config/namelist_defaults_scream.xml workflow_dispatch: concurrency: From 4fff598074ac9f4e1abb4de5dcd1b13f78ff2bdb Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 27 Nov 2024 19:12:27 -0700 Subject: [PATCH 456/529] EAMxx: removed pointless CMake lines --- components/eamxx/src/share/CMakeLists.txt | 4 ---- 1 file changed, 4 deletions(-) diff --git a/components/eamxx/src/share/CMakeLists.txt b/components/eamxx/src/share/CMakeLists.txt index dd290dfb364..a0d6fc63a1d 100644 --- a/components/eamxx/src/share/CMakeLists.txt +++ b/components/eamxx/src/share/CMakeLists.txt @@ -49,14 +49,10 @@ if (EAMXX_ENABLE_EXPERIMENTAL_CODE) endif() add_library(scream_share ${SHARE_SRC}) -set_target_properties(scream_share PROPERTIES - Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/modules -) target_include_directories(scream_share PUBLIC ${SCREAM_SRC_DIR} ${SCREAM_BIN_DIR}/src ${CMAKE_CURRENT_SOURCE_DIR} - ${CMAKE_CURRENT_BINARY_DIR}/modules ) if (GPTL_PATH) From 4c7bdf05fa75ca56498c755bfe6bc5fe51caa35c Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 6 Dec 2024 12:27:26 -0700 Subject: [PATCH 457/529] EAMXX: fix misc compiler warnings --- .../dynamics/homme/interface/homme_context_mod.F90 | 12 ++++++------ .../shoc/tests/shoc_pdf_thl_parameters_tests.cpp | 2 -- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/components/eamxx/src/dynamics/homme/interface/homme_context_mod.F90 b/components/eamxx/src/dynamics/homme/interface/homme_context_mod.F90 index 5e9f6bd2f9d..377f3c9ed2c 100644 --- a/components/eamxx/src/dynamics/homme/interface/homme_context_mod.F90 +++ b/components/eamxx/src/dynamics/homme/interface/homme_context_mod.F90 @@ -168,37 +168,37 @@ end subroutine init_parallel_f90 function is_parallel_inited_f90 () result(inited) bind(c) logical (kind=c_bool) :: inited - inited = is_parallel_inited + inited = LOGICAL(is_parallel_inited,kind=c_bool) end function is_parallel_inited_f90 function is_params_inited_f90 () result(inited) bind(c) logical (kind=c_bool) :: inited - inited = is_params_inited + inited = LOGICAL(is_params_inited,kind=c_bool) end function is_params_inited_f90 function is_geometry_inited_f90 () result(inited) bind(c) logical (kind=c_bool) :: inited - inited = is_geometry_inited + inited = LOGICAL(is_geometry_inited,kind=c_bool) end function is_geometry_inited_f90 function is_data_structures_inited_f90 () result(inited) bind(c) logical (kind=c_bool) :: inited - inited = is_data_structures_inited + inited = LOGICAL(is_data_structures_inited,kind=c_bool) end function is_data_structures_inited_f90 function is_model_inited_f90 () result(inited) bind(c) logical (kind=c_bool) :: inited - inited = is_model_inited + inited = LOGICAL(is_model_inited,kind=c_bool) end function is_model_inited_f90 function is_hommexx_functors_inited_f90 () result(inited) bind(c) logical (kind=c_bool) :: inited - inited = is_hommexx_functors_inited + inited = LOGICAL(is_hommexx_functors_inited,kind=c_bool) end function is_hommexx_functors_inited_f90 end module homme_context_mod diff --git a/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp b/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp index 23ca0120a0a..96fdbbc2dfc 100644 --- a/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp +++ b/components/eamxx/src/physics/shoc/tests/shoc_pdf_thl_parameters_tests.cpp @@ -50,8 +50,6 @@ struct UnitWrap::UnitTest::TestShocThlParameters { static constexpr Real Skew_w_test1 = 3; // Define fraction of first gaussian static constexpr Real a_test1 = 0.2; - // Define logical - static constexpr bool dothetal_skew = false; // Define reasonable bounds checking for output static constexpr Real thl_bound_low = 200; // [K] From de36de67ad85a1d87403315f49951a08cc6b2a22 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 22 Nov 2024 17:00:43 -0700 Subject: [PATCH 458/529] EAMxx: allow to reset fields/filename in AtmosphereInput --- .../eamxx/src/share/io/scorpio_input.cpp | 42 +++++++++++++++++-- .../eamxx/src/share/io/scorpio_input.hpp | 10 ++++- 2 files changed, 46 insertions(+), 6 deletions(-) diff --git a/components/eamxx/src/share/io/scorpio_input.cpp b/components/eamxx/src/share/io/scorpio_input.cpp index e8a510130e0..f81bb09f8a3 100644 --- a/components/eamxx/src/share/io/scorpio_input.cpp +++ b/components/eamxx/src/share/io/scorpio_input.cpp @@ -46,6 +46,14 @@ AtmosphereInput (const std::string& filename, init(params,fm); } +AtmosphereInput:: +AtmosphereInput (const std::vector& fields_names, + const std::shared_ptr& grid) +{ + set_grid(grid); + m_fields_names = fields_names; +} + AtmosphereInput:: ~AtmosphereInput () { @@ -73,10 +81,10 @@ init (const ekat::ParameterList& params, // Sets the internal field mgr, and possibly sets up the remapper set_field_manager(field_mgr); + m_inited_with_fields = true; + // Init scorpio internal structures init_scorpio_structures (); - - m_inited_with_fields = true; } void AtmosphereInput:: @@ -113,10 +121,10 @@ init (const ekat::ParameterList& params, " layout = " + it.first); } + m_inited_with_views = true; + // Init scorpio internal structures init_scorpio_structures (); - - m_inited_with_views = true; } /* ---------------------------------------------------------- */ @@ -173,6 +181,28 @@ set_field_manager (const std::shared_ptr& field_mgr) } } +void AtmosphereInput:: +set_fields (const std::vector& fields) { + auto fm = std::make_shared(m_io_grid); + m_fields_names.clear(); + for (const auto& f : fields) { + fm->add_field(f); + m_fields_names.push_back(f.name()); + } + set_field_manager(fm); + m_inited_with_fields = true; +} + +void AtmosphereInput:: +reset_filename (const std::string& filename) +{ + if (m_filename!="") { + scorpio::release_file(m_filename); + } + m_params.set("Filename",filename); + m_filename = filename; + init_scorpio_structures(); +} /* ---------------------------------------------------------- */ void AtmosphereInput:: @@ -220,6 +250,7 @@ void AtmosphereInput::read_variables (const int time_index) // Read the data auto v1d = m_host_views_1d.at(name); + scorpio::read_var(m_filename,name,v1d.data(),time_index); // If we have a field manager, make sure the data is correctly @@ -350,6 +381,9 @@ void AtmosphereInput::finalize() /* ---------------------------------------------------------- */ void AtmosphereInput::init_scorpio_structures() { + EKAT_REQUIRE_MSG (m_inited_with_views or m_inited_with_fields, + "Error! Cannot init scorpio structures until fields/views have been set.\n"); + std::string iotype_str = m_params.get("iotype", "default"); auto iotype = scorpio::str2iotype(iotype_str); diff --git a/components/eamxx/src/share/io/scorpio_input.hpp b/components/eamxx/src/share/io/scorpio_input.hpp index 2c0a7e76c3e..7a53f1e8063 100644 --- a/components/eamxx/src/share/io/scorpio_input.hpp +++ b/components/eamxx/src/share/io/scorpio_input.hpp @@ -61,6 +61,10 @@ class AtmosphereInput const std::shared_ptr& grid, const std::vector& fields, const bool skip_grid_checks = false); + // This constructor only sets the minimal info, deferring initialization + // to when set_field_manager/reset_fields and reset_filename are called + AtmosphereInput (const std::vector& fields_names, + const std::shared_ptr& grid); // Due to resource acquisition (in scorpio), avoid copies AtmosphereInput (const AtmosphereInput&) = delete; @@ -98,9 +102,11 @@ class AtmosphereInput // Getters std::string get_filename() { return m_filename; } // Simple getter to query the filename for this stream. - // Expose the ability to set field manager for cases like time_interpolation where we swap fields - // between field managers to avoid deep_copy. + // Expose the ability to set/reset fields/field_manager for cases like data interpolation, + // where we swap pointers but all the scorpio data structures are unchanged. void set_field_manager (const std::shared_ptr& field_mgr); + void set_fields (const std::vector& fields); + void reset_filename (const std::string& filename); // Option to add a logger void set_logger(const std::shared_ptr& atm_logger) { From 8b527077428f03c4a2ea733de301671f996c5e75 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 4 Dec 2024 14:15:38 -0700 Subject: [PATCH 459/529] EAMxx: add QOL methods to TimeStamp Simplifies some operations that looked clunky on the client end --- .../mam/readfiles/marine_organics_impl.hpp | 8 ++--- .../mam/readfiles/tracer_reader_utils.hpp | 6 ++-- .../src/physics/mam/srf_emission_impl.hpp | 6 ++-- .../src/physics/spa/spa_functions_impl.hpp | 4 +-- .../src/physics/spa/tests/spa_main_test.cpp | 2 +- .../eamxx/src/share/io/scream_io_control.hpp | 33 +++++++---------- .../src/share/util/scream_time_stamp.cpp | 35 ++++++++++++++----- .../src/share/util/scream_time_stamp.hpp | 9 ++--- 8 files changed, 54 insertions(+), 49 deletions(-) diff --git a/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp b/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp index 389445fa024..6758dccdef5 100644 --- a/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp +++ b/components/eamxx/src/physics/mam/readfiles/marine_organics_impl.hpp @@ -154,10 +154,8 @@ void marineOrganicsFunctions::update_marine_organics_timestate( if(month != time_state.current_month) { // Update the marineOrganics time state information time_state.current_month = month; - time_state.t_beg_month = - util::TimeStamp({ts.get_year(), month + 1, 1}, {0, 0, 0}) - .frac_of_year_in_days(); - time_state.days_this_month = util::days_in_month(ts.get_year(), month + 1); + time_state.t_beg_month = ts.curr_month_beg().frac_of_year_in_days(); + time_state.days_this_month = ts.days_in_curr_month(); // Copy end'data into beg'data, and read in the new // end @@ -293,4 +291,4 @@ void marineOrganicsFunctions::init_marine_organics_file_read( } // namespace marine_organics } // namespace scream -#endif // MARINE_ORGANICS_IMPL_HPP \ No newline at end of file +#endif // MARINE_ORGANICS_IMPL_HPP diff --git a/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp b/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp index c605d3a0b9f..6e45750354d 100644 --- a/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp +++ b/components/eamxx/src/physics/mam/readfiles/tracer_reader_utils.hpp @@ -508,10 +508,8 @@ inline void update_tracer_timestate( // Update the tracer external forcing time state information time_state.current_month = month; - time_state.t_beg_month = - util::TimeStamp({ts.get_year(), month + 1, 1}, {0, 0, 0}) - .frac_of_year_in_days(); - time_state.days_this_month = util::days_in_month(ts.get_year(), month + 1); + time_state.t_beg_month = ts.curr_month_beg().frac_of_year_in_days(); + time_state.days_this_month = ts.days_in_curr_month(); // Copy spa_end'data into spa_beg'data, and read in the new spa_end for(int ivar = 0; ivar < nvars; ++ivar) { diff --git a/components/eamxx/src/physics/mam/srf_emission_impl.hpp b/components/eamxx/src/physics/mam/srf_emission_impl.hpp index b8ebfdbe501..e1c471edf4b 100644 --- a/components/eamxx/src/physics/mam/srf_emission_impl.hpp +++ b/components/eamxx/src/physics/mam/srf_emission_impl.hpp @@ -227,10 +227,8 @@ void srfEmissFunctions::update_srfEmiss_timestate( if(month != time_state.current_month) { // Update the srfEmiss time state information time_state.current_month = month; - time_state.t_beg_month = - util::TimeStamp({ts.get_year(), month + 1, 1}, {0, 0, 0}) - .frac_of_year_in_days(); - time_state.days_this_month = util::days_in_month(ts.get_year(), month + 1); + time_state.t_beg_month = ts.curr_month_beg().frac_of_year_in_days(); + time_state.days_this_month = ts.days_in_curr_month(); // Copy srfEmiss_end'data into srfEmiss_beg'data, and read in the new // srfEmiss_end diff --git a/components/eamxx/src/physics/spa/spa_functions_impl.hpp b/components/eamxx/src/physics/spa/spa_functions_impl.hpp index e566d0c985c..6c971183702 100644 --- a/components/eamxx/src/physics/spa/spa_functions_impl.hpp +++ b/components/eamxx/src/physics/spa/spa_functions_impl.hpp @@ -568,8 +568,8 @@ ::update_spa_timestate( if (month != time_state.current_month) { // Update the SPA time state information time_state.current_month = month; - time_state.t_beg_month = util::TimeStamp({ts.get_year(),month+1,1}, {0,0,0}).frac_of_year_in_days(); - time_state.days_this_month = util::days_in_month(ts.get_year(),month+1); + time_state.t_beg_month = ts.curr_month_beg().frac_of_year_in_days(); + time_state.days_this_month = ts.days_in_curr_month(); // Copy spa_end'data into spa_beg'data, and read in the new spa_end std::swap(spa_beg,spa_end); diff --git a/components/eamxx/src/physics/spa/tests/spa_main_test.cpp b/components/eamxx/src/physics/spa/tests/spa_main_test.cpp index 736796d3eb0..1bd66687ad4 100644 --- a/components/eamxx/src/physics/spa/tests/spa_main_test.cpp +++ b/components/eamxx/src/physics/spa/tests/spa_main_test.cpp @@ -107,7 +107,7 @@ TEST_CASE("spa_main") util::TimeStamp t_end(1900,2,1,0,0,0); spa_time_state.current_month = t_beg.get_month(); spa_time_state.t_beg_month = t_beg.frac_of_year_in_days(); - spa_time_state.days_this_month = util::days_in_month(t_beg.get_year(),t_beg.get_month()); + spa_time_state.days_this_month = t_beg.days_in_curr_month(); // Generate random beg/end data randomize(spa_beg.data,engine,RPDF(1.0,10.0)); diff --git a/components/eamxx/src/share/io/scream_io_control.hpp b/components/eamxx/src/share/io/scream_io_control.hpp index b24eaeea727..8e553907c55 100644 --- a/components/eamxx/src/share/io/scream_io_control.hpp +++ b/components/eamxx/src/share/io/scream_io_control.hpp @@ -74,39 +74,32 @@ struct IOControl { void compute_next_write_ts () { EKAT_REQUIRE_MSG (last_write_ts.is_valid(), "Error! Cannot compute next_write_ts, since last_write_ts was never set.\n"); + next_write_ts = last_write_ts; if (frequency_units=="nsteps") { // This avoids having an invalid/wrong date/time in StorageSpecs::snapshot_fits // if storage type is NumSnaps - next_write_ts = last_write_ts + dt*frequency; + next_write_ts += dt*frequency; next_write_ts.set_num_steps(last_write_ts.get_num_steps()+frequency); } else if (frequency_units=="nsecs") { - next_write_ts = last_write_ts; next_write_ts += frequency; } else if (frequency_units=="nmins") { - next_write_ts = last_write_ts; next_write_ts += frequency*60; } else if (frequency_units=="nhours") { - next_write_ts = last_write_ts; next_write_ts += frequency*3600; } else if (frequency_units=="ndays") { - next_write_ts = last_write_ts; next_write_ts += frequency*86400; - } else if (frequency_units=="nmonths" or frequency_units=="nyears") { - auto date = last_write_ts.get_date(); - if (frequency_units=="nmonths") { - int temp = date[1] + frequency - 1; - date[1] = temp % 12 + 1; - date[0] += temp / 12; - } else { - date[0] += frequency; + } else if (frequency_units=="nmonths") { + for (int im=0; im=1 && mm<=12, - "Error! Month out of bounds. Did you call `days_in_month` with yy and mm swapped?\n"); - constexpr int nonleap_days [12] = {31,28,31,30,31,30,31,31,30,31,30,31}; - constexpr int leap_days [12] = {31,29,31,30,31,30,31,31,30,31,30,31}; - auto& arr = is_leap_year(yy) ? leap_days : nonleap_days; - return arr[mm-1]; -} - bool is_leap_year (const int yy) { if (use_leap_year()) { if (yy%4==0) { @@ -41,6 +32,15 @@ bool is_leap_year (const int yy) { return false; } +int days_in_month (const int yy, const int mm) { + EKAT_REQUIRE_MSG (mm>=1 && mm<=12, + "Error! Month out of bounds. Did you call `days_in_month` with yy and mm swapped?\n"); + constexpr int nonleap_days [12] = {31,28,31,30,31,30,31,31,30,31,30,31}; + constexpr int leap_days [12] = {31,29,31,30,31,30,31,31,30,31,30,31}; + auto& arr = is_leap_year(yy) ? leap_days : nonleap_days; + return arr[mm-1]; +} + TimeStamp::TimeStamp() : m_date (3,std::numeric_limits::lowest()) , m_time (3,std::numeric_limits::lowest()) @@ -135,6 +135,23 @@ double TimeStamp::frac_of_year_in_days () const { return doy; } +int TimeStamp::days_in_curr_month () const +{ + return days_in_month(m_date[0],m_date[1]); +} + +int TimeStamp::days_in_curr_year () const +{ + return is_leap_year(m_date[0]) ? 366 : 365; +} + +TimeStamp TimeStamp::curr_month_beg () const +{ + auto date = m_date; + date[2] = 1; + return TimeStamp (date,m_time); +} + TimeStamp& TimeStamp::operator+=(const double seconds) { // Sanity checks // Note: (x-int(x)) only works for x small enough that can be stored in an int, diff --git a/components/eamxx/src/share/util/scream_time_stamp.hpp b/components/eamxx/src/share/util/scream_time_stamp.hpp index 259686eacf6..1553394546e 100644 --- a/components/eamxx/src/share/util/scream_time_stamp.hpp +++ b/components/eamxx/src/share/util/scream_time_stamp.hpp @@ -45,6 +45,11 @@ class TimeStamp { std::string get_time_string () const; double frac_of_year_in_days () const; + int days_in_curr_month () const; + int days_in_curr_year () const; + + TimeStamp curr_month_beg () const; + // === Update method(s) === // // Set the counter for the number of steps. @@ -78,10 +83,6 @@ std::int64_t operator- (const TimeStamp& ts1, const TimeStamp& ts2); // Rewind time by given number of seconds TimeStamp operator- (const TimeStamp& ts, const int dt); -// Time-related free-functions -int days_in_month (const int year, const int month); -bool is_leap_year (const int year); - // If input string is not of the format YYYY-MM-DD-XXXXX, returns an invalid time stamp TimeStamp str_to_time_stamp (const std::string& s); From 331e6a28bff13a784e451cf7ce308ca620c127be Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 6 Dec 2024 10:24:35 -0700 Subject: [PATCH 460/529] EAMxx: add a TimeInterval lightweight struct --- .../src/share/util/scream_time_stamp.hpp | 80 +++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/components/eamxx/src/share/util/scream_time_stamp.hpp b/components/eamxx/src/share/util/scream_time_stamp.hpp index 1553394546e..1fd1c04e421 100644 --- a/components/eamxx/src/share/util/scream_time_stamp.hpp +++ b/components/eamxx/src/share/util/scream_time_stamp.hpp @@ -86,6 +86,86 @@ TimeStamp operator- (const TimeStamp& ts, const int dt); // If input string is not of the format YYYY-MM-DD-XXXXX, returns an invalid time stamp TimeStamp str_to_time_stamp (const std::string& s); +// An enum describing two ways to look at timestamps: +// - Linear: treat them as part of a 1d line +// - YearlyPeriodic: treat them as part of a yearly periodic orbit +// This is used in the TimeInterval class below to correctly handle time stamps differences +enum class TimeLine { + YearlyPeriodic, + Linear +}; + +/* + * Small struct to deal with time intervals + * + * The struct simply contains timestamps for [begin,end] interval, + * and allows two things: compute the interval length (in days), and check if + * a timestamp lies within the interval. + * + * When the TimeLine arg to the ctor is YearlyPeriodic, the year part of beg/end + * time points is ignored. In this case, the length of the time interval is bound + * to be in the interval [0,365] (in non-leap years) + */ +struct TimeInterval { + + TimeStamp beg; + TimeStamp end; + TimeLine timeline = TimeLine::Linear; + double length = -1; // the interval length + + TimeInterval () = default; + TimeInterval (const util::TimeStamp& b, const util::TimeStamp& e, TimeLine tl, bool do_compute_length = true) + : beg (b), end (e), timeline (tl) + { + if (do_compute_length) + compute_length (); + } + + bool contains (const util::TimeStamp& t) const { + if (timeline==TimeLine::Linear) { + // Compare the full time stamps + return beg<=t and t<=end; + } else { + // Compare the fraction of year for beg/end and t. + // Pay extra attention to the case where new year's eve + // is in [bec,end] + auto t_frac = t.frac_of_year_in_days(); + auto end_frac = end.frac_of_year_in_days(); + auto beg_frac = beg.frac_of_year_in_days(); + bool across_nye = beg.get_month()>end.get_month(); + if (not across_nye) { + return beg_frac<=t_frac and t_frac<=end_frac; + } else { + // We are either PAST beg or BEFORE end (but not both) + return t_frac>=beg_frac or t_frac<=end_frac; + } + } + } + + void compute_length () { + if (timeline==TimeLine::Linear) { + length = end.days_from(beg); + } else { + bool across_nye = beg.get_month()>end.get_month(); + auto frac_beg = beg.frac_of_year_in_days(); + auto frac_end = end.frac_of_year_in_days(); + if (across_nye) { + double year = end.days_in_curr_year(); + length = frac_end + (year - frac_beg); + } else { + length = frac_end - frac_beg; + } + } + } + + // Advance the interval, so that it now starts from the old end + void advance(const TimeStamp& new_end) { + beg = end; + end = new_end; + compute_length(); + } +}; + } // namespace util } // namespace scream From 2e07ed5ff0a982294c675e58200539159fbd9494 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 6 Dec 2024 17:36:00 -0700 Subject: [PATCH 461/529] EAMxx: changes in VerticalRemapper * Allow to set only one src or tgt pressure profile. This is because we may not have any mid or any int field. No need to force us to create a valid field just for passing checks. * Allow to query the remapper for the src/tgt mid/int pressure profile --- .../share/grid/remap/vertical_remapper.cpp | 197 ++++++++++-------- .../share/grid/remap/vertical_remapper.hpp | 39 +++- 2 files changed, 145 insertions(+), 91 deletions(-) diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp index 8e3b44d0e1f..394a1205fb8 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp @@ -50,13 +50,7 @@ VerticalRemapper (const grid_ptr_type& src_grid, const std::string& map_file) : VerticalRemapper(src_grid,create_tgt_grid(src_grid,map_file)) { - // NOTE: we prescribe a uniform tgt pressure levels, so pmid_tgt = pint_tgt (1d field) - // Cannot call set_target_pressure(p_tgt,p_tgt), since in there we do check the - // number of levels (i.e., pint/pmid cannot have the same nlevs). Since we remap - // every field (mid or int) to the same pressure coords, we just hard-code them. - m_tgt_pmid = m_tgt_pint = m_tgt_grid->get_geometry_data("p_levs"); - - m_tgt_int_same_as_mid = true; + set_target_pressure (m_tgt_grid->get_geometry_data("p_levs"),Both); } VerticalRemapper:: @@ -77,56 +71,75 @@ VerticalRemapper (const grid_ptr_type& src_grid, FieldLayout VerticalRemapper:: create_src_layout (const FieldLayout& tgt_layout) const { - // Since we don't know if the tgt layout is "LEV for everything", - // we cannot infer what the corresponding src layout was. - // This function should never be used for this remapper. - EKAT_ERROR_MSG ("Error! VerticalRemapper does not support creating a src layout from a tgt layout.\n"); - return FieldLayout(); + EKAT_REQUIRE_MSG (is_valid_tgt_layout(tgt_layout), + "[VerticalRemapper] Error! Input target layout is not valid for this remapper.\n" + " - input layout: " + tgt_layout.to_string()); + + EKAT_REQUIRE_MSG (not m_tgt_mid_same_as_int, + "[VerticalRemapper::create_src_layout] Error! Cannot deduce source layout.\n" + " The target layout does not distinguish between LEV and ILEV.\n"); + + const auto& mid_layout = m_src_pmid.get_header().get_identifier().get_layout(); + const auto& int_layout = m_src_pint.get_header().get_identifier().get_layout(); + return create_layout(tgt_layout,m_src_grid,mid_layout.congruent(int_layout)); } FieldLayout VerticalRemapper:: create_tgt_layout (const FieldLayout& src_layout) const { - using namespace ShortFieldTagsNames; - EKAT_REQUIRE_MSG (is_valid_src_layout(src_layout), - "[VerticalRemapper] Error! Input source layout is not valid for this remapper.\n" + "[VerticalRemapper::create_tgt_layout] Error! Input source layout is not valid for this remapper.\n" " - input layout: " + src_layout.to_string()); - // If we remap to a fixed set of pressure levels during I/O, - // it doesn't really make sense to distinguish between midpoints - // and interfaces, so choose fl_out to have LEV as vertical tag. - auto tgt_layout = FieldLayout::invalid(); + EKAT_REQUIRE_MSG (not m_src_mid_same_as_int, + "[VerticalRemapper::create_tgt_layout] Error! Cannot deduce target layout.\n" + " The source layout does not distinguish between LEV and ILEV.\n"); + + const auto& mid_layout = m_tgt_pmid.get_header().get_identifier().get_layout(); + const auto& int_layout = m_tgt_pint.get_header().get_identifier().get_layout(); + return create_layout(src_layout,m_tgt_grid,mid_layout.congruent(int_layout)); +} + +FieldLayout VerticalRemapper:: +create_layout (const FieldLayout& from_layout, + const std::shared_ptr& to_grid, + const bool int_same_as_mid) const +{ + using namespace ShortFieldTagsNames; + + auto to_layout = FieldLayout::invalid(); bool midpoints; - switch (src_layout.type()) { + std::string vdim_name; + switch (from_layout.type()) { case LayoutType::Scalar0D: [[ fallthrough ]]; case LayoutType::Vector0D: [[ fallthrough ]]; case LayoutType::Scalar2D: [[ fallthrough ]]; case LayoutType::Vector2D: [[ fallthrough ]]; case LayoutType::Tensor2D: // These layouts do not have vertical dim tags, so no change - tgt_layout = src_layout; + to_layout = from_layout; break; case LayoutType::Scalar1D: - midpoints = m_tgt_int_same_as_mid || src_layout.tags().back()==LEV; - tgt_layout = m_tgt_grid->get_vertical_layout(midpoints); + midpoints = int_same_as_mid || from_layout.tags().back()==LEV; + to_layout = to_grid->get_vertical_layout(midpoints); break; case LayoutType::Scalar3D: - midpoints = m_tgt_int_same_as_mid || src_layout.tags().back()==LEV; - tgt_layout = m_tgt_grid->get_3d_scalar_layout(midpoints); + midpoints = int_same_as_mid || from_layout.tags().back()==LEV; + to_layout = to_grid->get_3d_scalar_layout(midpoints); break; case LayoutType::Vector3D: - midpoints = m_tgt_int_same_as_mid || src_layout.tags().back()==LEV; - tgt_layout = m_tgt_grid->get_3d_vector_layout(midpoints,src_layout.get_vector_dim()); + vdim_name = from_layout.name(from_layout.get_vector_component_idx()); + midpoints = int_same_as_mid || from_layout.tags().back()==LEV; + to_layout = to_grid->get_3d_vector_layout(midpoints,from_layout.get_vector_dim(),vdim_name); break; default: // NOTE: this also include Tensor3D. We don't really have any atm proc // that needs to handle a tensor3d quantity, so no need to add it EKAT_ERROR_MSG ( "[VerticalRemapper] Error! Layout not supported by VerticalRemapper.\n" - " - input layout: " + src_layout.to_string() + "\n"); + " - input layout: " + from_layout.to_string() + "\n"); } - return tgt_layout; + return to_layout; } void VerticalRemapper:: @@ -150,71 +163,83 @@ set_mask_value (const Real mask_val) } void VerticalRemapper:: -set_source_pressure (const Field& pmid, const Field& pint) +set_source_pressure (const Field& p, const ProfileType ptype) { - using namespace ShortFieldTagsNames; - using PackT = ekat::Pack; - - EKAT_REQUIRE_MSG(pmid.is_allocated(), - "Error! Source midpoint pressure field is not yet allocated.\n" - " - field name: " + pmid.name() + "\n"); - - EKAT_REQUIRE_MSG(pint.is_allocated(), - "Error! Source interface pressure field is not yet allocated.\n" - " - field name: " + pint.name() + "\n"); - - EKAT_REQUIRE_MSG(pmid.get_header().get_alloc_properties().is_compatible(), - "Error! Source midpoints pressure field not compatible with default pack size.\n" - " - pack size: " + std::to_string(SCREAM_PACK_SIZE) + "\n"); - EKAT_REQUIRE_MSG(pint.get_header().get_alloc_properties().is_compatible(), - "Error! Source interfaces pressure field not compatible with default pack size.\n" - " - pack size: " + std::to_string(SCREAM_PACK_SIZE) + "\n"); + set_pressure (p, "source", ptype); +} - const auto& pmid_layout = pmid.get_header().get_identifier().get_layout(); - const auto& pint_layout = pint.get_header().get_identifier().get_layout(); - EKAT_REQUIRE_MSG(pmid_layout.dim(LEV)==m_src_grid->get_num_vertical_levels(), - "Error! Source midpoint pressure field has the wrong layout.\n" - " - field name: " + pmid.name() + "\n" - " - field layout: " + pmid_layout.to_string() + "\n" - " - expected num levels: " + std::to_string(m_src_grid->get_num_vertical_levels()) + "\n"); - EKAT_REQUIRE_MSG(pint_layout.dim(ILEV)==m_src_grid->get_num_vertical_levels()+1, - "Error! Source interface pressure field has the wrong layout.\n" - " - field name: " + pint.name() + "\n" - " - field layout: " + pint_layout.to_string() + "\n" - " - expected num levels: " + std::to_string(m_src_grid->get_num_vertical_levels()+1) + "\n"); - - m_src_pmid = pmid; - m_src_pint = pint; +void VerticalRemapper:: +set_target_pressure (const Field& p, const ProfileType ptype) +{ + set_pressure (p, "target", ptype); } void VerticalRemapper:: -set_target_pressure (const Field& pmid, const Field& pint) +set_pressure (const Field& p, const std::string& src_or_tgt, const ProfileType ptype) { using namespace ShortFieldTagsNames; + using PackT = ekat::Pack; + + bool src = src_or_tgt=="source"; + + std::string msg_prefix = "[VerticalRemapper::set_" + src_or_tgt + "_pressure] "; - EKAT_REQUIRE_MSG(pmid.is_allocated(), - "Error! Target midpoint pressure field is not yet allocated.\n" - " - field name: " + pmid.name() + "\n"); - - EKAT_REQUIRE_MSG(pint.is_allocated(), - "Error! Target interface pressure field is not yet allocated.\n" - " - field name: " + pint.name() + "\n"); - - const auto& pmid_layout = pmid.get_header().get_identifier().get_layout(); - const auto& pint_layout = pint.get_header().get_identifier().get_layout(); - EKAT_REQUIRE_MSG(pmid_layout.dim(LEV)==m_tgt_grid->get_num_vertical_levels(), - "Error! Target midpoint pressure field has the wrong layout.\n" - " - field name: " + pmid.name() + "\n" - " - field layout: " + pmid_layout.to_string() + "\n" - " - expected num levels: " + std::to_string(m_tgt_grid->get_num_vertical_levels()) + "\n"); - EKAT_REQUIRE_MSG(pint_layout.dim(ILEV)==m_tgt_grid->get_num_vertical_levels()+1, - "Error! Target interface pressure field has the wrong layout.\n" - " - field name: " + pint.name() + "\n" - " - field layout: " + pint_layout.to_string() + "\n" - " - expected num levels: " + std::to_string(m_tgt_grid->get_num_vertical_levels()+1) + "\n"); - - m_tgt_pmid = pmid; - m_tgt_pint = pint; + EKAT_REQUIRE_MSG(p.is_allocated(), + msg_prefix + "Field is not yet allocated.\n" + " - field name: " + p.name() + "\n"); + + EKAT_REQUIRE_MSG(p.get_header().get_alloc_properties().is_compatible(), + msg_prefix + "Field not compatible with default pack size.\n" + " - pack size: " + std::to_string(SCREAM_PACK_SIZE) + "\n"); + + const int nlevs = src ? m_src_grid->get_num_vertical_levels() + : m_tgt_grid->get_num_vertical_levels(); + const auto& p_layout = p.get_header().get_identifier().get_layout(); + const auto vtag = p_layout.tags().back(); + const auto vdim = p_layout.dims().back(); + + FieldTag expected_tag; + int expected_dim; + switch (ptype) { + case Midpoints: + expected_tag = LEV; + expected_dim = nlevs; + if (src) { + m_src_pmid = p; + } else { + m_tgt_pmid = p; + } + break; + case Interfaces: + expected_tag = ILEV; + expected_dim = nlevs+1; + if (src) { + m_src_pint = p; + } else { + m_tgt_pint = p; + } + break; + case Both: + expected_tag = LEV; + expected_dim = nlevs; + if (src) { + m_src_pint = p; + m_src_pmid = p; + m_src_mid_same_as_int = true; + } else { + m_tgt_pint = p; + m_tgt_pmid = p; + m_tgt_mid_same_as_int = true; + } + break; + default: + EKAT_ERROR_MSG ("[VerticalRemapper::set_source_pressure] Error! Unrecognized value for 'ptype'.\n"); + } + EKAT_REQUIRE_MSG (vtag==expected_tag and vdim==expected_dim, + msg_prefix + "Invalid pressure layout.\n" + " - layout: " + p_layout.to_string() + "\n" + " - expected last layout tag: " + e2str(expected_tag) + "\n" + " - expected last layout dim: " + std::to_string(expected_dim) + "\n"); } void VerticalRemapper:: diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.hpp b/components/eamxx/src/share/grid/remap/vertical_remapper.hpp index a22a9bb56df..480b56a32dc 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.hpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.hpp @@ -26,6 +26,15 @@ class VerticalRemapper : public AbstractRemapper TopAndBot = Top | Bot }; + // When setting src/tgt pressure profiles, we may not care to distinguish + // between midpoints/interface. E.g., in output, we may remap both midpoints + // and interface quantities to the SAME set of pressure levels. + enum ProfileType { + Midpoints, + Interfaces, + Both + }; + // Use fixed value as mask value VerticalRemapper (const grid_ptr_type& src_grid, const std::string& map_file); @@ -65,8 +74,24 @@ class VerticalRemapper : public AbstractRemapper void set_extrapolation_type (const ExtrapType etype, const TopBot where = TopAndBot); void set_mask_value (const Real mask_val); - void set_source_pressure (const Field& pmid, const Field& pint); - void set_target_pressure (const Field& pmid, const Field& pint); + void set_source_pressure (const Field& p, const ProfileType ptype); + void set_target_pressure (const Field& p, const ProfileType ptype); + + void set_source_pressure (const Field& pmid, const Field& pint) { + set_source_pressure (pmid, Midpoints); + set_source_pressure (pint, Interfaces); + } + void set_target_pressure (const Field& pmid, const Field& pint) { + set_target_pressure (pmid, Midpoints); + set_target_pressure (pint, Interfaces); + } + + Field get_source_pressure (bool midpoints) const { + return midpoints ? m_src_pmid : m_src_pint; + } + Field get_target_pressure (bool midpoints) const { + return midpoints ? m_tgt_pmid : m_tgt_pint; + } // This method simply creates the tgt grid from a map file static std::shared_ptr @@ -75,6 +100,11 @@ class VerticalRemapper : public AbstractRemapper protected: + void set_pressure (const Field& p, const std::string& src_or_tgt, const ProfileType ptype); + FieldLayout create_layout (const FieldLayout& from_layout, + const std::shared_ptr& to_grid, + const bool int_same_as_mid) const; + const identifier_type& do_get_src_field_id (const int ifield) const override { return m_src_fields[ifield].get_header().get_identifier(); } @@ -142,9 +172,8 @@ class VerticalRemapper : public AbstractRemapper Field m_tgt_pmid; Field m_tgt_pint; - // If we remap to a fixed set of pressure levels during I/O, - // our tgt pint would be the same as tgt pmid. - bool m_tgt_int_same_as_mid = false; + bool m_src_mid_same_as_int = false; + bool m_tgt_mid_same_as_int = false; // Extrapolation settings at top/bottom. Default to P0 extrapolation ExtrapType m_etype_top = P0; From d243c39548c613865ff30f16ecf7b7c3b73df5b6 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 22 Nov 2024 17:02:34 -0700 Subject: [PATCH 462/529] EAMxx: first attempt at DataInterpolation class * The class handles time, horizontal, and vertical interpolation * The vertical/horizontal are optional, but the time dimension is REQUIRED --- components/eamxx/src/share/CMakeLists.txt | 7 +- .../share/util/eamxx_data_interpolation.cpp | 399 ++++++++++++++++++ .../share/util/eamxx_data_interpolation.hpp | 96 +++++ 3 files changed, 500 insertions(+), 2 deletions(-) create mode 100644 components/eamxx/src/share/util/eamxx_data_interpolation.cpp create mode 100644 components/eamxx/src/share/util/eamxx_data_interpolation.hpp diff --git a/components/eamxx/src/share/CMakeLists.txt b/components/eamxx/src/share/CMakeLists.txt index a0d6fc63a1d..f0263e4a225 100644 --- a/components/eamxx/src/share/CMakeLists.txt +++ b/components/eamxx/src/share/CMakeLists.txt @@ -32,13 +32,13 @@ set(SHARE_SRC property_checks/field_nan_check.cpp property_checks/field_within_interval_check.cpp property_checks/mass_and_energy_column_conservation_check.cpp + util/eamxx_data_interpolation.cpp util/eamxx_fv_phys_rrtmgp_active_gases_workaround.cpp + util/eamxx_time_interpolation.cpp util/scream_time_stamp.cpp util/scream_timing.cpp util/scream_utils.cpp - util/eamxx_time_interpolation.cpp util/scream_bfbhash.cpp - util/eamxx_time_interpolation.cpp ) if (EAMXX_ENABLE_EXPERIMENTAL_CODE) @@ -54,6 +54,9 @@ target_include_directories(scream_share PUBLIC ${SCREAM_BIN_DIR}/src ${CMAKE_CURRENT_SOURCE_DIR} ) +# Used in the data interpolation +target_link_libraries(scream_share PUBLIC stdc++fs) + if (GPTL_PATH) target_include_directories(scream_share PUBLIC ${GPTL_PATH}) diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp new file mode 100644 index 00000000000..8a7c0becd53 --- /dev/null +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp @@ -0,0 +1,399 @@ +#include "share/util/eamxx_data_interpolation.hpp" + +#include "share/grid/remap/identity_remapper.hpp" +#include "share/grid/remap/vertical_remapper.hpp" +#include "share/grid/remap/refining_remapper_p2p.hpp" +#include "share/io/scream_scorpio_interface.hpp" +#include "share/io/scream_io_utils.hpp" +#include "share/field/field_utils.hpp" +#include "share/util/scream_universal_constants.hpp" + +#include +#include +#include +#include + +namespace scream{ + +DataInterpolation:: +DataInterpolation (const std::shared_ptr& model_grid, + const std::vector& fields) + : m_model_grid (model_grid) + , m_fields (fields) +{ + EKAT_REQUIRE_MSG (model_grid!=nullptr, + "[DataInterpolation] Error! Invalid grid pointer.\n"); + + m_comm = model_grid->get_comm(); +} + +void DataInterpolation::run (const util::TimeStamp& ts) +{ + EKAT_REQUIRE_MSG (m_data_initialized, + "[DataInterpolation] Error! You must call 'init_data_interval' before calling 'run'.\n"); + + // If we went past the current interval end, we need to update the end state + if (not m_data_interval.contains(ts)) { + shift_data_interval (); + } + + // Perform the time interpolation: f_out = f_beg*alpha + f_end*(1-alpha), + // where alpha = (ts-t_beg) / (t_end-t_beg). + // NOTE: pay attention to time strategy, since for YearlyPeriodic you may + // have t_beg>t_end + util::TimeInterval beg_to_ts (m_data_interval.beg,ts,m_data_interval.timeline); + double alpha = beg_to_ts.length / m_data_interval.length; + EKAT_REQUIRE_MSG (alpha>=0 and alpha<=1, + "[DataInterpolation] Error! Input timestamp is outside the current data time interval.\n" + " data interval beg ; " + m_data_interval.beg.to_string() + "\n" + " data interval end ; " + m_data_interval.end.to_string() + "\n" + " input timestamp ; " + ts.to_string() + "\n" + " interval length : " + std::to_string(m_data_interval.length) + "\n" + " interpolation coeff: " + std::to_string(alpha) + "\n"); + + int nfields = m_fields.size(); + for (int i=0; iget_tgt_field(i); + const auto& end = m_horiz_remapper_end->get_tgt_field(i); + auto out = m_vert_remapper->get_src_field(i); + + out.deep_copy(beg); + out.update(end,alpha,1-alpha); + } + + m_vert_remapper->remap(true); +} + +void DataInterpolation::shift_data_interval () +{ + m_curr_interval_idx.first = m_curr_interval_idx.second; + m_curr_interval_idx.second = m_time_database.get_next_idx(m_curr_interval_idx.first); + + m_data_interval.advance(m_time_database.slices[m_curr_interval_idx.second].time); + std::swap (m_horiz_remapper_beg,m_horiz_remapper_end); + update_end_fields (); +} + +void DataInterpolation:: +update_end_fields () +{ + // First, set the correct fields in the reader + int nfields = m_horiz_remapper_end->get_num_fields(); + std::vector fields; + for (int i=0; iget_src_field(i)); + } + m_reader->set_fields(fields); + + // If we're also changing the file, must (re)init the scorpio structures + const auto& slice = m_time_database.slices[m_curr_interval_idx.second]; + if (m_reader->get_filename()!=slice.filename) { + m_reader->reset_filename(slice.filename); + } + + // Read and interpolate fields + m_reader->read_variables(slice.time_idx); + m_horiz_remapper_end->remap(true); +} + +void DataInterpolation:: +init_data_interval (const util::TimeStamp& t0) +{ + EKAT_REQUIRE_MSG (m_remappers_created, + "[DataInterpolation] Error! Cannot call 'init_data_interval' until after remappers creation.\n"); + + // Create a bare reader. Fields and filename are set inside the update_end_fields call + strvec_t fnames; + for (auto f : m_fields) { + fnames.push_back(f.name()); + } + m_reader = std::make_shared(fnames,m_horiz_remapper_beg->get_src_grid()); + + // Loop over all stored time slices to find an interval that contains t0 + auto t0_interval = m_time_database.find_interval(t0); + const auto& t_beg = m_time_database.slices[t0_interval].time; + + // We need to read in the beg/end fields for the initial interval. However, our generic + // framework can only load the end slice (since that's what we need at runtime). + // So, load end state for t=t_beg, then call shift_data_interval + // NOTE: don't compute length now, since beg time point is invalid (we don't need length yet). + m_data_interval = util::TimeInterval (util::TimeStamp(),t_beg,m_time_database.timeline,false); + m_curr_interval_idx.second = t0_interval; + update_end_fields (); + shift_data_interval (); + + m_data_initialized = true; +} + +void DataInterpolation:: +setup_time_database (const strvec_t& input_files, + const util::TimeLine timeline) +{ + // Make sure there are no repetitions + EKAT_REQUIRE_MSG (std::unordered_set(input_files.begin(),input_files.end()).size()==input_files.size(), + "[DataInterpolation] Error! The input files list contains duplicates.\n" + " - input_files:\n " + ekat::join(input_files,"\n ") + "\n"); + + // We perform a bunch of checks on the input files + namespace fs = std::filesystem; + + auto file_readable = [] (const std::string& fileName) { + std::ifstream file(fileName); + return file.good(); // Check if the file can be opened + }; + + // Log the final list of files, so the user know if something went wrong (e.g. a bad regex) + if (m_comm.am_i_root()) { + std::cout << "Setting up DataInerpolation object. List of input files:\n"; + for (const auto& fname : input_files) { + std::cout << " - " << fname << "\n"; + } + } + + // Read what time stamps we have in each file + auto ts2str = [](const util::TimeStamp& t) { return t.to_string(); }; + std::vector> times; + for (const auto& fname : input_files) { + EKAT_REQUIRE_MSG (file_readable(input_files.back()), + "Error! One of the input files is not readable.\n" + " - file : " + input_files.back() + "\n"); + + scorpio::register_file(fname,scorpio::Read); + + auto file_times = scorpio::get_all_times(fname); + EKAT_REQUIRE_MSG (file_times.size()>0, + "[DataInterpolation] Error! Input file contains no time variable.\n" + " - file name: " + fname + "\n"); + + auto t_ref = read_timestamp (fname,"reference_time_stamp"); + + times.emplace_back(); + for (const auto& t : file_times) { + times.back().push_back(t_ref + t*constants::seconds_per_day); + } + scorpio::release_file(fname); + + // Ensure time slices are sorted (it would make code messy otherwise) + EKAT_REQUIRE_MSG (std::is_sorted(times.back().begin(),times.back().end()), + "[DataInterpolation] Error! One of the input files has time slices not sorted.\n" + " - file name : " + fname + "\n" + " - time stamps: " + ekat::join(times.back(),ts2str,", ") + "\n"); + } + + // Sort the files based on start date + auto fileCmp = [](const std::vector& times1, + const std::vector& times2) + { + return times1.front() < times2.front(); + }; + std::sort(times.begin(),times.end(),fileCmp); + + // Setup the time database + m_time_database.timeline = timeline; + m_time_database.files = input_files; + + int nfiles = input_files.size(); + for (int i=0; i0) { + // Ensure files don't overlap (it would be a mess) + const auto& prev = times[i-1]; + const auto& next = times[i]; + EKAT_REQUIRE_MSG (prev.back() < next.front(), + "[DataInterpolation] Error! The input files contain overlapping time slices.\n" + " - file1 name : " + input_files[i-1] + "\n" + " - file2 name : " + input_files[i] + "\n" + " - file1 times: " + ekat::join(prev,ts2str,", ") + "\n" + " - file2 times: " + ekat::join(next,ts2str,", ") + "\n"); + } + } + + // To avoid trouble in our logic of handling time stamps relationshipc, + // we must ensure we have 2+ time slices overall + EKAT_REQUIRE_MSG (m_time_database.size()>=2, + "[DataInterpolation] Error! Input file(s) only contain 1 time slice overall.\n"); + + m_time_db_created = true; + + // Initialize horiz/vert remappers to identities + setup_remappers ("",None,"",{},{}); +} + +void DataInterpolation:: +setup_remappers (const std::string& hremap_filename, + const VRemapType vr_type, + const std::string& data_pname, + const Field& model_pmid, + const Field& model_pint) +{ + EKAT_REQUIRE_MSG (m_time_db_created, + "[DataInterpolation] Error! Cannot create remappers before time database.\n"); + + using IDR = IdentityRemapper; + constexpr auto SAT = IDR::SrcAliasTgt; + + // Whether horiz remap happens or not, the tgt grid of hremap is the same + // as the model grid, but with the same nubmer of levels as in the input files + auto grid_after_hremap = m_model_grid->clone("after_hremap",true); + int nlevs_data = get_input_files_dimlen ("lev"); + grid_after_hremap->reset_num_vertical_lev(nlevs_data); + + if (hremap_filename!="") { + m_horiz_remapper_beg = std::make_shared(grid_after_hremap,hremap_filename); + m_horiz_remapper_end = std::make_shared(grid_after_hremap,hremap_filename); + } else { + // If there's NO hremap, then ncols from the data must match the model grid (nlev can differ) + int ncols = get_input_files_dimlen ("ncol"); + EKAT_REQUIRE_MSG (ncols==m_model_grid->get_num_global_dofs(), + "Error! No horiz remap was requested, but the 'ncol' dim from file does not match with the model grid one.\n" + " - model grid num global cols: " + std::to_string(m_model_grid->get_num_global_dofs()) + "\n" + " - input data num global cols: " + std::to_string(ncols) + "\n"); + + m_horiz_remapper_beg = std::make_shared(grid_after_hremap,SAT); + m_horiz_remapper_end = std::make_shared(grid_after_hremap,SAT); + } + + if (vr_type!=None) { + m_vert_remapper = std::make_shared(grid_after_hremap,m_model_grid); + } else { + // If no vert remap is requested, model_grid and grid_after_hremap MUST have same nlevs + int model_nlevs = m_model_grid->get_num_vertical_levels(); + EKAT_REQUIRE_MSG (model_nlevs==nlevs_data, + "Error! No vertical remap was requested, but the 'lev' dim from file does not match the model grid one.\n" + " - model grid num vert levels: " + std::to_string(model_nlevs) + "\n" + " - input data num vert levels: " + std::to_string(nlevs_data) + "\n"); + m_vert_remapper = std::make_shared(grid_after_hremap,SAT); + } + + // Setup remappers. Vertical first, since we only have model-grid fields + int nfields = m_fields.size(); + m_vert_remapper->registration_begins(); + for (int i=0; iregister_field_from_tgt(m_fields[i]); + } + m_vert_remapper->registration_ends(); + + m_horiz_remapper_beg->registration_begins(); + m_horiz_remapper_end->registration_begins(); + for (int i=0; iget_src_field(i); + m_horiz_remapper_beg->register_field_from_tgt(f.clone()); + m_horiz_remapper_end->register_field_from_tgt(f.clone()); + } + + // Setup vertical pressure profiles (which can add 1 extra field to hremap) + if (vr_type==Dynamic3D) { + // We also need to load and remap the pressure from the input files + auto hr_tgt_grid = m_horiz_remapper_beg->get_tgt_grid(); + auto p_layout = hr_tgt_grid->get_3d_scalar_layout(true); + Field data_p (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); + data_p.allocate_view(); + m_horiz_remapper_beg->register_field_from_tgt(data_p.clone()); + m_horiz_remapper_end->register_field_from_tgt(data_p.clone()); + + auto vremap = std::dynamic_pointer_cast(m_vert_remapper); + vremap->set_source_pressure (data_p,VerticalRemapper::Both); + vremap->set_target_pressure (model_pmid,model_pint); + } else if (vr_type==Static1D) { + auto hr_tgt_grid = m_horiz_remapper_beg->get_tgt_grid(); + auto p_layout = hr_tgt_grid->get_vertical_layout(true); + Field data_p (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); + data_p.allocate_view(); + + auto vremap = std::dynamic_pointer_cast(m_vert_remapper); + vremap->set_target_pressure (data_p,VerticalRemapper::Both); + vremap->set_source_pressure (model_pmid,model_pint); + } + + m_horiz_remapper_beg->registration_ends(); + m_horiz_remapper_end->registration_ends(); + + m_remappers_created = true; +} + +int DataInterpolation::TimeDatabase:: +get_next_idx (int prev) const +{ + int next = prev+1; + if (next >= size()) { + EKAT_REQUIRE_MSG (timeline==util::TimeLine::YearlyPeriodic, + "[TimeDatabase::get_next_idx] Error! Requesting slice that is past the database end.\n"); + next = next % size(); + } + return next; +} + +int DataInterpolation::TimeDatabase:: +find_interval (const util::TimeStamp& t) const +{ + EKAT_REQUIRE_MSG (size()>1, + "[TimeDatabase::find_interval] Error! The database has not been initialized yet.\n"); + + auto contains = [&](int beg, int end, const util::TimeStamp& t) { + const auto& t_beg = slices[beg].time; + const auto& t_end = slices[end].time; + util::TimeInterval t_int (t_beg,t_end,timeline); + return t_int.contains(t); + }; + int beg=0; + int end=1; + while (end; + enum VRemapType { + None, + Static1D, + Dynamic3D + }; + + // Constructor(s) & Destructor + DataInterpolation (const std::shared_ptr& model_grid, + const std::vector& fields); + + ~DataInterpolation () = default; + + void setup_time_database (const strvec_t& input_files, const util::TimeLine timeline); + + void setup_remappers (const std::string& hremap_filename, + const VRemapType vremap, + const std::string& data_pname, + const Field& model_pmid, + const Field& model_pint); + + void init_data_interval (const util::TimeStamp& t0); + + void run (const util::TimeStamp& ts); + +protected: + + void shift_data_interval (); + void update_end_fields (); + + int get_input_files_dimlen (const std::string& dimname) const; + + // ----------- Internal data types ---------- // + + struct DataSlice { + util::TimeStamp time; + std::string filename; + int time_idx; // slice index within the input file + }; + + struct TimeDatabase { + strvec_t files; + std::vector slices; + util::TimeLine timeline; + + int size () const { return slices.size(); } + int get_next_idx (int prev_idx) const; + + // Find interval containing t + int find_interval (const util::TimeStamp& t) const; + }; + + // --------------- Internal data ------------- // + + std::shared_ptr m_reader; + + std::shared_ptr m_model_grid; + + std::vector m_fields; + + // Use two horiz remappers, so we only set them up once (it may be costly) + std::shared_ptr m_horiz_remapper_beg; + std::shared_ptr m_horiz_remapper_end; + std::shared_ptr m_vert_remapper; + + util::TimeInterval m_data_interval; + std::pair m_curr_interval_idx; + + TimeDatabase m_time_database; + + ekat::Comm m_comm; + ekat::ParameterList m_params; + + bool m_time_db_created = false; + bool m_remappers_created = false; + bool m_data_initialized = false; +}; + +} // namespace scream + +#endif // EAMXX_DATA_INTERPOLATION_HPP From 5a407b6d089077dbe76febcd28d6d1ba13e243f5 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 26 Nov 2024 17:41:46 -0700 Subject: [PATCH 463/529] EAMxx: add tests for data interpolation --- .../eamxx/src/share/tests/CMakeLists.txt | 12 +- .../share/tests/data_interpolation_setup.cpp | 91 ++++++++ .../share/tests/data_interpolation_tests.cpp | 219 ++++++++++++++++++ .../share/tests/data_interpolation_tests.hpp | 103 ++++++++ 4 files changed, 422 insertions(+), 3 deletions(-) create mode 100644 components/eamxx/src/share/tests/data_interpolation_setup.cpp create mode 100644 components/eamxx/src/share/tests/data_interpolation_tests.cpp create mode 100644 components/eamxx/src/share/tests/data_interpolation_tests.hpp diff --git a/components/eamxx/src/share/tests/CMakeLists.txt b/components/eamxx/src/share/tests/CMakeLists.txt index 3b4b60cb283..c64659575cb 100644 --- a/components/eamxx/src/share/tests/CMakeLists.txt +++ b/components/eamxx/src/share/tests/CMakeLists.txt @@ -51,10 +51,16 @@ if (NOT SCREAM_ONLY_GENERATE_BASELINES) LIBS scream_io MPI_RANKS 1 ${SCREAM_TEST_MAX_RANKS}) - # Test vertical remap - CreateUnitTest(time_interpolation "eamxx_time_interpolation_tests.cpp" + # Generate data for data interpolation test + CreateUnitTest(data_interpolation_setup "data_interpolation_setup.cpp" LIBS scream_io - MPI_RANKS 1 ${SCREAM_TEST_MAX_RANKS}) + FIXTURES_SETUP data_interpolation_setup) + + # Test data interpolation + CreateUnitTest(data_interpolation "data_interpolation_tests.cpp" + LIBS scream_io + MPI_RANKS 1 ${SCREAM_TEST_MAX_RANKS} + FIXTURES_REQUIRED data_interpolation_setup) # Test common physics functions CreateUnitTest(common_physics "common_physics_functions_tests.cpp") diff --git a/components/eamxx/src/share/tests/data_interpolation_setup.cpp b/components/eamxx/src/share/tests/data_interpolation_setup.cpp new file mode 100644 index 00000000000..5341872d74a --- /dev/null +++ b/components/eamxx/src/share/tests/data_interpolation_setup.cpp @@ -0,0 +1,91 @@ +#include + +#include "data_interpolation_tests.hpp" + +#include "share/io/scream_io_utils.hpp" +#include "share/io/scream_scorpio_interface.hpp" +#include "share/grid/point_grid.hpp" + +namespace scream { + +TEST_CASE ("data_interpolation_setup") +{ + // NOTE: ensure these match what's used in data_interpolation_tests.cpp + constexpr int ncols = 12; + constexpr int nlevs = 32; + + auto t_ref = get_t_ref(); + + // Init test session + ekat::Comm comm(MPI_COMM_WORLD); + scorpio::init_subsystem(comm); + + EKAT_REQUIRE_MSG (comm.size()==1, + "Error! You should run the data_interpolation_setup test with ONE rank.\n"); + + // Create grid + std::shared_ptr grid = create_point_grid("pg",ncols,nlevs,comm); + + // Create and setup two files, so we can test both YearlyPeriodic and LinearHistory + std::vector files = { + "data_interpolation_0.nc", + "data_interpolation_1.nc", + "data_interpolation_2.nc", + "data_interpolation_3.nc" + }; + for (const std::string& fname : files) { + scorpio::register_file(fname,scorpio::Write); + scorpio::define_dim(fname,"ncol",ncols); + scorpio::define_dim(fname,"lev",nlevs); + scorpio::define_dim(fname,"ilev",nlevs+1); + scorpio::define_dim(fname,"dim2",ncmps); + scorpio::define_time(fname,"days since " + t_ref.to_string()); + + scorpio::define_var(fname,"s2d", {"ncol"}, "real", true); + scorpio::define_var(fname,"v2d", {"ncol","dim2"}, "real", true); + scorpio::define_var(fname,"s3d_m",{"ncol","lev"}, "real", true); + scorpio::define_var(fname,"v3d_m",{"ncol","dim2","lev"}, "real", true); + scorpio::define_var(fname,"s3d_i",{"ncol","ilev"}, "real", true); + scorpio::define_var(fname,"v3d_i",{"ncol","dim2","ilev"},"real", true); + + scorpio::enddef(fname); + } + + // Fields and some helper fields (for later) + auto base_fields = create_fields (grid,true); + auto fields = create_fields(grid,false); + auto ones = create_fields(grid,false); + for (const auto& f : ones) { + f.deep_copy(1); + } + int nfields = fields.size(); + + // Loop over time, and add 30 to the value for the first 6 months, + // and subtract 30 for the last 6 months. This guarantees that the data + // is indeed periodic. We'll write at the 15th of each month + // Generate three files: + // - one to be used for yearly-periodic interp + // - two to be used for linear-hystory interp + util::TimeStamp time = get_first_slice_time (); + for (int mm=0; mm<24; ++mm) { + std::string file_name = "data_interpolation_" + std::to_string(mm/6) + ".nc"; + + scorpio::update_time(file_name,time.days_from(t_ref)); + for (int i=0; i()); + } + time += 86400*time.days_in_curr_month(); + } + + for (const std::string& fname : files) { + write_timestamp(fname,"reference_time_stamp",t_ref); + scorpio::release_file(fname); + } + + scorpio::finalize_subsystem(); +} + +} // anonymous namespace diff --git a/components/eamxx/src/share/tests/data_interpolation_tests.cpp b/components/eamxx/src/share/tests/data_interpolation_tests.cpp new file mode 100644 index 00000000000..86b7d11ee85 --- /dev/null +++ b/components/eamxx/src/share/tests/data_interpolation_tests.cpp @@ -0,0 +1,219 @@ +#include + +#include "data_interpolation_tests.hpp" + +#include "share/io/scream_scorpio_interface.hpp" +#include "share/util/eamxx_data_interpolation.hpp" +#include "share/grid/point_grid.hpp" +#include "share/field/field_utils.hpp" +#include "share/scream_config.hpp" + +// NOTE: ensure these are the same used in data_interpolation_setup.cpp +constexpr int data_ncols = 12; +constexpr int data_nlevs = 32; + +namespace scream { + +using strvec_t = std::vector; + +std::shared_ptr +create_interp (const std::shared_ptr& grid, + const std::vector& fields) +{ + return std::make_shared(grid,fields); +} + +TEST_CASE ("exceptions") +{ + // Test correctness of some exception handling inside the DataInterpolation source code + ekat::Comm comm(MPI_COMM_WORLD); + scorpio::init_subsystem(comm); + auto grid = create_point_grid("pg",data_ncols,data_nlevs,comm); + + auto fields = create_fields(grid,false); + + REQUIRE_THROWS (create_interp(nullptr,fields)); // Invalid grid pointer + + auto interp = create_interp(grid,fields); + + strvec_t files = {"/etc/shadow"}; + REQUIRE_THROWS (interp->setup_time_database(files,util::TimeLine::Linear)); // Input file not readable + + interp->setup_time_database({"./data_interpolation_0.nc"},util::TimeLine::Linear); + util::TimeStamp t0 ({2000,1,1},{0,0,0}); + REQUIRE_THROWS (interp->init_data_interval(t0)); // linear timeline, but t0init_data_interval(t1)); // linear timeline, but t0>last_slice + + scorpio::finalize_subsystem(); +} + +TEST_CASE ("interpolation") +{ + ekat::Comm comm(MPI_COMM_WORLD); + + // Regardless of how EAMxx is configured, ignore leap years for this test + set_use_leap_year(false); + + scorpio::init_subsystem(comm); + + Real tol = std::numeric_limits::epsilon()*10; + SECTION ("only-time") + { + auto grid = create_point_grid("pg",data_ncols,data_nlevs,comm); + + // Create a bunch of copies of the fields. All but the first set of them + // are used in the test phase to check the result against what's expected + auto fields = create_fields(grid,false); + auto base_f = create_fields(grid,true); + auto ones = create_fields (grid,false); + auto diff = create_fields (grid,false); + auto expected = create_fields (grid,false); + for (auto& f : ones) { + f.deep_copy(1); + } + int nfields = fields.size(); + + auto interp = create_interp(grid,fields); + + SECTION ("periodic") + { + strvec_t files = {"data_interpolation_0.nc","data_interpolation_1.nc"}; + + util::TimeStamp t0 ({2020,1,1},{0,0,0}); + + // t_beg/t_end keep track of the interval [beg,end] where we currently are, + // where beg/end are timestamps at which we have data. + // We assume we start with t0 after the last input slice of the 1st year. + // NOTE: -365*spd is since we actually need to *rewind* t0, if we want begsetup_time_database(files,util::TimeLine::YearlyPeriodic); + interp->init_data_interval(t0); + + // Loop for two year at a 20 day increment + int dt = 20*spd; + for (auto time = t0+dt; time.days_from(t0)<365; time+=dt) { + if (t_end1) { + std::cout << "TEST ERROR:\n" + << " t beg: " << t_beg.to_string() << "\n" + << " t end: " << t_end.to_string() << "\n" + << " time : " << time.to_string() << "\n" + << " t-beg: " << time_from_beg.length << "\n" + << " days in mm_beg: " << t_beg.days_in_curr_month() << "\n" + << " alpha: " << alpha << "\n" + << " delta_beg: " << delta_data[mm_beg] << "\n" + << " delta_end: " << delta_data[mm_end] << "\n" + << " delta: " << delta << "\n"; + } + // Compute expected difference from base value + interp->run(time); + for (int i=0; i(expected[i])); + if (frobenius_norm(diff[i])>=tol) { + auto n = fields[i].name(); + print_field_hyperslab(fields[i].alias(n+"_computed")); + print_field_hyperslab(expected[i].alias(n+"_expected")); + print_field_hyperslab(diff[i].alias(n+"_diff")); + } + REQUIRE (frobenius_norm(diff[i])setup_time_database(files,util::TimeLine::Linear); + interp->init_data_interval(t0); + + // Loop for two year at a 20 day increment + int dt = 20*spd; + for (auto time = t0+dt; time.days_from(t0)<200; time+=dt) { + if (t_end1) { + std::cout << "TEST ERROR:\n" + << " t beg: " << t_beg.to_string() << "\n" + << " t end: " << t_end.to_string() << "\n" + << " time : " << time.to_string() << "\n" + << " t-beg: " << time_from_beg.length << "\n" + << " days in mm_beg: " << t_beg.days_in_curr_month() << "\n" + << " alpha: " << alpha << "\n" + << " delta_beg: " << delta_data[mm_beg] << "\n" + << " delta_end: " << delta_data[mm_end] << "\n" + << " delta: " << delta << "\n"; + } + // Compute expected difference from base value + interp->run(time); + for (int i=0; i(expected[i])); + if (frobenius_norm(diff[i])>=tol) { + print_field_hyperslab(fields[i]); + print_field_hyperslab(expected[i]); + print_field_hyperslab(diff[i]); + } + REQUIRE (frobenius_norm(diff[i]) + +namespace scream +{ + +constexpr int ncmps = 2; +constexpr auto spd = constants::seconds_per_day; + +// At each month in the input data, we are adding a delta to the "base" value of the fields. +constexpr double delta_data[12] = {0, 30, 60, 90, 120, 150, 180, 150, 120, 90, 60, 30}; + +inline util::TimeStamp get_t_ref () { + return util::TimeStamp ({2010,1,1},{0,0,0}); +} + +inline util::TimeStamp get_first_slice_time () { + // 15 days after the reference time + return get_t_ref() + 86400*15; +} + +inline util::TimeStamp get_last_slice_time () { + // 11 months after the 1st slice + auto t = get_first_slice_time(); + + for (int mm=0; mm<23; ++mm) { + t += constants::seconds_per_day*t.days_in_curr_month(); + } + return t; +} + +std::vector +create_fields (const std::shared_ptr& grid, + const bool init_values) +{ + constexpr auto m = ekat::units::m; + const auto& gn = grid->name(); + + // Create fields and initialize their data as + // set data as f(icol,icmp,ilev) = icol*ncmp*nlev + icmp*nlev + ilev + + auto layout_s2d = grid->get_2d_scalar_layout(); + auto layout_v2d = grid->get_2d_vector_layout(ncmps); + auto layout_s3d_m = grid->get_3d_scalar_layout(true); + auto layout_v3d_m = grid->get_3d_vector_layout(true,ncmps); + auto layout_s3d_i = grid->get_3d_scalar_layout(false); + auto layout_v3d_i = grid->get_3d_vector_layout(false,ncmps); + + Field s2d (FieldIdentifier("s2d", layout_s2d, m, gn)); + Field v2d (FieldIdentifier("v2d", layout_v2d, m, gn)); + Field s3d_m(FieldIdentifier("s3d_m", layout_s3d_m, m, gn)); + Field v3d_m(FieldIdentifier("v3d_m", layout_v3d_m, m, gn)); + Field s3d_i(FieldIdentifier("s3d_i", layout_s3d_i, m, gn)); + Field v3d_i(FieldIdentifier("v3d_i", layout_v3d_i, m, gn)); + + s2d.allocate_view(); + v2d.allocate_view(); + s3d_m.allocate_view(); + v3d_m.allocate_view(); + s3d_i.allocate_view(); + v3d_i.allocate_view(); + + if (init_values) { + int ncols = grid->get_num_local_dofs(); + int nlevs = grid->get_num_vertical_levels(); + int nlevsp1 = nlevs+1; + for (int icol=0; icol()(icol,icmp,ilev) = icol*ncmps*nlevs + icmp*nlevs + ilev; + v3d_i.get_view()(icol,icmp,ilev) = icol*ncmps*nlevsp1 + icmp*nlevsp1 + ilev; + } + s3d_m.get_view()(icol,ilev) = icol*nlevs + ilev; + s3d_i.get_view()(icol,ilev) = icol*nlevsp1 + ilev; + } + s3d_i.get_view()(icol,nlevs) = icol*nlevsp1 + nlevs; + for (int icmp=0; icmp()(icol,icmp,nlevs) = icol*ncmps*nlevsp1 + icmp*nlevsp1 + nlevs; + v2d.get_view()(icol,icmp) = icol*ncmps + icmp; + } + s2d.get_view()(icol) = icol; + } + + s2d.sync_to_dev(); + v2d.sync_to_dev(); + s3d_m.sync_to_dev(); + v3d_m.sync_to_dev(); + s3d_i.sync_to_dev(); + v3d_i.sync_to_dev(); + } + + return {s2d, v2d, s3d_m, v3d_m, s3d_i, v3d_i}; +} + +} // namespace scream + +#endif // EAMXX_DATA_INTERPOLATION_TESTS_HPP From 41d756e06ff6fdfbc4b035cb6461c85739d38810 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 17 Dec 2024 17:47:19 -0700 Subject: [PATCH 464/529] EAMxx: add testing for horiz remap to data interpolation --- .../share/tests/data_interpolation_setup.cpp | 185 +++++++--- .../share/tests/data_interpolation_tests.cpp | 319 +++++++++--------- .../share/tests/data_interpolation_tests.hpp | 90 +++-- .../share/util/eamxx_data_interpolation.cpp | 67 ++-- .../share/util/eamxx_data_interpolation.hpp | 4 + 5 files changed, 407 insertions(+), 258 deletions(-) diff --git a/components/eamxx/src/share/tests/data_interpolation_setup.cpp b/components/eamxx/src/share/tests/data_interpolation_setup.cpp index 5341872d74a..e8401b2e63a 100644 --- a/components/eamxx/src/share/tests/data_interpolation_setup.cpp +++ b/components/eamxx/src/share/tests/data_interpolation_setup.cpp @@ -11,8 +11,8 @@ namespace scream { TEST_CASE ("data_interpolation_setup") { // NOTE: ensure these match what's used in data_interpolation_tests.cpp - constexpr int ncols = 12; - constexpr int nlevs = 32; + constexpr int ngcols = data_ngcols; + constexpr int nlevs = data_nlevs; auto t_ref = get_t_ref(); @@ -24,67 +24,146 @@ TEST_CASE ("data_interpolation_setup") "Error! You should run the data_interpolation_setup test with ONE rank.\n"); // Create grid - std::shared_ptr grid = create_point_grid("pg",ncols,nlevs,comm); + std::shared_ptr grid = create_point_grid("pg",ngcols,nlevs,comm); // Create and setup two files, so we can test both YearlyPeriodic and LinearHistory std::vector files = { - "data_interpolation_0.nc", - "data_interpolation_1.nc", - "data_interpolation_2.nc", - "data_interpolation_3.nc" + "data_interpolation_0", + "data_interpolation_1" }; - for (const std::string& fname : files) { - scorpio::register_file(fname,scorpio::Write); - scorpio::define_dim(fname,"ncol",ncols); - scorpio::define_dim(fname,"lev",nlevs); - scorpio::define_dim(fname,"ilev",nlevs+1); - scorpio::define_dim(fname,"dim2",ncmps); - scorpio::define_time(fname,"days since " + t_ref.to_string()); - - scorpio::define_var(fname,"s2d", {"ncol"}, "real", true); - scorpio::define_var(fname,"v2d", {"ncol","dim2"}, "real", true); - scorpio::define_var(fname,"s3d_m",{"ncol","lev"}, "real", true); - scorpio::define_var(fname,"v3d_m",{"ncol","dim2","lev"}, "real", true); - scorpio::define_var(fname,"s3d_i",{"ncol","ilev"}, "real", true); - scorpio::define_var(fname,"v3d_i",{"ncol","dim2","ilev"},"real", true); - - scorpio::enddef(fname); - } - // Fields and some helper fields (for later) - auto base_fields = create_fields (grid,true); - auto fields = create_fields(grid,false); - auto ones = create_fields(grid,false); - for (const auto& f : ones) { - f.deep_copy(1); - } - int nfields = fields.size(); - - // Loop over time, and add 30 to the value for the first 6 months, - // and subtract 30 for the last 6 months. This guarantees that the data - // is indeed periodic. We'll write at the 15th of each month - // Generate three files: - // - one to be used for yearly-periodic interp - // - two to be used for linear-hystory interp - util::TimeStamp time = get_first_slice_time (); - for (int mm=0; mm<24; ++mm) { - std::string file_name = "data_interpolation_" + std::to_string(mm/6) + ".nc"; - - scorpio::update_time(file_name,time.days_from(t_ref)); - for (int i=0; i()); + for (auto with_pressure : {true, false}) { + auto suffix = with_pressure ? "_with_p.nc" : ".nc"; + for (const std::string& fname : files) { + scorpio::register_file(fname+suffix,scorpio::Write); + + scorpio::define_dim (fname+suffix,"ncol",ngcols); + scorpio::define_dim (fname+suffix,"lev",nlevs); + if (not with_pressure) { + scorpio::define_dim (fname+suffix,"ilev",nlevs+1); + } + scorpio::define_dim (fname+suffix,"dim2",ncmps); + scorpio::define_time(fname+suffix,"days since " + t_ref.to_string()); + + std::string ilev_tag = with_pressure ? "lev" : "ilev"; + + scorpio::define_var(fname+suffix,"s2d", {"ncol"}, "real", true); + scorpio::define_var(fname+suffix,"s2d", {"ncol"}, "real", true); + scorpio::define_var(fname+suffix,"v2d", {"ncol","dim2"}, "real", true); + scorpio::define_var(fname+suffix,"s3d_m",{"ncol","lev"}, "real", true); + scorpio::define_var(fname+suffix,"v3d_m",{"ncol","dim2","lev"}, "real", true); + scorpio::define_var(fname+suffix,"s3d_i",{"ncol",ilev_tag}, "real", true); + scorpio::define_var(fname+suffix,"v3d_i",{"ncol","dim2",ilev_tag}, "real", true); + + if (with_pressure) { + scorpio::define_var(fname+suffix,"p1d",{"lev"},"real", false); + scorpio::define_var(fname+suffix,"p3d",{"ncol","lev"},"real", true); + } + + scorpio::enddef(fname+suffix); + } + + // Fields and some helper fields (for later) + // NOTE: if we save a pressure field, there is not distinction + // between interfaces and midpoints in the file + auto base_fields = create_fields (grid,true,with_pressure); + auto fields = create_fields(grid,false,with_pressure); + auto ones = create_fields(grid,false,with_pressure); + for (const auto& f : ones) { + f.deep_copy(1); + } + int nfields = fields.size(); + + // Loop over time, and add 30 to the value for the first 6 months, + // and subtract 30 for the last 6 months. This guarantees that the data + // is indeed periodic. We'll write at the 15th of each month + // Generate three files: + // - one to be used for yearly-periodic interp + // - two to be used for linear-hystory interp + util::TimeStamp time = get_first_slice_time (); + + if (with_pressure) { + // Create p1d as slice of p3d, and ensure it's the same on all ranks, then write it. + auto p1d = fields.back().subfield(0,0).clone("p1d"); + auto comm = grid->get_comm(); + comm.broadcast(p1d.get_internal_view_data(),nlevs,0); + p1d.sync_to_dev(); + for (const std::string& fname : files) { + scorpio::write_var(fname+suffix,p1d.name(),p1d.get_internal_view_data()); + } + } + + for (int mm=0; mm<12; ++mm) { + std::string file_name = "data_interpolation_" + std::to_string(mm/6) + suffix; + + // We start the files with July + int mm_index = mm+6; + scorpio::update_time(file_name,time.days_from(t_ref)); + for (int i=0; i()); + } + time += 86400*time.days_in_curr_month(); + } + + for (const std::string& fname : files) { + write_timestamp(fname+suffix,"reference_time_stamp",t_ref); + scorpio::release_file(fname+suffix); } - time += 86400*time.days_in_curr_month(); } - for (const std::string& fname : files) { - write_timestamp(fname,"reference_time_stamp",t_ref); - scorpio::release_file(fname); + // Now write a map file for horiz remap, that splits each dof interval in two + const int ngdofs_src = data_ngcols; + const int ngdofs_tgt = fine_ngcols; + + // Existing dofs are "copied", added dofs are averaged from neighbors + const int nnz = ngdofs_src + 2*(ngdofs_src-1); + + std::string filename = map_file_name; + scorpio::register_file(filename, scorpio::FileMode::Write); + + scorpio::define_dim(filename, "n_a", ngdofs_src); + scorpio::define_dim(filename, "n_b", ngdofs_tgt); + scorpio::define_dim(filename, "n_s", nnz); + + scorpio::define_var(filename, "col", {"n_s"}, "int"); + scorpio::define_var(filename, "row", {"n_s"}, "int"); + scorpio::define_var(filename, "S", {"n_s"}, "double"); + + scorpio::enddef(filename); + + std::vector col(nnz), row(nnz); + std::vector S(nnz); + for (int i=0,nnz=0; i::epsilon()*10; +constexpr auto P1D = DataInterpolation::Static1D; +constexpr auto P3D = DataInterpolation::Dynamic3D; using strvec_t = std::vector; +util::TimeStamp reset_year (const util::TimeStamp& t_in, int yy) +{ + auto date = t_in.get_date(); + auto time = t_in.get_time(); + date[0] = yy; + return util::TimeStamp(date,time); +} + std::shared_ptr create_interp (const std::shared_ptr& grid, const std::vector& fields) @@ -23,14 +30,107 @@ create_interp (const std::shared_ptr& grid, return std::make_shared(grid,fields); } +void root_print (const ekat::Comm& comm, + const std::string& msg) +{ + if (comm.am_i_root()) { + printf("%s",msg.c_str()); + } +} + +// Run the data interpolation to the input grid, and check against expected values +void run_tests (const std::shared_ptr& grid, + const strvec_t& input_files, util::TimeStamp t_beg, + const util::TimeLine timeline, + const DataInterpolation::VRemapType vr_type = DataInterpolation::None) +{ + auto t_end = t_beg + t_beg.days_in_curr_month()*spd; + auto t0 = t_beg + (t_end-t_beg)/2; + + // These are the fields we will compute + auto fields = create_fields(grid,false,false); + + std::string map_file = grid->get_num_global_dofs()==data_ngcols ? "" : map_file_name; + + // These are used to check the answer + auto base_f = create_fields(grid,true); + auto ones = create_fields(grid,false); + auto diff = create_fields(grid,false); + auto expected = create_fields(grid,false); + for (auto& f : ones) { + f.deep_copy(1); + } + int nfields = fields.size(); + + std::string data_pname = vr_type==P1D ? "p1d" : "p3d"; // if vr_type==None, it's not used anyways + auto model_pmid = base_f[2].clone("pmid"); // ensure the 2nd field is s3d_m + auto model_pint = base_f[4].clone("pint"); // ensure the 4th field is s3d_i + + auto interp = create_interp(grid,fields); + interp->setup_time_database(input_files,util::TimeLine::YearlyPeriodic); + interp->setup_remappers (map_file,vr_type,data_pname,model_pmid,model_pint); + interp->init_data_interval(t0); + + // Loop for two year at a 20 day increment + int dt = 20*spd; + for (auto time = t0+dt; time.days_from(t0)<365; time+=dt) { + if (t_end1) { + std::cout << "TEST ERROR:\n" + << " t beg: " << t_beg.to_string() << "\n" + << " t end: " << t_end.to_string() << "\n" + << " time : " << time.to_string() << "\n" + << " t-beg: " << time_from_beg.length << "\n" + << " days in mm_beg: " << t_beg.days_in_curr_month() << "\n" + << " alpha: " << alpha << "\n" + << " delta_beg: " << delta_data[mm_beg] << "\n" + << " delta_end: " << delta_data[mm_end] << "\n" + << " delta: " << delta << "\n"; + } + // Compute expected difference from base value + interp->run(time); + for (int i=0; i(expected[i])); + if (frobenius_norm(diff[i])>=tol) { + auto n = fields[i].name(); + print_field_hyperslab(fields[i].alias(n+"_computed")); + print_field_hyperslab(expected[i].alias(n+"_expected")); + print_field_hyperslab(diff[i].alias(n+"_diff")); + } + REQUIRE (frobenius_norm(diff[i])::epsilon()*10; - SECTION ("only-time") - { - auto grid = create_point_grid("pg",data_ncols,data_nlevs,comm); - - // Create a bunch of copies of the fields. All but the first set of them - // are used in the test phase to check the result against what's expected - auto fields = create_fields(grid,false); - auto base_f = create_fields(grid,true); - auto ones = create_fields (grid,false); - auto diff = create_fields (grid,false); - auto expected = create_fields (grid,false); - for (auto& f : ones) { - f.deep_copy(1); - } - int nfields = fields.size(); - - auto interp = create_interp(grid,fields); - - SECTION ("periodic") - { - strvec_t files = {"data_interpolation_0.nc","data_interpolation_1.nc"}; - - util::TimeStamp t0 ({2020,1,1},{0,0,0}); - - // t_beg/t_end keep track of the interval [beg,end] where we currently are, - // where beg/end are timestamps at which we have data. - // We assume we start with t0 after the last input slice of the 1st year. - // NOTE: -365*spd is since we actually need to *rewind* t0, if we want begsetup_time_database(files,util::TimeLine::YearlyPeriodic); - interp->init_data_interval(t0); - - // Loop for two year at a 20 day increment - int dt = 20*spd; - for (auto time = t0+dt; time.days_from(t0)<365; time+=dt) { - if (t_end1) { - std::cout << "TEST ERROR:\n" - << " t beg: " << t_beg.to_string() << "\n" - << " t end: " << t_end.to_string() << "\n" - << " time : " << time.to_string() << "\n" - << " t-beg: " << time_from_beg.length << "\n" - << " days in mm_beg: " << t_beg.days_in_curr_month() << "\n" - << " alpha: " << alpha << "\n" - << " delta_beg: " << delta_data[mm_beg] << "\n" - << " delta_end: " << delta_data[mm_end] << "\n" - << " delta: " << delta << "\n"; - } - // Compute expected difference from base value - interp->run(time); - for (int i=0; i(expected[i])); - if (frobenius_norm(diff[i])>=tol) { - auto n = fields[i].name(); - print_field_hyperslab(fields[i].alias(n+"_computed")); - print_field_hyperslab(expected[i].alias(n+"_expected")); - print_field_hyperslab(diff[i].alias(n+"_diff")); - } - REQUIRE (frobenius_norm(diff[i])setup_time_database(files,util::TimeLine::Linear); - interp->init_data_interval(t0); - - // Loop for two year at a 20 day increment - int dt = 20*spd; - for (auto time = t0+dt; time.days_from(t0)<200; time+=dt) { - if (t_end1) { - std::cout << "TEST ERROR:\n" - << " t beg: " << t_beg.to_string() << "\n" - << " t end: " << t_end.to_string() << "\n" - << " time : " << time.to_string() << "\n" - << " t-beg: " << time_from_beg.length << "\n" - << " days in mm_beg: " << t_beg.days_in_curr_month() << "\n" - << " alpha: " << alpha << "\n" - << " delta_beg: " << delta_data[mm_beg] << "\n" - << " delta_end: " << delta_data[mm_end] << "\n" - << " delta: " << delta << "\n"; - } - // Compute expected difference from base value - interp->run(time); - for (int i=0; i(expected[i])); - if (frobenius_norm(diff[i])>=tol) { - print_field_hyperslab(fields[i]); - print_field_hyperslab(expected[i]); - print_field_hyperslab(diff[i]); - } - REQUIRE (frobenius_norm(diff[i]) create_fields (const std::shared_ptr& grid, - const bool init_values) + const bool init_values, + const bool with_pressure = false) { - constexpr auto m = ekat::units::m; + constexpr auto m = ekat::units::m; + constexpr auto Pa = ekat::units::Pa; const auto& gn = grid->name(); - // Create fields and initialize their data as - // set data as f(icol,icmp,ilev) = icol*ncmp*nlev + icmp*nlev + ilev + auto int_same_as_mid = with_pressure; + + // Create fields auto layout_s2d = grid->get_2d_scalar_layout(); auto layout_v2d = grid->get_2d_vector_layout(ncmps); auto layout_s3d_m = grid->get_3d_scalar_layout(true); auto layout_v3d_m = grid->get_3d_vector_layout(true,ncmps); - auto layout_s3d_i = grid->get_3d_scalar_layout(false); - auto layout_v3d_i = grid->get_3d_vector_layout(false,ncmps); + auto layout_s3d_i = grid->get_3d_scalar_layout(int_same_as_mid); + auto layout_v3d_i = grid->get_3d_vector_layout(int_same_as_mid,ncmps); Field s2d (FieldIdentifier("s2d", layout_s2d, m, gn)); Field v2d (FieldIdentifier("v2d", layout_v2d, m, gn)); @@ -59,6 +72,11 @@ create_fields (const std::shared_ptr& grid, Field s3d_i(FieldIdentifier("s3d_i", layout_s3d_i, m, gn)); Field v3d_i(FieldIdentifier("v3d_i", layout_v3d_i, m, gn)); + s3d_m.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + v3d_m.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + s3d_i.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + v3d_i.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + s2d.allocate_view(); v2d.allocate_view(); s3d_m.allocate_view(); @@ -67,24 +85,49 @@ create_fields (const std::shared_ptr& grid, v3d_i.allocate_view(); if (init_values) { + // We set horiz/vert values based on the position of the dof, assuming that + // - we have a 1d horiz grid + // - leftmost h dof gets a value of 0, rightmost a value of 1.0 + // - bottom interface gets a value of 0, top interface get a value of 1.0 + // - midpoints are the avg of interfaces + // - we do hvalue*prod_other_dims + icmp*num_v_levs + v_value int ncols = grid->get_num_local_dofs(); int nlevs = grid->get_num_vertical_levels(); int nlevsp1 = nlevs+1; + int ngcols = grid->get_num_global_dofs(); + int nh_intervals = ngcols - 1; + double h_value, v_value; + double h_max = 1.0; + double v_max = 1.0; + double dh = h_max / nh_intervals; + double dv = v_max / nlevs; + auto gids = grid->get_dofs_gids().get_view(); for (int icol=0; icol()(icol,icmp,ilev) = icol*ncmps*nlevs + icmp*nlevs + ilev; - v3d_i.get_view()(icol,icmp,ilev) = icol*ncmps*nlevsp1 + icmp*nlevsp1 + ilev; + v3d_m.get_view()(icol,icmp,ilev) = h_value*ncmps*nlevs + icmp*nlevs + v_value + dv/2; + v3d_i.get_view()(icol,icmp,ilev) = h_value*ncmps*nlevsp1 + icmp*nlevsp1 + v_value; } - s3d_m.get_view()(icol,ilev) = icol*nlevs + ilev; - s3d_i.get_view()(icol,ilev) = icol*nlevsp1 + ilev; + s3d_m.get_view()(icol,ilev) = h_value*nlevs + v_value; + s3d_i.get_view()(icol,ilev) = h_value*nlevsp1 + v_value; } - s3d_i.get_view()(icol,nlevs) = icol*nlevsp1 + nlevs; + // Last interface (if mid!=int) + if (not int_same_as_mid) { + s3d_i.get_view()(icol,nlevs) = h_value*nlevsp1 + v_max; + for (int icmp=0; icmp()(icol,icmp,nlevs) = h_value*ncmps*nlevsp1 + icmp*nlevsp1 + v_max; + } + } + + // 2D quantities for (int icmp=0; icmp()(icol,icmp,nlevs) = icol*ncmps*nlevsp1 + icmp*nlevsp1 + nlevs; - v2d.get_view()(icol,icmp) = icol*ncmps + icmp; + v2d.get_view()(icol,icmp) = h_value*ncmps + icmp; } - s2d.get_view()(icol) = icol; + s2d.get_view()(icol) = h_value; } s2d.sync_to_dev(); @@ -95,7 +138,16 @@ create_fields (const std::shared_ptr& grid, v3d_i.sync_to_dev(); } - return {s2d, v2d, s3d_m, v3d_m, s3d_i, v3d_i}; + if (with_pressure) { + // Don't just clone s3d_m, so we actually get "Pa" in the nc file units + Field p3d(FieldIdentifier("p3d",layout_s3d_m,Pa,gn)); + p3d.allocate_view(); + p3d.deep_copy(s3d_m); + + return {s2d, v2d, s3d_m, v3d_m, s3d_i, v3d_i, p3d}; + } else { + return {s2d, v2d, s3d_m, v3d_m, s3d_i, v3d_i}; + } } } // namespace scream diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp index 8a7c0becd53..b14196e009d 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp @@ -129,6 +129,14 @@ void DataInterpolation:: setup_time_database (const strvec_t& input_files, const util::TimeLine timeline) { + // Log the final list of files, so the user know if something went wrong (e.g. a bad regex) + if (m_dbg_output and m_comm.am_i_root()) { + std::cout << "Setting up DataInerpolation object. List of input files:\n"; + for (const auto& fname : input_files) { + std::cout << " - " << fname << "\n"; + } + } + // Make sure there are no repetitions EKAT_REQUIRE_MSG (std::unordered_set(input_files.begin(),input_files.end()).size()==input_files.size(), "[DataInterpolation] Error! The input files list contains duplicates.\n" @@ -142,14 +150,6 @@ setup_time_database (const strvec_t& input_files, return file.good(); // Check if the file can be opened }; - // Log the final list of files, so the user know if something went wrong (e.g. a bad regex) - if (m_comm.am_i_root()) { - std::cout << "Setting up DataInerpolation object. List of input files:\n"; - for (const auto& fname : input_files) { - std::cout << " - " << fname << "\n"; - } - } - // Read what time stamps we have in each file auto ts2str = [](const util::TimeStamp& t) { return t.to_string(); }; std::vector> times; @@ -222,9 +222,6 @@ setup_time_database (const strvec_t& input_files, "[DataInterpolation] Error! Input file(s) only contain 1 time slice overall.\n"); m_time_db_created = true; - - // Initialize horiz/vert remappers to identities - setup_remappers ("",None,"",{},{}); } void DataInterpolation:: @@ -273,31 +270,16 @@ setup_remappers (const std::string& hremap_filename, m_vert_remapper = std::make_shared(grid_after_hremap,SAT); } - // Setup remappers. Vertical first, since we only have model-grid fields - int nfields = m_fields.size(); - m_vert_remapper->registration_begins(); - for (int i=0; iregister_field_from_tgt(m_fields[i]); - } - m_vert_remapper->registration_ends(); - - m_horiz_remapper_beg->registration_begins(); - m_horiz_remapper_end->registration_begins(); - for (int i=0; iget_src_field(i); - m_horiz_remapper_beg->register_field_from_tgt(f.clone()); - m_horiz_remapper_end->register_field_from_tgt(f.clone()); - } - // Setup vertical pressure profiles (which can add 1 extra field to hremap) + // This MUST be done before registering in vremap, since register_field_from_tgt + // REQUIRES to have source pressure profiles set BEFORE. + Field data_p; if (vr_type==Dynamic3D) { // We also need to load and remap the pressure from the input files auto hr_tgt_grid = m_horiz_remapper_beg->get_tgt_grid(); auto p_layout = hr_tgt_grid->get_3d_scalar_layout(true); - Field data_p (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); + data_p = Field (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); data_p.allocate_view(); - m_horiz_remapper_beg->register_field_from_tgt(data_p.clone()); - m_horiz_remapper_end->register_field_from_tgt(data_p.clone()); auto vremap = std::dynamic_pointer_cast(m_vert_remapper); vremap->set_source_pressure (data_p,VerticalRemapper::Both); @@ -305,14 +287,33 @@ setup_remappers (const std::string& hremap_filename, } else if (vr_type==Static1D) { auto hr_tgt_grid = m_horiz_remapper_beg->get_tgt_grid(); auto p_layout = hr_tgt_grid->get_vertical_layout(true); - Field data_p (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); + data_p = Field (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); data_p.allocate_view(); auto vremap = std::dynamic_pointer_cast(m_vert_remapper); - vremap->set_target_pressure (data_p,VerticalRemapper::Both); - vremap->set_source_pressure (model_pmid,model_pint); + vremap->set_source_pressure (data_p,VerticalRemapper::Both); + vremap->set_target_pressure (model_pmid,model_pint); + } + + // Register fields in the remappers. Vertical first, since we only have model-grid fields + int nfields = m_fields.size(); + m_vert_remapper->registration_begins(); + for (int i=0; iregister_field_from_tgt(m_fields[i]); } + m_vert_remapper->registration_ends(); + m_horiz_remapper_beg->registration_begins(); + m_horiz_remapper_end->registration_begins(); + for (int i=0; iget_src_field(i); + m_horiz_remapper_beg->register_field_from_tgt(f.clone()); + m_horiz_remapper_end->register_field_from_tgt(f.clone()); + } + if (vr_type==Dynamic3D) { + m_horiz_remapper_beg->register_field_from_tgt(data_p.clone()); + m_horiz_remapper_end->register_field_from_tgt(data_p.clone()); + } m_horiz_remapper_beg->registration_ends(); m_horiz_remapper_end->registration_ends(); diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.hpp b/components/eamxx/src/share/util/eamxx_data_interpolation.hpp index 508d4ffc427..fe770e37f97 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.hpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.hpp @@ -26,6 +26,8 @@ class DataInterpolation ~DataInterpolation () = default; + void toggle_debug_output (bool enable_dbg_output) { m_dbg_output = enable_dbg_output; } + void setup_time_database (const strvec_t& input_files, const util::TimeLine timeline); void setup_remappers (const std::string& hremap_filename, @@ -89,6 +91,8 @@ class DataInterpolation bool m_time_db_created = false; bool m_remappers_created = false; bool m_data_initialized = false; + + bool m_dbg_output = false; }; } // namespace scream From d04e6983575018fb71c0041a4b2a4922dde50865 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 19 Dec 2024 16:28:08 -0700 Subject: [PATCH 465/529] EAMxx: fix issues in VerticalRemapper We were still assuming tgt layout could only have LEV and not ILEV. --- .../src/share/grid/remap/vertical_remapper.cpp | 7 +++++-- .../src/share/grid/remap/vertical_remapper.hpp | 16 +++++++++------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp index 394a1205fb8..cb55080da38 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.cpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.cpp @@ -278,10 +278,13 @@ do_bind_field (const int ifield, const field_type& src, const field_type& tgt) auto& f_tgt = m_tgt_fields[ifield]; // Nonconst, since we need to set extra data in the header if (src_layout.has_tag(LEV) or src_layout.has_tag(ILEV)) { // Determine if this field can be handled with packs, and whether it's at midpoints + // NOTE: we don't know if mid==int on src or tgt. If it is, we use the other to determine mid-vs-int // Add mask tracking to the target field. The mask tracks location of tgt pressure levs that are outside the // bounds of the src pressure field, and hence cannot be recovered by interpolation auto& ft = m_field2type[src.name()]; - ft.midpoints = src.get_header().get_identifier().get_layout().has_tag(LEV); + ft.midpoints = m_src_mid_same_as_int + ? tgt.get_header().get_identifier().get_layout().has_tag(LEV) + : src.get_header().get_identifier().get_layout().has_tag(LEV); ft.packed = src.get_header().get_alloc_properties().is_compatible() and tgt.get_header().get_alloc_properties().is_compatible(); @@ -440,7 +443,7 @@ void VerticalRemapper::do_remap_fwd () const auto& f_src = m_src_fields[i]; auto& f_tgt = m_tgt_fields[i]; const auto& tgt_layout = f_tgt.get_header().get_identifier().get_layout(); - if (tgt_layout.has_tag(LEV)) { + if (tgt_layout.has_tag(LEV) or tgt_layout.has_tag(ILEV)) { const auto& type = m_field2type.at(f_src.name()); // Dispatch interpolation to the proper lin interp object if (type.midpoints) { diff --git a/components/eamxx/src/share/grid/remap/vertical_remapper.hpp b/components/eamxx/src/share/grid/remap/vertical_remapper.hpp index 480b56a32dc..15495497062 100644 --- a/components/eamxx/src/share/grid/remap/vertical_remapper.hpp +++ b/components/eamxx/src/share/grid/remap/vertical_remapper.hpp @@ -54,23 +54,25 @@ class VerticalRemapper : public AbstractRemapper // NOTE: tgt layouts always use LEV (not ILEV), while src can have ILEV or LEV. using namespace ShortFieldTagsNames; - auto src_stripped = src.clone().strip_dim(ILEV,false).strip_dim(LEV,false); - auto tgt_stripped = tgt.clone().strip_dim(LEV,false); + auto src_stripped = src.clone().strip_dims({LEV,ILEV}); + auto tgt_stripped = tgt.clone().strip_dims({LEV,ILEV}); return src.rank()==tgt.rank() and src_stripped.congruent(tgt_stripped); } - // NOTE: for the vert remapper, it doesn't really make sense to distinguish - // between midpoints and interfaces: we're simply asking for a quantity - // at a given set of pressure levels. So we choose to NOT allow a tgt - // layout with ILEV tag. bool is_valid_tgt_layout (const layout_type& layout) const override { using namespace ShortFieldTagsNames; - return not layout.has_tag(ILEV) + return !(m_tgt_mid_same_as_int and layout.has_tag(ILEV)) and AbstractRemapper::is_valid_tgt_layout(layout); } + bool is_valid_src_layout (const layout_type& layout) const override { + using namespace ShortFieldTagsNames; + return !(m_src_mid_same_as_int and layout.has_tag(ILEV)) + and AbstractRemapper::is_valid_src_layout(layout); + } + void set_extrapolation_type (const ExtrapType etype, const TopBot where = TopAndBot); void set_mask_value (const Real mask_val); From fe14d0ced27fb9211cdcb4b1c644a67fc6ed830e Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 19 Dec 2024 16:28:58 -0700 Subject: [PATCH 466/529] EAMxx: allow to specify extrap type for vremap in DataInterpolation --- .../share/util/eamxx_data_interpolation.cpp | 38 +++++++++++++++++-- .../share/util/eamxx_data_interpolation.hpp | 11 +++++- 2 files changed, 45 insertions(+), 4 deletions(-) diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp index b14196e009d..122ddeb3de1 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp @@ -230,6 +230,22 @@ setup_remappers (const std::string& hremap_filename, const std::string& data_pname, const Field& model_pmid, const Field& model_pint) +{ + setup_remappers(hremap_filename, + vr_type,"P0","P0", + -1, // Unused, since we do P0 extrapolation at top/bot + data_pname,model_pmid,model_pint); +} + +void DataInterpolation:: +setup_remappers (const std::string& hremap_filename, + const VRemapType vr_type, + const std::string& extrap_type_top, + const std::string& extrap_type_bot, + const Real mask_value, + const std::string& data_pname, + const Field& model_pmid, + const Field& model_pint) { EKAT_REQUIRE_MSG (m_time_db_created, "[DataInterpolation] Error! Cannot create remappers before time database.\n"); @@ -258,8 +274,26 @@ setup_remappers (const std::string& hremap_filename, m_horiz_remapper_end = std::make_shared(grid_after_hremap,SAT); } + std::shared_ptr vremap; if (vr_type!=None) { - m_vert_remapper = std::make_shared(grid_after_hremap,m_model_grid); + auto s2et = [](const std::string& s) { + if (s=="P0") { + return VerticalRemapper::P0; + } else if (s=="Mask") { + return VerticalRemapper::Mask; + } else { + EKAT_ERROR_MSG ( + "Error! Invalid/unsupported extrapolation type.\n" + " - input value : " + s + "\n" + " - valid values: P0, Mask\n"); + return static_cast(-1); + } + }; + + m_vert_remapper = vremap = std::make_shared(grid_after_hremap,m_model_grid); + vremap->set_extrapolation_type(s2et(extrap_type_top),VerticalRemapper::Top); + vremap->set_extrapolation_type(s2et(extrap_type_bot),VerticalRemapper::Bot); + vremap->set_mask_value(mask_value); } else { // If no vert remap is requested, model_grid and grid_after_hremap MUST have same nlevs int model_nlevs = m_model_grid->get_num_vertical_levels(); @@ -281,7 +315,6 @@ setup_remappers (const std::string& hremap_filename, data_p = Field (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); data_p.allocate_view(); - auto vremap = std::dynamic_pointer_cast(m_vert_remapper); vremap->set_source_pressure (data_p,VerticalRemapper::Both); vremap->set_target_pressure (model_pmid,model_pint); } else if (vr_type==Static1D) { @@ -290,7 +323,6 @@ setup_remappers (const std::string& hremap_filename, data_p = Field (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); data_p.allocate_view(); - auto vremap = std::dynamic_pointer_cast(m_vert_remapper); vremap->set_source_pressure (data_p,VerticalRemapper::Both); vremap->set_target_pressure (model_pmid,model_pint); } diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.hpp b/components/eamxx/src/share/util/eamxx_data_interpolation.hpp index fe770e37f97..df43695e481 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.hpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.hpp @@ -31,7 +31,16 @@ class DataInterpolation void setup_time_database (const strvec_t& input_files, const util::TimeLine timeline); void setup_remappers (const std::string& hremap_filename, - const VRemapType vremap, + const VRemapType vr_type, + const std::string& data_pname, + const Field& model_pmid, + const Field& model_pint); + + void setup_remappers (const std::string& hremap_filename, + const VRemapType vr_type, + const std::string& extrap_type_top, + const std::string& extrap_type_bot, + const Real mask_value, const std::string& data_pname, const Field& model_pmid, const Field& model_pint); From 95630c2dd1b89e64aeddea7028e4ce56e1465a29 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 20 Dec 2024 18:50:36 -0700 Subject: [PATCH 467/529] EAMxx: some small fixes to horiz/refine remappers --- .../grid/remap/horiz_interp_remapper_base.cpp | 8 ++++---- .../share/grid/remap/refining_remapper_p2p.cpp | 18 ++++++++++++++++-- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/components/eamxx/src/share/grid/remap/horiz_interp_remapper_base.cpp b/components/eamxx/src/share/grid/remap/horiz_interp_remapper_base.cpp index 65da6f2447a..0dc73499ce6 100644 --- a/components/eamxx/src/share/grid/remap/horiz_interp_remapper_base.cpp +++ b/components/eamxx/src/share/grid/remap/horiz_interp_remapper_base.cpp @@ -183,7 +183,7 @@ do_register_field (const identifier_type& src, const identifier_type& tgt) { constexpr auto COL = ShortFieldTagsNames::COL; EKAT_REQUIRE_MSG (src.get_layout().has_tag(COL), - "Error! Cannot register a field without COL tag in RefiningRemapperP2P.\n" + "Error! Cannot register a field without COL tag in HorizInterpRemapperBase.\n" " - field name: " + src.name() + "\n" " - field layout: " + src.get_layout().to_string() + "\n"); m_src_fields.push_back(field_type(src)); @@ -194,11 +194,11 @@ void HorizInterpRemapperBase:: do_bind_field (const int ifield, const field_type& src, const field_type& tgt) { EKAT_REQUIRE_MSG (src.data_type()==DataType::RealType, - "Error! RefiningRemapperRMA only allows fields with RealType data.\n" + "Error! HorizInterpRemapperBase only allows fields with RealType data.\n" " - src field name: " + src.name() + "\n" " - src field type: " + e2str(src.data_type()) + "\n"); EKAT_REQUIRE_MSG (tgt.data_type()==DataType::RealType, - "Error! RefiningRemapperRMA only allows fields with RealType data.\n" + "Error! HorizInterpRemapperBase only allows fields with RealType data.\n" " - tgt field name: " + tgt.name() + "\n" " - tgt field type: " + e2str(tgt.data_type()) + "\n"); @@ -352,7 +352,7 @@ local_mat_vec (const Field& x, const Field& y) const } default: { - EKAT_ERROR_MSG("Error::refining_remapper::local_mat_vec doesn't support fields of rank 4 or greater"); + EKAT_ERROR_MSG("[HorizInterpRemapperBase::local_mat_vec] Error! Fields of rank 4 or greater are not supported.\n"); } } } diff --git a/components/eamxx/src/share/grid/remap/refining_remapper_p2p.cpp b/components/eamxx/src/share/grid/remap/refining_remapper_p2p.cpp index f2b9871053e..5f9d91595ec 100644 --- a/components/eamxx/src/share/grid/remap/refining_remapper_p2p.cpp +++ b/components/eamxx/src/share/grid/remap/refining_remapper_p2p.cpp @@ -52,7 +52,7 @@ void RefiningRemapperP2P::do_remap_fwd () for (int i=0; i; + constexpr auto COL = ShortFieldTagsNames::COL; + auto export_pids = m_imp_exp->export_pids(); auto export_lids = m_imp_exp->export_lids(); auto ncols_send = m_imp_exp->num_exports_per_pid(); @@ -174,6 +178,10 @@ void RefiningRemapperP2P::pack_and_send () for (int ifield=0; ifieldtgt later + continue; + } const auto f_col_sizes_scan_sum = m_fields_col_sizes_scan_sum[ifield]; switch (fl.rank()) { case 1: @@ -308,6 +316,8 @@ void RefiningRemapperP2P::recv_and_unpack () using TeamMember = typename KT::MemberType; using ESU = ekat::ExeSpaceUtils; + constexpr auto COL = ShortFieldTagsNames::COL; + auto import_pids = m_imp_exp->import_pids(); auto import_lids = m_imp_exp->import_lids(); auto ncols_recv = m_imp_exp->num_imports_per_pid(); @@ -318,6 +328,10 @@ void RefiningRemapperP2P::recv_and_unpack () for (int ifield=0; ifieldtgt later + continue; + } const auto f_col_sizes_scan_sum = m_fields_col_sizes_scan_sum[ifield]; switch (fl.rank()) { case 1: From 209b3ff2ed028cd0763d7e411e7e37ab22b9aca1 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 20 Dec 2024 18:51:09 -0700 Subject: [PATCH 468/529] EAMxx: fix p1d read in DataInterpolation --- .../eamxx/src/share/util/eamxx_data_interpolation.cpp | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp index 122ddeb3de1..19040641c07 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp @@ -323,6 +323,13 @@ setup_remappers (const std::string& hremap_filename, data_p = Field (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); data_p.allocate_view(); + // Use raw scorpio to read this var, since it's not decomposed. Use any file, since it's static + auto filename = m_time_database.files.front(); + scorpio::register_file(filename,scorpio::Read); + scorpio::read_var(filename,data_pname,data_p.get_internal_view_data()); + scorpio::release_file(filename); + data_p.sync_to_dev(); + vremap->set_source_pressure (data_p,VerticalRemapper::Both); vremap->set_target_pressure (model_pmid,model_pint); } From f4bc654caeea2aa3596e375e70720eddec419d3a Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 20 Dec 2024 18:53:32 -0700 Subject: [PATCH 469/529] EAMxx: finally get DataInterpolation and its tests to work --- .../share/tests/data_interpolation_setup.cpp | 62 +++---- .../share/tests/data_interpolation_tests.cpp | 173 ++++++++++++++---- .../share/tests/data_interpolation_tests.hpp | 62 ++++--- .../share/util/eamxx_data_interpolation.cpp | 49 +++-- .../share/util/eamxx_data_interpolation.hpp | 6 + 5 files changed, 243 insertions(+), 109 deletions(-) diff --git a/components/eamxx/src/share/tests/data_interpolation_setup.cpp b/components/eamxx/src/share/tests/data_interpolation_setup.cpp index e8401b2e63a..3ce20351312 100644 --- a/components/eamxx/src/share/tests/data_interpolation_setup.cpp +++ b/components/eamxx/src/share/tests/data_interpolation_setup.cpp @@ -20,6 +20,7 @@ TEST_CASE ("data_interpolation_setup") ekat::Comm comm(MPI_COMM_WORLD); scorpio::init_subsystem(comm); + // We use raw scorpio calls without decomp, so ensure we're in serial case EKAT_REQUIRE_MSG (comm.size()==1, "Error! You should run the data_interpolation_setup test with ONE rank.\n"); @@ -32,33 +33,32 @@ TEST_CASE ("data_interpolation_setup") "data_interpolation_1" }; - for (auto with_pressure : {true, false}) { - auto suffix = with_pressure ? "_with_p.nc" : ".nc"; + for (auto int_same_as_mid : {true, false}) { + auto suffix = int_same_as_mid ? "_no_ilev.nc" : ".nc"; for (const std::string& fname : files) { scorpio::register_file(fname+suffix,scorpio::Write); scorpio::define_dim (fname+suffix,"ncol",ngcols); scorpio::define_dim (fname+suffix,"lev",nlevs); - if (not with_pressure) { - scorpio::define_dim (fname+suffix,"ilev",nlevs+1); - } scorpio::define_dim (fname+suffix,"dim2",ncmps); scorpio::define_time(fname+suffix,"days since " + t_ref.to_string()); + if (not int_same_as_mid) { + scorpio::define_dim (fname+suffix,"ilev",nlevs+1); + } - std::string ilev_tag = with_pressure ? "lev" : "ilev"; + std::string ilev = int_same_as_mid ? "lev" : "ilev"; - scorpio::define_var(fname+suffix,"s2d", {"ncol"}, "real", true); - scorpio::define_var(fname+suffix,"s2d", {"ncol"}, "real", true); - scorpio::define_var(fname+suffix,"v2d", {"ncol","dim2"}, "real", true); - scorpio::define_var(fname+suffix,"s3d_m",{"ncol","lev"}, "real", true); - scorpio::define_var(fname+suffix,"v3d_m",{"ncol","dim2","lev"}, "real", true); - scorpio::define_var(fname+suffix,"s3d_i",{"ncol",ilev_tag}, "real", true); - scorpio::define_var(fname+suffix,"v3d_i",{"ncol","dim2",ilev_tag}, "real", true); + scorpio::define_var(fname+suffix,"s2d", {"ncol"}, "real", true); + scorpio::define_var(fname+suffix,"s2d", {"ncol"}, "real", true); + scorpio::define_var(fname+suffix,"v2d", {"ncol","dim2"}, "real", true); + scorpio::define_var(fname+suffix,"s3d_m",{"ncol","lev"}, "real", true); + scorpio::define_var(fname+suffix,"v3d_m",{"ncol","dim2","lev"},"real", true); + scorpio::define_var(fname+suffix,"s3d_i",{"ncol",ilev}, "real", true); + scorpio::define_var(fname+suffix,"v3d_i",{"ncol","dim2",ilev}, "real", true); - if (with_pressure) { - scorpio::define_var(fname+suffix,"p1d",{"lev"},"real", false); - scorpio::define_var(fname+suffix,"p3d",{"ncol","lev"},"real", true); - } + // We keep p1d and p3d NOT time-dep + scorpio::define_var(fname+suffix,"p1d", {"lev"},"real", false); + scorpio::define_var(fname+suffix,"p3d", {"ncol","lev"},"real", false); scorpio::enddef(fname+suffix); } @@ -66,14 +66,13 @@ TEST_CASE ("data_interpolation_setup") // Fields and some helper fields (for later) // NOTE: if we save a pressure field, there is not distinction // between interfaces and midpoints in the file - auto base_fields = create_fields (grid,true,with_pressure); - auto fields = create_fields(grid,false,with_pressure); - auto ones = create_fields(grid,false,with_pressure); + // NOTE: do not pad, so that we can grab pointers and pass them to scorpio + auto base_fields = create_fields(grid,true, int_same_as_mid,false); + auto fields = create_fields(grid,false,int_same_as_mid,false); + auto ones = create_fields(grid,false,int_same_as_mid,false); for (const auto& f : ones) { f.deep_copy(1); } - int nfields = fields.size(); - // Loop over time, and add 30 to the value for the first 6 months, // and subtract 30 for the last 6 months. This guarantees that the data // is indeed periodic. We'll write at the 15th of each month @@ -82,17 +81,17 @@ TEST_CASE ("data_interpolation_setup") // - two to be used for linear-hystory interp util::TimeStamp time = get_first_slice_time (); - if (with_pressure) { - // Create p1d as slice of p3d, and ensure it's the same on all ranks, then write it. - auto p1d = fields.back().subfield(0,0).clone("p1d"); - auto comm = grid->get_comm(); - comm.broadcast(p1d.get_internal_view_data(),nlevs,0); - p1d.sync_to_dev(); - for (const std::string& fname : files) { - scorpio::write_var(fname+suffix,p1d.name(),p1d.get_internal_view_data()); - } + // We keep p1d and p3d NOT time-dep, so we write outside the loop + auto p1d = base_fields.back(); + auto p3d = base_fields[2].alias("p3d"); + p1d.sync_to_host(); + p3d.sync_to_host(); + for (const std::string& fname : files) { + scorpio::write_var(fname+suffix,p1d.name(),p1d.get_internal_view_data()); + scorpio::write_var(fname+suffix,p3d.name(),p3d.get_internal_view_data()); } + int nfields = fields.size() - 1; // Don't handle p1d, since it's done above for (int mm=0; mm<12; ++mm) { std::string file_name = "data_interpolation_" + std::to_string(mm/6) + suffix; @@ -103,6 +102,7 @@ TEST_CASE ("data_interpolation_setup") auto& f = fields[i]; f.deep_copy(base_fields[i]); f.update(ones[i],delta_data[ mm_index % 12],1.0); + f.sync_to_host(); scorpio::write_var(file_name,f.name(),f.get_internal_view_data()); } time += 86400*time.days_in_curr_month(); diff --git a/components/eamxx/src/share/tests/data_interpolation_tests.cpp b/components/eamxx/src/share/tests/data_interpolation_tests.cpp index 291ebed70ad..68672e63b3f 100644 --- a/components/eamxx/src/share/tests/data_interpolation_tests.cpp +++ b/components/eamxx/src/share/tests/data_interpolation_tests.cpp @@ -10,10 +10,15 @@ namespace scream { +// Give ourselves some room for roundoff errors, since our manual +// evaluation may be different (in finite prec) from the one in the class. constexpr auto tol = std::numeric_limits::epsilon()*10; + constexpr auto P1D = DataInterpolation::Static1D; constexpr auto P3D = DataInterpolation::Dynamic3D; + using strvec_t = std::vector; +using namespace ShortFieldTagsNames; util::TimeStamp reset_year (const util::TimeStamp& t_in, int yy) { @@ -47,30 +52,72 @@ void run_tests (const std::shared_ptr& grid, auto t_end = t_beg + t_beg.days_in_curr_month()*spd; auto t0 = t_beg + (t_end-t_beg)/2; + auto ncols = grid->get_num_local_dofs(); + auto nlevs = grid->get_num_vertical_levels(); + + auto vcoarse_grid = grid->clone("vcoarse",true); + vcoarse_grid->reset_num_vertical_lev(data_nlevs); + // These are the fields we will compute auto fields = create_fields(grid,false,false); + fields.pop_back(); // We don't interpolate p1d... std::string map_file = grid->get_num_global_dofs()==data_ngcols ? "" : map_file_name; // These are used to check the answer - auto base_f = create_fields(grid,true); + auto base = create_fields(grid,true); auto ones = create_fields(grid,false); auto diff = create_fields(grid,false); auto expected = create_fields(grid,false); for (auto& f : ones) { f.deep_copy(1); } - int nfields = fields.size(); std::string data_pname = vr_type==P1D ? "p1d" : "p3d"; // if vr_type==None, it's not used anyways - auto model_pmid = base_f[2].clone("pmid"); // ensure the 2nd field is s3d_m - auto model_pint = base_f[4].clone("pint"); // ensure the 4th field is s3d_i + auto model_pmid = base[2].clone("pmid"); + auto model_pint = base[4].clone("pint"); + if (vr_type==P1D) { + // It's complicated to test the static profile, since we'd have to really do + // a manual interpolation. But setting all model pressure equal to the 1st col + // of the pressure makes things doable + auto comm = grid->get_comm(); + for (const Field& p : {model_pmid, model_pint}) { + auto col_0 = p.subfield(0,0); + auto len = col_0.get_header().get_identifier().get_layout().size(); + comm.broadcast(col_0.get_internal_view_data(),len,0); + col_0.sync_to_dev(); + + for (int icol=0; icol expected_vcoarse, base_vcoarse, ones_vcoarse; + if (vr_type==P1D or vr_type==P3D) { + // If we do remap, there is some P0 extrapolation, + // for which we need to know the data at the top/bot + // NOTE: the data has NO ilev coord in this case + expected_vcoarse = create_fields(vcoarse_grid,false,true); + base_vcoarse = create_fields(vcoarse_grid,true,true); + ones_vcoarse = create_fields(vcoarse_grid,false,true); + for (auto& f : ones_vcoarse) { + f.deep_copy(1); + } + } + int nfields = fields.size(); auto interp = create_interp(grid,fields); interp->setup_time_database(input_files,util::TimeLine::YearlyPeriodic); interp->setup_remappers (map_file,vr_type,data_pname,model_pmid,model_pint); interp->init_data_interval(t0); + // We jump ahead by 2 months, but the shift interval logic cannot keep up with + // a dt that long, so we should get an error due to the interpolation param being + // outside the [0,1] interval. + REQUIRE_THROWS (interp->run(t0+60*spd)); + // Loop for two year at a 20 day increment int dt = 20*spd; for (auto time = t0+dt; time.days_from(t0)<365; time+=dt) { @@ -91,6 +138,8 @@ void run_tests (const std::shared_ptr& grid, double alpha = time_from_beg.length / t_beg.days_in_curr_month(); double delta = delta_data[mm_beg]*(1-alpha) + delta_data[mm_end]*alpha; + // Just in case our testing logic is buggy, the run call below should print + // similar information, so we can more easily debug. if (alpha<0 or alpha>1) { std::cout << "TEST ERROR:\n" << " t beg: " << t_beg.to_string() << "\n" @@ -106,18 +155,53 @@ void run_tests (const std::shared_ptr& grid, // Compute expected difference from base value interp->run(time); for (int i=0; i(); + auto e_vcoarse = expected_vcoarse[i].get_view(); + + for (int icol=0; icol(); + auto e_vcoarse = expected_vcoarse[i].get_view(); + + for (int icol=0; icol(expected[i])); - if (frobenius_norm(diff[i])>=tol) { - auto n = fields[i].name(); - print_field_hyperslab(fields[i].alias(n+"_computed")); - print_field_hyperslab(expected[i].alias(n+"_expected")); - print_field_hyperslab(diff[i].alias(n+"_diff")); - } REQUIRE (frobenius_norm(diff[i]) create_fields (const std::shared_ptr& grid, const bool init_values, - const bool with_pressure = false) + const bool int_same_as_mid = false, + const bool pad_for_packing = true) { constexpr auto m = ekat::units::m; - constexpr auto Pa = ekat::units::Pa; const auto& gn = grid->name(); - auto int_same_as_mid = with_pressure; + int ncols = grid->get_num_local_dofs(); + int nlevs = grid->get_num_vertical_levels(); // Create fields @@ -72,10 +73,12 @@ create_fields (const std::shared_ptr& grid, Field s3d_i(FieldIdentifier("s3d_i", layout_s3d_i, m, gn)); Field v3d_i(FieldIdentifier("v3d_i", layout_v3d_i, m, gn)); - s3d_m.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); - v3d_m.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); - s3d_i.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); - v3d_i.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + if (pad_for_packing) { + s3d_m.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + v3d_m.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + s3d_i.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + v3d_i.get_header().get_alloc_properties().request_allocation(SCREAM_PACK_SIZE); + } s2d.allocate_view(); v2d.allocate_view(); @@ -90,10 +93,7 @@ create_fields (const std::shared_ptr& grid, // - leftmost h dof gets a value of 0, rightmost a value of 1.0 // - bottom interface gets a value of 0, top interface get a value of 1.0 // - midpoints are the avg of interfaces - // - we do hvalue*prod_other_dims + icmp*num_v_levs + v_value - int ncols = grid->get_num_local_dofs(); - int nlevs = grid->get_num_vertical_levels(); - int nlevsp1 = nlevs+1; + // - we do h_value*v_value + icmp int ngcols = grid->get_num_global_dofs(); int nh_intervals = ngcols - 1; double h_value, v_value; @@ -104,28 +104,36 @@ create_fields (const std::shared_ptr& grid, auto gids = grid->get_dofs_gids().get_view(); for (int icol=0; icol()(icol,icmp,ilev) = h_value*ncmps*nlevs + icmp*nlevs + v_value + dv/2; - v3d_i.get_view()(icol,icmp,ilev) = h_value*ncmps*nlevsp1 + icmp*nlevsp1 + v_value; + v3d_m.get_view()(icol,icmp,ilev) = h_value*(v_value + dv/2) + icmp; + if (int_same_as_mid) { + v3d_i.get_view()(icol,icmp,ilev) = h_value*(v_value + dv/2) + icmp; + } else { + v3d_i.get_view()(icol,icmp,ilev) = h_value*(v_value) + icmp; + } + } + s3d_m.get_view()(icol,ilev) = h_value*(v_value + dv/2); + if (int_same_as_mid) { + s3d_i.get_view()(icol,ilev) = h_value*(v_value + dv/2); + } else { + s3d_i.get_view()(icol,ilev) = h_value*(v_value); } - s3d_m.get_view()(icol,ilev) = h_value*nlevs + v_value; - s3d_i.get_view()(icol,ilev) = h_value*nlevsp1 + v_value; } - // Last interface (if mid!=int) + // Last interface (if mid!=int), where v_value=1 if (not int_same_as_mid) { - s3d_i.get_view()(icol,nlevs) = h_value*nlevsp1 + v_max; + s3d_i.get_view()(icol,nlevs) = h_value; for (int icmp=0; icmp()(icol,icmp,nlevs) = h_value*ncmps*nlevsp1 + icmp*nlevsp1 + v_max; + v3d_i.get_view()(icol,icmp,nlevs) = h_value + icmp; } } // 2D quantities for (int icmp=0; icmp()(icol,icmp) = h_value*ncmps + icmp; + v2d.get_view()(icol,icmp) = h_value + icmp; } s2d.get_view()(icol) = h_value; } @@ -138,16 +146,12 @@ create_fields (const std::shared_ptr& grid, v3d_i.sync_to_dev(); } - if (with_pressure) { - // Don't just clone s3d_m, so we actually get "Pa" in the nc file units - Field p3d(FieldIdentifier("p3d",layout_s3d_m,Pa,gn)); - p3d.allocate_view(); - p3d.deep_copy(s3d_m); + auto p1d = s3d_m.subfield(0,0).clone("p1d"); + auto comm = grid->get_comm(); + comm.broadcast(p1d.get_internal_view_data(),nlevs,0); + p1d.sync_to_dev(); - return {s2d, v2d, s3d_m, v3d_m, s3d_i, v3d_i, p3d}; - } else { - return {s2d, v2d, s3d_m, v3d_m, s3d_i, v3d_i}; - } + return {s2d, v2d, s3d_m, v3d_m, s3d_i, v3d_i, p1d}; } } // namespace scream diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp index 19040641c07..0b038c607bf 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp @@ -5,7 +5,6 @@ #include "share/grid/remap/refining_remapper_p2p.hpp" #include "share/io/scream_scorpio_interface.hpp" #include "share/io/scream_io_utils.hpp" -#include "share/field/field_utils.hpp" #include "share/util/scream_universal_constants.hpp" #include @@ -24,6 +23,7 @@ DataInterpolation (const std::shared_ptr& model_grid, EKAT_REQUIRE_MSG (model_grid!=nullptr, "[DataInterpolation] Error! Invalid grid pointer.\n"); + m_nfields = m_fields.size(); m_comm = model_grid->get_comm(); } @@ -51,8 +51,7 @@ void DataInterpolation::run (const util::TimeStamp& ts) " interval length : " + std::to_string(m_data_interval.length) + "\n" " interpolation coeff: " + std::to_string(alpha) + "\n"); - int nfields = m_fields.size(); - for (int i=0; iget_tgt_field(i); const auto& end = m_horiz_remapper_end->get_tgt_field(i); auto out = m_vert_remapper->get_src_field(i); @@ -60,6 +59,18 @@ void DataInterpolation::run (const util::TimeStamp& ts) out.deep_copy(beg); out.update(end,alpha,1-alpha); } + // For Dynamic3D profile we also need to compute the source pressure profile + // NOTE: this can't be done in the loop above, since src_p is not a "remapped" + // field in the vertical remapper (also, we need to use ad different ptr) + if (m_vr_type==Dynamic3D) { + // The pressure field is THE LAST registered in the horiz remappers + const auto p_beg = m_horiz_remapper_beg->get_tgt_field(m_nfields); + const auto p_end = m_horiz_remapper_end->get_tgt_field(m_nfields); + + auto p = m_vremap->get_source_pressure(true); // mid or int doesn't matter + p.deep_copy(p_beg); + p.update(p_end,alpha,1-alpha); + } m_vert_remapper->remap(true); } @@ -78,11 +89,15 @@ void DataInterpolation:: update_end_fields () { // First, set the correct fields in the reader - int nfields = m_horiz_remapper_end->get_num_fields(); std::vector fields; - for (int i=0; iget_src_field(i)); } + + if (m_vr_type==Dynamic3D) { + // We also need to read the src pressure profile + fields.push_back(m_horiz_remapper_end->get_src_field(m_nfields)); + } m_reader->set_fields(fields); // If we're also changing the file, must (re)init the scorpio structures @@ -107,6 +122,7 @@ init_data_interval (const util::TimeStamp& t0) for (auto f : m_fields) { fnames.push_back(f.name()); } + m_reader = std::make_shared(fnames,m_horiz_remapper_beg->get_src_grid()); // Loop over all stored time slices to find an interval that contains t0 @@ -274,7 +290,6 @@ setup_remappers (const std::string& hremap_filename, m_horiz_remapper_end = std::make_shared(grid_after_hremap,SAT); } - std::shared_ptr vremap; if (vr_type!=None) { auto s2et = [](const std::string& s) { if (s=="P0") { @@ -290,10 +305,10 @@ setup_remappers (const std::string& hremap_filename, } }; - m_vert_remapper = vremap = std::make_shared(grid_after_hremap,m_model_grid); - vremap->set_extrapolation_type(s2et(extrap_type_top),VerticalRemapper::Top); - vremap->set_extrapolation_type(s2et(extrap_type_bot),VerticalRemapper::Bot); - vremap->set_mask_value(mask_value); + m_vert_remapper = m_vremap = std::make_shared(grid_after_hremap,m_model_grid); + m_vremap->set_extrapolation_type(s2et(extrap_type_top),VerticalRemapper::Top); + m_vremap->set_extrapolation_type(s2et(extrap_type_bot),VerticalRemapper::Bot); + m_vremap->set_mask_value(mask_value); } else { // If no vert remap is requested, model_grid and grid_after_hremap MUST have same nlevs int model_nlevs = m_model_grid->get_num_vertical_levels(); @@ -315,8 +330,8 @@ setup_remappers (const std::string& hremap_filename, data_p = Field (FieldIdentifier(data_pname,p_layout,ekat::units::Pa,hr_tgt_grid->name())); data_p.allocate_view(); - vremap->set_source_pressure (data_p,VerticalRemapper::Both); - vremap->set_target_pressure (model_pmid,model_pint); + m_vremap->set_source_pressure (data_p,VerticalRemapper::Both); + m_vremap->set_target_pressure (model_pmid,model_pint); } else if (vr_type==Static1D) { auto hr_tgt_grid = m_horiz_remapper_beg->get_tgt_grid(); auto p_layout = hr_tgt_grid->get_vertical_layout(true); @@ -330,21 +345,21 @@ setup_remappers (const std::string& hremap_filename, scorpio::release_file(filename); data_p.sync_to_dev(); - vremap->set_source_pressure (data_p,VerticalRemapper::Both); - vremap->set_target_pressure (model_pmid,model_pint); + m_vremap->set_source_pressure (data_p,VerticalRemapper::Both); + m_vremap->set_target_pressure (model_pmid,model_pint); } + m_vr_type = vr_type; // Register fields in the remappers. Vertical first, since we only have model-grid fields - int nfields = m_fields.size(); m_vert_remapper->registration_begins(); - for (int i=0; iregister_field_from_tgt(m_fields[i]); } m_vert_remapper->registration_ends(); m_horiz_remapper_beg->registration_begins(); m_horiz_remapper_end->registration_begins(); - for (int i=0; iget_src_field(i); m_horiz_remapper_beg->register_field_from_tgt(f.clone()); m_horiz_remapper_end->register_field_from_tgt(f.clone()); diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.hpp b/components/eamxx/src/share/util/eamxx_data_interpolation.hpp index df43695e481..a281ef942c7 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.hpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.hpp @@ -10,6 +10,8 @@ namespace scream{ +class VerticalRemapper; + class DataInterpolation { public: @@ -88,6 +90,10 @@ class DataInterpolation std::shared_ptr m_horiz_remapper_beg; std::shared_ptr m_horiz_remapper_end; std::shared_ptr m_vert_remapper; + std::shared_ptr m_vremap; + + VRemapType m_vr_type; + int m_nfields; util::TimeInterval m_data_interval; std::pair m_curr_interval_idx; From f213a1378bf7b3f0c6e840f6eb384ba1564016f0 Mon Sep 17 00:00:00 2001 From: xie7 Date: Mon, 23 Dec 2024 21:02:41 -0800 Subject: [PATCH 470/529] Fixed the namelist bug for changing tuning par in oro_drag. modified: control/runtime_opts.F90 modified: physics/cam/clubb_intr.F90 modified: physics/cam/gw_drag.F90 modified: physics/cam/od_common.F90 modified: physics/cam/phys_control.F90 [BFB] --- components/eam/src/control/runtime_opts.F90 | 2 + components/eam/src/physics/cam/clubb_intr.F90 | 3 +- components/eam/src/physics/cam/gw_drag.F90 | 3 +- components/eam/src/physics/cam/od_common.F90 | 58 ++++++++++++++++++- .../eam/src/physics/cam/phys_control.F90 | 7 --- 5 files changed, 63 insertions(+), 10 deletions(-) diff --git a/components/eam/src/control/runtime_opts.F90 b/components/eam/src/control/runtime_opts.F90 index c52c02a5c23..1fcd84806b7 100644 --- a/components/eam/src/control/runtime_opts.F90 +++ b/components/eam/src/control/runtime_opts.F90 @@ -246,6 +246,7 @@ subroutine read_namelist(single_column_in, scmlon_in, scmlat_in, scm_multcols_in use uwshcu, only: uwshcu_readnl use pkg_cld_sediment, only: cld_sediment_readnl use gw_drag, only: gw_drag_readnl + use od_common, only: oro_drag_readnl use qbo, only: qbo_readnl use iondrag, only: iondrag_readnl use phys_debug_util, only: phys_debug_readnl @@ -516,6 +517,7 @@ subroutine read_namelist(single_column_in, scmlon_in, scmlat_in, scm_multcols_in call uwshcu_readnl(nlfilename) call cld_sediment_readnl(nlfilename) call gw_drag_readnl(nlfilename) + call oro_drag_readnl(nlfilename) call qbo_readnl(nlfilename) call iondrag_readnl(nlfilename) call phys_debug_readnl(nlfilename) diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90 index 0d45232f8a9..33815759e7c 100644 --- a/components/eam/src/physics/cam/clubb_intr.F90 +++ b/components/eam/src/physics/cam/clubb_intr.F90 @@ -20,7 +20,8 @@ module clubb_intr use shr_kind_mod, only: r8=>shr_kind_r8 use shr_log_mod , only: errMsg => shr_log_errMsg use ppgrid, only: pver, pverp - use phys_control, only: phys_getopts, use_od_ss, use_od_fd, od_ls_ncleff, od_bl_ncd, od_ss_sncleff + use phys_control, only: phys_getopts, use_od_ss, use_od_fd + use od_common, only: od_ls_ncleff, od_bl_ncd, od_ss_sncleff use physconst, only: rair, cpair, gravit, latvap, latice, zvir, rh2o, karman, & tms_orocnst, tms_z0fac, pi use cam_logfile, only: iulog diff --git a/components/eam/src/physics/cam/gw_drag.F90 b/components/eam/src/physics/cam/gw_drag.F90 index c17ca3b4b36..2f3c1652a68 100644 --- a/components/eam/src/physics/cam/gw_drag.F90 +++ b/components/eam/src/physics/cam/gw_drag.F90 @@ -38,7 +38,8 @@ module gw_drag ! These are the actual switches for different gravity wave sources. ! The orographic control switches are also here - use phys_control, only: use_gw_oro, use_gw_front, use_gw_convect, use_gw_energy_fix, use_od_ls, use_od_bl, use_od_ss, od_ls_ncleff, od_bl_ncd, od_ss_sncleff + use phys_control, only: use_gw_oro, use_gw_front, use_gw_convect, use_gw_energy_fix, use_od_ls, use_od_bl, use_od_ss + use od_common, only: od_ls_ncleff, od_bl_ncd, od_ss_sncleff ! Typical module header implicit none diff --git a/components/eam/src/physics/cam/od_common.F90 b/components/eam/src/physics/cam/od_common.F90 index 5d84e718b28..52658d2dbec 100644 --- a/components/eam/src/physics/cam/od_common.F90 +++ b/components/eam/src/physics/cam/od_common.F90 @@ -13,8 +13,9 @@ module od_common use ppgrid, only: pcols, pver, begchunk, endchunk use cam_logfile, only: iulog use cam_abortutils,only: endrun +use spmd_utils, only: masterproc use pio, only: file_desc_t -use phys_control, only: use_od_ls, use_od_bl, use_od_ss, od_ls_ncleff, od_bl_ncd, od_ss_sncleff +use phys_control, only: use_od_ls, use_od_bl, use_od_ss use physics_buffer,only: dtype_r8, physics_buffer_desc, pbuf_get_chunk use physics_buffer,only: pbuf_get_index, pbuf_get_field, pbuf_add_field, pbuf_set_field @@ -23,6 +24,7 @@ module od_common save ! Public interface. +public :: oro_drag_readnl public :: oro_drag_register public :: oro_drag_init public :: oro_drag_interface @@ -40,10 +42,64 @@ module od_common integer :: oro_drag_efflength_idx = -1 ! Effective length integer :: oro_drag_ribulk_idx = -1 ! bulk richardson number (calculated in CLUBB) +!tunable parameter to the od schemes +real(r8),public, protected :: od_ls_ncleff = 3._r8 !tunable parameter for oGWD +real(r8),public, protected :: od_bl_ncd = 3._r8 !tunable parameter for FBD +real(r8),public, protected :: od_ss_sncleff= 1._r8 !tunable parameter for sGWD + contains !========================================================================== +subroutine oro_drag_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use mpishorthand + + ! File containing namelist input. + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'oro_drag_readnl' + + ! More specific name for dc to prevent a name clash or confusion in the + ! namelist. + + namelist /oro_drag_nl/ od_ls_ncleff, od_bl_ncd, od_ss_sncleff + !--------------------------------------------------------------------- + !read oro_drag_nl only when use the od schemes + if (use_od_ls.or.use_od_bl.or.use_od_ss) then + if (masterproc) then + unitn = getunit() + open( unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'oro_drag_nl', status=ierr) + if (ierr == 0) then + read(unitn, oro_drag_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + call freeunit(unitn) + end if + + if (masterproc) write(iulog,*) "oro_drag_readnl od_ls_ncleff, od_bl_ncd, od_ss_sncleff ",od_ls_ncleff,od_bl_ncd,od_ss_sncleff + +#ifdef SPMD + ! Broadcast namelist variables + call mpibcast(od_ls_ncleff, 1, mpir8, 0, mpicom) + call mpibcast(od_bl_ncd, 1, mpir8, 0, mpicom) + call mpibcast(od_ss_sncleff, 1, mpir8, 0, mpicom) +#endif + ! + endif + +end subroutine oro_drag_readnl + +!========================================================================== + subroutine oro_drag_open_topo_file() use filenames, only: bnd_topo use ioFileMod, only: getfil diff --git a/components/eam/src/physics/cam/phys_control.F90 b/components/eam/src/physics/cam/phys_control.F90 index 1ac5d841dc4..bd25ef8655c 100644 --- a/components/eam/src/physics/cam/phys_control.F90 +++ b/components/eam/src/physics/cam/phys_control.F90 @@ -182,9 +182,6 @@ module phys_control logical, public, protected :: use_od_bl = .false. logical, public, protected :: use_od_ss = .false. logical, public, protected :: use_od_fd = .false. -real(r8),public, protected :: od_ls_ncleff = 3._r8 !tunable parameter for oGWD -real(r8),public, protected :: od_bl_ncd = 3._r8 !tunable parameter for FBD -real(r8),public, protected :: od_ss_sncleff = 1._r8 !tunable parameter for sGWD ! ! Switches that turn on/off individual parameterizations. ! @@ -259,7 +256,6 @@ subroutine phys_ctl_readnl(nlfile) use_hetfrz_classnuc, use_gw_oro, use_gw_front, use_gw_convect, & use_gw_energy_fix, & use_od_ls,use_od_bl,use_od_ss,use_od_fd,& - od_ls_ncleff,od_bl_ncd,od_ss_sncleff,& cld_macmic_num_steps, micro_do_icesupersat, & fix_g1_err_ndrop, ssalt_tuning, resus_fix, convproc_do_aer, & convproc_do_gas, convproc_method_activate, liqcf_fix, regen_fix, demott_ice_nuc, pergro_mods, pergro_test_active, & @@ -383,9 +379,6 @@ subroutine phys_ctl_readnl(nlfile) call mpibcast(use_od_bl, 1 , mpilog, 0, mpicom) call mpibcast(use_od_ss, 1 , mpilog, 0, mpicom) call mpibcast(use_od_fd, 1 , mpilog, 0, mpicom) - call mpibcast(od_ls_ncleff, 1 , mpilog, 0, mpicom) - call mpibcast(od_bl_ncd, 1 , mpilog, 0, mpicom) - call mpibcast(od_ss_sncleff, 1 , mpilog, 0, mpicom) call mpibcast(fix_g1_err_ndrop, 1 , mpilog, 0, mpicom) call mpibcast(ssalt_tuning, 1 , mpilog, 0, mpicom) call mpibcast(resus_fix, 1 , mpilog, 0, mpicom) From d37159c947f7af1aa4eb08c63d856aa4717d8dbd Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 30 Dec 2024 10:46:12 +0000 Subject: [PATCH 471/529] Bump DavidAnson/markdownlint-cli2-action from 18 to 19 Bumps [DavidAnson/markdownlint-cli2-action](https://github.com/davidanson/markdownlint-cli2-action) from 18 to 19. - [Release notes](https://github.com/davidanson/markdownlint-cli2-action/releases) - [Commits](https://github.com/davidanson/markdownlint-cli2-action/compare/v18...v19) --- updated-dependencies: - dependency-name: DavidAnson/markdownlint-cli2-action dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/e3sm-gh-md-linter.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/e3sm-gh-md-linter.yml b/.github/workflows/e3sm-gh-md-linter.yml index ff0c61cf576..8be6f87893b 100644 --- a/.github/workflows/e3sm-gh-md-linter.yml +++ b/.github/workflows/e3sm-gh-md-linter.yml @@ -25,7 +25,7 @@ jobs: with: files: '**/*.md' separator: "," - - uses: DavidAnson/markdownlint-cli2-action@v18 + - uses: DavidAnson/markdownlint-cli2-action@v19 if: steps.changed-files.outputs.any_changed == 'true' with: config: 'docs/.markdownlint.json' From 3f5a43677e774654041baadee9113482bbb4824b Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 3 Jan 2025 09:16:54 -0700 Subject: [PATCH 472/529] reorganize data ocean docs --- .../{data-atmos-main.md => data-atmos.md} | 0 .../{data-land-main.md => data-land.md} | 0 .../docs/user-guide/data-ocean-RSO.md | 24 ---- .../docs/user-guide/data-ocean-SOM.md | 5 - .../docs/user-guide/data-ocean-amip.md | 17 --- .../docs/user-guide/data-ocean-idealized.md | 60 --------- .../docs/user-guide/data-ocean-main.md | 10 -- .../data_comps/docs/user-guide/data-ocean.md | 120 ++++++++++++++++++ 8 files changed, 120 insertions(+), 116 deletions(-) rename components/data_comps/docs/user-guide/{data-atmos-main.md => data-atmos.md} (100%) rename components/data_comps/docs/user-guide/{data-land-main.md => data-land.md} (100%) delete mode 100644 components/data_comps/docs/user-guide/data-ocean-RSO.md delete mode 100644 components/data_comps/docs/user-guide/data-ocean-SOM.md delete mode 100644 components/data_comps/docs/user-guide/data-ocean-amip.md delete mode 100644 components/data_comps/docs/user-guide/data-ocean-idealized.md delete mode 100644 components/data_comps/docs/user-guide/data-ocean-main.md create mode 100644 components/data_comps/docs/user-guide/data-ocean.md diff --git a/components/data_comps/docs/user-guide/data-atmos-main.md b/components/data_comps/docs/user-guide/data-atmos.md similarity index 100% rename from components/data_comps/docs/user-guide/data-atmos-main.md rename to components/data_comps/docs/user-guide/data-atmos.md diff --git a/components/data_comps/docs/user-guide/data-land-main.md b/components/data_comps/docs/user-guide/data-land.md similarity index 100% rename from components/data_comps/docs/user-guide/data-land-main.md rename to components/data_comps/docs/user-guide/data-land.md diff --git a/components/data_comps/docs/user-guide/data-ocean-RSO.md b/components/data_comps/docs/user-guide/data-ocean-RSO.md deleted file mode 100644 index 5107c261411..00000000000 --- a/components/data_comps/docs/user-guide/data-ocean-RSO.md +++ /dev/null @@ -1,24 +0,0 @@ -# Data Ocean - Relaxed Slab Ocean (RSO) - -The relaxed slab ocean (RSO) is similar in many ways to the [traditional slab ocean model](data-ocean-SOM.md), but uses a specified relaxation time scale to avoid the need for specified "Q-flux" data to represent the effects of ocean transport. The RSO implementation in E3SM was inspired by Zarzycki (2016)[@Zarzycki_TC-ocn-cpl_2016]. - -A key consideration for the user is whether they need to use a realistic distribution of mixed layer depths (MLD), or whether their use case can benefit from the simplicity of a globally uniform MLD. - -The RSO mode has the following namelist variables to influence the ocean behavior: - -```text -RSO_relax_tau SST relaxation timescale -RSO_fixed_MLD globally uniform MLD value (use -1 for realistic MLD) -``` - -Other RSO parameter values are hardcoded in `components/data_comps/docn/src/docn_comp_mod.F90`. - -```text -RSO_slab_option = 0 ! Option for setting RSO_X_cool -RSO_R_cool = 11.75/86400 ! base cooling rate [K/s] -RSO_Tdeep = 271.00 ! deep water temperature [K] -RSO_dT_o = 27.0 ! scaling temperature gradient -RSO_h_o = 30.0 ! scaling mixed layer depth -``` - -The RSO mode uses the `SSTICE_DATA_FILENAME` in `env_run.xml` for its data stream. For a globally uniform MLD this file only need to contain a `SST_cpl` variable for the SST that will act as the target SST value for relaxation. If a realistic MLD pattern is desired then the `hblt` variable must also be present. This data can be derived a number of ways, but we currently do not have a dedicated tool or workflow. diff --git a/components/data_comps/docs/user-guide/data-ocean-SOM.md b/components/data_comps/docs/user-guide/data-ocean-SOM.md deleted file mode 100644 index f22f3486ba7..00000000000 --- a/components/data_comps/docs/user-guide/data-ocean-SOM.md +++ /dev/null @@ -1,5 +0,0 @@ -# Data Ocean - Traditional Slab Ocean Model (SOM) - -A slab ocean model (SOM) allows responsive SSTs to address the "infinite heat source" problem associated with prescribed SSTs, but is much cheaper than running with a full ocean model. The traditional SOM appraoch requires special inputs, such as a specified mixed layer depth pattern that can vary in time and a prescribed heat flux to account for the missing effects of ocean dynamics often referred to as "Q-flux". The Q-flux data is often estimated from a fully coupled simulation with active ocean and sea-ice so that the SOM simulation will resemble the full model. - -Currently, we do not have Q-flux data to drive the SOM in E3SM. An alternative appraoch is to use a "relaxed" slab ocean (RSO) in which a specified relaxation time scale is used to bring the SST field back to a target SST field. The RSO mode is much simpler to use, but carries caveats that the user should be aware of before using. See [Data Ocean - Relaxed Slab Ocean](data-ocean-RSO.md) for more information. diff --git a/components/data_comps/docs/user-guide/data-ocean-amip.md b/components/data_comps/docs/user-guide/data-ocean-amip.md deleted file mode 100644 index b97cc2dcbb0..00000000000 --- a/components/data_comps/docs/user-guide/data-ocean-amip.md +++ /dev/null @@ -1,17 +0,0 @@ -# Data Ocean - SST from Observations - -Using SST data derived from observations is the most common use of the data ocean model, often for AMIP style experiments to reproduce historical periods. - -Example compsets that use this capability are `F2010` and `F20TR`. These compsets use the `_DOCN%DOM_` compset modifier, which sets the `DOCN_MODE` variable in `env_run.xml` to "prescribed". - -Several additional XML variables need to be set in order to use this capability, which are set to defaults for common configurations, such as `F2010` at `ne30pg2` atmospheric resolution. - -```text -SSTICE_DATA_FILENAME Prescribed SST and ice coverage data file name -SSTICE_GRID_FILENAME Grid file in "domain" format corresponding to SSTICE_DATA_FILENAME -SSTICE_YEAR_ALIGN The model year that corresponds to SSTICE_YEAR_START on the data file -SSTICE_YEAR_START The first year of data to use from SSTICE_DATA_FILENAME -SSTICE_YEAR_END The last year of data to use from SSTICE_DATA_FILENAME -``` - -Most users will not need to edit these values from their defaults, but many scenarios require non-standard SST data, such as tropical cyclone hindcasts where the daily evolution of high-resolution SST data may be desireable. diff --git a/components/data_comps/docs/user-guide/data-ocean-idealized.md b/components/data_comps/docs/user-guide/data-ocean-idealized.md deleted file mode 100644 index ea980589479..00000000000 --- a/components/data_comps/docs/user-guide/data-ocean-idealized.md +++ /dev/null @@ -1,60 +0,0 @@ -# Data Ocean - Idealized - -The two main uses of idealized SST modes are aquaplanet (AQP) and radiative-convective equilibrium (RCE). The latter is just a special case of an aquaplanet where the SST is [usually] a constant value everywhere, traditionally used in conjunction with special modifications to homogenize radiation and disable rotation. There are several analytically specified SST patterns established by model intercomparison projects such as the Aqua-Planet Experiment (APE)[@blackburn_APE_context_2013] and RCEMIP[@wing_rcemip1_2018,@wing_rcemip2_2024]. - -## Idealized SST compsets - -The following list shows the currently defined E3SM compsets that utilize idealized SST. - -```text -FAQP -FAQP-MMF1 -FAQP-MMF2 -F-SCREAM-LR-AQP1 -F-SCREAM-HR-AQP1 -FRCE -FRCE-MMF1 -FRCE-MMF2 -FRCE-MW_295dT1p25 -FRCE-MW_300dT0p625 -FRCE-MW_300dT1p25 -FRCE-MW_300dT2p5 -FRCE-MW_305dT1p25 -FRCE-MW-MMF1_295dT1p25 -FRCE-MW-MMF1_300dT0p625 -FRCE-MW-MMF1_300dT1p25 -FRCE-MW-MMF1_300dT2p5 -FRCE-MW-MMF1_305dT1p25 -``` - -These all use "analytic" SST patterns that are specified via the `docn_comp_run()` subroutine in `components/data_comps/docn/src/docn_comp_mod.F90`. The `AQP` compsets currently only use the basic aquaplanet pattern that is symmetric about the equator. Other APE patterns introduce different meridional gradients and/or asymmetries. The various analytic SST patterns can be selected by changing the data ocean specifier: `_DOCN%AQP1_`. - -The first 10 analytic aquaplanet SST patterns correspond to the aqua-planet experiment (APE) protocol as follows - -```text -AQP1 = control symmetric SST pattern -AQP2 = Flat -AQP3 = Qobs = average of AQP1 and AQP2 -AQP4 = Peaked -AQP5 = Control+5N -AQP6 = 1KEQ - small warm pool -AQP7 = 3KEQ - small warm pool -AQP8 = 3KW1 - large warm pool -AQP9 = Control+10N -AQP10 = Control+15N -``` - -!!!NOTE - When using aquaplanet mode the orbital parameters will take on the idealized values shown below such that there are no seasonal variations, but there is still a diurnal cycle. - ```text - orb_eccen = 0 - orb_obliq = 0 - orb_mvelp = 0 - orb_mode = "fixed_parameters" - ``` - -The basic RCE compsets use the `_DOCN%AQPCONST_` modifier to produce a globally constant SST value, which is set by the `DOCN_AQPCONST_VALUE` variable in `env_run.xml`. The "FRCE-MW" compsets were designed for RCEMIP-II to produce a "mock walker-cell" configuration, in which sinusoidal SST variations are applied to promote a coherent large-scale circulation. - -## SST Data File - -In addition to the analytic SST modes the user can also specify an idealized aquaplanet SST pattern via the `_DOCN%AQPFILE_` option. The `aquapfile` namelist variable is used to specify the SST pattern in this mode. Note that this option has not been used or tested recently, so the user may experience difficulty trying to use this feature. diff --git a/components/data_comps/docs/user-guide/data-ocean-main.md b/components/data_comps/docs/user-guide/data-ocean-main.md deleted file mode 100644 index e6312116ebc..00000000000 --- a/components/data_comps/docs/user-guide/data-ocean-main.md +++ /dev/null @@ -1,10 +0,0 @@ -# The E3SM Data Ocean Model - -The E3SM data ocean has several different modes to support various realistic and idealized experiments. Sea surface temperatures (SST) can be either prescribed or prognostic. Prescribed SSTs are specified either through a data stream or analytically. Prognostic modes allow the SST field to evolve and respond to atmospheric conditions. The guides below provide more details on how to use these capabilities. - -- Prescribed - - [SST from Observations](data-ocean-amip.md) - - [Idealized SST](data-ocean-idealized.md) -- Prognostic - - [Traditional Slab Ocean Model (SOM)](data-ocean-SOM.md) - - [Relaxed Slab Ocean (RSO)](data-ocean-RSO.md) diff --git a/components/data_comps/docs/user-guide/data-ocean.md b/components/data_comps/docs/user-guide/data-ocean.md new file mode 100644 index 00000000000..a08fa4f418f --- /dev/null +++ b/components/data_comps/docs/user-guide/data-ocean.md @@ -0,0 +1,120 @@ +# The E3SM Data Ocean Model + +The E3SM data ocean has several different modes to support various realistic and idealized experiments. Sea surface temperatures (SST) can be either prescribed or prognostic. Prescribed SSTs are specified either through a data stream or analytically. Prognostic modes allow the SST field to evolve and respond to atmospheric conditions. The guides below provide more details on how to use these capabilities. + +- Prescribed + - [SST from Observations](#sst-from-observations) + - [Idealized SST](#idealized-sst) +- Prognostic + - [Traditional Slab Ocean Model](#traditional-slab-ocean-model) (SOM) + - [Relaxed Slab Ocean](#relaxed-slab-ocean) (RSO) + +# SST from Observations + +Using SST data derived from observations is the most common use of the data ocean model, often for AMIP style experiments to reproduce historical periods. + +Example compsets that use this capability are `F2010` and `F20TR`. These compsets use the `_DOCN%DOM_` compset modifier, which sets the `DOCN_MODE` variable in `env_run.xml` to "prescribed". + +Several additional XML variables need to be set in order to use this capability, which are set to defaults for common configurations, such as `F2010` at `ne30pg2` atmospheric resolution. + +```text +SSTICE_DATA_FILENAME Prescribed SST and ice coverage data file name +SSTICE_GRID_FILENAME Grid file in "domain" format corresponding to SSTICE_DATA_FILENAME +SSTICE_YEAR_ALIGN The model year that corresponds to SSTICE_YEAR_START on the data file +SSTICE_YEAR_START The first year of data to use from SSTICE_DATA_FILENAME +SSTICE_YEAR_END The last year of data to use from SSTICE_DATA_FILENAME +``` + +Most users will not need to edit these values from their defaults, but many scenarios require non-standard SST data, such as tropical cyclone hindcasts where the daily evolution of high-resolution SST data may be desireable. + +# Idealized SST + +The two main uses of idealized SST modes are aquaplanet (AQP) and radiative-convective equilibrium (RCE). The latter is just a special case of an aquaplanet where the SST is [usually] a constant value everywhere, traditionally used in conjunction with special modifications to homogenize radiation and disable rotation. There are several analytically specified SST patterns established by model intercomparison projects such as the Aqua-Planet Experiment (APE)[@blackburn_APE_context_2013] and RCEMIP[@wing_rcemip1_2018,@wing_rcemip2_2024]. + +## Idealized SST compsets + +The following list shows the currently defined E3SM compsets that utilize idealized SST. + +```text +FAQP +FAQP-MMF1 +FAQP-MMF2 +F-SCREAM-LR-AQP1 +F-SCREAM-HR-AQP1 +FRCE +FRCE-MMF1 +FRCE-MMF2 +FRCE-MW_295dT1p25 +FRCE-MW_300dT0p625 +FRCE-MW_300dT1p25 +FRCE-MW_300dT2p5 +FRCE-MW_305dT1p25 +FRCE-MW-MMF1_295dT1p25 +FRCE-MW-MMF1_300dT0p625 +FRCE-MW-MMF1_300dT1p25 +FRCE-MW-MMF1_300dT2p5 +FRCE-MW-MMF1_305dT1p25 +``` + +These all use "analytic" SST patterns that are specified via the `docn_comp_run()` subroutine in `components/data_comps/docn/src/docn_comp_mod.F90`. The `AQP` compsets currently only use the basic aquaplanet pattern that is symmetric about the equator. Other APE patterns introduce different meridional gradients and/or asymmetries. The various analytic SST patterns can be selected by changing the data ocean specifier: `_DOCN%AQP1_`. + +The first 10 analytic aquaplanet SST patterns correspond to the aqua-planet experiment (APE) protocol as follows + +```text +AQP1 = control symmetric SST pattern +AQP2 = Flat +AQP3 = Qobs = average of AQP1 and AQP2 +AQP4 = Peaked +AQP5 = Control+5N +AQP6 = 1KEQ - small warm pool +AQP7 = 3KEQ - small warm pool +AQP8 = 3KW1 - large warm pool +AQP9 = Control+10N +AQP10 = Control+15N +``` + +!!!NOTE + When using aquaplanet mode the orbital parameters will take on the idealized values shown below such that there are no seasonal variations, but there is still a diurnal cycle. + ```text + orb_eccen = 0 + orb_obliq = 0 + orb_mvelp = 0 + orb_mode = "fixed_parameters" + ``` + +The basic RCE compsets use the `_DOCN%AQPCONST_` modifier to produce a globally constant SST value, which is set by the `DOCN_AQPCONST_VALUE` variable in `env_run.xml`. The "FRCE-MW" compsets were designed for RCEMIP-II to produce a "mock walker-cell" configuration, in which sinusoidal SST variations are applied to promote a coherent large-scale circulation. + +## SST Data File + +In addition to the analytic SST modes the user can also specify an idealized aquaplanet SST pattern via the `_DOCN%AQPFILE_` option. The `aquapfile` namelist variable is used to specify the SST pattern in this mode. Note that this option has not been used or tested recently, so the user may experience difficulty trying to use this feature. + +# Traditional Slab Ocean Model + +A slab ocean model (SOM) allows responsive SSTs to address the "infinite heat source" problem associated with prescribed SSTs, but is much cheaper than running with a full ocean model. The traditional SOM appraoch requires special inputs, such as a specified mixed layer depth pattern that can vary in time and a prescribed heat flux to account for the missing effects of ocean dynamics often referred to as "Q-flux". The Q-flux data is often estimated from a fully coupled simulation with active ocean and sea-ice so that the SOM simulation will resemble the full model. + +Currently, we do not have Q-flux data to drive the SOM in E3SM. An alternative appraoch is to use a "relaxed" slab ocean (RSO) in which a specified relaxation time scale is used to bring the SST field back to a target SST field. The RSO mode is much simpler to use, but carries caveats that the user should be aware of before using. See [Data Ocean - Relaxed Slab Ocean](data-ocean-RSO.md) for more information. + +# Relaxed Slab Ocean + +The relaxed slab ocean (RSO) is similar in many ways to the [traditional slab ocean model](data-ocean-SOM.md), but uses a specified relaxation time scale to avoid the need for specified "Q-flux" data to represent the effects of ocean transport. The RSO implementation in E3SM was inspired by Zarzycki (2016)[@Zarzycki_TC-ocn-cpl_2016]. + +A key consideration for the user is whether they need to use a realistic distribution of mixed layer depths (MLD), or whether their use case can benefit from the simplicity of a globally uniform MLD. + +The RSO mode has the following namelist variables to influence the ocean behavior: + +```text +RSO_relax_tau SST relaxation timescale +RSO_fixed_MLD globally uniform MLD value (use -1 for realistic MLD) +``` + +Other RSO parameter values are hardcoded in `components/data_comps/docn/src/docn_comp_mod.F90`. + +```text +RSO_slab_option = 0 ! Option for setting RSO_X_cool +RSO_R_cool = 11.75/86400 ! base cooling rate [K/s] +RSO_Tdeep = 271.00 ! deep water temperature [K] +RSO_dT_o = 27.0 ! scaling temperature gradient +RSO_h_o = 30.0 ! scaling mixed layer depth +``` + +The RSO mode uses the `SSTICE_DATA_FILENAME` in `env_run.xml` for its data stream. For a globally uniform MLD this file only need to contain a `SST_cpl` variable for the SST that will act as the target SST value for relaxation. If a realistic MLD pattern is desired then the `hblt` variable must also be present. This data can be derived a number of ways, but we currently do not have a dedicated tool or workflow. From 99ab6ba8840a9f0526f2db0303ad86d4fcb21765 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 3 Jan 2025 09:41:25 -0700 Subject: [PATCH 473/529] linter fixes --- components/data_comps/docs/index.md | 6 +++--- .../data_comps/docs/user-guide/data-ocean.md | 15 +++++++++------ 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/components/data_comps/docs/index.md b/components/data_comps/docs/index.md index c75eee169a5..adef0842673 100644 --- a/components/data_comps/docs/index.md +++ b/components/data_comps/docs/index.md @@ -8,6 +8,6 @@ The E3SM data models are key components to support many different scenarios: More details can be found for each component below. -- [Data Atmosphere](user-guide/data-atmos-main.md) -- [Data Land](user-guide/data-land-main.md) -- [Data Ocean](user-guide/data-ocean-main.md) +- [Data Atmosphere](user-guide/data-atmos.md) +- [Data Land](user-guide/data-land.md) +- [Data Ocean](user-guide/data-ocean.md) diff --git a/components/data_comps/docs/user-guide/data-ocean.md b/components/data_comps/docs/user-guide/data-ocean.md index a08fa4f418f..e7fa0505eb4 100644 --- a/components/data_comps/docs/user-guide/data-ocean.md +++ b/components/data_comps/docs/user-guide/data-ocean.md @@ -1,5 +1,8 @@ # The E3SM Data Ocean Model + + + The E3SM data ocean has several different modes to support various realistic and idealized experiments. Sea surface temperatures (SST) can be either prescribed or prognostic. Prescribed SSTs are specified either through a data stream or analytically. Prognostic modes allow the SST field to evolve and respond to atmospheric conditions. The guides below provide more details on how to use these capabilities. - Prescribed @@ -9,7 +12,7 @@ The E3SM data ocean has several different modes to support various realistic and - [Traditional Slab Ocean Model](#traditional-slab-ocean-model) (SOM) - [Relaxed Slab Ocean](#relaxed-slab-ocean) (RSO) -# SST from Observations +## SST from Observations Using SST data derived from observations is the most common use of the data ocean model, often for AMIP style experiments to reproduce historical periods. @@ -27,11 +30,11 @@ SSTICE_YEAR_END The last year of data to use from SSTICE_DATA_FILENAME Most users will not need to edit these values from their defaults, but many scenarios require non-standard SST data, such as tropical cyclone hindcasts where the daily evolution of high-resolution SST data may be desireable. -# Idealized SST +## Idealized SST The two main uses of idealized SST modes are aquaplanet (AQP) and radiative-convective equilibrium (RCE). The latter is just a special case of an aquaplanet where the SST is [usually] a constant value everywhere, traditionally used in conjunction with special modifications to homogenize radiation and disable rotation. There are several analytically specified SST patterns established by model intercomparison projects such as the Aqua-Planet Experiment (APE)[@blackburn_APE_context_2013] and RCEMIP[@wing_rcemip1_2018,@wing_rcemip2_2024]. -## Idealized SST compsets +### Idealized SST compsets The following list shows the currently defined E3SM compsets that utilize idealized SST. @@ -84,17 +87,17 @@ AQP10 = Control+15N The basic RCE compsets use the `_DOCN%AQPCONST_` modifier to produce a globally constant SST value, which is set by the `DOCN_AQPCONST_VALUE` variable in `env_run.xml`. The "FRCE-MW" compsets were designed for RCEMIP-II to produce a "mock walker-cell" configuration, in which sinusoidal SST variations are applied to promote a coherent large-scale circulation. -## SST Data File +### SST Data File In addition to the analytic SST modes the user can also specify an idealized aquaplanet SST pattern via the `_DOCN%AQPFILE_` option. The `aquapfile` namelist variable is used to specify the SST pattern in this mode. Note that this option has not been used or tested recently, so the user may experience difficulty trying to use this feature. -# Traditional Slab Ocean Model +## Traditional Slab Ocean Model A slab ocean model (SOM) allows responsive SSTs to address the "infinite heat source" problem associated with prescribed SSTs, but is much cheaper than running with a full ocean model. The traditional SOM appraoch requires special inputs, such as a specified mixed layer depth pattern that can vary in time and a prescribed heat flux to account for the missing effects of ocean dynamics often referred to as "Q-flux". The Q-flux data is often estimated from a fully coupled simulation with active ocean and sea-ice so that the SOM simulation will resemble the full model. Currently, we do not have Q-flux data to drive the SOM in E3SM. An alternative appraoch is to use a "relaxed" slab ocean (RSO) in which a specified relaxation time scale is used to bring the SST field back to a target SST field. The RSO mode is much simpler to use, but carries caveats that the user should be aware of before using. See [Data Ocean - Relaxed Slab Ocean](data-ocean-RSO.md) for more information. -# Relaxed Slab Ocean +## Relaxed Slab Ocean The relaxed slab ocean (RSO) is similar in many ways to the [traditional slab ocean model](data-ocean-SOM.md), but uses a specified relaxation time scale to avoid the need for specified "Q-flux" data to represent the effects of ocean transport. The RSO implementation in E3SM was inspired by Zarzycki (2016)[@Zarzycki_TC-ocn-cpl_2016]. From 165a6ac87d92d6bc3190a9df3a979f5a7f23bc15 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 3 Jan 2025 19:00:38 -0800 Subject: [PATCH 474/529] Update zOcean error check --- .../src/mode_forward/mpas_li_iceshelf_melt.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F index a0e91e1f126..44925ced45f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F @@ -1252,8 +1252,8 @@ subroutine iceshelf_melt_ismip6(domain, err) IS_area(:) = 0.d0 ! Check zOcean for valid values - if (minval(zOcean) == 0.0_RKIND) then - call mpas_log_write("Invalid value for zOcean. It should have negative values but min value of 0.0 was found", & + if (minval(zOcean) >= 0.0_RKIND) then + call mpas_log_write("Invalid value for zOcean. It should have negative values but min value >= 0.0 was found", & MPAS_LOG_ERR) err = ior(err, 1) endif From 2f684b31c0f42ee398a06f6704f7cfd5a2f5b1d8 Mon Sep 17 00:00:00 2001 From: Matt Hoffman Date: Mon, 6 Jan 2025 11:26:14 -0700 Subject: [PATCH 475/529] Update error message Co-authored-by: Xylar Asay-Davis --- .../src/mode_forward/mpas_li_iceshelf_melt.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F index 44925ced45f..daa1d5cca87 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_iceshelf_melt.F @@ -1258,7 +1258,7 @@ subroutine iceshelf_melt_ismip6(domain, err) err = ior(err, 1) endif if (maxval(zOcean) > 0.0_RKIND) then - call mpas_log_write("Invalid value for zOcean. It should have negative values but max value greater than 0.0 was found", & + call mpas_log_write("Invalid value for zOcean. It should have non-positive values but max value greater than 0.0 was found", & MPAS_LOG_ERR) err = ior(err, 1) endif From 0fbbc3281a0aa5d409283a889a16da82c78eabf0 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Mon, 6 Jan 2025 16:21:48 -0700 Subject: [PATCH 476/529] Change new table names to not conflict with older tables --- .../cime_config/namelist_defaults_scream.xml | 8 ++++---- components/eamxx/src/physics/p3/CMakeLists.txt | 8 ++++---- .../eamxx/src/physics/p3/impl/p3_init_impl.hpp | 17 ++++++++++------- .../eamxx/src/physics/p3/tests/CMakeLists.txt | 9 +++------ .../src/physics/p3/tests/p3_tables_setup.cpp | 2 +- 5 files changed, 22 insertions(+), 22 deletions(-) diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index 6d4c36b81bd..b74dde218c7 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -199,10 +199,10 @@ be lost if SCREAM_HACK_XML is not enabled. 740.0e3 ${DIN_LOC_ROOT}/atm/scream/tables/p3_lookup_table_1.dat-v4.1.1, - ${DIN_LOC_ROOT}/atm/scream/tables/mu_r_table_vals.dat8, - ${DIN_LOC_ROOT}/atm/scream/tables/revap_table_vals.dat8, - ${DIN_LOC_ROOT}/atm/scream/tables/vn_table_vals.dat8, - ${DIN_LOC_ROOT}/atm/scream/tables/vm_table_vals.dat8 + ${DIN_LOC_ROOT}/atm/scream/tables/mu_r_table_vals_v2.dat8, + ${DIN_LOC_ROOT}/atm/scream/tables/revap_table_vals_v2.dat8, + ${DIN_LOC_ROOT}/atm/scream/tables/vn_table_vals_v2.dat8, + ${DIN_LOC_ROOT}/atm/scream/tables/vm_table_vals_v2.dat8 1350.0 2.47 diff --git a/components/eamxx/src/physics/p3/CMakeLists.txt b/components/eamxx/src/physics/p3/CMakeLists.txt index 9a56c185541..6c39a9fcf1a 100644 --- a/components/eamxx/src/physics/p3/CMakeLists.txt +++ b/components/eamxx/src/physics/p3/CMakeLists.txt @@ -96,10 +96,10 @@ else() endif() set (P3_TABLES scream/tables/p3_lookup_table_1.dat-v4.1.1 - scream/tables/mu_r_table_vals.dat${PRECISION_SUFFIX} - scream/tables/revap_table_vals.dat${PRECISION_SUFFIX} - scream/tables/vm_table_vals.dat${PRECISION_SUFFIX} - scream/tables/vn_table_vals.dat${PRECISION_SUFFIX} + scream/tables/mu_r_table_vals_v2.dat${PRECISION_SUFFIX} + scream/tables/revap_table_vals_v2.dat${PRECISION_SUFFIX} + scream/tables/vm_table_vals_v2.dat${PRECISION_SUFFIX} + scream/tables/vn_table_vals_v2.dat${PRECISION_SUFFIX} ) include (ScreamUtils) diff --git a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp index 463c32dd8b8..2082b9fbf96 100644 --- a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp @@ -115,6 +115,7 @@ void compute_tables(const bool masterproc, MuRT& mu_r_table_vals, VNT& vn_table_ Kokkos::deep_copy(mu_r_table_vals_nc, 1); // mu_r_constant =1. In other places, this is runtime_options.constant_mu_rain static constexpr S thrd = 1./3; + static constexpr S small = 1.e-30; //....................................................................... // Generate lookup table for rain fallspeed and ventilation parameters @@ -173,9 +174,9 @@ void compute_tables(const bool masterproc, MuRT& mu_r_table_vals, VNT& vn_table_ dum5 += std::pow(vt*dia, 0.5) * std::pow(10, (mu_r+1)*std::log10(dia) + 3*mu_r) * std::exp(-lamr*dia) * dd * 1.e-6; } - dum2 = std::max(dum2, 1.e-30); // to prevent divide-by-zero below - dum4 = std::max(dum4, 1.e-30); // to prevent divide-by-zero below - dum5 = std::max(dum5, 1.e-30); // to prevent log10-of-zero below + dum2 = std::max(dum2, small); // to prevent divide-by-zero below + dum4 = std::max(dum4, small); // to prevent divide-by-zero below + dum5 = std::max(dum5, small); // to prevent log10-of-zero below vn_table_vals_nc(jj-1,ii-1) = dum1/dum2; vm_table_vals_nc(jj-1,ii-1) = dum3/dum4; @@ -217,10 +218,12 @@ void io_impl(const bool masterproc, const char* dir, MuRT& mu_r_table_vals, VNT& const char* rw_flag = IsRead ? "r" : "w"; - std::string mu_r_filename = std::string(dir) + "/mu_r_table_vals.dat" + extension; - std::string revap_filename = std::string(dir) + "/revap_table_vals.dat" + extension; - std::string vn_filename = std::string(dir) + "/vn_table_vals.dat" + extension; - std::string vm_filename = std::string(dir) + "/vm_table_vals.dat" + extension; + // Add v2 because these tables are not identical to v1 due to roundoff differences + // caused by doing the math in C++ instead of f90. + std::string mu_r_filename = std::string(dir) + "/mu_r_table_vals_v2.dat" + extension; + std::string revap_filename = std::string(dir) + "/revap_table_vals_v2.dat" + extension; + std::string vn_filename = std::string(dir) + "/vn_table_vals_v2.dat" + extension; + std::string vm_filename = std::string(dir) + "/vm_table_vals_v2.dat" + extension; ekat::FILEPtr mu_r_file(fopen(mu_r_filename.c_str(), rw_flag)); ekat::FILEPtr revap_file(fopen(revap_filename.c_str(), rw_flag)); diff --git a/components/eamxx/src/physics/p3/tests/CMakeLists.txt b/components/eamxx/src/physics/p3/tests/CMakeLists.txt index d66d734d127..b8d6c7d2b7a 100644 --- a/components/eamxx/src/physics/p3/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/p3/tests/CMakeLists.txt @@ -101,12 +101,9 @@ CreateUnitTest(p3_run_and_cmp "p3_run_and_cmp.cpp" EXE_ARGS "${BASELINE_FILE_ARG}" LABELS "p3;physics;baseline_gen;baseline_cmp") -if (SCREAM_ONLY_GENERATE_BASELINES) - # This test can be used to re-generate tables in ${SCREAM_DATA_DIR} - CreateUnitTest(p3_tables_setup "p3_tables_setup.cpp" - LIBS p3 - LABELS "p3;physics;baseline_gen") -endif() +# This executable can be used to re-generate tables in ${SCREAM_DATA_DIR} +add_executable(p3_tables_setup EXCLUDE_FROM_ALL p3_tables_setup.cpp) +target_link_libraries(p3_tables_setup p3) # Make sure that a diff from baselines triggers a failed test (in debug only) if (SCREAM_ENABLE_BASELINE_TESTS) diff --git a/components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp b/components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp index 91386db9c56..ad9b299a4d9 100644 --- a/components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp +++ b/components/eamxx/src/physics/p3/tests/p3_tables_setup.cpp @@ -7,7 +7,7 @@ int main(int argc, char** argv) { using P3F = scream::p3::Functions; scream::initialize_scream_session(argc, argv); - P3F::p3_init(/* write_tables = */ true); + P3F::p3_init(/* write_tables = */ true, /* masterproc */ true); scream::finalize_scream_session(); return 0; From 98a20f08060988dbf9f4eead2a6f26ef2fcdaed3 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Thu, 21 Nov 2024 17:37:46 -0800 Subject: [PATCH 477/529] Homme: Update Perlmutter machine file. --- components/homme/cmake/machineFiles/perlmutter-gnu.cmake | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/components/homme/cmake/machineFiles/perlmutter-gnu.cmake b/components/homme/cmake/machineFiles/perlmutter-gnu.cmake index a9ad558677a..aa7b73e6c32 100644 --- a/components/homme/cmake/machineFiles/perlmutter-gnu.cmake +++ b/components/homme/cmake/machineFiles/perlmutter-gnu.cmake @@ -13,7 +13,7 @@ SET(HDF5_DIR $ENV{CRAY_HDF5_PARALLEL_PREFIX} CACHE FILEPATH "") SET (NetCDF_C_PATH $ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} CACHE FILEPATH "") SET (NetCDF_Fortran_PATH $ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} CACHE FILEPATH "") -SET(BUILD_HOMME_WITHOUT_PIOLIBRARY TRUE CACHE BOOL "") +SET(BUILD_HOMME_WITHOUT_PIOLIBRARY FALSE CACHE BOOL "") SET(HOMME_FIND_BLASLAPACK TRUE CACHE BOOL "") @@ -42,7 +42,10 @@ SET(Kokkos_ENABLE_EXPLICIT_INSTANTIATION OFF CACHE BOOL "") SET(CMAKE_C_COMPILER "cc" CACHE STRING "") SET(CMAKE_Fortran_COMPILER "ftn" CACHE STRING "") SET(CMAKE_CXX_COMPILER "CC" CACHE STRING "") -# Note: need to set MPICH_CXX env variable and perhaps NVCC_WRAPPER_DEFAULT_COMPILER +# Note: No longer need to set MPICH_CXX env variable and perhaps +# NVCC_WRAPPER_DEFAULT_COMPILER. Ignore the warning about nvcc_wrapper during +# configuration. +SET(CUDA_BUILD TRUE CACHE STRING "") SET(CXXLIB_SUPPORTED_CACHE FALSE CACHE BOOL "") From 7346ecea7fcd99b82ee729f06dc35a78144be410 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Wed, 27 Nov 2024 15:33:44 -0800 Subject: [PATCH 478/529] Homme: Update perlmutter machine file with PR 6423 fix. --- components/homme/cmake/machineFiles/perlmutter-gnu.cmake | 1 + 1 file changed, 1 insertion(+) diff --git a/components/homme/cmake/machineFiles/perlmutter-gnu.cmake b/components/homme/cmake/machineFiles/perlmutter-gnu.cmake index aa7b73e6c32..a27f83900c1 100644 --- a/components/homme/cmake/machineFiles/perlmutter-gnu.cmake +++ b/components/homme/cmake/machineFiles/perlmutter-gnu.cmake @@ -31,6 +31,7 @@ SET(Kokkos_ENABLE_OPENMP OFF CACHE BOOL "") SET(Kokkos_ENABLE_CUDA ON CACHE BOOL "") SET(Kokkos_ENABLE_CUDA_LAMBDA ON CACHE BOOL "") SET(Kokkos_ARCH_AMPERE80 ON CACHE BOOL "") +SET(Kokkos_ENABLE_IMPL_CUDA_MALLOC_ASYNC OFF CACHE BOOL "") #SET(Kokkos_ARCH_ZEN2 ON CACHE BOOL "") # works, and perf same if both AMPERE80 and ZEN2 are on #SET(Kokkos_ENABLE_CUDA_UVM ON CACHE BOOL "") SET(Kokkos_ENABLE_EXPLICIT_INSTANTIATION OFF CACHE BOOL "") From 7948e5b6d186a6502fad70eddbc36317de350344 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Tue, 14 Nov 2023 20:21:59 -0600 Subject: [PATCH 479/529] Homme(xx)/SL: Enhanced trajectory method. --- .../cime_config/namelist_defaults_scream.xml | 1 + .../homme/src/preqx/prim_advection_mod.F90 | 21 +- .../src/preqx_acc/prim_advection_mod.F90 | 12 + .../homme/src/preqx_kokkos/CMakeLists.txt | 2 +- .../src/preqx_kokkos/prim_advection_mod.F90 | 10 + .../homme/src/share/compose/CMakeLists.txt | 2 + .../homme/src/share/compose/compose_cedr.cpp | 60 +- .../src/share/compose/compose_cedr_cdr.hpp | 18 +- .../compose/compose_cedr_sl_run_global.cpp | 173 +- .../compose/compose_cedr_sl_run_local.cpp | 18 +- .../homme/src/share/compose/compose_homme.cpp | 148 +- .../homme/src/share/compose/compose_homme.hpp | 38 +- .../src/share/compose/compose_hommexx.cpp | 29 +- .../src/share/compose/compose_hommexx.hpp | 17 +- .../homme/src/share/compose/compose_slmm.cpp | 115 +- .../compose/compose_slmm_departure_point.hpp | 1 + .../src/share/compose/compose_slmm_islmpi.cpp | 94 +- .../src/share/compose/compose_slmm_islmpi.hpp | 88 +- .../share/compose/compose_slmm_islmpi_buf.hpp | 53 + .../compose_slmm_islmpi_calc_trajectory.cpp | 333 +++ .../compose_slmm_islmpi_interpolate.cpp | 67 + .../compose_slmm_islmpi_interpolate.hpp | 142 ++ .../compose/compose_slmm_islmpi_pack.cpp | 90 +- .../share/compose/compose_slmm_islmpi_q.cpp | 339 +-- .../compose/compose_slmm_islmpi_step.cpp | 4 +- .../homme/src/share/compose/compose_test.cpp | 2 +- .../homme/src/share/compose/compose_test.hpp | 1 + components/homme/src/share/compose_mod.F90 | 69 +- .../homme/src/share/compose_test_mod.F90 | 4 +- components/homme/src/share/control_mod.F90 | 6 + .../homme/src/share/cxx/ComposeTransport.cpp | 10 +- .../src/share/cxx/ComposeTransportImpl.hpp | 167 +- ...ComposeTransportImplEnhancedTrajectory.cpp | 2254 +++++++++++++++++ .../share/cxx/ComposeTransportImplGeneral.cpp | 76 +- .../cxx/ComposeTransportImplTrajectory.cpp | 124 +- .../homme/src/share/cxx/GllFvRemapImpl.hpp | 1 - components/homme/src/share/cxx/Tracers.cpp | 5 +- components/homme/src/share/cxx/Tracers.hpp | 4 +- .../src/share/cxx/utilities/SubviewUtils.hpp | 15 + .../src/share/cxx/vector/vector_pragmas.hpp | 7 + components/homme/src/share/namelist_mod.F90 | 21 + .../homme/src/share/prim_driver_base.F90 | 10 +- components/homme/src/share/reduction_mod.F90 | 67 +- components/homme/src/share/sl_advection.F90 | 1359 +++++++++- components/homme/src/test_mod.F90 | 18 +- .../homme/src/test_src/dcmip12_wrapper.F90 | 232 +- .../src/test_src/dcmip2012_test1_conv.F90 | 175 -- .../src/test_src/dcmip2012_test1_conv_mod.F90 | 548 ++++ .../src/theta-l/share/prim_advection_mod.F90 | 13 +- .../homme/src/theta-l_kokkos/CMakeLists.txt | 3 +- .../theta-l_kokkos/cxx/prim_advance_exp.cpp | 11 +- .../src/theta-l_kokkos/prim_driver_mod.F90 | 150 +- .../thetah-sl-test11conv-r0t1-cdr30-rrm.nl | 2 +- .../thetah-sl-test11conv-r1t2-cdr20.nl | 2 +- .../namelists/thetah-sl-testconv-3e.nl | 62 + .../test/reg_test/run_tests/test-list.cmake | 6 +- ...-sl-test11conv-r0t1-cdr30-rrm-kokkos.cmake | 2 +- .../thetah-sl-test11conv-r0t1-cdr30-rrm.cmake | 2 +- .../thetah-sl-test11conv-r1t2-cdr20.cmake | 2 +- .../thetah-sl-testconv-3e-kokkos.cmake | 11 + .../run_tests/thetah-sl-testconv-3e.cmake | 11 + components/homme/test/unit_tests/tester.cpp | 6 +- components/homme/test_execs/CMakeLists.txt | 5 +- .../homme/test_execs/stt/CMakeLists.txt | 4 +- .../thetal_kokkos_ut/compose_interface.F90 | 33 +- .../thetal_kokkos_ut/compose_ut.cpp | 153 +- 66 files changed, 6325 insertions(+), 1203 deletions(-) create mode 100644 components/homme/src/share/compose/compose_slmm_islmpi_buf.hpp create mode 100644 components/homme/src/share/compose/compose_slmm_islmpi_calc_trajectory.cpp create mode 100644 components/homme/src/share/compose/compose_slmm_islmpi_interpolate.cpp create mode 100644 components/homme/src/share/compose/compose_slmm_islmpi_interpolate.hpp create mode 100644 components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp delete mode 100644 components/homme/src/test_src/dcmip2012_test1_conv.F90 create mode 100644 components/homme/src/test_src/dcmip2012_test1_conv_mod.F90 create mode 100644 components/homme/test/reg_test/namelists/thetah-sl-testconv-3e.nl create mode 100644 components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e-kokkos.cmake create mode 100644 components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e.cmake diff --git a/components/eamxx/cime_config/namelist_defaults_scream.xml b/components/eamxx/cime_config/namelist_defaults_scream.xml index b3153431570..8da3ede3ed5 100644 --- a/components/eamxx/cime_config/namelist_defaults_scream.xml +++ b/components/eamxx/cime_config/namelist_defaults_scream.xml @@ -864,6 +864,7 @@ be lost if SCREAM_HACK_XML is not enabled. 6 6 12 + 0 2 none diff --git a/components/homme/src/preqx/prim_advection_mod.F90 b/components/homme/src/preqx/prim_advection_mod.F90 index 8e7fd8b0cfb..ecbc745c730 100644 --- a/components/homme/src/preqx/prim_advection_mod.F90 +++ b/components/homme/src/preqx/prim_advection_mod.F90 @@ -6,14 +6,13 @@ module prim_advection_mod use dimensions_mod, only : nlev, qsize, nelemd use kinds, only : real_kind - use parallel_mod, only : parallel_t + use parallel_mod, only : parallel_t, abortmp use derivative_mod, only : derivative_t use element_mod, only : element_t use hybvcoord_mod, only : hvcoord_t use time_mod, only : TimeLevel_t use hybrid_mod, only : hybrid_t use control_mod, only : transport_alg - use sl_advection, only : prim_advec_tracers_remap_ALE, sl_init1 use prim_advection_base, only: prim_advec_init1_rk2, prim_advec_tracers_remap_rk2,& prim_advec_init2 @@ -35,12 +34,20 @@ subroutine Prim_Advec_Init1(par, elem) type (element_t) :: elem(:) call prim_advec_init1_rk2(par, elem) - call sl_init1(par,elem) - end subroutine Prim_Advec_Init1 + subroutine Prim_Advec_Tracers_observe_velocity(elem, tl, n, nets, nete) + type (element_t) , intent(inout) :: elem(:) + type (TimeLevel_t) , intent(in ) :: tl + integer , intent(in ) :: n + integer , intent(in ) :: nets + integer , intent(in ) :: nete + + ! Do nothing. Only SL transport uses this routine, and it's not supported in + ! preqx. + end subroutine Prim_Advec_Tracers_observe_velocity - subroutine Prim_Advec_Tracers_remap( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) + subroutine Prim_Advec_Tracers_remap( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) implicit none type (element_t) , intent(inout) :: elem(:) type (derivative_t) , intent(in ) :: deriv @@ -54,8 +61,8 @@ subroutine Prim_Advec_Tracers_remap( elem , deriv , hvcoord , hybrid , dt , tl if (transport_alg == 0) then call Prim_Advec_Tracers_remap_rk2( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) - else - call Prim_Advec_Tracers_remap_ALE( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) + else + call abortmp('Semi-Lagrangian transport is not supported in preqx.') end if end subroutine Prim_Advec_Tracers_remap diff --git a/components/homme/src/preqx_acc/prim_advection_mod.F90 b/components/homme/src/preqx_acc/prim_advection_mod.F90 index dbf055eb920..694c8440530 100644 --- a/components/homme/src/preqx_acc/prim_advection_mod.F90 +++ b/components/homme/src/preqx_acc/prim_advection_mod.F90 @@ -41,6 +41,7 @@ module prim_advection_mod logical, private :: first_time = .true. public :: Prim_Advec_Tracers_remap + public :: Prim_Advec_Tracers_observe_velocity public :: prim_advec_init1 public :: prim_advec_init2 @@ -302,6 +303,17 @@ subroutine prim_advec_init2(elem,hvcoord,hybrid) !$omp barrier end subroutine prim_advec_init2 + subroutine Prim_Advec_Tracers_observe_velocity(elem, tl, n, nets, nete) + type (element_t) , intent(inout) :: elem(:) + type (TimeLevel_t) , intent(in ) :: tl + integer , intent(in ) :: n + integer , intent(in ) :: nets + integer , intent(in ) :: nete + + ! Do nothing. Only SL transport uses this routine, and it's not supported in + ! preqx. + end subroutine Prim_Advec_Tracers_observe_velocity + subroutine advance_hypervis_scalar( elem , hvcoord , hybrid , deriv , nt , nt_qdp , nets , nete , dt2 ) ! hyperviscsoity operator for foward-in-time scheme ! take one timestep of: diff --git a/components/homme/src/preqx_kokkos/CMakeLists.txt b/components/homme/src/preqx_kokkos/CMakeLists.txt index dff42bb97c6..53691c9f2da 100644 --- a/components/homme/src/preqx_kokkos/CMakeLists.txt +++ b/components/homme/src/preqx_kokkos/CMakeLists.txt @@ -115,7 +115,7 @@ MACRO(PREQX_KOKKOS_SETUP) ${TEST_SRC_DIR}/dcmip12_wrapper.F90 ${TEST_SRC_DIR}/dcmip16_wrapper.F90 ${TEST_SRC_DIR}/dcmip2012_test1_2_3.F90 - ${TEST_SRC_DIR}/dcmip2012_test1_conv.F90 + ${TEST_SRC_DIR}/dcmip2012_test1_conv_mod.F90 ${TEST_SRC_DIR}/dcmip2012_test4.F90 ${TEST_SRC_DIR}/dcmip2012_test5.F90 ${TEST_SRC_DIR}/dcmip2016-baroclinic.F90 diff --git a/components/homme/src/preqx_kokkos/prim_advection_mod.F90 b/components/homme/src/preqx_kokkos/prim_advection_mod.F90 index b3d5595b874..07895e67e8e 100644 --- a/components/homme/src/preqx_kokkos/prim_advection_mod.F90 +++ b/components/homme/src/preqx_kokkos/prim_advection_mod.F90 @@ -39,6 +39,16 @@ subroutine Prim_Advec_Init1(par, elem) end subroutine Prim_Advec_Init1 + subroutine Prim_Advec_Tracers_observe_velocity(elem, tl, n, nets, nete) + type (element_t) , intent(inout) :: elem(:) + type (TimeLevel_t) , intent(in ) :: tl + integer , intent(in ) :: n + integer , intent(in ) :: nets + integer , intent(in ) :: nete + + ! Do nothing. Only SL transport uses this routine, and it's not supported in + ! preqx. + end subroutine Prim_Advec_Tracers_observe_velocity subroutine Prim_Advec_Tracers_remap( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) implicit none diff --git a/components/homme/src/share/compose/CMakeLists.txt b/components/homme/src/share/compose/CMakeLists.txt index a052dcc3032..6bec15c08a0 100644 --- a/components/homme/src/share/compose/CMakeLists.txt +++ b/components/homme/src/share/compose/CMakeLists.txt @@ -30,12 +30,14 @@ add_library (${COMPOSE_LIBRARY} compose_slmm_islmpi_pack.cpp compose_slmm_islmpi_q.cpp compose_slmm_islmpi_qextrema.cpp + compose_slmm_islmpi_interpolate.cpp compose_slmm_islmpi_step.cpp compose_cedr_sl_run_global.cpp compose_cedr_sl_run_local.cpp compose_cedr_sl_run_check.cpp compose_cedr_qlt.cpp compose_cedr_caas.cpp + compose_slmm_islmpi_calc_trajectory.cpp cedr_util.cpp cedr_mpi.cpp cedr_local.cpp diff --git a/components/homme/src/share/compose/compose_cedr.cpp b/components/homme/src/share/compose/compose_cedr.cpp index 0aeaebf9487..9a8648d86da 100644 --- a/components/homme/src/share/compose/compose_cedr.cpp +++ b/components/homme/src/share/compose/compose_cedr.cpp @@ -419,12 +419,12 @@ struct TreeReducer : }; template -CDR::CDR (Int cdr_alg_, Int ngblcell_, Int nlclcell_, Int nlev_, Int qsize_, - bool use_sgi, bool independent_time_steps, const bool hard_zero_, - const Int* gid_data, const Int* rank_data, +CDR::CDR (Int cdr_alg_, Int ngblcell_, Int nlclcell_, Int nlev_, Int np_, + Int qsize_, bool use_sgi, bool independent_time_steps, + const bool hard_zero_, const Int* gid_data, const Int* rank_data, const cedr::mpi::Parallel::Ptr& p_, Int fcomm) : alg(Alg::convert(cdr_alg_)), - ncell(ngblcell_), nlclcell(nlclcell_), nlev(nlev_), qsize(qsize_), + ncell(ngblcell_), nlclcell(nlclcell_), nlev(nlev_), np(np_), qsize(qsize_), nsublev(Alg::is_suplev(alg) ? nsublev_per_suplev : 1), nsuplev((nlev + nsublev - 1) / nsublev), threed(independent_time_steps), @@ -444,8 +444,9 @@ CDR::CDR (Int cdr_alg_, Int ngblcell_, Int nlclcell_, Int nlev_, Int qsize_, cdr = std::make_shared(p, nleaf, tree, options, threed ? nsuplev : 0); tree = nullptr; } else if (Alg::is_caas(alg)) { - const Int n_accum_in_place = n_id_in_suplev*(cdr_over_super_levels ? - nsuplev : 1); + const Int n_accum_in_place = (n_id_in_suplev* + (Alg::is_point(alg) ? np*np : 1)* + (cdr_over_super_levels ? nsuplev : 1)); typename CAAST::UserAllReducer::Ptr reducer; //todo Measure perf on CPU and GPU of TreeReducer vs // ReproSumReducer. For now, I'll continue to use ReproSumReducer. @@ -458,7 +459,8 @@ CDR::CDR (Int cdr_alg_, Int ngblcell_, Int nlclcell_, Int nlev_, Int qsize_, } else { reducer = std::make_shared >(fcomm, n_accum_in_place); } - const auto caas = std::make_shared(p, nlclcell*n_accum_in_place, reducer); + const auto caas = std::make_shared(p, nlclcell*n_accum_in_place, + reducer); cdr = caas; } else { cedr_throw_if(true, "Invalid semi_lagrange_cdr_alg " << alg); @@ -502,11 +504,13 @@ void set_ie2gci (CDR& q, const Int ie, const Int gci) { q.ie2gci_h[ie] = gci template void init_ie2lci (CDR& q) { + const Int n_in_elem = Alg::is_point(q.alg) ? q.np*q.np : 1; const Int n_id_in_suplev = q.caas_in_suplev ? 1 : q.nsublev; const Int nleaf = n_id_in_suplev* q.ie2gci.size()* - (q.cdr_over_super_levels ? q.nsuplev : 1); + (q.cdr_over_super_levels ? q.nsuplev : 1)* + n_in_elem; q.ie2lci = typename CDR::Idxs("ie2lci", nleaf); q.ie2lci_h = Kokkos::create_mirror_view(q.ie2lci); if (Alg::is_qlt(q.alg)) { @@ -516,9 +520,9 @@ void init_ie2lci (CDR& q) { for (size_t ie = 0; ie < q.ie2gci_h.size(); ++ie) for (Int spli = 0; spli < q.nsuplev; ++spli) for (Int sbli = 0; sbli < n_id_in_suplev; ++sbli) - // local indexing is fastest over the whole column + // Local indexing is fastest over the whole column ... q.ie2lci_h[nlevwrem*ie + n_id_in_suplev*spli + sbli] = - // but global indexing is organized according to the tree + // ... but global indexing is organized according to the tree. qlt->gci2lci(n_id_in_suplev*(q.ncell*spli + q.ie2gci_h[ie]) + sbli); } else { for (size_t ie = 0; ie < q.ie2gci_h.size(); ++ie) @@ -531,16 +535,18 @@ void init_ie2lci (CDR& q) { const auto nlevwrem = q.nsuplev*n_id_in_suplev; for (size_t ie = 0; ie < q.ie2gci_h.size(); ++ie) for (Int spli = 0; spli < q.nsuplev; ++spli) - for (Int sbli = 0; sbli < n_id_in_suplev; ++sbli) { - const Int id = nlevwrem*ie + n_id_in_suplev*spli + sbli; - q.ie2lci_h[id] = id; - } + for (Int sbli = 0; sbli < n_id_in_suplev; ++sbli) + for (Int k = 0; k < n_in_elem; ++k) { + const Int id = nlevwrem*(n_in_elem*ie + k) + n_id_in_suplev*spli + sbli; + q.ie2lci_h[id] = id; + } } else { for (size_t ie = 0; ie < q.ie2gci_h.size(); ++ie) - for (Int sbli = 0; sbli < n_id_in_suplev; ++sbli) { - const Int id = n_id_in_suplev*ie + sbli; - q.ie2lci_h[id] = id; - } + for (Int sbli = 0; sbli < n_id_in_suplev; ++sbli) + for (Int k = 0; k < n_in_elem; ++k) { + const Int id = n_id_in_suplev*(n_in_elem*ie + k) + sbli; + q.ie2lci_h[id] = id; + } } } Kokkos::deep_copy(q.ie2lci, q.ie2lci_h); @@ -625,12 +631,12 @@ extern "C" void cedr_init_impl (const homme::Int fcomm, const homme::Int cdr_alg, const bool use_sgi, const homme::Int* gid_data, const homme::Int* rank_data, const homme::Int gbl_ncell, const homme::Int lcl_ncell, - const homme::Int nlev, const homme::Int qsize, + const homme::Int nlev, const homme::Int np, const homme::Int qsize, const bool independent_time_steps, const bool hard_zero, const homme::Int, const homme::Int) { const auto p = cedr::mpi::make_parallel(MPI_Comm_f2c(fcomm)); g_cdr = std::make_shared >( - cdr_alg, gbl_ncell, lcl_ncell, nlev, qsize, use_sgi, + cdr_alg, gbl_ncell, lcl_ncell, nlev, np, qsize, use_sgi, independent_time_steps, hard_zero, gid_data, rank_data, p, fcomm); } @@ -650,17 +656,7 @@ extern "C" void cedr_set_bufs (homme::Real* sendbuf, homme::Real* recvbuf, extern "C" void cedr_set_null_bufs () { cedr_set_bufs(nullptr, nullptr, 0, 0); } extern "C" void cedr_unittest (const homme::Int fcomm, homme::Int* nerrp) { -#if 0 - auto p = cedr::mpi::make_parallel(MPI_Comm_f2c(fcomm)); - cedr_assert(g_cdr); - cedr_assert(g_cdr->tree); - if (homme::CDR::Alg::is_qlt(g_cdr->alg)) - *nerrp = cedr::qlt::test::test_qlt(p, g_cdr->tree, g_cdr->nsublev*g_cdr->ncell, - 1, false, false, true, false); - else - *nerrp = cedr::caas::test::unittest(p); -#endif - *nerrp += compose::test::cedr_unittest(); + *nerrp = compose::test::cedr_unittest(); } extern "C" void cedr_set_ie2gci (const homme::Int ie, const homme::Int gci) { @@ -715,7 +711,6 @@ extern "C" void cedr_sl_run_global (homme::Real* minq, const homme::Real* maxq, cedr_assert(g_cdr); cedr_assert(g_sl); { homme::Timer timer("h2d"); - //if (g_cdr->p->amroot() && s_h2d) printf("cedr_h2d\n"); homme::cedr_h2d(*g_sl->ta, s_h2d); } homme::sl::run_global(*g_cdr, *g_sl, minq, maxq, nets-1, nete-1); } @@ -730,7 +725,6 @@ extern "C" void cedr_sl_run_local (homme::Real* minq, const homme::Real* maxq, homme::sl::run_local(*g_cdr, *g_sl, minq, maxq, nets-1, nete-1, use_ir, limiter_option); { homme::Timer timer("d2h"); - //if (g_cdr->p->amroot() && s_d2h) printf("cedr_d2h\n"); homme::cedr_d2h(*g_sl->ta, s_d2h); } } diff --git a/components/homme/src/share/compose/compose_cedr_cdr.hpp b/components/homme/src/share/compose/compose_cedr_cdr.hpp index 1c15b364fdf..2c73bd6de07 100644 --- a/components/homme/src/share/compose/compose_cedr_cdr.hpp +++ b/components/homme/src/share/compose/compose_cedr_cdr.hpp @@ -8,7 +8,8 @@ namespace homme { struct Alg { - enum Enum { qlt, qlt_super_level, qlt_super_level_local_caas, caas, caas_super_level }; + enum Enum { qlt, qlt_super_level, qlt_super_level_local_caas, caas, + caas_super_level, caas_point }; static Enum convert (int cdr_alg) { switch (cdr_alg) { case 2: return qlt; @@ -17,6 +18,7 @@ struct Alg { case 3: return caas; case 30: return caas_super_level; case 42: return caas_super_level; // actually none + case 5: return caas_point; default: cedr_throw_if(true, "cdr_alg " << cdr_alg << " is invalid."); } } @@ -25,7 +27,10 @@ struct Alg { e == qlt_super_level_local_caas); } static bool is_caas (Enum e) { - return e == caas || e == caas_super_level; + return e == caas || e == caas_super_level || e == caas_point; + } + static bool is_point (Enum e) { + return e == caas_point; } static bool is_suplev (Enum e) { return (e == qlt_super_level || e == caas_super_level || @@ -55,7 +60,7 @@ struct CDR { enum { nsublev_per_suplev = 8 }; const Alg::Enum alg; - const Int ncell, nlclcell, nlev, qsize, nsublev, nsuplev; + const Int ncell, nlclcell, nlev, np, qsize, nsublev, nsuplev; const bool threed, cdr_over_super_levels, caas_in_suplev, hard_zero; const cedr::mpi::Parallel::Ptr p; cedr::tree::Node::Ptr tree; // Don't need this except for unit testing. @@ -67,9 +72,10 @@ struct CDR { BoolsH nonneg_h; bool run; // for debugging, it can be useful not to run the CEDR. - CDR(Int cdr_alg_, Int ngblcell_, Int nlclcell_, Int nlev_, Int qsize_, bool use_sgi, - bool independent_time_steps, const bool hard_zero_, const Int* gid_data, - const Int* rank_data, const cedr::mpi::Parallel::Ptr& p_, Int fcomm); + CDR(Int cdr_alg_, Int ngblcell_, Int nlclcell_, Int nlev_, Int np_, Int qsize_, + bool use_sgi, bool independent_time_steps, const bool hard_zero_, + const Int* gid_data, const Int* rank_data, const cedr::mpi::Parallel::Ptr& p_, + Int fcomm); CDR(const CDR&) = delete; CDR& operator=(const CDR&) = delete; diff --git a/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp b/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp index 69fab390726..40348736167 100644 --- a/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp +++ b/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp @@ -5,6 +5,76 @@ namespace homme { namespace sl { +template +void run_relaxed_local (CDR& cdr, const Data& d, Real* q_min_r, + const Real* q_max_r, const Int nets, const Int nete) { + const auto& ta = *d.ta; + cedr_assert(ta.np == np_); + static const Int np2 = np_*np_; + const Int nlev = ta.nlev, qsize = ta.qsize, nlevwrem = cdr.nsuplev*cdr.nsublev; +#ifdef COMPOSE_PORT + const auto& q_min = ta.q_min; + const auto& q_max = ta.q_max; +#else + const QExtremaH + q_min(q_min_r, ta.nelemd, ta.qsize, ta.nlev, np2); + const QExtremaHConst + q_max(q_max_r, ta.nelemd, ta.qsize, ta.nlev, np2); +#endif + const auto np1 = ta.np1; + const auto& spheremp = ta.spheremp; + const auto& dp3d_c = ta.dp3d; + const auto& q_c = ta.q; + const Int nsublev = cdr.nsublev; + const Int nsuplev = cdr.nsuplev; + const auto caas_in_suplev = cdr.caas_in_suplev; + cedr_assert( ! caas_in_suplev); + const auto is_point = Alg::is_point(cdr.alg); +#ifdef COMPOSE_PORT + const auto f = COMPOSE_LAMBDA (const Int& idx) { + const Int ie = nets + idx/(nsuplev*qsize); + const Int q = (idx / nsuplev) % qsize; + const Int spli = idx % nsuplev; +#else + for (Int ie = nets; ie <= nete; ++ie) { +#endif + const auto spheremp1 = subview_ie(ie, spheremp); + const auto dp3d_c1 = subview_ie(ie, dp3d_c); + const auto q_c1 = subview_ie(ie, q_c); +#ifndef COMPOSE_PORT + for (Int q = 0; q < qsize; ++q) + for (Int spli = 0; spli < nsuplev; ++spli) { +#endif + const Int k0 = nsublev*spli; + for (Int sbli = 0; sbli < nsublev; ++sbli) { + const Int k = k0 + sbli; + if (k >= nlev) break; + Real qlo[np2], qhi[np2], wa[np2], y[np2], x[np2], Qm = 0; + for (Int g = 0; g < np2; ++g) { + const auto del = 0.01*(qhi[g] - qlo[g]); + qlo[g] = idx_qext(q_min,ie,q,g,k) - del; + qhi[g] = idx_qext(q_max,ie,q,g,k) + del; + } + for (Int g = 0; g < np2; ++g) { + const Real rhomij = dp3d_c1(np1,g,k) * spheremp1(g); + wa[g] = rhomij; + y[g] = q_c1(q,g,k); + x[g] = y[g]; + Qm += rhomij*y[g]; + } + cedr::local::caas(np2, wa, Qm, qlo, qhi, y, x, false); + for (Int g = 0; g < np2; ++g) + q_c1(q,g,k) = x[g]; + } +#ifdef COMPOSE_PORT + }; + ko::fence(); + ko::parallel_for(ko::RangePolicy(0, (nete - nets + 1)*nsuplev*qsize), f); +#else + }} +#endif +} + template ko::EnableIfNotOnGpu warn_on_Qm_prev_negative ( Real Qm_prev, Int rank, Int ie, const Ie2gci& ie2gci, Int np2, Int spli, @@ -78,6 +148,9 @@ void run_global (CDR& cdr, CDRT* cedr_cdr_p, const Int nsublev = cdr.nsublev; const Int nsuplev = cdr.nsuplev; + const Int n_in_elem = Alg::is_point(cdr.alg) ? np2 : 1; + const Int g_outer_lim = n_in_elem; + const Int g_inner_lim = Alg::is_point(cdr.alg) ? 1 : np2; const auto rank = cdr.p->rank(); const auto cdr_over_super_levels = cdr.cdr_over_super_levels; const auto caas_in_suplev = cdr.caas_in_suplev; @@ -116,58 +189,61 @@ void run_global (CDR& cdr, CDRT* cedr_cdr_p, const Int k0 = nsublev*spli; const Int ti = cdr_over_super_levels ? q : spli*qsize + q; const bool nonneg = nonnegs[q]; - Real Qm = 0, Qm_min = 0, Qm_max = 0, Qm_prev = 0, rhom = 0, volume = 0; - Int ie_idx; - if (caas_in_suplev) - ie_idx = (cdr_over_super_levels ? - nsuplev*ie + spli : - ie); - for (Int sbli = 0; sbli < nsublev; ++sbli) { - const auto k = k0 + sbli; - if ( ! caas_in_suplev) + for (Int g_out = 0; g_out < g_outer_lim; ++g_out) { + Real Qm = 0, Qm_min = 0, Qm_max = 0, Qm_prev = 0, rhom = 0, volume = 0; + Int ie_idx; + if (caas_in_suplev) ie_idx = (cdr_over_super_levels ? - nlevwrem*ie + k : - nsublev*ie + sbli); - const auto lci = ie2lci[ie_idx]; - if ( ! caas_in_suplev) { - Qm = 0; Qm_min = 0; Qm_max = 0; Qm_prev = 0; - rhom = 0; - volume = 0; - } - if (k < nlev) { - for (Int g = 0; g < np2; ++g) { - const auto smp = spheremp1(g); - volume += smp; - const Real rhomij = dp3d_c1(np1,g,k) * smp; - rhom += rhomij; - Qm += q_c1(q,g,k) * rhomij; - auto& q_min_val = idx_qext(q_min,ie,q,g,k); - if ( ! cedr::impl::OnGpu::value && nonneg) - q_min_val = ko::max(q_min_val, 0); - Qm_min += q_min_val * rhomij; - Qm_max += idx_qext(q_max,ie,q,g,k) * rhomij; - Qm_prev += qdp_p1(n0_qdp,q,g,k) * smp; + nsuplev*(n_in_elem*ie + g_out) + spli : + n_in_elem*ie + g_out); + for (Int sbli = 0; sbli < nsublev; ++sbli) { + const auto k = k0 + sbli; + if ( ! caas_in_suplev) + ie_idx = (cdr_over_super_levels ? + nlevwrem*(n_in_elem*ie + g_out) + k : + nsublev*(n_in_elem*ie + g_out) + sbli); + const auto lci = ie2lci[ie_idx]; + if ( ! caas_in_suplev) { + Qm = 0; Qm_min = 0; Qm_max = 0; Qm_prev = 0; + rhom = 0; + volume = 0; + } + if (k < nlev) { + for (Int g_in = 0; g_in < g_inner_lim; ++g_in) { + const Int g = g_out + g_in; + const auto smp = spheremp1(g); + volume += smp; + const Real rhomij = dp3d_c1(np1,g,k) * smp; + rhom += rhomij; + Qm += q_c1(q,g,k) * rhomij; + auto& q_min_val = idx_qext(q_min,ie,q,g,k); + if ( ! cedr::impl::OnGpu::value && nonneg) + q_min_val = ko::max(q_min_val, 0); + Qm_min += q_min_val * rhomij; + Qm_max += idx_qext(q_max,ie,q,g,k) * rhomij; + Qm_prev += qdp_p1(n0_qdp,q,g,k) * smp; + } + } + const bool write = ! caas_in_suplev || sbli == nsublev-1; + if (write) { + // For now, handle just one rhom. For feasible global problems, it's + // used only as a weight vector in QLT, so it's fine. In fact, use + // just the cell geometry, rather than total density, since in QLT + // this field is used as a weight vector. + //todo Generalize to one rhom field per level. Until then, we're not + // getting QLT's safety benefit. + if (ti == 0) cedr_cdr.set_rhom(lci, 0, volume); + cedr_cdr.set_Qm(lci, ti, Qm, Qm_min, Qm_max, Qm_prev); + if (Qm_prev < -0.5) + warn_on_Qm_prev_negative(Qm_prev, rank, ie, ie2gci, np2, spli, k0, q, + ti, sbli, lci, k, n0_qdp, np1, qdp_p, dp3d_c); } - } - const bool write = ! caas_in_suplev || sbli == nsublev-1; - if (write) { - // For now, handle just one rhom. For feasible global problems, - // it's used only as a weight vector in QLT, so it's fine. In fact, - // use just the cell geometry, rather than total density, since in QLT - // this field is used as a weight vector. - //todo Generalize to one rhom field per level. Until then, we're not - // getting QLT's safety benefit. - if (ti == 0) cedr_cdr.set_rhom(lci, 0, volume); - cedr_cdr.set_Qm(lci, ti, Qm, Qm_min, Qm_max, Qm_prev); - if (Qm_prev < -0.5) - warn_on_Qm_prev_negative(Qm_prev, rank, ie, ie2gci, np2, spli, k0, q, - ti, sbli, lci, k, n0_qdp, np1, qdp_p, dp3d_c); } } #ifdef COMPOSE_PORT - }; - ko::fence(); - ko::parallel_for(ko::RangePolicy(0, (nete - nets + 1)*nsuplev*qsize), f); + }; + ko::fence(); + ko::parallel_for(ko::RangePolicy(0, (nete - nets + 1)*nsuplev*qsize), f); #else }} #endif @@ -176,6 +252,9 @@ void run_global (CDR& cdr, CDRT* cedr_cdr_p, template void run_global (CDR& cdr, const Data& d, Real* q_min_r, const Real* q_max_r, const Int nets, const Int nete) { + if (Alg::is_point(cdr.alg)) + run_relaxed_local<4, MT>(cdr, d, q_min_r, q_max_r, nets, nete); + ko::fence(); if (dynamic_cast::QLTT*>(cdr.cdr.get())) run_global<4, MT, typename CDR::QLTT>( cdr, dynamic_cast::QLTT*>(cdr.cdr.get()), diff --git a/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp b/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp index 393b3f943ec..3cd7e094dc3 100644 --- a/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp +++ b/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp @@ -186,6 +186,8 @@ void run_local (CDR& cdr, CDRT* cedr_cdr_p, const Int nsuplev = cdr.nsuplev; const auto cdr_over_super_levels = cdr.cdr_over_super_levels; const auto caas_in_suplev = cdr.caas_in_suplev; + const auto is_point = Alg::is_point(cdr.alg); + const Int n_in_elem = is_point ? np2 : 1; const typename CDRT::DeviceOp #ifndef COMPOSE_PORT & @@ -211,7 +213,21 @@ void run_local (CDR& cdr, CDRT* cedr_cdr_p, #endif const Int k0 = nsublev*spli; const Int ti = cdr_over_super_levels ? q : spli*qsize + q; - if (caas_in_suplev) { + if (is_point) { + for (Int g = 0; g < np2; ++g) + for (Int sbli = 0; sbli < nsublev; ++sbli) { + const Int k = k0 + sbli; + if (k >= nlev) break; + const auto ie_idx = (cdr_over_super_levels ? + nlevwrem*(n_in_elem*ie + g) + k : + nsublev*(n_in_elem*ie + g) + sbli); + const auto lci = ie2lci[ie_idx]; + const Real Qm = cedr_cdr.get_Qm(lci, ti); + const Real rhom = dp3d_c1(np1,g,k) * spheremp1(g); + q_c1(q,g,k) = Qm / rhom; + qdp_c1(n1_qdp,q,g,k) = q_c1(q,g,k) * dp3d_c1(np1,g,k); + } + } else if (caas_in_suplev) { const auto ie_idx = (cdr_over_super_levels ? nsuplev*ie + spli : ie); diff --git a/components/homme/src/share/compose/compose_homme.cpp b/components/homme/src/share/compose/compose_homme.cpp index 4399e0b5cf9..938403d096f 100644 --- a/components/homme/src/share/compose/compose_homme.cpp +++ b/components/homme/src/share/compose/compose_homme.cpp @@ -9,7 +9,6 @@ TracerArrays::TracerArrays (Int nelemd_, Int nlev_, Int np_, Int qsize_, Int pdp(nelemd, np2, nlev), pdp3d(nelemd, np2, nlev, -1, 3), pqdp(nelemd, np2, nlev, qsized, 2), pq(nelemd, np2, nlev, qsized), #if defined COMPOSE_PORT - dep_points("dep_points", nelemd, nlev, np2), q_min("q_min", nelemd, qsize, np2, nlev), q_max("q_max", nelemd, qsize, np2, nlev) #else @@ -31,46 +30,109 @@ void TracerArrays::alloc_if_not () { #endif template -void sl_h2d (TracerArrays& ta, bool transfer, Cartesian3D* dep_points) { +void sl_traj_h2d (TracerArrays& ta, Real* dep_points, Real* vnode, + Real* vdep, Int ndim) { #if defined COMPOSE_PORT +# if defined COMPOSE_HORIZ_OPENMP +# pragma omp master + { +# endif ko::fence(); ta.alloc_if_not(); const Int nelemd = ta.nelemd, qsize = ta.qsize, np2 = ta.np2, nlev = ta.nlev; - const DepPointsH cart_h(reinterpret_cast(dep_points), nelemd, nlev, np2); - const auto dep_points_h = ko::create_mirror_view(ta.dep_points); - for (Int ie = 0; ie < nelemd; ++ie) - for (Int lev = 0; lev < nlev; ++lev) - for (Int k = 0; k < np2; ++k) - for (Int d = 0; d < 3; ++d) - dep_points_h(ie,lev,k,d) = cart_h(ie,lev,k,d); - ko::deep_copy(ta.dep_points, dep_points_h); - if ( ! transfer) return; - const auto qdp_m = ko::create_mirror_view(ta.qdp); - const auto dp_m = ko::create_mirror_view(ta.dp); + const DepPointsH cart_h(dep_points, nelemd, nlev, np2, ndim); + ko::deep_copy(ta.dep_points, cart_h); + if (vnode) { + const DepPointsH h(vnode, nelemd, nlev, np2, ndim); + ko::deep_copy(ta.vnode, h); + } + if (vdep) { + const DepPointsH h(vdep, nelemd, nlev, np2, ndim); + ko::deep_copy(ta.vdep, h); + } +# ifdef COMPOSE_HORIZ_OPENMP + } +# pragma omp barrier +# endif +#endif +} + +template +void sl_traj_d2h (const TracerArrays& ta, Real* dep_points, Real* vnode, + Real* vdep, Int ndim) { +#if defined COMPOSE_PORT +# if defined COMPOSE_HORIZ_OPENMP +# pragma omp master + { +# endif + ko::fence(); const auto q_m = ko::create_mirror_view(ta.q); - for (Int ie = 0; ie < nelemd; ++ie) - for (Int iq = 0; iq < qsize; ++iq) + const Int nelemd = ta.nelemd, np2 = ta.np2, nlev = ta.nlev; + const DepPointsH dep_points_h(dep_points, nelemd, nlev, np2, ndim); + ko::deep_copy(dep_points_h, ta.dep_points); + if (vnode) { + const DepPointsH h(vnode, nelemd, nlev, np2, ndim); + ko::deep_copy(h, ta.vnode); + } + if (vdep) { + const DepPointsH h(vdep, nelemd, nlev, np2, ndim); + ko::deep_copy(h, ta.vdep); + } +# ifdef COMPOSE_HORIZ_OPENMP + } +# pragma omp barrier +# endif +#endif +} + +template +void sl_h2d (TracerArrays& ta, bool transfer, Real* dep_points, Int ndim) { +#if defined COMPOSE_PORT +# if defined COMPOSE_HORIZ_OPENMP +# pragma omp master + { +# endif + ko::fence(); + ta.alloc_if_not(); + const Int nelemd = ta.nelemd, qsize = ta.qsize, np2 = ta.np2, nlev = ta.nlev; + const DepPointsH cart_h(dep_points, nelemd, nlev, np2, ndim); + ko::deep_copy(ta.dep_points, cart_h); + if (transfer) { + const auto qdp_m = ko::create_mirror_view(ta.qdp); + const auto dp_m = ko::create_mirror_view(ta.dp); + const auto q_m = ko::create_mirror_view(ta.q); + for (Int ie = 0; ie < nelemd; ++ie) + for (Int iq = 0; iq < qsize; ++iq) + for (Int k = 0; k < np2; ++k) + for (Int lev = 0; lev < nlev; ++lev) { + for (Int qtl = 0; qtl < 2; ++qtl) + qdp_m(ie,qtl,iq,k,lev) = ta.pqdp(ie,qtl,iq,k,lev); + q_m(ie,iq,k,lev) = ta.pq(ie,iq,k,lev); + } + for (Int ie = 0; ie < nelemd; ++ie) for (Int k = 0; k < np2; ++k) - for (Int lev = 0; lev < nlev; ++lev) { - for (Int qtl = 0; qtl < 2; ++qtl) - qdp_m(ie,qtl,iq,k,lev) = ta.pqdp(ie,qtl,iq,k,lev); - q_m(ie,iq,k,lev) = ta.pq(ie,iq,k,lev); - } - for (Int ie = 0; ie < nelemd; ++ie) - for (Int k = 0; k < np2; ++k) - for (Int lev = 0; lev < nlev; ++lev) - dp_m(ie,k,lev) = ta.pdp(ie,k,lev); - ko::deep_copy(ta.qdp, qdp_m); - ko::deep_copy(ta.dp, dp_m); - ko::deep_copy(ta.q, q_m); + for (Int lev = 0; lev < nlev; ++lev) + dp_m(ie,k,lev) = ta.pdp(ie,k,lev); + ko::deep_copy(ta.qdp, qdp_m); + ko::deep_copy(ta.dp, dp_m); + ko::deep_copy(ta.q, q_m); + } +# ifdef COMPOSE_HORIZ_OPENMP + } +# pragma omp barrier +# endif #endif } template -void sl_d2h (const TracerArrays& ta, bool transfer, Cartesian3D* dep_points, +void sl_d2h (const TracerArrays& ta, bool transfer, Real* dep_points, Int ndim, Real* minq, Real* maxq) { #if defined COMPOSE_PORT if ( ! transfer) return; +# if defined COMPOSE_HORIZ_OPENMP +# pragma omp master + { +# endif ko::fence(); const auto q_m = ko::create_mirror_view(ta.q); const Int nelemd = ta.nelemd, qsize = ta.qsize, np2 = ta.np2, nlev = ta.nlev; @@ -80,13 +142,17 @@ void sl_d2h (const TracerArrays& ta, bool transfer, Cartesian3D* dep_points, for (Int k = 0; k < np2; ++k) for (Int lev = 0; lev < nlev; ++lev) ta.pq(ie,iq,k,lev) = q_m(ie,iq,k,lev); - const DepPointsH dep_points_h(reinterpret_cast(dep_points), nelemd, nlev, np2); + const DepPointsH dep_points_h(dep_points, nelemd, nlev, np2, ndim); const QExtremaH q_min_h(minq, nelemd, qsize, np2, nlev), q_max_h(maxq, nelemd, qsize, np2, nlev); ko::deep_copy(dep_points_h, ta.dep_points); ko::deep_copy(q_min_h, ta.q_min); ko::deep_copy(q_max_h, ta.q_max); +# ifdef COMPOSE_HORIZ_OPENMP + } +# pragma omp barrier +# endif #endif } @@ -94,6 +160,10 @@ template void cedr_h2d (const TracerArrays& ta, bool transfer) { #if defined COMPOSE_PORT if ( ! transfer) return; +# if defined COMPOSE_HORIZ_OPENMP +# pragma omp master + { +# endif ko::fence(); const auto dp3d_m = ko::create_mirror_view(ta.dp3d); const auto q_m = ko::create_mirror_view(ta.q); @@ -114,6 +184,10 @@ void cedr_h2d (const TracerArrays& ta, bool transfer) { ko::deep_copy(ta.dp3d, dp3d_m); ko::deep_copy(ta.q, q_m); ko::deep_copy(ta.spheremp, spheremp_m); +# ifdef COMPOSE_HORIZ_OPENMP + } +# pragma omp barrier +# endif #endif } @@ -121,6 +195,10 @@ template void cedr_d2h (const TracerArrays& ta, bool transfer) { #if defined COMPOSE_PORT if ( ! transfer) return; +# if defined COMPOSE_HORIZ_OPENMP +# pragma omp master + { +# endif ko::fence(); const auto q_m = ko::create_mirror_view(ta.q); const auto qdp_m = ko::create_mirror_view(ta.qdp); @@ -135,6 +213,10 @@ void cedr_d2h (const TracerArrays& ta, bool transfer) { ta.pqdp(ie,n1_qdp,iq,k,lev) = qdp_m(ie,n1_qdp,iq,k,lev); ta.pq(ie,iq,k,lev) = q_m(ie,iq,k,lev); } +# ifdef COMPOSE_HORIZ_OPENMP + } +# pragma omp barrier +# endif #endif } @@ -161,10 +243,14 @@ void delete_tracer_arrays () { } template struct TracerArrays; +template void sl_traj_h2d(TracerArrays& ta, + Real*, Real*, Real*, Int ndim); +template void sl_traj_d2h(const TracerArrays& ta, + Real*, Real*, Real*, Int ndim); template void sl_h2d(TracerArrays& ta, bool transfer, - Cartesian3D* dep_points); + Real* dep_points, Int ndim); template void sl_d2h(const TracerArrays& ta, bool transfer, - Cartesian3D* dep_points, Real* minq, Real* maxq); + Real* dep_points, Int ndim, Real* minq, Real* maxq); template void cedr_h2d(const TracerArrays& ta, bool transfer); template void cedr_d2h(const TracerArrays& ta, bool transfer); diff --git a/components/homme/src/share/compose/compose_homme.hpp b/components/homme/src/share/compose/compose_homme.hpp index a3b40a204a9..4f12b44fccf 100644 --- a/components/homme/src/share/compose/compose_homme.hpp +++ b/components/homme/src/share/compose/compose_homme.hpp @@ -22,7 +22,7 @@ template using FA4 = ko::View using FA5 = ko::View; template using DepPoints = - ko::View; + ko::View; template using QExtrema = ko::View; @@ -140,26 +140,26 @@ struct HommeFormatArray { COMPOSE_FORCEINLINE_FUNCTION T& operator() (const Int& ie, const Int& i) const { static_assert(rank == 2, "rank 2 array"); - assert(i >= 0); - assert(ie_data_ptr[ie]); // These routines are not used on the GPU, but they can be called from // KOKKOS_FUNCTIONs on CPU in GPU builds. Avoid nvcc warnings as follows: #if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ return unused(); #else + assert(i >= 0); + assert(ie_data_ptr[ie]); return *(ie_data_ptr[ie] + i); #endif } COMPOSE_FORCEINLINE_FUNCTION T& operator() (const Int& ie, const Int& k, const Int& lev) const { static_assert(rank == 3, "rank 3 array"); +#if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ + return unused(); +#else assert(k >= 0); assert(lev >= 0); assert(ie_data_ptr[ie]); check(ie, k, lev); -#if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ - return unused(); -#else return *(ie_data_ptr[ie] + lev*np2 + k); #endif } @@ -167,14 +167,14 @@ struct HommeFormatArray { T& operator() (const Int& ie, const Int& q_or_timelev, const Int& k, const Int& lev) const { static_assert(rank == 4, "rank 4 array"); +#if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ + return unused(); +#else assert(q_or_timelev >= 0); assert(k >= 0); assert(lev >= 0); assert(ie_data_ptr[ie]); check(ie, k, lev, q_or_timelev); -#if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ - return unused(); -#else return *(ie_data_ptr[ie] + (q_or_timelev*nlev + lev)*np2 + k); #endif } @@ -182,15 +182,15 @@ struct HommeFormatArray { T& operator() (const Int& ie, const Int& timelev, const Int& q, const Int& k, const Int& lev) const { static_assert(rank == 5, "rank 4 array"); +#if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ + return unused(); +#else assert(timelev >= 0); assert(q >= 0); assert(k >= 0); assert(lev >= 0); assert(ie_data_ptr[ie]); check(ie, k, lev, q, timelev); -#if defined __CUDA_ARCH__ || defined __HIP_DEVICE_COMPILE__ - return unused(); -#else return *(ie_data_ptr[ie] + ((timelev*qsized + q)*nlev + lev)*np2 + k); #endif } @@ -255,7 +255,7 @@ struct TracerArrays { View dp3d; // elem%state%dp3d or the sl3d equivalent View qdp; // elem%state%Qdp(:,:,:,:,:) View q; // elem%state%Q - DepPoints dep_points; + DepPoints dep_points, vnode, vdep; QExtrema q_min, q_max; void alloc_if_not(); #else @@ -287,10 +287,18 @@ subview_ie (const Int ie, const TracerView& s) { return TracerView(&s(ie,0,0,0,0), s.extent(1), s.extent(2), s.extent(3), s.extent(4)); } template -void sl_h2d(TracerArrays& ta, bool transfer, Cartesian3D* dep_points); +void sl_traj_h2d(TracerArrays& ta, Real* dep_points, Real* vnode, Real* vdep, + Int ndim); + +template +void sl_traj_d2h(const TracerArrays& ta, Real* dep_points, Real* vnode, + Real* vdep, Int ndim); + +template +void sl_h2d(TracerArrays& ta, bool transfer, Real* dep_points, Int ndim); template -void sl_d2h(const TracerArrays& ta, bool transfer, Cartesian3D* dep_points, +void sl_d2h(const TracerArrays& ta, bool transfer, Real* dep_points, Int ndim, Real* minq, Real* maxq); template diff --git a/components/homme/src/share/compose/compose_hommexx.cpp b/components/homme/src/share/compose/compose_hommexx.cpp index fdc6cdf4bcf..0b88e6024a1 100644 --- a/components/homme/src/share/compose/compose_hommexx.cpp +++ b/components/homme/src/share/compose/compose_hommexx.cpp @@ -21,10 +21,13 @@ template using View = typename TracerArrays::View; #endif -void set_views (const SetView& spheremp, - const SetView& dp, const SetView& dp3d, - const SetView& qdp, const SetView& q, - const SetView& dep_points) { +void set_views (const SetView& spheremp, + const SetView& dp, const SetView5& dp3d, + const SetView& qdp, const SetView5& q, + const SetView5& dep_points, const SetView5& vnode, + const SetView5& vdep, const Int ndim) { + static_assert(std::is_same::value, + "Hommexx and Compose real types must be the same."); #ifdef COMPOSE_PORT auto& ta = *get_tracer_arrays(); const auto nel = spheremp.extent_int(0); @@ -35,13 +38,29 @@ void set_views (const SetView& spheremp, ta.dp3d = View(dp3d.data(), nel, dp3d.extent_int(1), np2, nlev); ta.qdp = View(qdp.data(), nel, qdp.extent_int(1), qdp.extent_int(2), np2, nlev); ta.q = View(q.data(), nel, q.extent_int(1), np2, nlev); - ta.dep_points = View(dep_points.data(), nel, dep_points.extent_int(1), np2); + ta.dep_points = View(dep_points.data(), nel, dep_points.extent_int(1), np2, ndim); + if (vnode.data()) + ta.vnode = View(vnode.data(), nel, vnode.extent_int(1), np2, ndim); + if (vdep.data()) + ta.vdep = View(vdep.data(), nel, vdep .extent_int(1), np2, ndim); #else slmm_throw_if(true, "Running a Hommexx code path with the non-Hommexx build" " is not supported.\n"); #endif } +void set_hvcoord (const HommexxReal etai_beg, const HommexxReal etai_end, + const HommexxReal* etam) { + auto& cm = *get_isl_mpi_singleton(); + islmpi::set_hvcoord(cm, etai_beg, etai_end, etam); +} + +void calc_v_departure (const int step, const HommexxReal dtsub) { + auto& cm = *get_isl_mpi_singleton(); + islmpi::calc_v_departure<>(cm, 0, cm.nelemd - 1, step, dtsub, + nullptr, nullptr, nullptr); +} + void advect (const int np1, const int n0_qdp, const int np1_qdp) { auto& cm = *get_isl_mpi_singleton(); cm.tracer_arrays->np1 = np1; diff --git a/components/homme/src/share/compose/compose_hommexx.hpp b/components/homme/src/share/compose/compose_hommexx.hpp index 6cd8f510e8e..b2e33905540 100644 --- a/components/homme/src/share/compose/compose_hommexx.hpp +++ b/components/homme/src/share/compose/compose_hommexx.hpp @@ -6,13 +6,22 @@ namespace homme { namespace compose { +typedef double HommexxReal; + template using SetView = Kokkos::View; -void set_views(const SetView& spheremp, - const SetView& dp, const SetView& dp3d, - const SetView& qdp, const SetView& q, - const SetView& dep_points); +typedef SetView SetView5; + +void set_views(const SetView& spheremp, + const SetView& dp, const SetView5& dp3d, + const SetView& qdp, const SetView5& q, + const SetView5& dep_points, const SetView5& vnode, + const SetView5& vdep, const int trajectory_ndim); + +void set_hvcoord(const HommexxReal etai_beg, const HommexxReal etai_end, + const HommexxReal* etam); +void calc_v_departure(const int step, const HommexxReal dtsub); void advect(const int np1, const int n0_qdp, const int np1_qdp); diff --git a/components/homme/src/share/compose/compose_slmm.cpp b/components/homme/src/share/compose/compose_slmm.cpp index 27ab1e1a7d0..ec570e21580 100644 --- a/components/homme/src/share/compose/compose_slmm.cpp +++ b/components/homme/src/share/compose/compose_slmm.cpp @@ -98,11 +98,12 @@ init (const typename IslMpi::Advecter::ConstPtr& advecter, const mpi::Parallel::Ptr& p, Int np, Int nlev, Int qsize, Int qsized, Int nelemd, const Int* nbr_id_rank, const Int* nirptr, - Int halo) { - slmm_throw_if(halo < 1 || halo > 2, "halo must be 1 (default) or 2."); + Int halo, Int traj_3d, Int traj_nsubstep) { + slmm_throw_if(halo < 1, "halo must be 1 (default) or larger."); auto tracer_arrays = homme::init_tracer_arrays(nelemd, nlev, np, qsize, qsized); auto cm = std::make_shared >(p, advecter, tracer_arrays, np, nlev, - qsize, qsized, nelemd, halo); + qsize, qsized, nelemd, halo, traj_3d, + traj_nsubstep); setup_comm_pattern(*cm, nbr_id_rank, nirptr); return cm; } @@ -111,13 +112,43 @@ init (const typename IslMpi::Advecter::ConstPtr& advecter, // already has a ref to the const'ed one. template void finalize_init_phase (IslMpi& cm, typename IslMpi::Advecter& advecter) { - if (cm.halo == 2) + if (cm.halo > 1) extend_halo::extend_local_meshes(*cm.p, cm.ed_h, advecter); advecter.fill_nearest_points_if_needed(); advecter.sync_to_device(); sync_to_device(cm); } +template +void set_hvcoord (IslMpi& cm, const Real etai_beg, const Real etai_end, + const Real* etam) { + if (cm.etam.size() > 0) return; +#if defined COMPOSE_HORIZ_OPENMP +# pragma omp barrier +# pragma omp master +#endif + { + slmm_assert(cm.nlev > 0); + cm.etai_beg = etai_beg; + cm.etai_end = etai_end; + cm.etam = typename IslMpi::template ArrayD("etam", cm.nlev); + const auto h = ko::create_mirror_view(cm.etam); + for (int k = 0; k < cm.nlev; ++k) { + h(k) = etam[k]; + slmm_assert(k == 0 || h(k) > h(k-1)); + slmm_assert(h(k) > 0 && h(k) < 1); + } + ko::deep_copy(cm.etam, h); + } +#if defined COMPOSE_HORIZ_OPENMP +# pragma omp barrier +#endif +} + +template void set_hvcoord( + IslMpi& cm, const Real etai_beg, const Real etai_end, + const Real* etam); + // Set pointers to HOMME data arrays. template void set_elem_data (IslMpi& cm, const Int ie, Real* qdp, const Int n0_qdp, @@ -297,8 +328,9 @@ void slmm_init_impl ( homme::Int nelemd, homme::Int cubed_sphere_map, homme::Int geometry, const homme::Int* lid2gid, const homme::Int* lid2facenum, const homme::Int* nbr_id_rank, const homme::Int* nirptr, - homme::Int sl_nearest_point_lev, homme::Int, homme::Int, homme::Int, - homme::Int) + homme::Int sl_halo, homme::Int sl_traj_3d, homme::Int sl_traj_nsubstep, + homme::Int sl_nearest_point_lev, + homme::Int, homme::Int, homme::Int, homme::Int) { amb::dev_init_threads(); homme::slmm_init(np, nelem, nelemd, transport_alg, cubed_sphere_map, @@ -308,7 +340,7 @@ void slmm_init_impl ( const auto p = homme::mpi::make_parallel(MPI_Comm_f2c(fcomm)); homme::g_csl_mpi = homme::islmpi::init( homme::g_advecter, p, np, nlev, qsize, qsized, nelemd, - nbr_id_rank, nirptr, 2 /* halo */); + nbr_id_rank, nirptr, sl_halo, sl_traj_3d, sl_traj_nsubstep); amb::dev_fin_threads(); } @@ -374,6 +406,42 @@ void slmm_check_ref2sphere (homme::Int ie, homme::Cartesian3D* p) { amb::dev_fin_threads(); } +void slmm_set_hvcoord (const homme::Real etai_beg, const homme::Real etai_end, + const homme::Real* etam) { + amb::dev_init_threads(); + slmm_assert(homme::g_csl_mpi); + homme::islmpi::set_hvcoord(*homme::g_csl_mpi, etai_beg, etai_end, etam); + amb::dev_fin_threads(); +} + +void slmm_calc_v_departure ( + homme::Int nets, homme::Int nete, homme::Int step, homme::Real dtsub, + homme::Real* dep_points, homme::Int dep_points_ndim, homme::Real* vnode, + homme::Real* vdep, homme::Int* info) +{ + amb::dev_init_threads(); + check_threading(); + slmm_assert(homme::g_csl_mpi); + slmm_assert(homme::g_csl_mpi->sendsz.empty()); // alloc_mpi_buffers was called + auto& cm = *homme::g_csl_mpi; + slmm_assert(cm.dep_points_ndim == dep_points_ndim); + { + slmm::Timer timer("h2d"); + homme::sl_traj_h2d(*cm.tracer_arrays, dep_points, vnode, vdep, + cm.dep_points_ndim); + } + homme::islmpi::calc_v_departure(cm, nets - 1, nete - 1, step - 1, + dtsub, dep_points, vnode, vdep); + *info = 0; + { + slmm::Timer timer("d2h"); + homme::sl_traj_d2h(*cm.tracer_arrays, dep_points, vnode, vdep, + cm.dep_points_ndim); + } + amb::dev_fin_threads(); +} + +// Request extra data to be transferred for analysis. static bool s_h2d, s_d2h; void slmm_csl_set_elem_data ( @@ -389,34 +457,35 @@ void slmm_csl_set_elem_data ( amb::dev_fin_threads(); } -void slmm_csl ( - homme::Int nets, homme::Int nete, homme::Cartesian3D* dep_points, - homme::Real* minq, homme::Real* maxq, homme::Int* info) -{ +void slmm_csl (homme::Int nets, homme::Int nete, homme::Real* dep_points, + homme::Int dep_points_ndim, homme::Real* minq, homme::Real* maxq, + homme::Int* info) { amb::dev_init_threads(); check_threading(); slmm_assert(homme::g_csl_mpi); slmm_assert(homme::g_csl_mpi->sendsz.empty()); // alloc_mpi_buffers was called - { slmm::Timer timer("h2d"); - //if (homme::g_csl_mpi->p->amroot() && s_h2d) printf("sl_h2d\n"); - homme::sl_h2d(*homme::g_csl_mpi->tracer_arrays, s_h2d, dep_points); } + auto& cm = *homme::g_csl_mpi; + slmm_assert(cm.dep_points_ndim == dep_points_ndim); + { + slmm::Timer timer("h2d"); + homme::sl_h2d(*cm.tracer_arrays, s_h2d, dep_points, cm.dep_points_ndim); + } *info = 0; -#if 0 -#pragma message "RM TRY-CATCH WHILE DEV'ING" +#if 1 try { - homme::islmpi::step(*homme::g_csl_mpi, nets - 1, nete - 1, - reinterpret_cast(dep_points), minq, maxq); + homme::islmpi::step(cm, nets - 1, nete - 1, dep_points, minq, maxq); } catch (const std::exception& e) { std::cerr << e.what(); *info = -1; } #else - homme::islmpi::step(*homme::g_csl_mpi, nets - 1, nete - 1, - reinterpret_cast(dep_points), minq, maxq); + homme::islmpi::step(cm, nets - 1, nete - 1, dep_points, minq, maxq); #endif - { slmm::Timer timer("d2h"); - //if (homme::g_csl_mpi->p->amroot() && s_d2h) printf("sl_d2h\n"); - homme::sl_d2h(*homme::g_csl_mpi->tracer_arrays, s_d2h, dep_points, minq, maxq); } + { + slmm::Timer timer("d2h"); + homme::sl_d2h(*cm.tracer_arrays, s_d2h, dep_points, cm.dep_points_ndim, + minq, maxq); + } amb::dev_fin_threads(); } diff --git a/components/homme/src/share/compose/compose_slmm_departure_point.hpp b/components/homme/src/share/compose/compose_slmm_departure_point.hpp index de912c54216..c226787cfc8 100644 --- a/components/homme/src/share/compose/compose_slmm_departure_point.hpp +++ b/components/homme/src/share/compose/compose_slmm_departure_point.hpp @@ -1,6 +1,7 @@ #ifndef INCLUDE_COMPOSE_SLMM_DEPARTURE_POINT_HPP #define INCLUDE_COMPOSE_SLMM_DEPARTURE_POINT_HPP +#include "compose.hpp" #include "compose_slmm.hpp" namespace slmm { diff --git a/components/homme/src/share/compose/compose_slmm_islmpi.cpp b/components/homme/src/share/compose/compose_slmm_islmpi.cpp index 822780dd967..635e020877c 100644 --- a/components/homme/src/share/compose/compose_slmm_islmpi.cpp +++ b/components/homme/src/share/compose/compose_slmm_islmpi.cpp @@ -92,20 +92,23 @@ typedef std::vector GidRankPairs; typedef std::map Gid2Nbrs; typedef std::vector IntBuf; typedef std::vector RealBuf; +typedef std::map Gid2Count; template -GidRankPairs all_nbrs_but_me (const typename IslMpi::ElemDataH& ed) { +GidRankPairs all_1halo_nbrs_but_me (const typename IslMpi::ElemDataH& ed) { GidRankPairs gs; - gs.reserve(ed.nbrs.size() - 1); - for (const auto& n : ed.nbrs) + gs.reserve(ed.nin1halo - 1); + for (Int i = 0; i < ed.nin1halo; ++i) { + const auto& n = ed.nbrs(i); if (&n != ed.me) gs.push_back(GidRankPair(n.gid, n.rank)); + } return gs; } template void fill_gid2nbrs (const mpi::Parallel& p, const typename IslMpi::ElemDataListH& eds, - Gid2Nbrs& gid2nbrs) { + Gid2Nbrs& gid2nbrs, Gid2Count& gid2ninprevhalo) { static const Int tag = 6; const Rank my_rank = p.rank(); const Int n_owned = eds.size(); @@ -113,7 +116,7 @@ void fill_gid2nbrs (const mpi::Parallel& p, const typename IslMpi::ElemDataL // Fill in the ones we know. for (const auto& ed : eds) { slmm_assert(ed.me->rank == my_rank); - gid2nbrs[ed.me->gid] = all_nbrs_but_me(ed); + gid2nbrs[ed.me->gid] = all_1halo_nbrs_but_me(ed); } std::vector ranks; @@ -126,13 +129,18 @@ void fill_gid2nbrs (const mpi::Parallel& p, const typename IslMpi::ElemDataL std::map needgid2rank; { std::set unique_ranks; - for (const auto& item : gid2nbrs) - for (const auto& n : item.second) - if (n.rank != my_rank) { - slmm_assert(gid2nbrs.find(n.gid) == gid2nbrs.end()); - needgid2rank.insert(std::make_pair(n.gid, n.rank)); - unique_ranks.insert(n.rank); - } + for (const auto& ed : eds) { + // We only need information for GIDs in the current outermost halo. + const auto& it = gid2ninprevhalo.find(ed.me->gid); + const Int i0 = it == gid2ninprevhalo.end() ? 0 : it->second; + for (Int i = i0; i < ed.nbrs.size(); ++i) { + const auto& n = ed.nbrs(i); + if (n.rank == my_rank) continue; + slmm_assert(gid2nbrs.find(n.gid) == gid2nbrs.end()); + needgid2rank.insert(std::make_pair(n.gid, n.rank)); + unique_ranks.insert(n.rank); + } + } nrank = unique_ranks.size(); ranks.insert(ranks.begin(), unique_ranks.begin(), unique_ranks.end()); Int i = 0; @@ -171,8 +179,9 @@ void fill_gid2nbrs (const mpi::Parallel& p, const typename IslMpi::ElemDataL std::vector nbr_send_reqs(nrank), nbr_recv_reqs(nrank); for (Int i = 0; i < nrank; ++i) { auto& r = nbr_recvs[i]; - // 20 is from dimensions_mod::set_mesh_dimensions; factor of 2 is to get - // (gid,rank); 1 is for size datum. + // 20 is from dimensions_mod::set_mesh_dimensions, the maximum size of the + // 1-halo minus the 0-halo; factor of 2 is to get (gid,rank); 1 is for the + // size datum. r.resize((20*2 + 1)*(req_sends[i].size() - 1)); mpi::irecv(p, r.data(), r.size(), ranks[i], tag, &nbr_recv_reqs[i]); } @@ -215,17 +224,22 @@ void fill_gid2nbrs (const mpi::Parallel& p, const typename IslMpi::ElemDataL } template -void extend_nbrs (const Gid2Nbrs& gid2nbrs, typename IslMpi::ElemDataListH& eds) { +void extend_nbrs (const Gid2Nbrs& gid2nbrs, typename IslMpi::ElemDataListH& eds, + Gid2Count& gid2ninprevhalo) { for (auto& ed : eds) { - // Get all <=2-halo neighbors. - std::set new_nbrs; - for (const auto& n : ed.nbrs) { - if (&n == ed.me) continue; - const auto& it = gid2nbrs.find(n.gid); - slmm_assert(it != gid2nbrs.end()); - const auto& gid_nbrs = it->second; - for (const auto& gn : gid_nbrs) - new_nbrs.insert(gn); + // Get all <=(n+1)-halo neighbors, where we already have <=n-halo neighbors. + std::set new_nbrs; { + const auto& it = gid2ninprevhalo.find(ed.me->gid); + const Int i0 = it == gid2ninprevhalo.end() ? 0 : it->second; + for (Int i = i0; i < ed.nbrs.size(); ++i) { + const auto& n = ed.nbrs(i); + if (&n == ed.me) continue; + const auto& it = gid2nbrs.find(n.gid); + slmm_assert(it != gid2nbrs.end()); + const auto& gid_nbrs = it->second; + for (const auto& gn : gid_nbrs) + new_nbrs.insert(gn); + } } // Remove the already known ones. for (const auto& n : ed.nbrs) @@ -238,8 +252,9 @@ void extend_nbrs (const Gid2Nbrs& gid2nbrs, typename IslMpi::ElemDataListH& break; } slmm_assert(me >= 0); - // Append the, now only new, 2-halo ones. + // Append the, now only new, (n+1)-halo ones. Int i = ed.nbrs.size(); + gid2ninprevhalo[ed.me->gid] = i; ed.nbrs.reset_capacity(i + new_nbrs.size(), true); ed.me = &ed.nbrs(me); for (const auto& n : new_nbrs) { @@ -250,14 +265,22 @@ void extend_nbrs (const Gid2Nbrs& gid2nbrs, typename IslMpi::ElemDataListH& en.lid_on_rank = -1; en.lid_on_rank_idx = -1; } +#ifndef NDEBUG + { + std::set ugid; + for (Int i = 0; i < ed.nbrs.size(); ++i) ugid.insert(ed.nbrs(i).gid); + slmm_assert(ugid.size() == size_t(ed.nbrs.size())); + } +#endif } } template -void collect_gid_rank (const mpi::Parallel& p, typename IslMpi::ElemDataListH& eds) { +void collect_gid_rank (const mpi::Parallel& p, typename IslMpi::ElemDataListH& eds, + Gid2Count& gid2ninprevhalo) { Gid2Nbrs gid2nbrs; - fill_gid2nbrs(p, eds, gid2nbrs); - extend_nbrs(gid2nbrs, eds); + fill_gid2nbrs(p, eds, gid2nbrs, gid2ninprevhalo); + extend_nbrs(gid2nbrs, eds, gid2ninprevhalo); } template @@ -478,7 +501,11 @@ void collect_gid_rank (IslMpi& cm, const Int* nbr_id_rank, const Int* nirptr } slmm_assert(ed.me); } - if (cm.halo == 2) extend_halo::collect_gid_rank(*cm.p, cm.ed_h); + if (cm.halo > 1) { + extend_halo::Gid2Count gid2ninprevhalo; + for (int halo = 2; halo <= cm.halo; ++halo) + extend_halo::collect_gid_rank(*cm.p, cm.ed_h, gid2ninprevhalo); + } #ifdef COMPOSE_PORT cm.own_dep_mask = typename IslMpi::DepMask("own_dep_mask", cm.nelemd, cm.nlev, cm.np2); @@ -682,17 +709,20 @@ void size_mpi_buffers (IslMpi& cm, const Rank2Gids& rank2rmtgids, const Int sor = sizeof(Real), soi = sizeof(Int), sosi = sor; static_assert(sizeof(Real) >= sizeof(Int), "For buffer packing, we require sizeof(Real) >= sizeof(Int)"); + const bool calc_trajectory = cm.traj_nsubstep > 0; + const Int ndim = calc_trajectory ? cm.dep_points_ndim : 3; + const Int qsize = calc_trajectory ? std::max(cm.dep_points_ndim, cm.qsize) : cm.qsize; const auto xbufcnt = [&] (const std::set& rmtgids, const std::set& owngids, const bool include_bulk = true) -> Int { - return (sosi + (2*soi + (2*soi)*cm.nlev)*rmtgids.size() + // meta data - (include_bulk ? 1 : 0)*owngids.size()*cm.nlev*cm.np2*3*sor); // bulk data + return (sosi + (2*soi + (2*soi)*cm.nlev)*rmtgids.size() + // meta data + (include_bulk ? 1 : 0)*owngids.size()*cm.nlev*cm.np2*ndim*sor); // bulk data }; const auto qbufcnt = [&] (const std::set& rmtgids, const std::set& owngids) -> Int { return ((rmtgids.size()*2 + // min/max q owngids.size()*cm.np2)* // q - cm.qsize*cm.nlev*sor); + qsize*cm.nlev*sor); }; const auto bytes2real = [&] (const Int& bytes) { return (bytes + sor - 1)/sor; diff --git a/components/homme/src/share/compose/compose_slmm_islmpi.hpp b/components/homme/src/share/compose/compose_slmm_islmpi.hpp index ef30c826acf..1e60d602dea 100644 --- a/components/homme/src/share/compose/compose_slmm_islmpi.hpp +++ b/components/homme/src/share/compose/compose_slmm_islmpi.hpp @@ -11,7 +11,9 @@ #include // AMB 2017/06-2020/05 Initial for E3SMv2 -// AMB 2020/05-? Performance-portable impl +// AMB 2020/05-2021/01 Performance-portable impl +// AMB 2021/04 Support doubly-periodic planar mode +// AMB 2024/04-2025/01 Enhanced trajectory method namespace homme { namespace mpi { //todo Share with cedr. @@ -20,14 +22,14 @@ class Parallel { MPI_Comm comm_; public: typedef std::shared_ptr Ptr; - Parallel(MPI_Comm comm) : comm_(comm) {} + Parallel (MPI_Comm comm) : comm_(comm) {} MPI_Comm comm () const { return comm_; } - Int size() const { + Int size () const { int sz = 0; MPI_Comm_size(comm_, &sz); return sz; } - Int rank() const { + Int rank () const { int pid = 0; MPI_Comm_rank(comm_, &pid); return pid; @@ -85,6 +87,12 @@ int irecv (const Parallel& p, T* buf, int count, int src, int tag, Request* ireq int waitany(int count, Request* reqs, int* index, MPI_Status* stats = nullptr); int waitall(int count, Request* reqs, MPI_Status* stats = nullptr); int wait(Request* req, MPI_Status* stat = nullptr); + +template +int all_reduce (const Parallel& p, const T* sendbuf, T* rcvbuf, int count, MPI_Op op) { + MPI_Datatype dt = get_type(); + return MPI_Allreduce(const_cast(sendbuf), rcvbuf, count, dt, op, p.comm()); +} } // namespace mpi namespace islmpi { @@ -251,6 +259,40 @@ void deep_copy (FixedCapList& d, const FixedCapList& s) { #endif } +template +struct FixedCapListHostOnly { + FixedCapListHostOnly (const Int cap = 0) { + slmm_assert_high(cap >= 0); + reset_capacity(cap); + } + + void reset_capacity (const Int cap, const bool also_size = false) { + slmm_assert(cap >= 0); + d_.resize(cap); + n_ = also_size ? cap : 0; + } + + Int capacity () const { return d_.size(); } + Int size () const { return n_; } + Int n () const { return n_; } + + void clear () { n_ = 0; } + + void inc () { ++n_; slmm_kernel_assert_high(n_ <= static_cast(d_.size())); } + void inc (const Int& dn) { n_ += dn; slmm_kernel_assert_high(n_ <= static_cast(d_.size())); } + + T& operator() (const Int& i) { slmm_kernel_assert_high(i >= 0 && i < n_); return d_[i]; } + + T* data () { return d_.data(); } + T& back () { slmm_kernel_assert_high(n_ > 0); return d_[n_-1]; } + T* begin () { return d_.data(); } + T* end () { return d_.data() + n_; } + +private: + std::vector d_; + Int n_; +}; + template struct BufferLayoutArray; template @@ -512,6 +554,11 @@ struct IslMpi { const mpi::Parallel::Ptr p; const typename Advecter::ConstPtr advecter; const Int np, np2, nlev, qsize, qsized, nelemd, halo; + const bool traj_3d; + const Int traj_nsubstep, dep_points_ndim; + + Real etai_beg, etai_end; + ArrayD etam; ElemDataListH ed_h; // this rank's owned cells, indexed by LID ElemDataListD ed_d; @@ -526,7 +573,7 @@ struct IslMpi { BufferLayoutArray bla; // MPI comm data. - FixedCapList sendreq, recvreq; + FixedCapListHostOnly sendreq, recvreq; FixedCapList recvreq_ri; ListOfLists sendbuf, recvbuf; #ifdef COMPOSE_MPI_ON_HOST @@ -559,11 +606,14 @@ struct IslMpi { Int own_dep_list_len; IslMpi (const mpi::Parallel::Ptr& ip, const typename Advecter::ConstPtr& advecter, - const typename TracerArrays::Ptr& tracer_arrays_, - Int inp, Int inlev, Int iqsize, Int iqsized, Int inelemd, Int ihalo) + const typename TracerArrays::Ptr& itracer_arrays, + Int inp, Int inlev, Int iqsize, Int iqsized, Int inelemd, Int ihalo, + Int itraj_3d, Int itraj_nsubstep) : p(ip), advecter(advecter), np(inp), np2(np*np), nlev(inlev), qsize(iqsize), qsized(iqsized), nelemd(inelemd), - halo(ihalo), tracer_arrays(tracer_arrays_) + halo(ihalo), traj_3d(itraj_3d), traj_nsubstep(itraj_nsubstep), + dep_points_ndim(traj_3d && traj_nsubstep > 0 ? 4 : 3), + tracer_arrays(itracer_arrays) {} IslMpi(const IslMpi&) = delete; @@ -635,16 +685,17 @@ void wait_on_send (IslMpi& cm, const bool skip_if_empty = false); template void recv(IslMpi& cm, const bool skip_if_empty = false); -const int nreal_per_2int = (2*sizeof(Int) + sizeof(Real) - 1) / sizeof(Real); - template -void pack_dep_points_sendbuf_pass1(IslMpi& cm); +void pack_dep_points_sendbuf_pass1(IslMpi& cm, const bool trajectory = false); template -void pack_dep_points_sendbuf_pass2(IslMpi& cm, const DepPoints& dep_points); +void pack_dep_points_sendbuf_pass2(IslMpi& cm, const DepPoints& dep_points, + const bool trajectory = false); template void calc_q_extrema(IslMpi& cm, const Int& nets, const Int& nete); +template +void calc_rmt_q_pass1(IslMpi& cm, const bool trajectory = false); template void calc_rmt_q(IslMpi& cm); template @@ -681,8 +732,17 @@ void copy_q(IslMpi& cm, const Int& nets, template void step( IslMpi& cm, const Int nets, const Int nete, - Real* dep_points_r, // dep_points(1:3, 1:np, 1:np) - Real* q_min_r, Real* q_max_r); // q_{min,max}(1:np, 1:np, lev, 1:qsize, ie-nets+1) + Real* dep_points_r, + Real* q_min_r, Real* q_max_r); + +template +void set_hvcoord(IslMpi& cm, const Real etai_beg, const Real etai_end, + const Real* etam); + +template +void calc_v_departure( + IslMpi& cm, const Int nets, const Int nete, const Int step, const Real dtsub, + Real* dep_points_r, const Real* vnode, Real* vdep); } // namespace islmpi } // namespace homme diff --git a/components/homme/src/share/compose/compose_slmm_islmpi_buf.hpp b/components/homme/src/share/compose/compose_slmm_islmpi_buf.hpp new file mode 100644 index 00000000000..9cf8b0fe61f --- /dev/null +++ b/components/homme/src/share/compose/compose_slmm_islmpi_buf.hpp @@ -0,0 +1,53 @@ +#ifndef INCLUDE_COMPOSE_SLMM_ISLMPI_BUF_HPP +#define INCLUDE_COMPOSE_SLMM_ISLMPI_BUF_HPP + +namespace homme { +namespace islmpi { + +const int nreal_per_2int = (2*sizeof(Int) + sizeof(Real) - 1) / sizeof(Real); + +template SLMM_KIF +Int setbuf (Buffer& buf, const Int& os, const Int& i1, const Int& i2) { + Int* const b = reinterpret_cast(&buf(os)); + b[0] = i1; + b[1] = i2; + return nreal_per_2int; +} + +template SLMM_KIF +Int setbuf (Buffer& buf, const Int& os, const Int& i1, const short& i2, const short& i3) { + static_assert(sizeof(Int) >= 2*sizeof(short), "Need >= 2 shorts per Int"); + Int* const b = reinterpret_cast(&buf(os)); + b[0] = i1; + short* const b2 = reinterpret_cast(b+1); + b2[0] = i2; + b2[1] = i3; + return nreal_per_2int; +} + +template SLMM_KIF +Int setbuf (Buffer& buf, const Int& os, const Int& i1, const Int& i2, + const bool final) { + if (final) setbuf(buf, os, i1, i2); + return nreal_per_2int; +} + +template SLMM_KIF +Int setbuf (Buffer& buf, const Int& os, const Int& i1, const short& i2, const short& i3, + const bool final) { + if (final) setbuf(buf, os, i1, i2, i3); + return nreal_per_2int; +} + +template SLMM_KIF +Int getbuf (Buffer& buf, const Int& os, Int& i1, Int& i2) { + const Int* const b = reinterpret_cast(&buf(os)); + i1 = b[0]; + i2 = b[1]; + return nreal_per_2int; +} + +} // namespace islmpi +} // namespace homme + +#endif diff --git a/components/homme/src/share/compose/compose_slmm_islmpi_calc_trajectory.cpp b/components/homme/src/share/compose/compose_slmm_islmpi_calc_trajectory.cpp new file mode 100644 index 00000000000..273a7e80e9c --- /dev/null +++ b/components/homme/src/share/compose/compose_slmm_islmpi_calc_trajectory.cpp @@ -0,0 +1,333 @@ +#include "compose_slmm_islmpi.hpp" +#include "compose_slmm_islmpi_interpolate.hpp" +#include "compose_slmm_islmpi_buf.hpp" + +namespace homme { +namespace islmpi { + +template using CA4 = ko::View; + +template SLMM_KF void +interpolate_vertical (const Int nlev, const Real etai_beg, const Real etai_end, + const EtamT& etam, const VnodeT& vnode, + const Int src_lid, const Int lev, const Real eta_dep, + const Real rx[np], const Real ry[np], Real* const v_tgt) { + slmm_kernel_assert(eta_dep > etai_beg && eta_dep < etai_end); + + // Search for the eta midpoint values that support the departure point's eta + // value. + Int lev_dep = lev; + if (eta_dep != etam(lev)) { + if (eta_dep < etam(lev)) { + for (lev_dep = lev-1; lev_dep >= 0; --lev_dep) + if (eta_dep >= etam(lev_dep)) + break; + } else { + for (lev_dep = lev; lev_dep < nlev-1; ++lev_dep) + if (eta_dep < etam(lev_dep+1)) + break; + } + } + slmm_kernel_assert(lev_dep >= -1 && lev_dep < nlev); + slmm_kernel_assert(lev_dep == -1 || eta_dep >= etam(lev_dep)); + Real a; + bool bdy = false; + if (lev_dep == -1) { + lev_dep = 0; + a = 0; + bdy = true; + } else if (lev_dep == nlev-1) { + a = 0; + bdy = true; + } else { + a = ((eta_dep - etam(lev_dep)) / + (etam(lev_dep+1) - etam(lev_dep))); + } + // Linear interp coefficients. + const Real alpha[] = {1-a, a}; + + for (int d = 0; d < 4; ++d) + v_tgt[d] = 0; + for (int i = 0; i < 2; ++i) { + if (alpha[i] == 0) continue; + for (int d = 0; d < 4; ++d) { + Real vel_nodes[np*np]; + for (int k = 0; k < np*np; ++k) + vel_nodes[k] = vnode(src_lid,lev_dep+i,k,d); + v_tgt[d] += alpha[i]*calc_q_tgt(rx, ry, vel_nodes); + } + } + // Treat eta_dot specially since eta_dot goes to 0 at the boundaries. + if (bdy) { + slmm_kernel_assert(etam(0) > etai_beg); + slmm_kernel_assert(etam(nlev-1) < etai_end); + if (lev_dep == 0) + v_tgt[3] *= (eta_dep - etai_beg)/(etam(0) - etai_beg); + else + v_tgt[3] *= (etai_end - eta_dep)/(etai_end - etam(nlev-1)); + } +} + +template +void calc_v (const IslMpi& cm, const VnodeT& vnode, + const Int src_lid, const Int lev, + const Real* const dep_point, Real* const v_tgt) { + // Horizontal interpolation. + Real rx[np], ry[np]; { + Real ref_coord[2]; + const auto& m = cm.advecter->local_mesh(src_lid); + cm.advecter->s2r().calc_sphere_to_ref(src_lid, m, dep_point, + ref_coord[0], ref_coord[1]); + interpolate(cm.advecter->alg(), ref_coord, rx, ry); + } + + if (not cm.traj_3d) { + for (int d = 0; d < cm.dep_points_ndim; ++d) { + Real vel_nodes[np*np]; + for (int k = 0; k < np*np; ++k) + vel_nodes[k] = vnode(src_lid,lev,k,d); + v_tgt[d] = calc_q_tgt(rx, ry, vel_nodes); + } + return; + } + + // Vertical Interpolation. + slmm_kernel_assert(cm.dep_points_ndim == 4); + interpolate_vertical(cm.nlev, cm.etai_beg, cm.etai_end, cm.etam, vnode, + src_lid, lev, dep_point[3], rx, ry, v_tgt); +} + +template +struct CalcVData { + typedef slmm::Advecter Adv; + const typename Adv::LocalMeshesD local_meshes; + const typename Adv::Alg::Enum interp_alg; + const slmm::SphereToRef s2r; + const bool traj_3d; + const int dep_points_ndim; + const int nlev; + const Real etai_beg, etai_end; + const typename IslMpi::template ArrayD etam; + + CalcVData (const IslMpi& cm) + : local_meshes(cm.advecter->local_meshes()), + interp_alg(cm.advecter->alg()), + s2r(cm.advecter->s2r()), + traj_3d(cm.traj_3d), + dep_points_ndim(cm.dep_points_ndim), + nlev(cm.nlev), + etai_beg(cm.etai_beg), etai_end(cm.etai_end), + etam(cm.etam) + {} +}; + +template SLMM_KF +void calc_v (const CalcVData& cvd, const VnodeT& vnode, + const Int src_lid, const Int lev, + const Real* const dep_point, Real* const v_tgt) { + // Horizontal interpolation. + Real rx[np], ry[np]; { + Real ref_coord[2]; + const auto& m = cvd.local_meshes(src_lid); + cvd.s2r.calc_sphere_to_ref(src_lid, m, dep_point, + ref_coord[0], ref_coord[1]); + interpolate(cvd.interp_alg, ref_coord, rx, ry); + } + + if (not cvd.traj_3d) { + for (int d = 0; d < cvd.dep_points_ndim; ++d) { + Real vel_nodes[np*np]; + for (int k = 0; k < np*np; ++k) + vel_nodes[k] = vnode(src_lid,lev,k,d); + v_tgt[d] = calc_q_tgt(rx, ry, vel_nodes); + } + return; + } + + // Vertical Interpolation. + slmm_kernel_assert(cvd.dep_points_ndim == 4); + interpolate_vertical(cvd.nlev, cvd.etai_beg, cvd.etai_end, cvd.etam, vnode, + src_lid, lev, dep_point[3], rx, ry, v_tgt); +} + +template +void traj_calc_rmt_next_step (IslMpi& cm, const VnodeT& vnode) { + calc_rmt_q_pass1(cm, true); + const auto ndim = cm.dep_points_ndim; + const auto& rmt_xs = cm.rmt_xs; + const auto& sendbuf = cm.sendbuf; + const auto& recvbuf = cm.recvbuf; + CalcVData cvd(cm); +#ifdef COMPOSE_PORT + ko::parallel_for(ko::RangePolicy(0, cm.nrmt_xs), + COMPOSE_LAMBDA (const Int it) +#else +# ifdef COMPOSE_HORIZ_OPENMP +# pragma omp for +# endif + for (Int it = 0; it < cm.nrmt_xs; ++it) +#endif + { + const Int + ri = rmt_xs(5*it), lid = rmt_xs(5*it + 1), lev = rmt_xs(5*it + 2), + xos = rmt_xs(5*it + 3), vos = ndim*rmt_xs(5*it + 4); + const auto&& xs = recvbuf(ri); + auto&& v = sendbuf(ri); + calc_v(cvd, vnode, lid, lev, &xs(xos), &v(vos)); + } +#ifdef COMPOSE_PORT + ); +#endif +} + +template +void traj_calc_own_next_step (IslMpi& cm, const DepPoints& dep_points, + const VnodeT& vnode, const VdepT& vdep) { + const auto ndim = cm.dep_points_ndim; +#ifdef COMPOSE_PORT + const auto& ed_d = cm.ed_d; + const auto& own_dep_list = cm.own_dep_list; + CalcVData cvd(cm); + const auto f = COMPOSE_LAMBDA (const Int& it) { + const Int tci = own_dep_list(it,0); + const Int tgt_lev = own_dep_list(it,1); + const Int tgt_k = own_dep_list(it,2); + const auto& ed = ed_d(tci); + const Int slid = ed.nbrs(ed.src(tgt_lev, tgt_k)).lid_on_rank; + Real v_tgt[4]; + calc_v(cvd, vnode, slid, tgt_lev, &dep_points(tci,tgt_lev,tgt_k,0), v_tgt); + for (int d = 0; d < ndim; ++d) + vdep(tci,tgt_lev,tgt_k,d) = v_tgt[d]; + }; + ko::parallel_for( + ko::RangePolicy(0, cm.own_dep_list_len), f); +#else + const int tid = get_tid(); + for (Int tci = 0; tci < cm.nelemd; ++tci) { + auto& ed = cm.ed_d(tci); + const Int ned = ed.own.n(); +#ifdef COMPOSE_HORIZ_OPENMP +# pragma omp for +#endif + for (Int idx = 0; idx < ned; ++idx) { + const auto& e = ed.own(idx); + const Int slid = ed.nbrs(ed.src(e.lev, e.k)).lid_on_rank; + Real v_tgt[4]; + calc_v(cm, vnode, slid, e.lev, &dep_points(tci,e.lev,e.k,0), v_tgt); + for (int d = 0; d < ndim; ++d) + vdep(tci,e.lev,e.k,d) = v_tgt[d]; + } + } +#endif +} + +template +void traj_copy_next_step (IslMpi& cm, const VdepT& vdep) { + const auto myrank = cm.p->rank(); + const auto ndim = cm.dep_points_ndim; +#ifdef COMPOSE_PORT + const auto& mylid_with_comm = cm.mylid_with_comm_d; + const auto& ed_d = cm.ed_d; + const auto& recvbufs = cm.recvbuf; + const Int nlid = cm.mylid_with_comm_h.size(); + const Int nlev = cm.nlev, np2 = cm.np2; + const auto f = COMPOSE_LAMBDA (const Int& it) { + const Int tci = mylid_with_comm(it/(np2*nlev)); + const Int rmt_id = it % (np2*nlev); + auto& ed = ed_d(tci); + if (rmt_id >= ed.rmt.size()) return; + const auto& e = ed.rmt(rmt_id); + slmm_kernel_assert(ed.nbrs(ed.src(e.lev, e.k)).rank != myrank); + const Int ri = ed.nbrs(ed.src(e.lev, e.k)).rank_idx; + const auto&& recvbuf = recvbufs(ri); + for (int d = 0; d < ndim; ++d) + vdep(tci,e.lev,e.k,d) = recvbuf(e.q_ptr + d); + }; + ko::parallel_for(ko::RangePolicy(0, nlid*np2*nlev), f); +#else + const int tid = get_tid(); + for (Int ptr = cm.mylid_with_comm_tid_ptr_h(tid), + end = cm.mylid_with_comm_tid_ptr_h(tid+1); + ptr < end; ++ptr) { + const Int tci = cm.mylid_with_comm_d(ptr); + auto& ed = cm.ed_d(tci); + for (const auto& e: ed.rmt) { + slmm_assert(ed.nbrs(ed.src(e.lev, e.k)).rank != myrank); + const Int ri = ed.nbrs(ed.src(e.lev, e.k)).rank_idx; + const auto&& recvbuf = cm.recvbuf(ri); + for (int d = 0; d < ndim; ++d) + vdep(tci,e.lev,e.k,d) = recvbuf(e.q_ptr + d); + } + } +#endif +} + +// vnode and vdep are indexed as (ie,lev,k,dim), On entry, vnode contains nodal +// velocity data. These data are used to provide updates at departure points for +// both own and remote departure points, writing to vdep. dim = 0:2 is for the +// 3D Cartesian representation of the horizontal velocity; dim = 3 is for +// eta_dot. +template void +calc_v_departure (IslMpi& cm, const Int nets, const Int nete, + const Int step, const Real dtsub, + Real* dep_points_r, const Real* vnode_r, Real* vdep_r) +{ + const int np = 4; + + slmm_assert(cm.np == np); + slmm_assert((cm.traj_3d and cm.dep_points_ndim == 4) or + (not cm.traj_3d and cm.dep_points_ndim == 3)); +#ifdef COMPOSE_PORT + slmm_assert(nets == 0 && nete+1 == cm.nelemd); +#endif + + // If step = 0, the departure points are at the nodes and no interpolation is + // needed. calc_v_departure should not have been called; rather, the calling + // routine should use vnode instead of vdep in subsequent calculations. + slmm_assert(step > 0); + + const auto ndim = cm.dep_points_ndim; + +#ifdef COMPOSE_PORT + const auto& vnode = cm.tracer_arrays->vnode; + const auto& vdep = cm.tracer_arrays->vdep; +#else + CA4 vnode(vnode_r, cm.nelemd, cm.nlev, cm.np2, ndim); + CA4< Real> vdep (vdep_r , cm.nelemd, cm.nlev, cm.np2, ndim); +#endif + slmm_assert(vnode.extent_int(3) == ndim); + slmm_assert(vdep .extent_int(3) == ndim); + +#ifdef COMPOSE_PORT + const auto& dep_points = cm.tracer_arrays->dep_points; +#else + DepPointsH dep_points(dep_points_r, cm.nelemd, cm.nlev, cm.np2, ndim); +#endif + slmm_assert(dep_points.extent_int(3) == ndim); + + // See comments in homme::islmpi::step for details. Each substep follows + // essentially the same pattern. + if (cm.mylid_with_comm_tid_ptr_h.capacity() == 0) + init_mylid_with_comm_threaded(cm, nets, nete); + setup_irecv(cm); + analyze_dep_points(cm, nets, nete, dep_points); + pack_dep_points_sendbuf_pass1(cm, true /* trajectory */); + pack_dep_points_sendbuf_pass2(cm, dep_points, true /* trajectory */); + isend(cm); + recv_and_wait_on_send(cm); + traj_calc_rmt_next_step(cm, vnode); + Kokkos::fence(); + isend(cm, true /* want_req */, true /* skip_if_empty */); + setup_irecv(cm, true /* skip_if_empty */); + traj_calc_own_next_step(cm, dep_points, vnode, vdep); + recv(cm, true /* skip_if_empty */); + traj_copy_next_step(cm, vdep); + wait_on_send(cm, true /* skip_if_empty */); +} + +template void calc_v_departure( + IslMpi&, const Int, const Int, const Int, const Real, + Real*, const Real*, Real*); + +} // namespace islmpi +} // namespace homme diff --git a/components/homme/src/share/compose/compose_slmm_islmpi_interpolate.cpp b/components/homme/src/share/compose/compose_slmm_islmpi_interpolate.cpp new file mode 100644 index 00000000000..3076fb89e78 --- /dev/null +++ b/components/homme/src/share/compose/compose_slmm_islmpi_interpolate.cpp @@ -0,0 +1,67 @@ +#include "compose_slmm_islmpi_interpolate.hpp" + +namespace slmm { + +static Int test_gll () { + Int nerr = 0; + const Real tol = 1e2*std::numeric_limits::epsilon(); + GLL gll; + const Real* x, * wt; + for (Int np = 2; np <= 4; ++np) { + for (Int monotone_type = 0; monotone_type <= 1; ++monotone_type) { + const Basis b(np, monotone_type); + gll.get_coef(b, x, wt); + Real sum = 0; + for (Int i = 0; i < b.np; ++i) + sum += wt[i]; + if (std::abs(2 - sum) > tol) { + std::cerr << "test_gll " << np << ", " << monotone_type + << ": 2 - sum = " << 2 - sum << "\n"; + ++nerr; + } + for (Int j = 0; j < b.np; ++j) { + Real gj[GLL::np_max]; + gll.eval(b, x[j], gj); + for (Int i = 0; i < b.np; ++i) { + if (j == i) continue; + if (std::abs(gj[i]) > tol) { + std::cerr << "test_gll " << np << ", " << monotone_type << ": gj[" + << i << "] = " << gj[i] << "\n"; + ++nerr; + } + } + } + } + } + for (Int np = 2; np <= 4; ++np) { + const Basis b(np, 0); + Real a[] = {-0.9, -0.7, -0.3, 0.1, 0.2, 0.4, 0.6, 0.8}; + const Real delta = std::sqrt(std::numeric_limits::epsilon()); + for (size_t ia = 0; ia < sizeof(a)/sizeof(Real); ++ia) { + Real gj[GLL::np_max], gjp[GLL::np_max], gjm[GLL::np_max]; + gll.eval_derivative(b, a[ia], gj); + gll.eval(b, a[ia] + delta, gjp); + gll.eval(b, a[ia] - delta, gjm); + for (Int i = 0; i < b.np; ++i) { + const Real fd = (gjp[i] - gjm[i])/(2*delta); + if (std::abs(fd - gj[i]) >= delta*std::abs(gjp[i])) + ++nerr; + } + } + } + return nerr; +} + +} // namespace slmm + +namespace compose { +namespace test { + +int interpolate_unittest () { + int nerr = 0; + nerr += slmm::test_gll(); + return nerr; +} + +} // namespace test +} // namespace compose diff --git a/components/homme/src/share/compose/compose_slmm_islmpi_interpolate.hpp b/components/homme/src/share/compose/compose_slmm_islmpi_interpolate.hpp new file mode 100644 index 00000000000..29536e9ab9a --- /dev/null +++ b/components/homme/src/share/compose/compose_slmm_islmpi_interpolate.hpp @@ -0,0 +1,142 @@ +#ifndef INCLUDE_COMPOSE_SLMM_ISLMPI_INTERPOLATE_HPP +#define INCLUDE_COMPOSE_SLMM_ISLMPI_INTERPOLATE_HPP + +#include "compose.hpp" +#include "compose_slmm.hpp" +#include "compose_slmm_islmpi.hpp" + +namespace slmm { + +static constexpr Real sqrt5 = 2.23606797749978969641; // std::sqrt(5.0); +static constexpr Real oosqrt5 = 1.0 / sqrt5; + +SLMM_KIF void gll_np4_eval (const Real x, Real y[4]) { + static constexpr Real oo8 = 1.0/8.0; + const Real x2 = x*x; + y[0] = (1.0 - x)*(5.0*x2 - 1.0)*oo8; + y[1] = -sqrt5*oo8*(sqrt5 - 5.0*x)*(x2 - 1.0); + y[2] = -sqrt5*oo8*(sqrt5 + 5.0*x)*(x2 - 1.0); + y[3] = (1.0 + x)*(5.0*x2 - 1.0)*oo8; +} + +// Linear interp in each region. +SLMM_KIF void gll_np4_subgrid_eval_impl (const Real& x, Real y[4]) { + if (x < -oosqrt5) { + const Real alpha = (x + 1)/(1 - oosqrt5); + y[0] = 1 - alpha; + y[1] = alpha; + y[2] = 0; + y[3] = 0; + } else { + const Real alpha = (x + oosqrt5)/(2*oosqrt5); + y[0] = 0; + y[1] = 1 - alpha; + y[2] = alpha; + y[3] = 0; + } +} + +SLMM_KIF void gll_np4_subgrid_eval (const Real& x, Real y[4]) { + if (x > 0) { + gll_np4_subgrid_eval_impl(-x, y); + ko::swap(y[0], y[3]); + ko::swap(y[1], y[2]); + return; + } + gll_np4_subgrid_eval_impl(x, y); +} + +// Quadratic interpolant across nodes 1,2,3 -- i.e., excluding node 0 -- of the +// np=4 reference element. +SLMM_KIF void outer_eval (const Real& x, Real v[4]) { + static constexpr Real + xbar = (2*oosqrt5) / (1 + oosqrt5), + ooxbar = 1 / xbar, + ybar = 1 / (xbar - 1); + const Real xn = (x + oosqrt5) / (1 + oosqrt5); + v[0] = 0; + v[1] = 1 + ybar*xn*((1 - ooxbar)*xn + ooxbar - xbar); + v[2] = ybar*ooxbar*xn*(xn - 1); + v[3] = ybar*xn*(xbar - xn); +} + +// In the middle region, use the standard GLL np=4 interpolant; in the two outer +// regions, use an order-reduced interpolant that stabilizes the method. +SLMM_KIF void gll_np4_subgrid_exp_eval (const Real& x, Real y[4]) { + static constexpr Real + alpha = 0.5527864045000416708, + v = 0.427*(1 + alpha), + x2 = 0.4472135954999579277, + x3 = 1 - x2, + det = x2*x3*(x2 - x3), + y2 = alpha, + y3 = v, + c1 = (x3*y2 - x2*y3)/det, + c2 = (-x3*x3*y2 + x2*x2*y3)/det; + if (x < -oosqrt5 || x > oosqrt5) { + if (x < -oosqrt5) { + outer_eval(-x, y); + ko::swap(y[0], y[3]); + ko::swap(y[1], y[2]); + } else + outer_eval(x, y); + Real y4[4]; + gll_np4_eval(x, y4); + const Real x0 = 1 - std::abs(x); + const Real a = (c1*x0 + c2)*x0; + for (int i = 0; i < 4; ++i) + y[i] = a*y[i] + (1 - a)*y4[i]; + } else + gll_np4_eval(x, y); +} + +} // namespace slmm + +namespace homme { +namespace islmpi { + +template +SLMM_KIF void interpolate (const typename IslMpi::Advecter::Alg::Enum& alg, + const Real ref_coord[2], Real rx[4], Real ry[4]) { + typedef typename IslMpi::Advecter::Alg Alg; + switch (alg) { + case Alg::csl_gll: + slmm::gll_np4_eval(ref_coord[0], rx); + slmm::gll_np4_eval(ref_coord[1], ry); + break; + case Alg::csl_gll_subgrid: + slmm::gll_np4_subgrid_eval(ref_coord[0], rx); + slmm::gll_np4_subgrid_eval(ref_coord[1], ry); + break; + case Alg::csl_gll_exp: + slmm::gll_np4_subgrid_exp_eval(ref_coord[0], rx); + slmm::gll_np4_subgrid_exp_eval(ref_coord[1], ry); + break; + default: + slmm_kernel_assert(0); + } +} + +SLMM_KIF Real calc_q_tgt (const Real rx[4], const Real ry[4], const Real qs[16]) { + return (ry[0]*(rx[0]*qs[ 0] + rx[1]*qs[ 1] + rx[2]*qs[ 2] + rx[3]*qs[ 3]) + + ry[1]*(rx[0]*qs[ 4] + rx[1]*qs[ 5] + rx[2]*qs[ 6] + rx[3]*qs[ 7]) + + ry[2]*(rx[0]*qs[ 8] + rx[1]*qs[ 9] + rx[2]*qs[10] + rx[3]*qs[11]) + + ry[3]*(rx[0]*qs[12] + rx[1]*qs[13] + rx[2]*qs[14] + rx[3]*qs[15])); +} + +SLMM_KIF Real calc_q_tgt (const Real rx[4], const Real ry[4], const Real qdp[16], + const Real dp[16]) { + return (ry[0]*(rx[0]*(qdp[ 0]/dp[ 0]) + rx[1]*(qdp[ 1]/dp[ 1]) + + rx[2]*(qdp[ 2]/dp[ 2]) + rx[3]*(qdp[ 3]/dp[ 3])) + + ry[1]*(rx[0]*(qdp[ 4]/dp[ 4]) + rx[1]*(qdp[ 5]/dp[ 5]) + + rx[2]*(qdp[ 6]/dp[ 6]) + rx[3]*(qdp[ 7]/dp[ 7])) + + ry[2]*(rx[0]*(qdp[ 8]/dp[ 8]) + rx[1]*(qdp[ 9]/dp[ 9]) + + rx[2]*(qdp[10]/dp[10]) + rx[3]*(qdp[11]/dp[11])) + + ry[3]*(rx[0]*(qdp[12]/dp[12]) + rx[1]*(qdp[13]/dp[13]) + + rx[2]*(qdp[14]/dp[14]) + rx[3]*(qdp[15]/dp[15]))); +} + +} // namespace islmpi +} // namespace homme + +#endif diff --git a/components/homme/src/share/compose/compose_slmm_islmpi_pack.cpp b/components/homme/src/share/compose/compose_slmm_islmpi_pack.cpp index 4fe325728df..213226b6c3b 100644 --- a/components/homme/src/share/compose/compose_slmm_islmpi_pack.cpp +++ b/components/homme/src/share/compose/compose_slmm_islmpi_pack.cpp @@ -1,46 +1,14 @@ #include "compose_slmm_islmpi.hpp" +#include "compose_slmm_islmpi_buf.hpp" namespace homme { namespace islmpi { -template SLMM_KIF -Int setbuf (Buffer& buf, const Int& os, const Int& i1, const Int& i2) { - Int* const b = reinterpret_cast(&buf(os)); - b[0] = i1; - b[1] = i2; - return nreal_per_2int; -} - -template SLMM_KIF -Int setbuf (Buffer& buf, const Int& os, const Int& i1, const short& i2, const short& i3) { - static_assert(sizeof(Int) >= 2*sizeof(short), "Need >= 2 shorts per Int"); - Int* const b = reinterpret_cast(&buf(os)); - b[0] = i1; - short* const b2 = reinterpret_cast(b+1); - b2[0] = i2; - b2[1] = i3; - return nreal_per_2int; -} - -template SLMM_KIF -Int setbuf (Buffer& buf, const Int& os, const Int& i1, const Int& i2, - const bool final) { - if (final) setbuf(buf, os, i1, i2); - return nreal_per_2int; -} - -template SLMM_KIF -Int setbuf (Buffer& buf, const Int& os, const Int& i1, const short& i2, const short& i3, - const bool final) { - if (final) setbuf(buf, os, i1, i2, i3); - return nreal_per_2int; -} - #ifdef COMPOSE_PORT /* GPU metadata are arranged differently than described below. The scheme is the following: - (#x-in-rank int - x-bulk-data-offset i + (x-bulk-data-offset int + #x-in-rank i (lid-on-rank i only packed if #x in lid > 0 lev short #x) s @@ -56,7 +24,7 @@ struct Accum { }; template -void pack_dep_points_sendbuf_pass1_scan (IslMpi& cm) { +void pack_dep_points_sendbuf_pass1_scan (IslMpi& cm, const bool trajectory) { ko::fence(); deep_copy(cm.nx_in_rank_h, cm.nx_in_rank); const auto& sendbufs = cm.sendbuf; @@ -68,6 +36,7 @@ void pack_dep_points_sendbuf_pass1_scan (IslMpi& cm) { const auto& blas = cm.bla; const auto nlev = cm.nlev; const Int nrmtrank = static_cast(cm.ranks.size()) - 1; + const Int ndim = trajectory ? cm.dep_points_ndim : 3; for (Int ri = 0; ri < nrmtrank; ++ri) { const Int lid_on_rank_n = cm.lid_on_rank_h(ri).n(); const auto f = COMPOSE_LAMBDA (const int idx, Accum& a, const bool fin) { @@ -97,10 +66,10 @@ void pack_dep_points_sendbuf_pass1_scan (IslMpi& cm) { if (nx > 0) { const auto dos = setbuf(sendbuf, a.mos, lid_on_rank(lidi), lev, nx, fin); a.mos += dos; - a.sendcount += dos + 3*nx; + a.sendcount += dos + ndim*nx; if (fin) t.xptr = a.xos; - a.xos += 3*nx; - a.qos += 2 + nx; + a.xos += ndim*nx; + a.qos += trajectory ? nx : 2 + nx; } }; Accum a; @@ -121,8 +90,8 @@ void pack_dep_points_sendbuf_pass1_scan (IslMpi& cm) { /* Pack the departure points (x). We use two passes. We also set up the q metadata. Two passes let us do some efficient tricks that are not available with one pass. Departure point and q messages are formatted as follows: - xs: (#x-in-rank int <- - x-bulk-data-offset i | + xs: (x-bulk-data-offset int <- + #x-in-rank i | (lid-on-rank i only packed if #x in lid > 0 | #x-in-lid i > 0 |- meta data (lev i only packed if #x in (lid,lev) > 0 | @@ -135,7 +104,7 @@ void pack_dep_points_sendbuf_pass1_scan (IslMpi& cm) { *#x) *#lev *#lid *#rank */ template -void pack_dep_points_sendbuf_pass1_noscan (IslMpi& cm) { +void pack_dep_points_sendbuf_pass1_noscan (IslMpi& cm, const bool trajectory) { #ifdef COMPOSE_PORT ko::fence(); deep_copy(cm.nx_in_rank_h, cm.nx_in_rank); @@ -143,6 +112,7 @@ void pack_dep_points_sendbuf_pass1_noscan (IslMpi& cm) { deep_copy(cm.bla_h, cm.bla); #endif const Int nrmtrank = static_cast(cm.ranks.size()) - 1; + const Int ndim = trajectory ? cm.dep_points_ndim : 3; #ifdef COMPOSE_HORIZ_OPENMP # pragma omp for #endif @@ -179,10 +149,10 @@ void pack_dep_points_sendbuf_pass1_noscan (IslMpi& cm) { slmm_assert_high(nx > 0); const auto dos = setbuf(sendbuf, mos, lev, nx); mos += dos; - sendcount += dos + 3*nx; + sendcount += dos + ndim*nx; t.xptr = xos; - xos += 3*nx; - qos += 2 + nx; + xos += ndim*nx; + qos += trajectory ? nx : 2 + nx; nx_in_lid -= nx; } slmm_assert(nx_in_lid == 0); @@ -210,17 +180,18 @@ void pack_dep_points_sendbuf_pass1_noscan (IslMpi& cm) { } template -void pack_dep_points_sendbuf_pass1 (IslMpi& cm) { +void pack_dep_points_sendbuf_pass1 (IslMpi& cm, const bool trajectory) { #if defined COMPOSE_PORT && ! defined COMPOSE_PACK_NOSCAN if (ko::OnGpu::value) - pack_dep_points_sendbuf_pass1_scan(cm); + pack_dep_points_sendbuf_pass1_scan(cm, trajectory); else #endif - pack_dep_points_sendbuf_pass1_noscan(cm); + pack_dep_points_sendbuf_pass1_noscan(cm, trajectory); } template -void pack_dep_points_sendbuf_pass2 (IslMpi& cm, const DepPoints& dep_points) { +void pack_dep_points_sendbuf_pass2 (IslMpi& cm, const DepPoints& dep_points, + const bool trajectory) { const auto myrank = cm.p->rank(); #ifdef COMPOSE_PORT const Int start = 0, end = cm.mylid_with_comm_h.n(); @@ -242,6 +213,7 @@ void pack_dep_points_sendbuf_pass2 (IslMpi& cm, const DepPoints& dep_poi } { ConstExceptGnu Int np2 = cm.np2, nlev = cm.nlev, qsize = cm.qsize; + ConstExceptGnu Int ndim = trajectory ? cm.dep_points_ndim : 3; const auto& ed_d = cm.ed_d; const auto& mylid_with_comm_d = cm.mylid_with_comm_d; const auto& sendbuf = cm.sendbuf; @@ -279,17 +251,21 @@ void pack_dep_points_sendbuf_pass2 (IslMpi& cm, const DepPoints& dep_poi ++t.cnt; #endif qptr = t.qptr; - xptr = x_bulkdata_offset(ri) + t.xptr + 3*cnt; + xptr = x_bulkdata_offset(ri) + t.xptr + ndim*cnt; } #ifdef COMPOSE_HORIZ_OPENMP if (horiz_openmp) omp_unset_lock(lock); #endif slmm_kernel_assert_high(xptr > 0); - for (Int i = 0; i < 3; ++i) + for (Int i = 0; i < ndim; ++i) sb(xptr + i) = dep_points(tci,lev,k,i); auto& item = ed.rmt.atomic_inc_and_return_next(); - item.q_extrema_ptr = qsize * qptr; - item.q_ptr = item.q_extrema_ptr + qsize*(2 + cnt); + if (trajectory) { + item.q_extrema_ptr = item.q_ptr = ndim*(qptr + cnt); + } else { + item.q_extrema_ptr = qsize * qptr; + item.q_ptr = item.q_extrema_ptr + qsize*(2 + cnt); + } item.lev = lev; item.k = k; }; @@ -300,9 +276,11 @@ void pack_dep_points_sendbuf_pass2 (IslMpi& cm, const DepPoints& dep_poi } } -template void pack_dep_points_sendbuf_pass1(IslMpi& cm); -template void pack_dep_points_sendbuf_pass2(IslMpi& cm, - const DepPoints& dep_points); +template void pack_dep_points_sendbuf_pass1( + IslMpi& cm, const bool trajectory); +template void pack_dep_points_sendbuf_pass2( + IslMpi& cm, const DepPoints& dep_points, + const bool trajectory); } // namespace islmpi } // namespace homme diff --git a/components/homme/src/share/compose/compose_slmm_islmpi_q.cpp b/components/homme/src/share/compose/compose_slmm_islmpi_q.cpp index c6633a0f5ae..aa848de4138 100644 --- a/components/homme/src/share/compose/compose_slmm_islmpi_q.cpp +++ b/components/homme/src/share/compose/compose_slmm_islmpi_q.cpp @@ -1,198 +1,10 @@ #include "compose_slmm_islmpi.hpp" - -namespace slmm { -static Int test_gll () { - Int nerr = 0; - const Real tol = 1e2*std::numeric_limits::epsilon(); - GLL gll; - const Real* x, * wt; - for (Int np = 2; np <= 4; ++np) { - for (Int monotone_type = 0; monotone_type <= 1; ++monotone_type) { - const Basis b(np, monotone_type); - gll.get_coef(b, x, wt); - Real sum = 0; - for (Int i = 0; i < b.np; ++i) - sum += wt[i]; - if (std::abs(2 - sum) > tol) { - std::cerr << "test_gll " << np << ", " << monotone_type - << ": 2 - sum = " << 2 - sum << "\n"; - ++nerr; - } - for (Int j = 0; j < b.np; ++j) { - Real gj[GLL::np_max]; - gll.eval(b, x[j], gj); - for (Int i = 0; i < b.np; ++i) { - if (j == i) continue; - if (std::abs(gj[i]) > tol) { - std::cerr << "test_gll " << np << ", " << monotone_type << ": gj[" - << i << "] = " << gj[i] << "\n"; - ++nerr; - } - } - } - } - } - for (Int np = 2; np <= 4; ++np) { - const Basis b(np, 0); - Real a[] = {-0.9, -0.7, -0.3, 0.1, 0.2, 0.4, 0.6, 0.8}; - const Real delta = std::sqrt(std::numeric_limits::epsilon()); - for (size_t ia = 0; ia < sizeof(a)/sizeof(Real); ++ia) { - Real gj[GLL::np_max], gjp[GLL::np_max], gjm[GLL::np_max]; - gll.eval_derivative(b, a[ia], gj); - gll.eval(b, a[ia] + delta, gjp); - gll.eval(b, a[ia] - delta, gjm); - for (Int i = 0; i < b.np; ++i) { - const Real fd = (gjp[i] - gjm[i])/(2*delta); - if (std::abs(fd - gj[i]) >= delta*std::abs(gjp[i])) - ++nerr; - } - } - } - return nerr; -} - -int unittest () { - int nerr = 0; - nerr += test_gll(); - return nerr; -} - -static constexpr Real sqrt5 = 2.23606797749978969641; // std::sqrt(5.0); -static constexpr Real oosqrt5 = 1.0 / sqrt5; - -SLMM_KF void gll_np4_eval (const Real x, Real y[4]) { - static constexpr Real oo8 = 1.0/8.0; - const Real x2 = x*x; - y[0] = (1.0 - x)*(5.0*x2 - 1.0)*oo8; - y[1] = -sqrt5*oo8*(sqrt5 - 5.0*x)*(x2 - 1.0); - y[2] = -sqrt5*oo8*(sqrt5 + 5.0*x)*(x2 - 1.0); - y[3] = (1.0 + x)*(5.0*x2 - 1.0)*oo8; -} - -// Linear interp in each region. -SLMM_KF void gll_np4_subgrid_eval_impl (const Real& x, Real y[4]) { - if (x < -oosqrt5) { - const Real alpha = (x + 1)/(1 - oosqrt5); - y[0] = 1 - alpha; - y[1] = alpha; - y[2] = 0; - y[3] = 0; - } else { - const Real alpha = (x + oosqrt5)/(2*oosqrt5); - y[0] = 0; - y[1] = 1 - alpha; - y[2] = alpha; - y[3] = 0; - } -} - -SLMM_KF void gll_np4_subgrid_eval (const Real& x, Real y[4]) { - if (x > 0) { - gll_np4_subgrid_eval_impl(-x, y); - ko::swap(y[0], y[3]); - ko::swap(y[1], y[2]); - return; - } - gll_np4_subgrid_eval_impl(x, y); -} - -// Quadratic interpolant across nodes 1,2,3 -- i.e., excluding node 0 -- of the -// np=4 reference element. -SLMM_KF void outer_eval (const Real& x, Real v[4]) { - static constexpr Real - xbar = (2*oosqrt5) / (1 + oosqrt5), - ooxbar = 1 / xbar, - ybar = 1 / (xbar - 1); - const Real xn = (x + oosqrt5) / (1 + oosqrt5); - v[0] = 0; - v[1] = 1 + ybar*xn*((1 - ooxbar)*xn + ooxbar - xbar); - v[2] = ybar*ooxbar*xn*(xn - 1); - v[3] = ybar*xn*(xbar - xn); -} - -// In the middle region, use the standard GLL np=4 interpolant; in the two outer -// regions, use an order-reduced interpolant that stabilizes the method. -SLMM_KF void gll_np4_subgrid_exp_eval (const Real& x, Real y[4]) { - static constexpr Real - alpha = 0.5527864045000416708, - v = 0.427*(1 + alpha), - x2 = 0.4472135954999579277, - x3 = 1 - x2, - det = x2*x3*(x2 - x3), - y2 = alpha, - y3 = v, - c1 = (x3*y2 - x2*y3)/det, - c2 = (-x3*x3*y2 + x2*x2*y3)/det; - if (x < -oosqrt5 || x > oosqrt5) { - if (x < -oosqrt5) { - outer_eval(-x, y); - ko::swap(y[0], y[3]); - ko::swap(y[1], y[2]); - } else - outer_eval(x, y); - Real y4[4]; - gll_np4_eval(x, y4); - const Real x0 = 1 - std::abs(x); - const Real a = (c1*x0 + c2)*x0; - for (int i = 0; i < 4; ++i) - y[i] = a*y[i] + (1 - a)*y4[i]; - } else - gll_np4_eval(x, y); -} -} // namespace slmm +#include "compose_slmm_islmpi_interpolate.hpp" +#include "compose_slmm_islmpi_buf.hpp" namespace homme { namespace islmpi { -template -SLMM_KIF void interpolate (const typename IslMpi::Advecter::Alg::Enum& alg, - const Real ref_coord[2], Real rx[4], Real ry[4]) { - typedef typename IslMpi::Advecter::Alg Alg; - switch (alg) { - case Alg::csl_gll: - slmm::gll_np4_eval(ref_coord[0], rx); - slmm::gll_np4_eval(ref_coord[1], ry); - break; - case Alg::csl_gll_subgrid: - slmm::gll_np4_subgrid_eval(ref_coord[0], rx); - slmm::gll_np4_subgrid_eval(ref_coord[1], ry); - break; - case Alg::csl_gll_exp: - slmm::gll_np4_subgrid_exp_eval(ref_coord[0], rx); - slmm::gll_np4_subgrid_exp_eval(ref_coord[1], ry); - break; - default: - slmm_kernel_assert(0); - } -} - -SLMM_KIF Real calc_q_tgt (const Real rx[4], const Real ry[4], const Real qs[16]) { - return (ry[0]*(rx[0]*qs[ 0] + rx[1]*qs[ 1] + rx[2]*qs[ 2] + rx[3]*qs[ 3]) + - ry[1]*(rx[0]*qs[ 4] + rx[1]*qs[ 5] + rx[2]*qs[ 6] + rx[3]*qs[ 7]) + - ry[2]*(rx[0]*qs[ 8] + rx[1]*qs[ 9] + rx[2]*qs[10] + rx[3]*qs[11]) + - ry[3]*(rx[0]*qs[12] + rx[1]*qs[13] + rx[2]*qs[14] + rx[3]*qs[15])); -} - -SLMM_KIF Real calc_q_tgt (const Real rx[4], const Real ry[4], const Real qdp[16], - const Real dp[16]) { - return (ry[0]*(rx[0]*(qdp[ 0]/dp[ 0]) + rx[1]*(qdp[ 1]/dp[ 1]) + - rx[2]*(qdp[ 2]/dp[ 2]) + rx[3]*(qdp[ 3]/dp[ 3])) + - ry[1]*(rx[0]*(qdp[ 4]/dp[ 4]) + rx[1]*(qdp[ 5]/dp[ 5]) + - rx[2]*(qdp[ 6]/dp[ 6]) + rx[3]*(qdp[ 7]/dp[ 7])) + - ry[2]*(rx[0]*(qdp[ 8]/dp[ 8]) + rx[1]*(qdp[ 9]/dp[ 9]) + - rx[2]*(qdp[10]/dp[10]) + rx[3]*(qdp[11]/dp[11])) + - ry[3]*(rx[0]*(qdp[12]/dp[12]) + rx[1]*(qdp[13]/dp[13]) + - rx[2]*(qdp[14]/dp[14]) + rx[3]*(qdp[15]/dp[15]))); -} - -template SLMM_KIF -Int getbuf (Buffer& buf, const Int& os, Int& i1, Int& i2) { - const Int* const b = reinterpret_cast(&buf(os)); - i1 = b[0]; - i2 = b[1]; - return nreal_per_2int; -} - #ifndef COMPOSE_PORT // Homme computational pattern. @@ -267,7 +79,7 @@ void calc_own_q (IslMpi& cm, const Int& nets, const Int& nete, auto& ed = cm.ed_d(tci); const FA3 q_tgt(ed.q, cm.np2, cm.nlev, cm.qsize); const Int ned = ed.own.n(); -#ifdef HORIZ_OPENMP +#ifdef COMPOSE_HORIZ_OPENMP # pragma omp for #endif for (Int idx = 0; idx < ned; ++idx) { @@ -317,7 +129,7 @@ template void calc_rmt_q_pass2 (IslMpi& cm) { const Int qsize = cm.qsize; -#ifdef HORIZ_OPENMP +#ifdef COMPOSE_HORIZ_OPENMP # pragma omp for #endif for (Int it = 0; it < cm.nrmt_qs_extrema; ++it) { @@ -331,7 +143,7 @@ void calc_rmt_q_pass2 (IslMpi& cm) { qs(qos + 2*iq + i) = ed.q_extrema(iq, lev, i); } -#ifdef HORIZ_OPENMP +#ifdef COMPOSE_HORIZ_OPENMP # pragma omp for #endif for (Int it = 0; it < cm.nrmt_xs; ++it) { @@ -466,12 +278,13 @@ struct Accum { } }; -template -void calc_rmt_q_pass1_scan (IslMpi& cm) { +template +void calc_rmt_q_pass1_scan (IslMpi& cm, const bool trajectory) { const auto& recvbuf = cm.recvbuf; const auto& rmt_xs = cm.rmt_xs; const auto& rmt_qs_extrema = cm.rmt_qs_extrema; const Int nrmtrank = static_cast(cm.ranks.size()) - 1; + const Int ndim = trajectory ? cm.dep_points_ndim : 3; Int cnt = 0, qcnt = 0; for (Int ri = 0; ri < nrmtrank; ++ri) { const auto get_xos = COMPOSE_LAMBDA (const Int, Int& xos) { @@ -492,7 +305,7 @@ void calc_rmt_q_pass1_scan (IslMpi& cm) { short lev, nx; getbuf(xs, (idx + 1)*nreal_per_2int, lid, lev, nx); slmm_kernel_assert(nx > 0); - if (fin) { + if (fin && ! trajectory) { const auto qcnt_tot = qcnt + a.qcnt; rmt_qs_extrema(4*qcnt_tot + 0) = ri; rmt_qs_extrema(4*qcnt_tot + 1) = lid; @@ -500,7 +313,8 @@ void calc_rmt_q_pass1_scan (IslMpi& cm) { rmt_qs_extrema(4*qcnt_tot + 3) = a.qos; } a.qcnt += 1; - a.qos += 2; + if ( ! trajectory) + a.qos += 2; if (fin) { for (Int xi = 0; xi < nx; ++xi) { const auto cnt_tot = cnt + a.cnt; @@ -510,23 +324,23 @@ void calc_rmt_q_pass1_scan (IslMpi& cm) { rmt_xs(5*cnt_tot + 3) = xos + a.xos; rmt_xs(5*cnt_tot + 4) = a.qos; a.cnt += 1; - a.xos += 3; + a.xos += ndim; a.qos += 1; } } else { a.cnt += nx; - a.xos += 3*nx; - a.qos += nx; + a.xos += ndim*nx; + a.qos += nx; } }; Accum a; ko::parallel_scan(ko::RangePolicy(0, xos/nreal_per_2int - 1), f, a); - cm.sendcount_h(ri) = cm.qsize*a.qos; + cm.sendcount_h(ri) = (trajectory ? ndim : cm.qsize)*a.qos; cnt += a.cnt; qcnt += a.qcnt; } cm.nrmt_xs = cnt; - cm.nrmt_qs_extrema = qcnt; + cm.nrmt_qs_extrema = trajectory ? 0 : qcnt; } template @@ -593,13 +407,20 @@ void calc_rmt_q_pass2 (IslMpi& cm) { #endif // COMPOSE_PORT -template -void calc_rmt_q_pass1_noscan (IslMpi& cm) { +template +void calc_rmt_q_pass1_noscan (IslMpi& cm, const bool trajectory) { const Int nrmtrank = static_cast(cm.ranks.size()) - 1; + const Int ndim = trajectory ? cm.dep_points_ndim : 3; #ifdef COMPOSE_PORT_SEPARATE_VIEWS +#ifdef COMPOSE_HORIZ_OPENMP +# pragma omp for +#endif for (Int ri = 0; ri < nrmtrank; ++ri) ko::deep_copy(ko::View(cm.recvbuf_meta_h(ri).data(), 1), ko::View(cm.recvbuf.get_h(ri).data(), 1)); +#ifdef COMPOSE_HORIZ_OPENMP +# pragma omp for +#endif for (Int ri = 0; ri < nrmtrank; ++ri) { const auto&& xs = cm.recvbuf_meta_h(ri); Int n, unused; @@ -610,71 +431,79 @@ void calc_rmt_q_pass1_noscan (IslMpi& cm) { ko::View(cm.recvbuf.get_h(ri).data(), n)); } #endif - Int cnt = 0, qcnt = 0; - for (Int ri = 0; ri < nrmtrank; ++ri) { - const auto&& xs = cm.recvbuf_meta_h(ri); - Int mos = 0, qos = 0, nx_in_rank, xos; - mos += getbuf(xs, mos, xos, nx_in_rank); - if (nx_in_rank == 0) { - cm.sendcount_h(ri) = 0; - continue; - } - // The upper bound is to prevent an inf loop if the msg is corrupted. - for (Int lidi = 0; lidi < cm.nelemd; ++lidi) { - Int lid, nx_in_lid; - mos += getbuf(xs, mos, lid, nx_in_lid); - for (Int levi = 0; levi < cm.nlev; ++levi) { // same re: inf loop - Int lev, nx; - mos += getbuf(xs, mos, lev, nx); - slmm_assert(nx > 0); - { - cm.rmt_qs_extrema_h(4*qcnt + 0) = ri; - cm.rmt_qs_extrema_h(4*qcnt + 1) = lid; - cm.rmt_qs_extrema_h(4*qcnt + 2) = lev; - cm.rmt_qs_extrema_h(4*qcnt + 3) = qos; - ++qcnt; - qos += 2; - } - for (Int xi = 0; xi < nx; ++xi) { - cm.rmt_xs_h(5*cnt + 0) = ri; - cm.rmt_xs_h(5*cnt + 1) = lid; - cm.rmt_xs_h(5*cnt + 2) = lev; - cm.rmt_xs_h(5*cnt + 3) = xos; - cm.rmt_xs_h(5*cnt + 4) = qos; - ++cnt; - xos += 3; - ++qos; +#ifdef COMPOSE_HORIZ_OPENMP +# pragma omp master +#endif + { + Int cnt = 0, qcnt = 0; + for (Int ri = 0; ri < nrmtrank; ++ri) { + const auto&& xs = cm.recvbuf_meta_h(ri); + Int mos = 0, qos = 0, nx_in_rank, xos; + mos += getbuf(xs, mos, xos, nx_in_rank); + if (nx_in_rank == 0) { + cm.sendcount_h(ri) = 0; + continue; + } + // The upper bound is to prevent an inf loop if the msg is corrupted. + for (Int lidi = 0; lidi < cm.nelemd; ++lidi) { + Int lid, nx_in_lid; + mos += getbuf(xs, mos, lid, nx_in_lid); + for (Int levi = 0; levi < cm.nlev; ++levi) { // same re: inf loop + Int lev, nx; + mos += getbuf(xs, mos, lev, nx); + slmm_assert(nx > 0); + if ( ! trajectory) { + cm.rmt_qs_extrema_h(4*qcnt + 0) = ri; + cm.rmt_qs_extrema_h(4*qcnt + 1) = lid; + cm.rmt_qs_extrema_h(4*qcnt + 2) = lev; + cm.rmt_qs_extrema_h(4*qcnt + 3) = qos; + ++qcnt; + qos += 2; + } + for (Int xi = 0; xi < nx; ++xi) { + cm.rmt_xs_h(5*cnt + 0) = ri; + cm.rmt_xs_h(5*cnt + 1) = lid; + cm.rmt_xs_h(5*cnt + 2) = lev; + cm.rmt_xs_h(5*cnt + 3) = xos; + cm.rmt_xs_h(5*cnt + 4) = qos; + ++cnt; + xos += ndim; + ++qos; + } + nx_in_lid -= nx; + nx_in_rank -= nx; + if (nx_in_lid == 0) break; } - nx_in_lid -= nx; - nx_in_rank -= nx; - if (nx_in_lid == 0) break; + slmm_assert(nx_in_lid == 0); + if (nx_in_rank == 0) break; } - slmm_assert(nx_in_lid == 0); - if (nx_in_rank == 0) break; + slmm_assert(nx_in_rank == 0); + cm.sendcount_h(ri) = (trajectory ? ndim : cm.qsize)*qos; } - slmm_assert(nx_in_rank == 0); - cm.sendcount_h(ri) = cm.qsize*qos; + cm.nrmt_xs = cnt; + cm.nrmt_qs_extrema = trajectory ? 0 : qcnt; + deep_copy(cm.rmt_xs, cm.rmt_xs_h); + deep_copy(cm.rmt_qs_extrema, cm.rmt_qs_extrema_h); } - cm.nrmt_xs = cnt; - cm.nrmt_qs_extrema = qcnt; - deep_copy(cm.rmt_xs, cm.rmt_xs_h); - deep_copy(cm.rmt_qs_extrema, cm.rmt_qs_extrema_h); +#ifdef COMPOSE_HORIZ_OPENMP +# pragma omp barrier +#endif } -template -void calc_rmt_q_pass1 (IslMpi& cm) { +template +void calc_rmt_q_pass1 (IslMpi& cm, const bool trajectory) { #if defined COMPOSE_PORT && ! defined COMPOSE_PACK_NOSCAN if (ko::OnGpu::value) - calc_rmt_q_pass1_scan(cm); + calc_rmt_q_pass1_scan(cm, trajectory); else #endif - calc_rmt_q_pass1_noscan(cm); + calc_rmt_q_pass1_noscan(cm, trajectory); } template void calc_rmt_q (IslMpi& cm) { { slmm::Timer t("09_rmt_q_pass1"); - calc_rmt_q_pass1(cm); } + calc_rmt_q_pass1(cm); } { slmm::Timer t("09_rmt_q_pass2"); calc_rmt_q_pass2(cm); } } @@ -697,6 +526,8 @@ void calc_rmt_q (IslMpi& cm) { } } +template void calc_rmt_q_pass1(IslMpi& cm, + const bool trajectory); template void calc_rmt_q(IslMpi& cm); template void calc_own_q(IslMpi& cm, const Int& nets, const Int& nete, diff --git a/components/homme/src/share/compose/compose_slmm_islmpi_step.cpp b/components/homme/src/share/compose/compose_slmm_islmpi_step.cpp index 1ae91c3e538..3c707c8919f 100644 --- a/components/homme/src/share/compose/compose_slmm_islmpi_step.cpp +++ b/components/homme/src/share/compose/compose_slmm_islmpi_step.cpp @@ -24,11 +24,13 @@ void step ( const auto& q_min = cm.tracer_arrays->q_min; const auto& q_max = cm.tracer_arrays->q_max; #else - const DepPointsH dep_points(dep_points_r, cm.nelemd, cm.nlev, cm.np2); + const DepPointsH dep_points(dep_points_r, cm.nelemd, cm.nlev, cm.np2, + cm.dep_points_ndim); const QExtremaH q_min(q_min_r, cm.nelemd, cm.qsize, cm.nlev, cm.np2), q_max(q_max_r, cm.nelemd, cm.qsize, cm.nlev, cm.np2); #endif + slmm_assert(dep_points.extent_int(3) == cm.dep_points_ndim); // Partition my elements that communicate with remotes among threads, if I // haven't done that yet. diff --git a/components/homme/src/share/compose/compose_test.cpp b/components/homme/src/share/compose/compose_test.cpp index 4b29f3ae7c3..944114d7975 100644 --- a/components/homme/src/share/compose/compose_test.cpp +++ b/components/homme/src/share/compose/compose_test.cpp @@ -327,7 +327,7 @@ struct StandaloneTracersTester { #endif } }; - + static StandaloneTracersTester::Ptr g_stt; } // namespace test } // namespace compose diff --git a/components/homme/src/share/compose/compose_test.hpp b/components/homme/src/share/compose/compose_test.hpp index 9a3e7d4b350..ff4d18cdfd9 100644 --- a/components/homme/src/share/compose/compose_test.hpp +++ b/components/homme/src/share/compose/compose_test.hpp @@ -13,6 +13,7 @@ namespace test { int slmm_unittest(); int cedr_unittest(); int cedr_unittest(MPI_Comm comm); +int interpolate_unittest(); typedef double Real; typedef int Int; diff --git a/components/homme/src/share/compose_mod.F90 b/components/homme/src/share/compose_mod.F90 index 8b134def384..ba10ab7b5c0 100644 --- a/components/homme/src/share/compose_mod.F90 +++ b/components/homme/src/share/compose_mod.F90 @@ -25,22 +25,24 @@ subroutine cedr_unittest(comm, nerr) bind(c) end subroutine cedr_unittest subroutine cedr_init_impl(comm, cdr_alg, use_sgi, gid_data, rank_data, & - ncell, nlclcell, nlev, qsize, independent_time_steps, hard_zero, & + ncell, nlclcell, nlev, np, qsize, independent_time_steps, hard_zero, & gid_data_sz, rank_data_sz) bind(c) use iso_c_binding, only: c_int, c_bool - integer(kind=c_int), value, intent(in) :: comm, cdr_alg, ncell, nlclcell, nlev, & + integer(kind=c_int), value, intent(in) :: comm, cdr_alg, ncell, nlclcell, nlev, np, & qsize, gid_data_sz, rank_data_sz logical(kind=c_bool), value, intent(in) :: use_sgi, independent_time_steps, hard_zero integer(kind=c_int), intent(in) :: gid_data(gid_data_sz), rank_data(rank_data_sz) end subroutine cedr_init_impl subroutine slmm_init_impl(comm, transport_alg, np, nlev, qsize, qsize_d, & - nelem, nelemd, cubed_sphere_map, geometry, lid2gid, lid2facenum, nbr_id_rank, nirptr, & - sl_nearest_point_lev, lid2gid_sz, lid2facenum_sz, nbr_id_rank_sz, nirptr_sz) bind(c) + nelem, nelemd, cubed_sphere_map, geometry, lid2gid, lid2facenum, & + nbr_id_rank, nirptr, sl_halo, sl_traj_3d, sl_traj_nsubstep, sl_nearest_point_lev, & + lid2gid_sz, lid2facenum_sz, nbr_id_rank_sz, nirptr_sz) bind(c) use iso_c_binding, only: c_int - integer(kind=c_int), value, intent(in) :: comm, transport_alg, np, nlev, qsize, qsize_d, & - nelem, nelemd, cubed_sphere_map, geometry, sl_nearest_point_lev, lid2gid_sz, & - lid2facenum_sz, nbr_id_rank_sz, nirptr_sz + integer(kind=c_int), value, intent(in) :: comm, transport_alg, np, nlev, qsize, & + qsize_d, nelem, nelemd, cubed_sphere_map, geometry, sl_halo, sl_traj_3d, & + sl_traj_nsubstep, sl_nearest_point_lev, lid2gid_sz, lid2facenum_sz, & + nbr_id_rank_sz, nirptr_sz integer(kind=c_int), intent(in) :: lid2gid(lid2gid_sz), lid2facenum(lid2facenum_sz), & nbr_id_rank(nbr_id_rank_sz), nirptr(nirptr_sz) end subroutine slmm_init_impl @@ -186,7 +188,28 @@ subroutine slmm_check_ref2sphere(ie, sphere_cart_coord) bind(c) type(cartesian3D_t), intent(in) :: sphere_cart_coord end subroutine slmm_check_ref2sphere - subroutine slmm_csl_set_elem_data(ie, metdet, qdp, n0_qdp, dp, q, nelem_in_patch, h2d, d2h) bind(c) + subroutine slmm_set_hvcoord(etai_beg, etai_end, etam) bind(c) + use iso_c_binding, only: c_double + use dimensions_mod, only : nlev + real(kind=c_double), value, intent(in) :: etai_beg, etai_end + real(kind=c_double), intent(in) :: etam(nlev) + end subroutine slmm_set_hvcoord + + subroutine slmm_calc_v_departure(nets, nete, step, dtsub, dep_points, & + dep_points_ndim, vnode, vdep, info) bind(c) + use iso_c_binding, only: c_int, c_double + use dimensions_mod, only : np, nlev, nelemd, qsize + use coordinate_systems_mod, only : cartesian3D_t + integer(kind=c_int), value, intent(in) :: nets, nete, step, dep_points_ndim + real(kind=c_double), value, intent(in) :: dtsub + real(kind=c_double), intent(inout) :: dep_points(dep_points_ndim,np,np,nlev,nelemd) + real(kind=c_double), intent(in) :: vnode(dep_points_ndim,np,np,nlev,nelemd) + real(kind=c_double), intent(out) :: vdep(dep_points_ndim,np,np,nlev,nelemd) + integer(kind=c_int), intent(out) :: info + end subroutine slmm_calc_v_departure + + subroutine slmm_csl_set_elem_data(ie, metdet, qdp, n0_qdp, dp, q, nelem_in_patch, & + h2d, d2h) bind(c) use iso_c_binding, only: c_int, c_double, c_bool use dimensions_mod, only : nlev, np, qsize real(kind=c_double), intent(in) :: metdet(np,np), qdp(np,np,nlev,qsize,2), & @@ -195,17 +218,17 @@ subroutine slmm_csl_set_elem_data(ie, metdet, qdp, n0_qdp, dp, q, nelem_in_patch logical(kind=c_bool), value, intent(in) :: h2d, d2h end subroutine slmm_csl_set_elem_data - subroutine slmm_csl(nets, nete, dep_points, minq, maxq, info) bind(c) + subroutine slmm_csl(nets, nete, dep_points, dep_points_ndim, minq, maxq, info) bind(c) use iso_c_binding, only: c_int, c_double use dimensions_mod, only : np, nlev, nelemd, qsize use coordinate_systems_mod, only : cartesian3D_t - integer(kind=c_int), value, intent(in) :: nets, nete + integer(kind=c_int), value, intent(in) :: nets, nete, dep_points_ndim ! dep_points is const in principle, but if lev <= ! semi_lagrange_nearest_point_lev, a departure point may be altered if ! the winds take it outside of the comm halo. - type(cartesian3D_t), intent(inout) :: dep_points(np,np,nlev,nelemd) + real(kind=c_double), intent(inout) :: dep_points(dep_points_ndim,np,np,nlev,nelemd) real(kind=c_double), intent(in) :: & - minq(np,np,nlev,qsize,nets:nete), maxq(np,np,nlev,qsize,nets:nete) + minq(np,np,nlev,qsize,nelemd), maxq(np,np,nlev,qsize,nelemd) integer(kind=c_int), intent(out) :: info end subroutine slmm_csl @@ -238,6 +261,7 @@ subroutine compose_init(par, elem, GridVertex, init_kokkos) use element_mod, only: element_t use gridgraph_mod, only: GridVertex_t use control_mod, only: semi_lagrange_cdr_alg, transport_alg, cubed_sphere_map, & + semi_lagrange_halo, semi_lagrange_trajectory_nsubstep, & semi_lagrange_nearest_point_lev, dt_remap_factor, dt_tracer_factor, geometry use physical_constants, only: Sx, Sy, Lx, Ly use scalable_grid_init_mod, only: sgi_is_initialized, sgi_get_rank2sfc, & @@ -254,7 +278,7 @@ subroutine compose_init(par, elem, GridVertex, init_kokkos) ! These are for non-scalable grid initialization, still used for RRM. sc2gci(:), sc2rank(:) ! space curve index -> (GID, rank) integer :: lid2gid(nelemd), lid2facenum(nelemd) - integer :: i, j, k, sfc, gid, igv, sc, geometry_type + integer :: i, j, k, sfc, gid, igv, sc, geometry_type, sl_traj_3d ! To map SFC index to IDs and ranks logical(kind=c_bool) :: use_sgi, owned, independent_time_steps, hard_zero integer, allocatable :: owned_ids(:) @@ -273,6 +297,16 @@ subroutine compose_init(par, elem, GridVertex, init_kokkos) hard_zero = .true. independent_time_steps = dt_remap_factor < dt_tracer_factor + + if (semi_lagrange_halo < 1) then + ! For test problems, the relationship between dt_tracer_factor and halo + ! may not be clear. But for real problems, the advective CFL implies that + ! a parcel can cross a cell in three time steps. Since this is closely + ! related to the dynamics' tstep, dt_tracer_factor is meaningful, + ! implying: + semi_lagrange_halo = dt_tracer_factor / 3 + if (semi_lagrange_halo < 1) semi_lagrange_halo = 1 + end if geometry_type = 0 ! sphere if (trim(geometry) == "plane") then @@ -316,12 +350,12 @@ subroutine compose_init(par, elem, GridVertex, init_kokkos) if (use_sgi) then if (.not. allocated(owned_ids)) allocate(owned_ids(1)) call cedr_init_impl(par%comm, semi_lagrange_cdr_alg, & - use_sgi, owned_ids, rank2sfc, nelem, nelemd, nlev, qsize, & + use_sgi, owned_ids, rank2sfc, nelem, nelemd, nlev, np, qsize, & independent_time_steps, hard_zero, size(owned_ids), size(rank2sfc)) else if (.not. allocated(sc2gci)) allocate(sc2gci(1), sc2rank(1)) call cedr_init_impl(par%comm, semi_lagrange_cdr_alg, & - use_sgi, sc2gci, sc2rank, nelem, nelemd, nlev, qsize, & + use_sgi, sc2gci, sc2rank, nelem, nelemd, nlev, np, qsize, & independent_time_steps, hard_zero, size(sc2gci), size(sc2rank)) end if if (allocated(sc2gci)) deallocate(sc2gci, sc2rank) @@ -360,9 +394,12 @@ subroutine compose_init(par, elem, GridVertex, init_kokkos) end do end do nirptr(nelemd+1) = k - 1 + sl_traj_3d = 0 + if (independent_time_steps) sl_traj_3d = 1 call slmm_init_impl(par%comm, transport_alg, np, nlev, qsize, qsize_d, & nelem, nelemd, cubed_sphere_map, geometry_type, lid2gid, lid2facenum, & - nbr_id_rank, nirptr, semi_lagrange_nearest_point_lev, & + nbr_id_rank, nirptr, semi_lagrange_halo, sl_traj_3d, & + semi_lagrange_trajectory_nsubstep, semi_lagrange_nearest_point_lev, & size(lid2gid), size(lid2facenum), size(nbr_id_rank), size(nirptr)) if (geometry_type == 1) call slmm_init_plane(Sx, Sy, Lx, Ly) deallocate(nbr_id_rank, nirptr) diff --git a/components/homme/src/share/compose_test_mod.F90 b/components/homme/src/share/compose_test_mod.F90 index 8421e41e5fa..8ba3b7f44d7 100644 --- a/components/homme/src/share/compose_test_mod.F90 +++ b/components/homme/src/share/compose_test_mod.F90 @@ -117,7 +117,7 @@ subroutine compose_test(par, hvcoord, dom_mt, elem, eval) ! 1. Unit tests. call compose_unittest() - call sl_unittest(par) + call sl_unittest(par, hvcoord) nerr = 0 call cedr_unittest(par%comm, nerr) if (nerr /= 0) print *, 'cedr_unittest returned', nerr @@ -240,7 +240,7 @@ subroutine compose_stt(hybrid, dom_mt, nets, nete, hvcoord, deriv, elem, eval) ! nsteps = nint(6*ne*(15.d0/qsplit)) nsteps = nmax if (hybrid%par%masterproc .and. hybrid%masterthread) then - print *, 'COMPOSE> nsteps', nsteps + print '(a,i6,a,i5)', 'COMPOSE> nsteps ', nsteps, ' ne ', ne end if dt = twelve_days / nsteps call t_barrierf('compose_stt_step_start_barrier', hybrid%par%comm) diff --git a/components/homme/src/share/control_mod.F90 b/components/homme/src/share/control_mod.F90 index 0e9494f5a6c..0e0276fbf2f 100644 --- a/components/homme/src/share/control_mod.F90 +++ b/components/homme/src/share/control_mod.F90 @@ -26,6 +26,8 @@ module control_mod ! 3 CAAS ! 20 QLT with superlevels ! 30 CAAS with superlevels + ! 4* reserved for debugging + ! 5 CAAS-point integer, public :: semi_lagrange_cdr_alg = 3 ! If true, check mass conservation and shape preservation. The second ! implicitly checks tracer consistency. @@ -39,6 +41,10 @@ module control_mod ! halo available to it if the actual point is outside the halo. This is done ! in levels <= this parameter. integer, public :: semi_lagrange_nearest_point_lev = 256 + integer, public :: semi_lagrange_halo = -1 + integer, public :: semi_lagrange_trajectory_nsubstep = 0 + integer, public :: semi_lagrange_trajectory_nvelocity = -1 + integer, public :: semi_lagrange_diagnostics = 0 ! flag used by preqx, theta-l and theta-c models ! should be renamed to "hydrostatic_mode" diff --git a/components/homme/src/share/cxx/ComposeTransport.cpp b/components/homme/src/share/cxx/ComposeTransport.cpp index 760a3dd06fa..8d734909328 100644 --- a/components/homme/src/share/cxx/ComposeTransport.cpp +++ b/components/homme/src/share/cxx/ComposeTransport.cpp @@ -69,9 +69,13 @@ std::vector > ComposeTransport::run_unit_tests () { assert(is_setup); std::vector > fails; - int nerr; - nerr = m_compose_impl->run_trajectory_unit_tests(); - if (nerr) fails.push_back(std::make_pair("run_trajectory_unit_tests", nerr)); + int ne, nerr = 0; + ne = m_compose_impl->run_trajectory_unit_tests(); + if (ne) fails.push_back(std::make_pair("run_trajectory_unit_tests", nerr)); + nerr += ne; + ne = m_compose_impl->run_enhanced_trajectory_unit_tests(); + if (ne) fails.push_back(std::make_pair("run_enhanced_trajectory_unit_tests", nerr)); + nerr += ne; return fails; } diff --git a/components/homme/src/share/cxx/ComposeTransportImpl.hpp b/components/homme/src/share/cxx/ComposeTransportImpl.hpp index 09bd43d9d53..b536b8ba65a 100644 --- a/components/homme/src/share/cxx/ComposeTransportImpl.hpp +++ b/components/homme/src/share/cxx/ComposeTransportImpl.hpp @@ -41,7 +41,6 @@ struct ComposeTransportImpl { enum : int { max_num_lev_pack = NUM_LEV_P }; enum : int { max_num_lev_aligned = max_num_lev_pack*packn }; enum : int { num_phys_lev = NUM_PHYSICAL_LEV }; - enum : int { num_work = 12 }; static_assert(max_num_lev_aligned >= 3, "We use wrk(0:2,:) and so need max_num_lev_aligned >= 3"); @@ -49,21 +48,56 @@ struct ComposeTransportImpl { using TeamPolicy = Kokkos::TeamPolicy; using MT = typename TeamPolicy::member_type; - using Buf1 = ExecViewUnmanaged; + // For the enhanced trajectory, we need one extra level beyond the usual. + using Buf1Alloc = ExecViewUnmanaged; + using Buf1o = ExecViewUnmanaged; + using Buf1e = Buf1Alloc; + using Buf2 = ExecViewUnmanaged; - using DeparturePoints = ExecViewManaged; + using DeparturePoints = ExecViewManaged; + + typedef ExecViewUnmanaged SNlev; + typedef ExecViewUnmanaged RNlev; + typedef ExecViewUnmanaged SNlevp; + typedef ExecViewUnmanaged RNlevp; + typedef ExecViewUnmanaged S2Nlev; + typedef ExecViewUnmanaged R2Nlev; + typedef ExecViewUnmanaged S2Nlevp; + typedef typename ViewConst::type CSNlev; + typedef typename ViewConst::type CRNlev; + typedef typename ViewConst::type CSNlevp; + typedef typename ViewConst::type CRNlevp; + typedef typename ViewConst::type CS2Nlev; + typedef typename ViewConst::type CR2Nlev; + + using DpSlot = ExecViewUnmanaged< Scalar** [NP][NP][NUM_LEV]>; + using VSlot = ExecViewUnmanaged< Scalar**[2][NP][NP][NUM_LEV]>; + using CDpSlot = ExecViewUnmanaged; + using CVSlot = ExecViewUnmanaged; + struct VelocityRecord; struct Data { int nelemd, qsize, limiter_option, cdr_check, hv_q, hv_subcycle_q; int geometry_type; // 0: sphere, 1: plane - Real nu_q, hv_scaling, dp_tol; + int trajectory_nsubstep; // 0: original alg, >= 1: enhanced + Real nu_q, hv_scaling, dp_tol, deta_tol; bool independent_time_steps; - Buf1 buf1[3]; - Buf2 buf2[2]; + // buf1o and buf1e point to the same memory, sized to the larger of the + // two. They are used in different parts of the code. + static constexpr int n_buf1 = 4, n_buf2 = 4; + Buf1o buf1o[n_buf1]; + Buf1e buf1e[n_buf1]; + Buf2 buf2[n_buf2]; + + ExecView hydetai; // diff(etai) + ExecView hydetam_ref; + + DeparturePoints dep_pts, vnode, vdep; // (ie,lev,i,j,d) - DeparturePoints dep_pts; + std::shared_ptr vrec; Data () : nelemd(-1), qsize(-1), limiter_option(9), cdr_check(0), hv_q(0), @@ -99,6 +133,7 @@ struct ComposeTransportImpl { } void set_dp_tol(); + void setup_enhanced_trajectory(); void reset(const SimulationParams& params); int requested_buffer_size() const; void init_buffers(const FunctorsBuffersManager& fbm); @@ -108,6 +143,7 @@ struct ComposeTransportImpl { void remap_q(const TimeLevel& tl); void calc_trajectory(const int np1, const Real dt); + void calc_enhanced_trajectory(const int np1, const Real dt); void remap_v(const ExecViewUnmanaged& dp3d, const int np1, const ExecViewUnmanaged& dp, const ExecViewUnmanaged& v); @@ -115,6 +151,7 @@ struct ComposeTransportImpl { void advance_hypervis_scalar(const Real dt); int run_trajectory_unit_tests(); + int run_enhanced_trajectory_unit_tests(); ComposeTransport::TestDepView::HostMirror test_trajectory(Real t0, Real t1, const bool independent_time_steps); @@ -122,8 +159,8 @@ struct ComposeTransportImpl { // avoid non-bfb-ness in, e.g., trig functions. void test_2d(const bool bfb, const int nstep, std::vector& eval); - template KOKKOS_INLINE_FUNCTION - static void loop_ijk (const KernelVariables& kv, const Fn& h) { + template KOKKOS_INLINE_FUNCTION + static void loop_ijk (const int KLIM, const KernelVariables& kv, const Fn& h) { using Kokkos::parallel_for; if (OnGpu::value) { const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); @@ -150,6 +187,11 @@ struct ComposeTransportImpl { } } + template KOKKOS_INLINE_FUNCTION + static void loop_ijk (const KernelVariables& kv, const Fn& h) { + loop_ijk(KLIM, kv, h); + } + template KOKKOS_INLINE_FUNCTION static void loop_ij (const KernelVariables& kv, const Fn& h) { if (OnGpu::value) { @@ -250,10 +292,113 @@ struct ComposeTransportImpl { return h; } + static KOKKOS_INLINE_FUNCTION + Real* pack2real (Scalar* pack) { return &(*pack)[0]; } + static KOKKOS_INLINE_FUNCTION + const Real* pack2real (const Scalar* pack) { return &(*pack)[0]; } template static KOKKOS_INLINE_FUNCTION - Real* pack2real (const View& v) { return &(*v.data())[0]; } + Real* pack2real (const View& v) { return pack2real(v.data()); } template static KOKKOS_INLINE_FUNCTION - const Real* cpack2real (const View& v) { return &(*v.data())[0]; } + const Real* cpack2real (const View& v) { return pack2real(v.data()); } + + KOKKOS_FUNCTION + static void ugradv_sphere ( + const SphereOperators& sphere_ops, const KernelVariables& kv, + const typename ViewConst >::type& vec_sphere2cart, + // velocity, latlon + const typename ViewConst >::type& u, + const typename ViewConst >::type& v, + const ExecViewUnmanaged& v_cart, + const ExecViewUnmanaged& ugradv_cart, + // [u dot grad] v, latlon + const ExecViewUnmanaged& ugradv) + { + for (int d_cart = 0; d_cart < 3; ++d_cart) { + const auto f1 = [&] (const int i, const int j, const int k) { + v_cart(i,j,k) = (vec_sphere2cart(0,d_cart,i,j) * v(0,i,j,k) + + vec_sphere2cart(1,d_cart,i,j) * v(1,i,j,k)); + }; + loop_ijk(kv, f1); + kv.team_barrier(); + + sphere_ops.gradient_sphere(kv, v_cart, ugradv_cart); + + const auto f2 = [&] (const int i, const int j, const int k) { + if (d_cart == 0) ugradv(0,i,j,k) = ugradv(1,i,j,k) = 0; + for (int d_latlon = 0; d_latlon < 2; ++d_latlon) + ugradv(d_latlon,i,j,k) += + vec_sphere2cart(d_latlon,d_cart,i,j)* + (u(0,i,j,k) * ugradv_cart(0,i,j,k) + u(1,i,j,k) * ugradv_cart(1,i,j,k)); + }; + loop_ijk(kv, f2); + } + } + + // Form a 3rd-degree Lagrange polynomial over (x(k-1:k+1), y(k-1:k+1)) and set + // yi(k) to its derivative at x(k). yps(:,:,0) is not written. + template + KOKKOS_FUNCTION static Real approx_derivative ( + const Real& xkm1, const Real& xk, const Real& xkp1, + const Real& ykm1, const Real& yk, const Real& ykp1) + { + return (ykm1*(( 1 /(xkm1 - xk ))*((xk - xkp1)/(xkm1 - xkp1))) + + yk *(( 1 /(xk - xkm1))*((xk - xkp1)/(xk - xkp1)) + + ((xk - xkm1)/(xk - xkm1))*( 1 /(xk - xkp1))) + + ykp1*(((xk - xkm1)/(xkp1 - xkm1))*( 1 /(xkp1 - xk )))); + } + + KOKKOS_INLINE_FUNCTION static void approx_derivative ( + const KernelVariables& kv, const CSNlevp& xs, const CSNlevp& ys, + const SNlev& yps) // yps(:,:,0) is undefined + { + CRNlevp x(cpack2real(xs)); + CRNlevp y(cpack2real(ys)); + RNlev yp(pack2real(yps)); + const auto f = [&] (const int i, const int j, const int k) { + if (k == 0) return; + const auto& xkm1 = x(i,j,k-1); + const auto& xk = x(i,j,k ); // also the interpolation point + const auto& xkp1 = x(i,j,k+1); + yp(i,j,k) = approx_derivative(x(i,j,k-1), x(i,j,k), x(i,j,k+1), + y(i,j,k-1), y(i,j,k), y(i,j,k+1)); + }; + loop_ijk(kv, f); + } + + template + KOKKOS_FUNCTION static void calc_eta_dot_dpdn ( + const KernelVariables& kv, + const HyBiPackT& hybrid_bi, // const Scalar[NUM_LEV_P] + // divergence_sphere of (v dp) at midpoints, scalar + const DivDpScalT& divdps, + // eta_dot_dpdn at interfaces, pack and scalar views of same data + const EddPackT& edd, const EddScalT& edds) + { + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr = Kokkos::ThreadVectorRange(kv.team, NUM_LEV); + const auto f = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto r = [&] (const int k, Real& dps, const bool final) { + assert(k != 0 || dps == 0); + if (final) edds(i,j,k) = dps; + dps += divdps(i,j,k); + }; + Dispatch<>::parallel_scan(kv.team, num_phys_lev, r); + const int kend = num_phys_lev - 1; + const Real dps = edds(i,j,kend) + divdps(i,j,kend); + assert(hybrid_bi(0)[0] == 0); + const auto s = [&] (const int kp) { + edd(i,j,kp) = hybrid_bi(kp)*dps - edd(i,j,kp); + if (kp == 0) edd(i,j,kp)[0] = 0; + }; + Kokkos::parallel_for(tvr, s); + assert(edds(i,j,0) == 0); + const int bottom = num_phys_lev; + edds(i,j,bottom) = 0; // benign write race + }; + Kokkos::parallel_for(ttr, f); + } }; } // namespace Homme diff --git a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp new file mode 100644 index 00000000000..a8b60805733 --- /dev/null +++ b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp @@ -0,0 +1,2254 @@ +/******************************************************************************** + * HOMMEXX 1.0: Copyright of Sandia Corporation + * This software is released under the BSD license + * See the file 'COPYRIGHT' in the HOMMEXX/src/share/cxx directory + *******************************************************************************/ + +#include "Config.hpp" +#ifdef HOMME_ENABLE_COMPOSE + +#include "ComposeTransportImpl.hpp" + +#include "compose_hommexx.hpp" + +#include + +namespace Homme { + +// For limit_etam. +void ComposeTransportImpl::setup_enhanced_trajectory () { + const auto etai = cmvdc(m_hvcoord.etai); + const Real deta_ave = (etai(num_phys_lev) - etai(0)) / num_phys_lev; + m_data.deta_tol = 10*std::numeric_limits::epsilon()*deta_ave; + + // diff(etai) + m_data.hydetai = decltype(m_data.hydetai)("hydetai"); + const auto detai_pack = Kokkos::create_mirror_view(m_data.hydetai); + HostViewUnmanaged detai(pack2real(detai_pack)); + for (int k = 0; k < num_phys_lev; ++k) + detai(k) = etai(k+1) - etai(k); + Kokkos::deep_copy(m_data.hydetai, detai_pack); + + const auto etamp = cmvdc(m_hvcoord.etam); + HostViewUnmanaged etam(pack2real(etamp)); + + // hydetam_ref. + m_data.hydetam_ref = decltype(m_data.hydetam_ref)("hydetam_ref"); + const auto m = Kokkos::create_mirror_view(m_data.hydetam_ref); + const int nlev = num_phys_lev; + m(0) = etam(0) - etai(0); + for (int k = 1; k < nlev; ++k) m(k) = etam(k) - etam(k-1); + m(nlev) = etai(nlev) - etam(nlev-1); + Kokkos::deep_copy(m_data.hydetam_ref, m); + + // etam + homme::compose::set_hvcoord(etai(0), etai(num_phys_lev), etam.data()); +} + +namespace { // anon + +using cti = ComposeTransportImpl; +using CTI = ComposeTransportImpl; +using CSelNlev = cti::CSNlev; +using CRelNlev = cti::CRNlev; +using CSelNlevp = cti::CSNlevp; +using CRelNlevp = cti::CRNlevp; +using CS2elNlev = cti::CS2Nlev; +using CR2elNlev = cti::CR2Nlev; +using SelNlev = cti::SNlev; +using RelNlev = cti::RNlev; +using SelNlevp = cti::SNlevp; +using RelNlevp = cti::RNlevp; +using S2elNlev = cti::S2Nlev; +using R2elNlev = cti::R2Nlev; +using S2elNlevp = cti::S2Nlevp; + +using RelV = ExecViewUnmanaged; +using CRelV = typename ViewConst::type; + +template using SelNV = ExecViewUnmanaged; +template using CSelNV = typename ViewConst>::type; + +template using RelNV = ExecViewUnmanaged; +template using CRelNV = typename ViewConst>::type; + +template using RNV = ExecViewUnmanaged; +template using CRNV = typename ViewConst>::type; +using RNlevp = RNV; +using CRNlevp = CRNV; + +using RnV = ExecViewUnmanaged; +using CRnV = ExecViewUnmanaged; +using SnV = ExecViewUnmanaged; +using CSnV = ExecViewUnmanaged; + +template using SNV = ExecViewUnmanaged; +template using CSNV = typename ViewConst>::type; + +using RelnV = ExecViewUnmanaged; +using CRelnV = ExecViewUnmanaged; +using SelnV = ExecViewUnmanaged; +using CSelnV = ExecViewUnmanaged; + +KOKKOS_INLINE_FUNCTION +static int calc_npack (const int nscal) { + return (nscal + cti::packn - 1) / VECTOR_SIZE; +} + +KOKKOS_INLINE_FUNCTION +static int calc_nscal (const int npack) { + return npack * VECTOR_SIZE; +} + +KOKKOS_INLINE_FUNCTION +RnV getcol (const RelnV& a, const int i, const int j) { + return Kokkos::subview(a,i,j,Kokkos::ALL); +} + +KOKKOS_INLINE_FUNCTION +CRnV getcolc (const CRelnV& a, const int i, const int j) { + return Kokkos::subview(a,i,j,Kokkos::ALL); +} + +KOKKOS_INLINE_FUNCTION +RelnV elp2r (const SelnV& p) { + return RelnV(cti::pack2real(p), NP, NP, calc_nscal(p.extent_int(2))); +} + +KOKKOS_INLINE_FUNCTION +CRelnV elp2r (const CSelnV& p) { + return CRelnV(cti::cpack2real(p), NP, NP, calc_nscal(p.extent_int(2))); +} + +KOKKOS_INLINE_FUNCTION +RelnV p2rel (Scalar* data, const int nlev) { + return RelnV(cti::pack2real(data), NP, NP, nlev); +} + +KOKKOS_INLINE_FUNCTION +void assert_eln (const CRelnV& a, const int nlev) { + assert(a.extent_int(0) >= NP); + assert(a.extent_int(1) >= NP); + assert(a.extent_int(2) >= nlev); +} + +KOKKOS_INLINE_FUNCTION +void assert_eln (const CSelnV& a, const int nlev) { + assert(a.extent_int(0) >= NP); + assert(a.extent_int(1) >= NP); + assert(calc_nscal(a.extent_int(2)) >= nlev); +} + +// For sorted ascending x[0:n] and x in [x[0], x[n-1]] with hint xi_idx, return +// i such that x[i] <= xi <= x[i+1]. +// This function is meant for the case that x_idx is very close to the +// support. If that isn't true, then this method is inefficient; binary search +// should be used instead. +template +KOKKOS_FUNCTION static +int find_support (const int n, const ConstRealArray& x, const int x_idx, + const Real xi) { + assert(xi >= x[0] and xi <= x[n-1]); + // Handle the most common case. + if (x_idx < n-1 and xi >= x[x_idx ] and xi <= x[x_idx+1]) return x_idx; + if (x_idx > 0 and xi >= x[x_idx-1] and xi <= x[x_idx ]) return x_idx-1; + // Move on to less common ones. + const int max_step = max(x_idx, n-1 - x_idx); + for (int step = 1; step <= max_step; ++step) { + if (x_idx < n-1-step and xi >= x[x_idx+step ] and xi <= x[x_idx+step+1]) + return x_idx+step; + if (x_idx > step and xi >= x[x_idx-step-1] and xi <= x[x_idx-step ]) + return x_idx-step-1; + } + assert(false); + return -1; +} + +// Linear interpolation core computation. +template +KOKKOS_FUNCTION Real +linterp (const int n, const XT& x, const YT& y, const int x_idx, const Real xi) { + const auto isup = find_support(n, x, x_idx, xi); + const Real a = (xi - x[isup])/(x[isup+1] - x[isup]); + return (1-a)*y[isup] + a*y[isup+1]; +} + +// Linear interpolation at the lowest level of team ||ism. +// Range provides this ||ism over index 0 <= k < ni. +// Interpolate y(x) to yi(xi). +// x_idx_offset is added to k in the call to find_support. +// Arrays should all have rank 1. +template +KOKKOS_FUNCTION void +linterp (const Range& range, + const int n , const XT& x , const YT& y, + const int ni, const XIT& xi, const YIT& yi, + const int x_idx_offset = 0, const char* const caller = nullptr) { +#ifndef NDEBUG + if (xi[0] < x[0] or xi[ni-1] > x[n-1]) { + if (caller) + printf("linterp: xi out of bounds: %s %1.15e %1.15e %1.15e %1.15e\n", + caller ? caller : "NONE", x[0], xi[0], xi[ni-1], x[n-1]); + assert(false); + } +#endif + assert(range.start == 0); + assert(range.end == ni); + const auto f = [&] (const int k) { + yi[k] = linterp(n, x, y, k + x_idx_offset, xi[k]); + }; + Kokkos::parallel_for(range, f); +} + +KOKKOS_FUNCTION void +eta_interp_eta (const KernelVariables& kv, const int nlev, + const CRnV& hy_etai, const CRelnV& x, const CRnV& y, + const RelnV& xwrk, const RnV& ywrk, + // Use xi(i_os:), yi(i,j,i_os:). + const int ni, const CRnV& xi, const RelnV& yi, const int i_os = 0) { + const auto& xbdy = xwrk; + const auto& ybdy = ywrk; + assert(hy_etai.extent_int(0) >= nlev+1); + assert_eln(x, nlev); + assert(y.extent_int(0) >= nlev); + assert_eln(xbdy, nlev+2); + assert(ybdy.extent_int(0) >= nlev+2); + assert(xi.extent_int(0) >= i_os + ni); + assert_eln(yi, i_os + ni); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_ni = Kokkos::ThreadVectorRange(kv.team, ni); + const auto tvr_nlevp2 = Kokkos::ThreadVectorRange(kv.team, nlev+2); + const auto f_y = [&] (const int k) { + ybdy(k) = (k == 0 ? hy_etai(0) : + k == nlev+1 ? hy_etai(nlev) : + /**/ y(k-1)); + }; + Kokkos::parallel_for(Kokkos::TeamVectorRange(kv.team, nlev+2), f_y); + kv.team_barrier(); + const auto f_x = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] (const int k) { + xbdy(i,j,k) = (k == 0 ? hy_etai(0) : + k == nlev+1 ? hy_etai(nlev) : + /**/ x(i,j,k-1)); + }; + Kokkos::parallel_for(tvr_nlevp2, g); + }; + Kokkos::parallel_for(ttr, f_x); + kv.team_barrier(); + const auto f_linterp = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + linterp(tvr_ni, + nlev+2, getcolc(xbdy,i,j), ybdy, + ni, xi.data() + i_os, getcol(yi,i,j).data() + i_os, + 1, "eta_interp_eta"); + }; + Kokkos::parallel_for(ttr, f_linterp); +} + +KOKKOS_FUNCTION void +eta_interp_horiz (const KernelVariables& kv, const int nlev, + const CRnV& hy_etai, const CRnV& x, const CRelnV& y, + const RnV& xwrk, const RelnV& ywrk, + const CRelnV& xi, const RelnV& yi) { + const auto& xbdy = xwrk; + const auto& ybdy = ywrk; + assert(hy_etai.extent_int(0) >= nlev+1); + assert(x.extent_int(0) >= nlev); + assert_eln(y, nlev); + assert(xbdy.extent_int(0) >= nlev+2); + assert_eln(ybdy, nlev+2); + assert_eln(xi, nlev); + assert_eln(yi, nlev); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_nlev = Kokkos::ThreadVectorRange(kv.team, nlev); + const auto tvr_nlevp2 = Kokkos::ThreadVectorRange(kv.team, nlev+2); + const auto f_x = [&] (const int k) { + xbdy(k) = (k == 0 ? hy_etai(0) : + k == nlev+1 ? hy_etai(nlev) : + /**/ x(k-1)); + }; + Kokkos::parallel_for(Kokkos::TeamVectorRange(kv.team, nlev+2), f_x); + kv.team_barrier(); + const auto f_y = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] (const int k) { + // Constant interp outside of the etam support. + ybdy(i,j,k) = (k == 0 ? y(i,j,0) : + k == nlev+1 ? y(i,j,nlev-1) : + /**/ y(i,j,k-1)); + }; + Kokkos::parallel_for(tvr_nlevp2, g); + }; + Kokkos::parallel_for(ttr, f_y); + kv.team_barrier(); + const auto f_linterp = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + linterp(tvr_nlev, + nlev+2, xbdy, getcolc(ybdy,i,j), + nlev, getcolc(xi,i,j), getcol(yi,i,j), + 1, "eta_interp_horiz"); + }; + Kokkos::parallel_for(ttr, f_linterp); +} + +/* Compute level pressure thickness given eta at interfaces using the following + approximation: + e = A(e) + B(e) + p(e) = A(e) p0 + B(e) ps + = e p0 + B(e) (ps - p0) + a= e p0 + I[Bi(eref)](e) (ps - p0). + Then dp = diff(p). +*/ +KOKKOS_FUNCTION void +eta_to_dp (const KernelVariables& kv, const int nlev, + const Real hy_ps0, const CRnV& hy_bi, const CRnV& hy_etai, + const CRelV& ps, const CRelnV& etai, const RelnV& wrk, + const RelnV& dp) { + const int nlevp = nlev + 1; + assert(hy_bi.extent_int(0) >= nlevp); + assert(hy_etai.extent_int(0) >= nlevp); + assert_eln(etai, nlevp); + assert_eln(wrk, nlevp); + assert_eln(dp, nlev); + const auto& bi = wrk; + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_linterp = Kokkos::ThreadVectorRange(kv.team, nlevp); + const auto f_linterp = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + linterp(tvr_linterp, + nlevp, hy_etai, hy_bi, + nlevp, getcolc(etai,i,j), getcol(bi,i,j), + 0, "eta_to_dp"); + }; + Kokkos::parallel_for(ttr, f_linterp); + kv.team_barrier(); + const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlev); + const auto f = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto dps = ps(i,j) - hy_ps0; + const auto g = [&] (const int k) { + dp(i,j,k) = ((etai(i,j,k+1) - etai(i,j,k))*hy_ps0 + + (bi(i,j,k+1) - bi(i,j,k))*dps); + }; + Kokkos::parallel_for(tvr, g); + }; + Kokkos::parallel_for(ttr, f); +} + +/* Limit eta levels so their thicknesses, deta, are bounded below by 'low'. + + This method pulls mass only from intervals k that are larger than their + reference value (deta(k) > deta_ref(k)), and only down to their reference + value. This concentrates changes to intervals that, by having a lot more mass + than usual, drive other levels negative, leaving all the other intervals + unchanged. + + This selective use of mass provides enough to fulfill the needed mass. + Inputs: + m (deta): input mass + r (deta_ref): level mass reference. + Preconditions: + (1) 0 <= low <= min r(i) + (2) 1 = sum r(i) = sum(m(i)). + Rewrite (2) as + 1 = sum_{m(i) >= r(i)} m(i) + sum_{m(i) < r(i)} m(i) + and, thus, + 0 = sum_{m(i) >= r(i)} (m(i) - r(i)) + sum_{m(i) < r(i)} (m(i) - r(i)). + Then + sum_{m(i) >= r(i)} (m(i) - r(i)) (available mass to redistribute) + = -sum_{m(i) < r(i)} (m(i) - r(i)) + >= -sum_{m(i) < lo } (m(i) - r(i)) + >= -sum_{m(i) < lo } (m(i) - lo ) (mass to fill in). + Thus, if the preconditions hold, then there's enough mass to redistribute. + */ +template +KOKKOS_FUNCTION void +deta_caas (const KernelVariables& kv, const Range& tvr_nlevp, + const CRnV& deta_ref, const Real low, const RnV& w, + const RnV& deta) { + const auto g1 = [&] (const int k, Kokkos::Real2& sums) { + Real wk; + if (deta(k) < low) { + sums.v[0] += deta(k) - low; + deta(k) = low; + wk = 0; + } else { + wk = (deta(k) > deta_ref(k) ? + deta(k) - deta_ref(k) : + 0); + } + sums.v[1] += wk; + w(k) = wk; + }; + Kokkos::Real2 sums; + Dispatch<>::parallel_reduce(kv.team, tvr_nlevp, g1, sums); + const Real wneeded = sums.v[0]; + if (wneeded == 0) return; + // Remove what is needed from the donors. + const Real wavail = sums.v[1]; + const auto g2 = [&] (const int k) { + deta(k) += wneeded*(w(k)/wavail); + }; + Kokkos::parallel_for(tvr_nlevp, g2); +} + +KOKKOS_FUNCTION void +deta_caas (const KernelVariables& kv, const int nlevp, const CRnV& deta_ref, + const Real low, const RelnV& wrk, const RelnV& deta) { + assert(deta_ref.extent_int(0) >= nlevp); + assert_eln(wrk, nlevp); + assert_eln(deta, nlevp); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlevp); + const auto f = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + deta_caas(kv, tvr, deta_ref, low, getcol(wrk,i,j), getcol(deta,i,j)); + }; + Kokkos::parallel_for(ttr, f); +} + +// Wrapper to deta_caas. On input and output, eta contains the midpoint eta +// values. On output, deta_caas has been applied, if necessary, to +// diff(eta(i,j,:)). +KOKKOS_FUNCTION void +limit_etam (const KernelVariables& kv, const int nlev, const CRnV& hy_etai, + const CRnV& deta_ref, const Real deta_tol, const RelnV& wrk1, + const RelnV& wrk2, const RelnV& eta) { + assert(hy_etai.extent_int(0) >= nlev+1); + assert(deta_ref.extent_int(0) >= nlev+1); + const auto deta = wrk2; + assert_eln(wrk1, nlev+1); + assert_eln(deta, nlev+1); + assert_eln(eta , nlev ); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlev+1); + // eta -> deta; limit deta if needed. + const auto f1 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto etaij = getcolc( eta,i,j); + const auto detaij = getcol(deta,i,j); + const auto g1 = [&] (const int k, int& nbad) { + const auto d = (k == 0 ? etaij(0) - hy_etai(0) : + k == nlev ? hy_etai(nlev) - etaij(nlev-1) : + /**/ etaij(k) - etaij(k-1)); + const bool ok = d >= deta_tol; + if (not ok) ++nbad; + detaij(k) = d; + }; + int nbad = 0; + Dispatch<>::parallel_reduce(kv.team, tvr, g1, nbad); + if (nbad == 0) { + // Signal this column is fine. + Kokkos::single(Kokkos::PerThread(kv.team), [&] () { detaij(0) = -1; }); + return; + }; + deta_caas(kv, tvr, deta_ref, deta_tol, getcol(wrk1,i,j), detaij); + }; + Kokkos::parallel_for(ttr, f1); + kv.team_barrier(); + // deta -> eta; ignore columns where limiting wasn't needed. + const auto f2 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto etaij = getcol( eta,i,j); + const auto detaij = getcol(deta,i,j); + if (detaij(0) == -1) return; + const auto g = [&] (const int k, Real& accum, const bool final) { + assert(k != 0 or accum == 0); + const Real d = k == 0 ? hy_etai(0) + detaij(0) : detaij(k); + accum += d; + if (final) etaij(k) = accum; + }; + Dispatch<>::parallel_scan(kv.team, nlev, g); + }; + Kokkos::parallel_for(ttr, f2); +} + +KOKKOS_FUNCTION void calc_ps ( + const KernelVariables& kv, const int nlev, + const Real& ps0, const Real& hyai0, + const CSelnV& dp, + const ExecViewUnmanaged& ps) +{ + assert_eln(dp, nlev); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_snlev = Kokkos::ThreadVectorRange(kv.team, nlev); + const CRelnV dps = elp2r(dp); + const auto f1 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] (int k, Real& sum) { sum += dps(i,j,k); }; + Real sum; + Dispatch<>::parallel_reduce(kv.team, tvr_snlev, g, sum); + Kokkos::single(Kokkos::PerThread(kv.team), + [&] { ps(i,j) = hyai0*ps0 + sum; }); + }; + Kokkos::parallel_for(ttr, f1); +} + +KOKKOS_FUNCTION void calc_ps ( + const KernelVariables& kv, const int nlev, + const Real& ps0, const Real& hyai0, + const Real alpha[2], const CSelnV& dp1, const CSelnV& dp2, + const ExecViewUnmanaged& ps) +{ + assert_eln(dp1, nlev); + assert_eln(dp2, nlev); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_snlev = Kokkos::ThreadVectorRange(kv.team, nlev); + const CRelnV dps[] = {elp2r(dp1), elp2r(dp2)}; + const auto f1 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + for (int t = 0; t < 2; ++t) { + const auto& dp = dps[t]; + const auto g = [&] (int k, Real& sum) { sum += dp(i,j,k); }; + Real sum; + Dispatch<>::parallel_reduce(kv.team, tvr_snlev, g, sum); + Kokkos::single(Kokkos::PerThread(kv.team), [&] { ps(t,i,j) = sum; }); + } + }; + Kokkos::parallel_for(ttr, f1); + kv.team_barrier(); + const auto f2 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] () { + Real vals[2]; + for (int t = 0; t < 2; ++t) + vals[t] = (hyai0*ps0 + + (1 - alpha[t])*ps(0,i,j) + + /**/ alpha[t] *ps(1,i,j)); + for (int t = 0; t < 2; ++t) + ps(t,i,j) = vals[t]; + }; + Kokkos::single(Kokkos::PerThread(kv.team), g); + }; + Kokkos::parallel_for(ttr, f2); +} + +// Transform eta_dot_dpdn at interfaces to eta_dot at midpoints using the +// formula +// eta_dot = eta_dot_dpdn/(A_eta p0 + B_eta ps). +// a= eta_dot_dpdn diff(eta)/(diff(A) p0 + diff(B) ps). +KOKKOS_FUNCTION void calc_etadotmid_from_etadotdpdnint ( + const KernelVariables& kv, const int nlev, + const Real& ps0, const CSnV& hydai, const CSnV& hydbi, + const CSnV& hydetai, const CRelV& ps, const SelnV& wrk, + // in: eta_dot_dpdn at interfaces + // out: eta_dot at midpoints, final slot unused + const SelnV& ed) +{ + assert(calc_nscal(hydai.extent_int(0)) >= nlev); + assert(calc_nscal(hydbi.extent_int(0)) >= nlev); + assert(calc_nscal(hydetai.extent_int(0)) >= nlev); + assert_eln(wrk, nlev+1); + assert_eln(ed, nlev+1); + const auto& edd_mid = wrk; + { + const CRelnV edd(elp2r(ed)); + const RelnV tmp(elp2r(wrk)); + const auto f = [&] (const int i, const int j, const int k) { + tmp(i,j,k) = (edd(i,j,k) + edd(i,j,k+1))/2; + }; + cti::loop_ijk(nlev, kv, f); + } + kv.team_barrier(); + { + const auto f = [&] (const int i, const int j, const int kp) { + ed(i,j,kp) = (edd_mid(i,j,kp) + * hydetai(kp) + / (hydai(kp)*ps0 + hydbi(kp)*ps(i,j))); + }; + cti::loop_ijk(calc_npack(nlev), kv, f); + } +} + +KOKKOS_FUNCTION void calc_eta_dot_ref_mid ( + const KernelVariables& kv, const SphereOperators& sphere_ops, + const Real& ps0, const Real& hyai0, const CSNV& hybi, + const CSNV& hydai, const CSNV& hydbi, // delta ai, bi + const CSNV& hydetai, // delta etai + const Real alpha[2], + const CS2elNlev& v1, const CSelNlev& dp1, const CS2elNlev& v2, const CSelNlev& dp2, + const SelNlevp& wrk1, const SelNlevp& wrk2, const S2elNlevp& vwrk1, + // Holds interface levels as intermediate data but is midpoint data on output, + // with final slot unused. + const SelNlevp eta_dot[2]) +{ + using Kokkos::ALL; + const int nlev = NUM_PHYSICAL_LEV; + const SelNlev divdp(wrk1.data()); + const S2elNlev vdp(vwrk1.data()); + const ExecViewUnmanaged ps(cti::pack2real(wrk2)); + // Calc surface pressure for use at the end. + calc_ps(kv, nlev, + ps0, hyai0, + alpha, dp1, dp2, + ps); + kv.team_barrier(); + for (int t = 0; t < 2; ++t) { + // Compute divdp. + const auto f = [&] (const int i, const int j, const int kp) { + for (int d = 0; d < 2; ++d) + vdp(d,i,j,kp) = ((1 - alpha[t])*v1(d,i,j,kp)*dp1(i,j,kp) + + /**/ alpha[t] *v2(d,i,j,kp)*dp2(i,j,kp)); + }; + cti::loop_ijk(kv, f); + kv.team_barrier(); + sphere_ops.divergence_sphere(kv, vdp, divdp); + kv.team_barrier(); + // Compute eta_dot_dpdn at interface nodes. + const auto& edd = eta_dot[t]; + const RelNlevp edds(cti::pack2real(edd)); + const RelNlev divdps(cti::pack2real(wrk1)); + cti::calc_eta_dot_dpdn(kv, + hybi, + divdps, edd, + edds); + kv.team_barrier(); + calc_etadotmid_from_etadotdpdnint(kv, nlev, + ps0, hydai, hydbi, hydetai, + Kokkos::subview(ps,t,ALL,ALL), + wrk1, + edd); + // No team_barrier: wrk1 is protected in second iteration. + } +} + +KOKKOS_FUNCTION void calc_vel_horiz_formula_node_ref_mid ( + const KernelVariables& kv, const SphereOperators& sphere_ops, + const CSNV& hyetam, const ExecViewUnmanaged& vec_sph2cart, + // Velocities are at midpoints. Final eta_dot entry is ignored. + const Real dtsub, const CS2elNlev vsph[2], const CSelNlevp eta_dot[2], + const SelNlevp& wrk1, const S2elNlevp& vwrk1, const S2elNlevp& vwrk2, + const ExecViewUnmanaged& vnode) +{ + using Kokkos::ALL; + const S2elNlev vfsph(vwrk1.data()), vw2(vwrk2.data()); + const SelNlev w1(wrk1.data()); + const R2elNlev vfsphs(cti::pack2real(vfsph)); + const auto& vsph1 = vsph[0]; + const auto& vsph2 = vsph[1]; + { // Horizontal terms. + cti::ugradv_sphere(sphere_ops, kv, vec_sph2cart, vsph2, vsph1, w1, vw2, vfsph); + for (int d = 0; d < 2; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + vfsph(d,i,j,k) = vsph1(d,i,j,k) + vsph2(d,i,j,k) - dtsub*vfsph(d,i,j,k); + }; + cti::loop_ijk(kv, f); + } + } + kv.team_barrier(); + { // Vertical terms. + const CRNV etams(cti::cpack2real(hyetam)); + const CR2elNlev vsph1s(cti::cpack2real(vsph1)); + const CRelNlevp eds(cti::cpack2real(eta_dot[1])); + for (int d = 0; d < 2; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + Real deriv; + if (k == 0 or k+1 == NUM_PHYSICAL_LEV) { + const int k1 = k == 0 ? 0 : NUM_PHYSICAL_LEV-2; + const int k2 = k == 0 ? 1 : NUM_PHYSICAL_LEV-1; + deriv = ((vsph1s(d,i,j,k2) - vsph1s(d,i,j,k1)) / + (etams(k2) - etams(k1))); + } else { + deriv = cti::approx_derivative( + etams(k-1), etams(k), etams(k+1), + vsph1s(d,i,j,k-1), vsph1s(d,i,j,k), vsph1s(d,i,j,k+1)); + } + vfsphs(d,i,j,k) = (vfsphs(d,i,j,k) - dtsub*eds(i,j,k)*deriv)/2; + }; + cti::loop_ijk(kv, f); + } + } + { // Transform to Cartesian. + for (int d = 0; d < 3; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + vnode(k,i,j,d) = (vec_sph2cart(0,d,i,j)*vfsphs(0,i,j,k) + + vec_sph2cart(1,d,i,j)*vfsphs(1,i,j,k)); + }; + cti::loop_ijk(kv, f); + } + } +} + +KOKKOS_FUNCTION void calc_eta_dot_formula_node_ref_mid ( + const KernelVariables& kv, const SphereOperators& sphere_ops, + const CRNV& hyetai, const CSNV& hyetam, + // Velocities are at midpoints. Final eta_dot entry is ignored. + const Real dtsub, const CS2elNlev vsph[2], const CSelNlevp eta_dot[2], + const SelNlevp& wrk1, const S2elNlevp& vwrk1, + const ExecViewUnmanaged& vnode) +{ + const SelNlev ed1_vderiv(wrk1.data()); + { + const CRNV etams(cti::cpack2real(hyetam)); + const CRelNlevp ed1s(cti::cpack2real(eta_dot[0])); + const RelNlev ed1_vderiv_s(cti::pack2real(ed1_vderiv)); + const auto f = [&] (const int i, const int j, const int k) { + Real deriv; + if (k == 0 or k+1 == NUM_PHYSICAL_LEV) { + deriv = cti::approx_derivative( + k == 0 ? hyetai(0) : etams(k-1), + etams(k), + k+1 == NUM_PHYSICAL_LEV ? hyetai(NUM_PHYSICAL_LEV) : etams(k+1), + k == 0 ? 0 : ed1s(i,j,k-1), + ed1s(i,j,k), + k+1 == NUM_PHYSICAL_LEV ? 0 : ed1s(i,j,k+1)); + } else { + deriv = cti::approx_derivative( + etams(k-1), etams(k), etams(k+1), + ed1s(i,j,k-1), ed1s(i,j,k), ed1s(i,j,k+1)); + } + ed1_vderiv_s(i,j,k) = deriv; + }; + cti::loop_ijk(kv, f); + } + kv.team_barrier(); + const S2elNlev ed1_hderiv(vwrk1.data()); + sphere_ops.gradient_sphere(kv, eta_dot[0], ed1_hderiv, NUM_LEV); + { + const auto& vsph2 = vsph[1]; + const auto& ed1 = eta_dot[0]; + const auto& ed2 = eta_dot[1]; + const auto f = [&] (const int i, const int j, const int k) { + const auto v = (ed1(i,j,k) + ed2(i,j,k) + - dtsub*( vsph2(0,i,j,k)*ed1_hderiv(0,i,j,k) + + vsph2(1,i,j,k)*ed1_hderiv(1,i,j,k) + + ed2( i,j,k)*ed1_vderiv( i,j,k)))/2; + for (int s = 0; s < VECTOR_SIZE; ++s) + vnode(VECTOR_SIZE*k+s, i,j,3) = v[s]; + }; + cti::loop_ijk(kv, f); + } +} + +// Set dep_points_all to level-midpoint arrival points. +void init_dep_points (const CTI& c, const cti::DeparturePoints& dep_pts) { + const auto independent_time_steps = c.m_data.independent_time_steps; + const auto& sphere_cart = c.m_geometry.m_sphere_cart; + const CRNV hyetam(cti::cpack2real(c.m_hvcoord.etam)); + assert(not independent_time_steps or dep_pts.extent_int(4) == 4); + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < 3; ++d) + dep_pts(ie,lev,i,j,d) = sphere_cart(ie,i,j,d); + if (independent_time_steps) + dep_pts(ie,lev,i,j,3) = hyetam(lev); + }; + c.launch_ie_physlev_ij(f); +} + +void update_dep_points ( + const CTI& c, const Real dtsub, const cti::DeparturePoints& vdep, + const cti::DeparturePoints& dep_pts) +{ + const auto independent_time_steps = c.m_data.independent_time_steps; + const auto is_sphere = c.m_data.geometry_type == 0; + const auto scale_factor = c.m_geometry.m_scale_factor; + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + // Update horizontal position. + Real p[3]; + for (int d = 0; d < 3; ++d) + p[d] = dep_pts(ie,lev,i,j,d) - dtsub*vdep(ie,lev,i,j,d)/scale_factor; + if (is_sphere) { + const auto norm = std::sqrt(square(p[0]) + square(p[1]) + square(p[2])); + for (int d = 0; d < 3; ++d) + p[d] /= norm; + } + for (int d = 0; d < 3; ++d) + dep_pts(ie,lev,i,j,d) = p[d]; + if (independent_time_steps) { + // Update vertical position. + dep_pts(ie,lev,i,j,3) -= dtsub*vdep(ie,lev,i,j,3); + } + }; + c.launch_ie_physlev_ij(f); +} + +/* Evaluate a formula to provide an estimate of nodal velocities that are use to + create a 2nd-order update to the trajectory. The fundamental formula for the + update in position p from arrival point p1 to departure point p0 is + p0 = p1 - dt/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). + Here we compute the velocity estimate at the nodes: + 1/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). +*/ +void calc_nodal_velocities ( + const CTI& c, const Real dtsub, const Real halpha[2], + const cti::CVSlot& v1, const cti::CDpSlot& dp1, const int idx1, + const cti::CVSlot& v2, const cti::CDpSlot& dp2, const int idx2, + const cti::DeparturePoints& vnode) +{ + using Kokkos::ALL; + const auto& d = c.m_data; + const auto& h = c.m_hvcoord; + const auto& sphere_ops = c.m_sphere_ops; + const auto& vec_sph2cart = c.m_geometry.m_vec_sph2cart; + const bool independent_time_steps = d.independent_time_steps; + const auto ps0 = h.ps0; + const auto hyai0 = h.hybrid_ai0; + const auto& hybi = h.hybrid_bi_packed; + const auto& hydai = h.hybrid_ai_delta; + const auto& hydbi = h.hybrid_bi_delta; + const auto& hyetam = h.etam; + const auto& hyetai = h.etai; + const auto& hydetai = d.hydetai; + const auto& buf1a = d.buf1o[0]; const auto& buf1b = d.buf1o[1]; + const auto& buf1c = d.buf1o[2]; const auto& buf1d = d.buf1o[3]; + const auto& buf2a = d.buf2 [0]; const auto& buf2b = d.buf2 [1]; + const auto& buf2c = d.buf2 [2]; const auto& buf2d = d.buf2 [3]; + const auto alpha0 = halpha[0], alpha1 = halpha[1]; + const auto f = KOKKOS_LAMBDA (const cti::MT& team) { + KernelVariables kv(team); + const int ie = kv.ie; + const auto wrk1 = Homme::subview(buf1a, kv.team_idx); + const auto wrk2 = Homme::subview(buf1b, kv.team_idx); + const auto vwrk1 = Homme::subview(buf2a, kv.team_idx); + const auto vwrk2 = Homme::subview(buf2b, kv.team_idx); + const auto v1_ie = Homme::subview(v1, ie, idx1); + const auto v2_ie = Homme::subview(v2, ie, idx2); + const Real alpha[] = {alpha0, alpha1}; + CSelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), + Homme::subview(buf1d, kv.team_idx)}; + { + SelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), + Homme::subview(buf1d, kv.team_idx)}; + if (independent_time_steps) { + const auto dp1_ie = Homme::subview(dp1, ie, idx1); + const auto dp2_ie = Homme::subview(dp2, ie, idx2); + calc_eta_dot_ref_mid(kv, sphere_ops, + ps0, hyai0, hybi, hydai, hydbi, hydetai, + alpha, v1_ie, dp1_ie, v2_ie, dp2_ie, + wrk1, wrk2, vwrk1, + eta_dot); + } else { + for (int t = 0; t < 2; ++t) { + const auto& ed = eta_dot[t]; + const auto f = [&] (const int i, const int j, const int k) { + ed(i,j,k) = 0; + }; + cti::loop_ijk(kv, f); + } + } + } + // Collect the horizontal nodal velocities. v1,2 are on Eulerian levels. v1 + // is from time t1 < t2. + auto* vm1 = Homme::subview(buf2c, kv.team_idx).data(); + auto* vm2 = Homme::subview(buf2d, kv.team_idx).data(); + CS2elNlev vsph[] = {CS2elNlev(vm1), CS2elNlev(vm2)}; + { + S2elNlev vsph[] = {S2elNlev(vm1), S2elNlev(vm2)}; + for (int t = 0; t < 2; ++t) { + const auto& v = vsph[t]; + for (int d = 0; d < 2; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + v(d,i,j,k) = ((1 - alpha[t])*v1_ie(d,i,j,k) + + /**/ alpha[t] *v2_ie(d,i,j,k)); + }; + cti::loop_ijk(kv, f); + } + } + } + kv.team_barrier(); + // Given the vertical and horizontal nodal velocities at time endpoints, + // evaluate the velocity estimate formula, providing the final horizontal + // and vertical velocity estimates at midpoint nodes. + const auto vnode_ie = Kokkos::subview(vnode, ie, ALL,ALL,ALL,ALL); + const auto vec_sph2cart_ie = Homme::subview(vec_sph2cart, ie); + calc_vel_horiz_formula_node_ref_mid(kv, sphere_ops, + hyetam, vec_sph2cart_ie, + dtsub, vsph, eta_dot, + wrk1, vwrk1, vwrk2, + vnode_ie); + if (independent_time_steps) { + kv.team_barrier(); + calc_eta_dot_formula_node_ref_mid(kv, sphere_ops, + hyetai, hyetam, + dtsub, vsph, eta_dot, + wrk1, vwrk1, + vnode_ie); + } + }; + Kokkos::parallel_for(c.m_tp_ne, f); +} + +// Determine the departure points corresponding to the vertically Lagragnian +// grid's arrival midpoints, where the floating levels are those that evolve +// over the course of the full tracer time step. Also compute divdp, which holds +// the floating levels' dp values for later use in vertical remap. +void interp_departure_points_to_floating_level_midpoints (const CTI& c, const int np1) { + using Kokkos::ALL; + const int nlev = NUM_PHYSICAL_LEV, nlevp = nlev+1; + const auto is_sphere = c.m_data.geometry_type == 0; + const auto& d = c.m_data; + const auto& h = c.m_hvcoord; + const auto ps0 = h.ps0; + const auto hyai0 = h.hybrid_ai0; + const auto& hybi = h.hybrid_bi; + const auto& hyetai = h.etai; + const CRNV hyetam(cti::cpack2real(h.etam)); + const auto& detam_ref = d.hydetam_ref; + const auto deta_tol = d.deta_tol; + const auto& dep_pts = d.dep_pts; + const auto& dp3d = c.m_state.m_dp3d; + const auto& buf1a = d.buf1e[0]; const auto& buf1b = d.buf1e[1]; + const auto& buf1c = d.buf1e[2]; const auto& buf1d = d.buf1e[3]; + const auto& buf2a = d.buf2[0]; + const auto f = KOKKOS_LAMBDA (const cti::MT& team) { + KernelVariables kv(team); + const int ie = kv.ie; + const auto wrk1 = Homme::subview(buf1a, kv.team_idx); + const auto wrk2 = Homme::subview(buf1b, kv.team_idx); + const auto wrk3 = Homme::subview(buf1c, kv.team_idx); + const auto wrk4 = Homme::subview(buf1d, kv.team_idx); + const auto vwrk = Homme::subview(buf2a, kv.team_idx); + // Reconstruct Lagrangian levels at t1 on arrival column: + // eta_arr_int = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_int) + const auto etam = p2rel(wrk3.data(), nlev); + const auto f = [&] (const int i, const int j, const int k) { + etam(i,j,k) = dep_pts(ie,k,i,j,3); + }; + cti::loop_ijk(kv, f); + kv.team_barrier(); + limit_etam(kv, nlev, + hyetai, detam_ref, deta_tol, + p2rel(wrk1.data(), nlevp), p2rel(wrk2.data(), nlevp), + etam); + kv.team_barrier(); + { + // Compute eta_arr_int. + const auto etai_arr = p2rel(wrk4.data(), nlevp); + eta_interp_eta(kv, nlev, + hyetai, + etam, hyetam, + p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), + nlevp-2, hyetai, etai_arr, 1); + const auto f = [&] (const int i, const int j) { + etai_arr(i,j,0) = hyetai(0); + etai_arr(i,j,nlev) = hyetai(nlev); + }; + c.loop_ij(kv, f); + // Compute divdp. + const ExecViewUnmanaged ps(cti::pack2real(vwrk)); + calc_ps(kv, nlev, + ps0, hyai0, + Homme::subview(dp3d, ie, np1), + ps); + kv.team_barrier(); + eta_to_dp(kv, nlev, + ps0, hybi, hyetai, + ps, etai_arr, + p2rel(wrk2.data(), nlev+1), + RelnV(cti::pack2real(Homme::subview(c.m_derived.m_divdp, ie)), + NP, NP, NUM_LEV*VECTOR_SIZE)); + kv.team_barrier(); + } + // Compute Lagrangian level midpoints at t1 on arrival column: + // eta_arr_mid = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_mid) + const auto etam_arr = p2rel(wrk4.data(), nlev); + eta_interp_eta(kv, nlev, + hyetai, + etam, hyetam, + p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), + nlev, hyetam, etam_arr); + kv.team_barrier(); + // Compute departure horizontal points corresponding to arrival + // Lagrangian level midpoints: + // p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid) + { + const RelnV dpts_in(cti::pack2real(vwrk), NP, NP, nlev); + const RelnV dpts_out(dpts_in.data() + NP*NP*nlev, NP, NP, nlev); + for (int d = 0; d < 3; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + dpts_in(i,j,k) = dep_pts(ie,k,i,j,d); + }; + c.loop_ijk(kv, f); + kv.team_barrier(); + eta_interp_horiz(kv, nlev, + hyetai, + hyetam, dpts_in, + RnV(cti::pack2real(wrk2), nlev+2), p2rel(wrk1.data(), nlev+2), + etam_arr, dpts_out); + kv.team_barrier(); + const auto g = [&] (const int i, const int j, const int k) { + dep_pts(ie,k,i,j,d) = dpts_out(i,j,k); + }; + c.loop_ijk(kv, g); + kv.team_barrier(); + } + if (is_sphere) { + // Normalize. + const auto h = [&] (const int i, const int j, const int k) { + Real norm = 0; + for (int d = 0; d < 3; ++d) norm += square(dep_pts(ie,k,i,j,d)); + norm = std::sqrt(norm); + for (int d = 0; d < 3; ++d) dep_pts(ie,k,i,j,d) /= norm; + }; + c.loop_ijk(kv, h); + } + } + }; + Kokkos::parallel_for(c.m_tp_ne, f); +} + +void dss_vnode (const CTI& c, const cti::DeparturePoints& vnode) { + const int ndim = c.m_data.independent_time_steps ? 4 : 3; + const auto& spheremp = c.m_geometry.m_spheremp; + const auto& rspheremp = c.m_geometry.m_rspheremp; + const auto& vp = c.m_tracers.qtens_biharmonic; + const ExecViewUnmanaged + v(cti::pack2real(vp), vp.extent_int(0), vp.extent_int(1)); + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < ndim; ++d) + v(ie,d,i,j,lev) = vnode(ie,lev,i,j,d)*spheremp(ie,i,j)*rspheremp(ie,i,j); + }; + c.launch_ie_physlev_ij(f); + Kokkos::fence(); + const auto be = c.m_v_dss_be[c.m_data.independent_time_steps ? 1 : 0]; + be->exchange(); + Kokkos::fence(); + const auto g = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < ndim; ++d) + vnode(ie,lev,i,j,d) = v(ie,d,i,j,lev); + }; + c.launch_ie_physlev_ij(g); +} + +} // namespace anon + +// When nvelocity > 2, we need to do bookkeeping to (1) accumulate intermediate +// velocity data and (2) use these data. This struct does this bookkeeping. At +// init time, it builds small integer and real arrays with indices and +// weights. During time stepping, it provides these data to the +// velocity-accumulation function and the trajectory method. +// +// Parameter short names: +// dtf = dt_tracer_factor +// drf = dt_remap_factor +// nsub = semi_lagrange_trajectory_nsubstep +// nvel = semi_lagrange_trajectory_nvelocity +struct CTI::VelocityRecord { + VelocityRecord () {} + VelocityRecord (const int dtf, const int drf, const int nsub, const int nvel) + { init(dtf, drf, nsub, nvel); } + + void init(const int dtf, const int drf, const int nsub, const int nvel); + + int dtf () const { return _dtf; } + int drf () const { return _drf; } + int nsub () const { return _nsub; } + int nvel () const { return _nvel; } + + // Times to which velocity slots i in 0:nvel-1 correspond, in reference time + // [0,dtf]. + Real t_vel(const int i) const; + + // For n = 0:dtf, obs_slots(n,0:1) = [slot1, slot2], -1 if unused. These are + // the slots to which velocity sample n contributes. obs_slots(0 or dtf,:) are + // always -1. + int obs_slots(const int n, const int k) const; + + // For n = 0:dtf, obs_wts(n,0:1) = [wt1, wt2], 0 if unused. + Real obs_wts(const int n, const int k) const; + + // Substep end point i in 0:nsub uses velocity slots run_step(n), + // run_step(n)-1. + int run_step(const int i) const; + +private: + int _dtf = -1, _drf = -1, _nsub = -1, _nvel = -1; + std::vector _obs_slots, _run_step; + std::vector _t_vel, _obs_wts; + + Real& t_vel(const int i); + int& obs_slots(const int n, const int k); + Real& obs_wts(const int n, const int k); + int& run_step(const int i); +}; + +Real& CTI::VelocityRecord::t_vel (const int i) { + assert(_nvel > 2); + assert(i >= 0 and i < _nvel); + return _t_vel[i]; +} + +int& CTI::VelocityRecord::obs_slots (const int n, const int k) { + assert(_nvel > 2); + assert(n >= 0 and n <= _dtf); + assert(k >= 0 and k <= 1); + return _obs_slots[2*n+k]; +} + +Real& CTI::VelocityRecord::obs_wts (const int n, const int k) { + assert(_nvel > 2); + assert(n >= 0 and n <= _dtf); + assert(k >= 0 and k <= 1); + return _obs_wts[2*n+k]; +} + +int& CTI::VelocityRecord::run_step (const int i) { + assert(_nvel > 2); + assert(i >= 0 and i <= _nsub); + return _run_step[i]; +} + +Real CTI::VelocityRecord::t_vel (const int i) const { + return const_cast(this)->t_vel(i); +} + +int CTI::VelocityRecord::obs_slots (const int n, const int k) const { + return const_cast(this)->obs_slots(n,k); +} + +Real CTI::VelocityRecord::obs_wts (const int n, const int k) const { + return const_cast(this)->obs_wts(n,k); +} + +int CTI::VelocityRecord::run_step (const int i) const { + return const_cast(this)->run_step(i); +} + +void CTI::VelocityRecord +::init (const int dtf, const int drf_param, const int nsub, const int nvel_param) { + const int + drf = drf_param == 0 ? 1 : drf_param, + navail = dtf/drf + 1, + nvel = std::min(nvel_param == -1 ? + (2 + (nsub-1)/2) : // default value + nvel_param, + std::min(nsub+1, // can't use more than this + navail)); // this is the max available + + _dtf = dtf; _drf = drf; _nsub = nsub; _nvel = nvel; + + // nsub <= 1: No substepping. + // nvel <= 2: Save velocity only at endpoints, as always occurs. + if (nsub <= 1 or nvel <= 2) { + _nvel = 2; + return; + } + + _t_vel.resize(nvel); + _obs_slots.resize(2*(dtf+1)); _obs_wts.resize(2*(dtf+1)); + _run_step.resize(nsub+1); + + // Times at which velocity data are available. + std::vector t_avail(navail); { + int i = 0; + for (int n = 0; n <= dtf; ++n) { + if (n % drf != 0) continue; + t_avail[i] = n; + i = i + 1; + } + assert(i == navail); + assert(t_avail[navail-1] == dtf); + } + + // Times to which we associate velocity data. + for (int n = 0; n < nvel; ++n) { + t_vel(n) = ((n*dtf) % (nvel-1) == 0 ? + /**/ (n*dtf) / (nvel-1) : + Real (n*dtf) / (nvel-1)); + assert(t_vel(n) >= 0 and t_vel(n) <= dtf); + assert(n == 0 or t_vel(n) > t_vel(n-1)); + } + + // Build the tables mapping n in 0:dtf-1 to velocity slots to accumulate into. + for (int n = 0; n <= dtf; ++n) { + for (int k = 0; k < 2; ++k) { + obs_slots(n,k) = -1; + obs_wts(n,k) = 0; + } + if (n == 0 or n == dtf) continue; + if (n % drf != 0) continue; + const int time = n; + int iav = -1; + for (int i = 1; i < navail-1; ++i) + if (time == t_avail[i]) { + iav = i; + break; + } + assert(iav > 0 and iav < navail-1); + for (int i = 1; i < nvel-1; ++i) { + if (t_avail[iav-1] < t_vel(i) and time > t_vel(i)) { + obs_slots(n,0) = i; + obs_wts(n,0) = ((t_vel(i) - t_avail[iav-1]) / + (t_avail[iav] - t_avail[iav-1])); + } + if (time <= t_vel(i) and t_avail[iav+1] > t_vel(i)) { + obs_slots(n,1) = i; + obs_wts(n,1) = ((t_avail[iav+1] - t_vel(i)) / + (t_avail[iav+1] - t_avail[iav])); + } + } + } + + // Build table mapping n to interval to use. The trajectories go backward in + // time, and this table reflects that. + run_step(0) = nvel-1; + run_step(nsub) = 1; + for (int n = 1; n < nsub; ++n) { + const auto time = Real((nsub-n)*dtf)/nsub; + int ifnd = -1; + for (int i = 0; i < nvel-1; ++i) + if (t_vel(i) <= time and time <= t_vel(i+1)) { + ifnd = i; + break; + } + assert(ifnd >= 0 and ifnd < nvel-1); + run_step(n) = ifnd + 1; + } +} + +// Public function. + +void ComposeTransportImpl::calc_enhanced_trajectory (const int np1, const Real dt) { + GPTLstart("compose_calc_enhanced_trajectory"); + + const auto& dep_pts = m_data.dep_pts; + const auto& vnode = m_data.vnode; + const auto& vdep = m_data.vdep; + + init_dep_points(*this, dep_pts); + + const int nelemd = m_data.nelemd; + const Real dtsub = dt / m_data.trajectory_nsubstep; + const int nsubstep = m_data.trajectory_nsubstep; + for (int step = 0; step < nsubstep; ++step) { + { + Kokkos::fence(); + GPTLstart("compose_vnode"); + const Real alpha[] = {Real(nsubstep-step-1)/nsubstep, + Real(nsubstep-step )/nsubstep}; + const CVSlot v1(m_derived.m_vstar.data(), nelemd, 1); + const CDpSlot dp1(m_derived.m_dp.data(), nelemd, 1); + const auto& v2 = m_state.m_v; + const auto& dp2 = m_state.m_dp3d; + calc_nodal_velocities(*this, dtsub, alpha, + v1, dp1, 0, v2, dp2, np1, + vnode); + Kokkos::fence(); + GPTLstop("compose_vnode"); + } + + GPTLstart("compose_v_bexchv"); + dss_vnode(*this, vnode); + Kokkos::fence(); + GPTLstop("compose_v_bexchv"); + + if (step == 0) { + update_dep_points(*this, dtsub, vnode, dep_pts); + } else { + GPTLstart("compose_vdep"); + homme::compose::calc_v_departure(step, dtsub); + Kokkos::fence(); + GPTLstop("compose_vdep"); + + update_dep_points(*this, dtsub, vdep, dep_pts); + } + } + Kokkos::fence(); + + if (m_data.independent_time_steps) { + GPTLstart("compose_floating_dep_pts"); + interp_departure_points_to_floating_level_midpoints(*this, np1); + Kokkos::fence(); + GPTLstop("compose_floating_dep_pts"); + } + + GPTLstop("compose_calc_enhanced_trajectory"); +} + +// Testing. + +namespace { // anon + +Kokkos::TeamPolicy +get_test_team_policy (const int nelem, const int nlev, const int ncol=NP*NP) { + ThreadPreferences tp; + tp.max_threads_usable = ncol; + tp.max_vectors_usable = nlev; + tp.prefer_threads = true; + tp.prefer_larger_team = true; + return Homme::get_default_team_policy(nelem, tp); +} + +struct TestData { + std::mt19937_64 engine; + static const Real eps; + const ComposeTransportImpl& cti; + + TestData (const CTI& cti_, const int seed = 0) + : cti(cti_), engine(seed == 0 ? std::random_device()() : seed) + {} + + Real urand (const Real lo = 0, const Real hi = 1) { + std::uniform_real_distribution urb(lo, hi); + return urb(engine); + } +}; + +// Data to deal with views of packs easily in tests. +struct ColData { + int npack; + ExecView d; + ExecView::HostMirror h; + ExecView::HostMirror r; + + ColData (const std::string& name, const int nlev) { + npack = calc_npack(nlev); + d = decltype(d)(name, npack); + h = Kokkos::create_mirror_view(d); + r = decltype(r)(cti::pack2real(h), calc_nscal(npack)); + } + + void h2d () { Kokkos::deep_copy(d, h); } +}; + +struct ElData { + int npack; + ExecView d; + ExecView::HostMirror h; + ExecView::HostMirror r; + + ElData (const std::string& name, const int nlev) { + npack = calc_npack(nlev); + d = decltype(d)(name, NP, NP, npack); + h = Kokkos::create_mirror_view(d); + r = decltype(r)(cti::pack2real(h), NP, NP, calc_nscal(npack)); + } + + void d2h () { Kokkos::deep_copy(h, d); } + void h2d () { Kokkos::deep_copy(d, h); } +}; + +const Real TestData::eps = std::numeric_limits::epsilon(); + +int test_find_support (TestData&) { + int ne = 0; + const int n = 97; + std::vector x(n); + for (int i = 0; i < n; ++i) x[i] = -11.7 + (i*i)/n; + const int ntest = 10000; + for (int i = 0; i < ntest; ++i) { + const Real xi = x[0] + (Real(i)/ntest)*(x[n-1] - x[0]); + for (int x_idx : {0, 1, n/3, n/2, n-2, n-1}) { + const int sup = find_support(n, x.data(), x_idx, xi); + if (sup > n-2) ++ne; + else if (xi < x[sup] or xi > x[sup+1]) ++ne; + } + } + return ne; +} + +void todev (const std::vector& h, const RnV& d) { + assert(h.size() <= d.size()); + const auto m = Kokkos::create_mirror_view(d); + for (size_t i = 0; i < h.size(); ++i) m(i) = h[i]; + Kokkos::deep_copy(d, m); +} + +void fillcols (const int n, const Real* const h, const RelnV::HostMirror& a) { + assert(n <= a.extent_int(2)); + for (int i = 0; i < a.extent_int(0); ++i) + for (int j = 0; j < a.extent_int(1); ++j) + for (size_t k = 0; k < n; ++k) + a(i,j,k) = h[k]; +} + +void todev (const int n, const Real* const h, const RelnV& d) { + const auto m = Kokkos::create_mirror_view(d); + fillcols(n, h, m) ; + Kokkos::deep_copy(d, m); +} + +void todev (const std::vector& h, const RelnV& d) { + todev(h.size(), h.data(), d); +} + +void tohost (const ExecView& d, std::vector& h) { + assert(h.size() <= d.size()); + const auto m = Kokkos::create_mirror_view(d); + Kokkos::deep_copy(m, d); + for (size_t i = 0; i < h.size(); ++i) h[i] = m(i); +} + +void run_linterp (const std::vector& x, const std::vector& y, + std::vector& xi, std::vector& yi) { + const auto n = x.size(), ni = xi.size(); + assert(y.size() == n); assert(yi.size() == ni); + // input -> device (test different sizes >= n) + ExecView xv("xv", n), yv("yv", n+1), xiv("xiv", ni+2), yiv("yiv", ni+3); + todev(x, xv); + todev(y, yv); + todev(xi, xiv); + // call linterp + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + const auto range = Kokkos::TeamVectorRange(team, ni); + linterp(range, n, xv, yv, ni, xiv, yiv, 0, "unittest"); + }; + Homme::ThreadPreferences tp; + tp.max_threads_usable = 1; + tp.max_vectors_usable = ni; + tp.prefer_threads = false; + tp.prefer_larger_team = true; + const auto policy = get_test_team_policy(1, n); + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + // output -> host + tohost(yiv, yi); +} + +void make_random_sorted (TestData& td, const int n, const Real xlo, const Real xhi, + std::vector& x) { + assert(n >= 2); + x.resize(n); + x[0] = xlo; + for (int i = 1; i < n-1; ++i) x[i] = td.urand(xlo, xhi); + x[n-1] = xhi; + std::sort(x.begin(), x.end()); +} + +int test_linterp (TestData& td) { + int nerr = 0; + { // xi == x => yi == y. + int ne = 0; + const int n = 30; + std::vector x(n), y(n), xi(n), yi(n); + make_random_sorted(td, n, -0.1, 1.2, x); + make_random_sorted(td, n, -3, -1, y); + for (int i = 0; i < n; ++i) xi[i] = x[i]; + run_linterp(x, y, xi, yi); + for (int i = 0; i < n; ++i) + if (yi[i] != y[i]) + ++ne; + nerr += ne; + } + { // Reconstruct a linear function exactly. + int ne = 0; + const int n = 56, ni = n-3; + const Real xlo = -1.2, xhi = 3.1; + const auto f = [&] (const Real x) { return -0.7 + 1.3*x; }; + std::vector x(n), y(n), xi(ni), yi(ni); + for (int trial = 0; trial < 4; ++trial) { + make_random_sorted(td, n, xlo, xhi, x); + make_random_sorted(td, ni, + xlo + (trial == 1 or trial == 3 ? 0.1 : 0), + xhi + (trial == 2 or trial == 3 ? -0.5 : 0), + xi); + for (int i = 0; i < n; ++i) y[i] = f(x[i]); + run_linterp(x, y, xi, yi); + for (int i = 0; i < ni; ++i) + if (std::abs(yi[i] - f(xi[i])) > 100*td.eps) + ++ne; + } + nerr += ne; + } + return nerr; +} + +int make_random_deta (TestData& td, const Real deta_tol, const int nlev, + Real* const deta) { + int nerr = 0; + Real sum = 0; + for (int k = 0; k < nlev; ++k) { + deta[k] = td.urand(0, 1) + 0.1; + sum += deta[k]; + } + for (int k = 0; k < nlev; ++k) { + deta[k] /= sum; + if (deta[k] < deta_tol) ++nerr; + } + return nerr; +} + +int make_random_deta (TestData& td, const Real deta_tol, const RnV& deta) { + int nerr = 0; + const int nlev = deta.extent_int(0); + const auto m = Kokkos::create_mirror_view(deta); + nerr = make_random_deta(td, deta_tol, nlev, &m(0)); + Kokkos::deep_copy(deta, m); + return nerr; +} + +int make_random_deta (TestData& td, const Real deta_tol, const RelnV& deta) { + int nerr = 0; + const int nlev = deta.extent_int(2); + const auto m = Kokkos::create_mirror_view(deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + nerr += make_random_deta(td, deta_tol, nlev, &m(i,j,0)); + Kokkos::deep_copy(deta, m); + return nerr; +} + +int test_deta_caas (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {15, 128, 161}) { + const Real deta_tol = 10*td.eps/nlev; + const auto err = [&] (const char* lbl) { + ++nerr; + printf("test_deta_caa nlev %d: %s\n", nlev, lbl); + }; + + // nlev+1 deltas: deta = diff([0, etam, 1]) + ExecView deta_ref("deta_ref", nlev+1); + ExecView deta("deta",NP,NP,nlev+1), wrk("wrk",NP,NP,nlev+1); + nerr += make_random_deta(td, deta_tol, deta_ref); + + const auto policy = get_test_team_policy(1, nlev); + const auto run = [&] (const RelnV& deta) { + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + deta_caas(kv, nlev+1, deta_ref, deta_tol, wrk, deta); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + }; + + { // Test that if all is OK, the input is not altered. + nerr += make_random_deta(td, deta_tol, deta); + ExecView::HostMirror copy("copy",NP,NP,nlev+1); + Kokkos::deep_copy(copy, deta); + run(deta); + const auto m = cti::cmvdc(deta); + bool diff = false; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k <= nlev; ++k) + if (m(i,j,k) != copy(i,j,k)) + diff = true; + if (diff) err("input not altered"); + } + + { // Modify one etam and test that only adjacent intervals change beyond eps. + // nlev midpoints + ExecView etam_ref("etam_ref",nlev); + const auto her = Kokkos::create_mirror_view(etam_ref); + const auto hder = cti::cmvdc(deta_ref); + { + her(0) = hder(0); + for (int k = 1; k < nlev; ++k) + her(k) = her(k-1) + hder(k); + Kokkos::deep_copy(etam_ref, her); + } + std::vector etam(nlev); + const auto hde = Kokkos::create_mirror_view(deta); + const auto get_idx = [&] (const int i, const int j) { + const int idx = static_cast(0.15*nlev); + return std::max(1, std::min(nlev-2, idx+NP*i+j)); + }; + for (int trial = 0; trial < 2; ++trial) { + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + for (int k = 0; k < nlev; ++k) etam[k] = her(k); + // Perturb one level. + const int idx = get_idx(i,j); + etam[idx] += trial == 0 ? 1.1 : -13.1; + hde(i,j,0) = etam[0]; + for (int k = 1; k < nlev; ++k) hde(i,j,k) = etam[k] - etam[k-1]; + hde(i,j,nlev) = 1 - etam[nlev-1]; + // Make sure we have a meaningful test. + Real minval = 1; + for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); + if (minval >= deta_tol) err("meaningful test"); + } + Kokkos::deep_copy(deta, hde); + run(deta); + Kokkos::deep_copy(hde, deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + const int idx = get_idx(i,j); + // Min val should be deta_tol. + Real minval = 1; + for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); + if (minval != deta_tol) err("min val"); + // Sum of levels should be 1. + Real sum = 0; + for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); + if (std::abs(sum - 1) > tol) err("sum 1"); + // Only two deltas should be affected. + Real maxdiff = 0; + for (int k = 0; k <= nlev; ++k) { + const auto diff = std::abs(hde(i,j,k) - hder(k)); + if (k == idx or k == idx+1) { + if (diff <= deta_tol) err("2 deltas a"); + } else { + maxdiff = std::max(maxdiff, diff); + } + } + if (maxdiff > tol) err("2 deltas b"); + } + } + } + + { // Test generally (and highly) perturbed levels. + const auto hde = Kokkos::create_mirror_view(deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + Real sum = 0; + for (int k = 0; k <= nlev; ++k) { + hde(i,j,k) = td.urand(-0.5, 0.5); + sum += hde(i,j,k); + } + // Make the column sum to 0.2 for safety in the next step. + const Real colsum = 0.2; + for (int k = 0; k <= nlev; ++k) hde(i,j,k) += (colsum - sum)/(nlev+1); + for (int k = 0; k <= nlev; ++k) hde(i,j,k) /= colsum; + sum = 0; + for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); + if (std::abs(sum - 1) > 10*tol) err("general sum 1"); + } + Kokkos::deep_copy(deta, hde); + run(deta); + Kokkos::deep_copy(hde, deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + Real sum = 0, minval = 1; + for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); + for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); + if (std::abs(sum - 1) > 1e3*td.eps) ++nerr; + if (minval != deta_tol) err("general minval"); + } + } + } + + return nerr; +} + +struct HybridLevels { + Real ps0, a_eta, b_eta; + std::vector ai, dai, bi, dbi, am, bm, etai, detai, etam, detam; +}; + +// Follow DCMIP2012 3D tracer transport specification for a, b, eta. +void fill (HybridLevels& h, const int n) { + h.ai.resize(n+1); h.bi.resize(n+1); + h.am.resize(n ); h.bm.resize(n ); + h.etai.resize(n+1); h.etam.resize(n); + + const auto Rd = PhysicalConstants::Rgas; + const auto T0 = 300; // K + const auto p0 = PhysicalConstants::p0; + const auto g = PhysicalConstants::g; + const Real ztop = 12e3; // m + + h.ps0 = p0; + + const auto calc_pressure = [&] (const Real z) { + return p0*std::exp(-g*z/(Rd*T0)); + }; + + const Real eta_top = calc_pressure(ztop)/p0; + assert(eta_top > 0); + for (int i = 0; i <= n; ++i) { + const auto z = (Real(n - i)/n)*ztop; + h.etai[i] = calc_pressure(z)/p0; + h.bi[i] = i == 0 ? 0 : (h.etai[i] - eta_top)/(1 - eta_top); + h.ai[i] = h.etai[i] - h.bi[i]; + assert(i == 0 or h.etai[i] > h.etai[i-1]); + } + assert(h.bi [0] == 0); // Real(n - i)/n is exactly 1, so exact = holds + assert(h.bi [n] == 1); // exp(0) is exactly 0, so exact = holds + assert(h.etai[n] == 1); // same + // b = (eta - eta_top)/(1 - eta_top) => b_eta = 1/(1 - eta_top) + // a = eta - b => a_eta = 1 - b_eta = -eta_top/(1 - eta_top) + // p_eta = a_eta p0 + b_eta ps + h.b_eta = 1/(1 - eta_top); + h.a_eta = 1 - h.b_eta; + + const auto tomid = [&] (const std::vector& in, std::vector& mi) { + for (int i = 0; i < n; ++i) mi[i] = (in[i] + in[i+1])/2; + }; + tomid(h.ai, h.am); + tomid(h.bi, h.bm); + tomid(h.etai, h.etam); + + const auto diff = [&] (const std::vector& ai, std::vector& dai) { + dai.resize(n); + for (int i = 0; i < n; ++i) dai[i] = ai[i+1] - ai[i]; + }; + diff(h.ai, h.dai); + diff(h.bi, h.dbi); + diff(h.etai, h.detai); + + h.detam.resize(n+1); + h.detam[0] = h.etam[0] - h.etai[0]; + for (int i = 1; i < n; ++i) h.detam[i] = h.etam[i] - h.etam[i-1]; + h.detam[n] = h.etai[n] - h.etam[n-1]; +} + +int test_limit_etam (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {143, 128, 81}) { + const Real deta_tol = 1e5*td.eps/nlev; + + ExecView hy_etai("hy_etai",nlev+1), detam("detam",nlev+1); + ExecView wrk1("wrk1",NP,NP,nlev+1), wrk2("wrk2",NP,NP,nlev+1); + ExecView etam("etam",NP,NP,nlev); + + HybridLevels h; + fill(h, nlev); + todev(h.etai, hy_etai); + todev(h.detam, detam); + + const auto he = Kokkos::create_mirror_view(etam); + + const auto policy = get_test_team_policy(1, nlev); + const auto run = [&] () { + Kokkos::deep_copy(etam, he); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + limit_etam(kv, nlev, hy_etai, detam, deta_tol, wrk1, wrk2, etam); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + Kokkos::deep_copy(he, etam); + }; + + fillcols(h.etam.size(), h.etam.data(), he); + // Col 0 should be untouched. Cols 1 and 2 should have very specific changes. + const int col1_idx = static_cast(0.25*nlev); + he(0,1,col1_idx) += 0.3; + const int col2_idx = static_cast(0.8*nlev); + he(0,2,col2_idx) -= 5.3; + // The rest of the columns get wild changes. + for (int idx = 3; idx < NP*NP; ++idx) { + const int i = idx / NP, j = idx % NP; + for (int k = 0; k < nlev; ++k) + he(i,j,k) += td.urand(-1, 1)*(h.etai[k+1] - h.etai[k]); + } + run(); + bool ok = true; + for (int k = 0; k < nlev; ++k) + if (he(0,0,k) != h.etam[k]) ok = false; + for (int k = 0; k < nlev; ++k) { + if (k == col1_idx) continue; + if (std::abs(he(0,1,k) - h.etam[k]) > tol) ok = false; + } + for (int k = 0; k < nlev; ++k) { + if (k == col2_idx) continue; + if (std::abs(he(0,2,k) - h.etam[k]) > tol) ok = false; + } + Real mingap = 1; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + mingap = std::min(mingap, he(i,j,0) - h.etai[0]); + for (int k = 1; k < nlev; ++k) + mingap = std::min(mingap, he(i,j,k) - he(i,j,k-1)); + mingap = std::min(mingap, h.etai[nlev] - he(i,j,nlev-1)); + } + // Test minimum level delta, with room for numerical error. + if (mingap < 0.8*deta_tol) ok = false; + if (not ok) ++nerr; + } + + return nerr; +} + +int test_eta_interp (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {15, 128, 161}) { + HybridLevels h; + fill(h, nlev); + + ExecView hy_etai("hy_etai",nlev+1); + ExecView x("x",NP,NP,nlev), y("y",NP,NP,nlev); + ExecView xi("xi",NP,NP,nlev+1), yi("yi",NP,NP,nlev+1); + ExecView xwrk("xwrk",NP,NP,nlev+2), ywrk("ywrk",NP,NP,nlev+2); + + todev(h.etai, hy_etai); + + const auto xh = Kokkos::create_mirror_view(x ); + const auto yh = Kokkos::create_mirror_view(y ); + const auto xih = Kokkos::create_mirror_view(xi); + const auto yih = Kokkos::create_mirror_view(yi); + + const auto policy = get_test_team_policy(1, nlev); + const auto run_eta = [&] (const int ni) { + Kokkos::deep_copy(x, xh); Kokkos::deep_copy(y, yh); + Kokkos::deep_copy(xi, xih); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + eta_interp_eta(kv, nlev, hy_etai, + x, getcolc(y,0,0), + xwrk, getcol(ywrk,0,0), + ni, getcolc(xi,0,0), yi); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + Kokkos::deep_copy(yih, yi); + }; + const auto run_horiz = [&] () { + Kokkos::deep_copy(x, xh); Kokkos::deep_copy(y, yh); + Kokkos::deep_copy(xi, xih); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + eta_interp_horiz(kv, nlev, hy_etai, + getcolc(x,0,0), y, + getcol(xwrk,0,0), ywrk, + xi, yi); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + Kokkos::deep_copy(yih, yi); + }; + + std::vector v; + const Real d = 1e-6, vlo = h.etai[0]+d, vhi = h.etai[nlev]-d; + + for (const int ni : {int(0.7*nlev), nlev-1, nlev, nlev+1}) { + make_random_sorted(td, nlev, vlo, vhi, v); + fillcols(nlev, v.data(), xh); + fillcols(nlev, v.data(), yh); + make_random_sorted(td, ni, vlo, vhi, v); + fillcols(ni, v.data(), xih); + run_eta(ni); + bool ok = true; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < ni; ++k) + if (std::abs(yih(i,j,k) - xih(i,j,k)) > tol) + ok = false; + if (not ok) ++nerr; + } + + { // Test exact interp of line in the interior, const interp near the bdys. + make_random_sorted(td, nlev, vlo+0.05, vhi-0.1, v); + fillcols(nlev, v.data(), xh); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + for (int k = 0; k < nlev; ++k) + yh(i,j,k) = i*xh(0,0,k) - j; + make_random_sorted(td, nlev, vlo, vhi, v); + for (int k = 0; k < nlev; ++k) + xih(i,j,k) = v[k]; + } + run_horiz(); + bool ok = true; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) { + if (xih(i,j,k) < xh(0,0,0)) { + if (std::abs(yih(i,j,k) - yih(i,j,0)) > tol) + ok = false; + } else if (xih(i,j,k) > xh(0,0,nlev-1)) { + if (std::abs(yih(i,j,k) - yih(i,j,nlev-1)) > tol) + ok = false; + } else { + if (std::abs(yih(i,j,k) - (i*xih(i,j,k) - j)) > tol) + ok = false; + } + } + if (not ok) ++nerr; + } + } + + return nerr; +} + +int test_eta_to_dp (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {143, 128, 81}) { + const auto err = [&] (const char* lbl) { + ++nerr; + printf("test_eta_to_dp nlev %d: %s\n", nlev, lbl); + }; + + HybridLevels h; + fill(h, nlev); + + ExecView hy_bi("hy_bi",nlev+1), hy_etai("hy_etai",nlev+1); + ExecView etai("etai",NP,NP,nlev+1), wrk("wrk",NP,NP,nlev+1); + ExecView dp("dp",NP,NP,nlev); + ExecView ps("ps"); + const Real hy_ps0 = h.ps0; + + todev(h.bi, hy_bi); + todev(h.etai, hy_etai); + + const auto psm = Kokkos::create_mirror_view(ps); + HostView dp1("dp1",NP,NP,nlev); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + psm(i,j) = (1 + 0.1*td.urand(-1, 1))*h.ps0; + Kokkos::deep_copy(ps, psm); + + const auto policy = get_test_team_policy(1, nlev); + const auto run = [&] () { + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + eta_to_dp(kv, nlev, hy_ps0, hy_bi, hy_etai, ps, etai, wrk, dp); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + }; + + { // Test that for etai_ref we get the same as the usual formula. + todev(h.etai, etai); + HostView dp1("dp1",NP,NP,nlev); + Real dp1_max = 0; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) { + dp1(i,j,k) = ((h.ai[k+1] - h.ai[k])*h.ps0 + + (h.bi[k+1] - h.bi[k])*psm(i,j)); + dp1_max = std::max(dp1_max, std::abs(dp1(i,j,k))); + } + run(); + const auto dph = cti::cmvdc(dp); + Real err_max = 0; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) + err_max = std::max(err_max, std::abs(dph(i,j,k) - dp1(i,j,k))); + if (err_max > tol*dp1_max) err("t1"); + } + + { // Test that sum(dp) = ps for random input etai. + std::vector etai_r; + make_random_sorted(td, nlev+1, h.etai[0], h.etai[nlev], etai_r); + todev(etai_r, etai); + run(); + const auto dph1 = cti::cmvdc(dp); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + Real ps = h.ai[0]*h.ps0; + for (int k = 0; k < nlev; ++k) + ps += dph1(i,j,k); + if (std::abs(ps - psm(i,j)) > tol*psm(i,j)) err("t2"); + } + // Test that values on input don't affect solution. + Kokkos::deep_copy(wrk, 0); + Kokkos::deep_copy(dp, 0); + run(); + const auto dph2 = cti::cmvdc(dp); + bool alleq = true; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) + if (dph2(i,j,k) != dph1(i,j,k)) + alleq = false; + if (not alleq) err("t3"); + } + } + + return nerr; +} + +int test_calc_ps (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {15, 128, 161}) { + HybridLevels h; + fill(h, nlev); + const auto ps0 = h.ps0, hyai0 = h.ai[0]; + + ElData dp1("dp1", nlev), dp2("dp2", nlev); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) { + dp1.r(i,j,k) = td.urand(0, 1000); + dp2.r(i,j,k) = td.urand(0, 1000); + } + dp1.h2d(); + dp2.h2d(); + + const Real alpha[] = {td.urand(0,1), td.urand(0,1)}; + + ExecView ps("ps"); + ExecView ps2("ps2"); + const auto policy = get_test_team_policy(1, nlev); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + calc_ps(kv, nlev, ps0, hyai0, alpha, dp1.d, dp2.d, ps2); + calc_ps(kv, nlev, ps0, hyai0, dp1.d, ps); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + + const auto ps_h = cti::cmvdc(ps); + const auto ps2_h = cti::cmvdc(ps2); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + { + Real ps = h.ai[0]*h.ps0; + for (int k = 0; k < nlev; ++k) + ps += dp1.r(i,j,k); + if (std::abs(ps_h(i,j) - ps) > tol*ps) ++nerr; + } + for (int t = 0; t < 2; ++t) { + Real ps = h.ai[0]*h.ps0; + for (int k = 0; k < nlev; ++k) + ps += (1 - alpha[t])*dp1.r(i,j,k) + alpha[t]*dp2.r(i,j,k); + if (std::abs(ps2_h(t,i,j) - ps) > tol*ps) ++nerr; + } + } + } + + return nerr; +} + +int test_calc_etadotmid_from_etadotdpdnint (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {143, 128, 81}) { + HybridLevels h; + fill(h, nlev); + + // Test function: + // eta_dot_dpdn(eta) = c eta + d. + // Then + // eta_dot = eta_dot_dpdn(eta)/dpdn(eta) + // = (c eta + d)/(a_eta p0 + b_eta ps). + // Since a_eta, b_eta are constants independent of eta in this test, eta_dot + // is then also a linear function of eta. Thus, we can test for exact + // agreement with the true solution. + + ColData hydai("hydai",nlev), hydbi("hydbi",nlev), hydetai("hydetai",nlev); + ElData wrk("wrk",nlev+1), ed("ed",nlev+1); + ExecView ps("ps"); + const Real ps0 = h.ps0; + + const auto ps_m = Kokkos::create_mirror_view(ps); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + ps_m(i,j) = td.urand(0.5, 1.2)*ps0; + for (int k = 0; k < nlev; ++k) { + hydai.r[k] = h.dai[k]; + hydbi.r[k] = h.dbi[k]; + hydetai.r[k] = h.detai[k]; + } + for (int k = 0; k <= nlev; ++k) + ed.r(i,j,k) = (i-j)*h.etai[k] + 0.3; + } + Kokkos::deep_copy(ps, ps_m); + hydai.h2d(); hydbi.h2d(); hydetai.h2d(); + ed.h2d(); + + const auto policy = get_test_team_policy(1, nlev); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + calc_etadotmid_from_etadotdpdnint( + kv, nlev, ps0, hydai.d, hydbi.d, hydetai.d, ps, wrk.d, ed.d); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + ed.d2h(); + + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + const auto den = h.a_eta*h.ps0 + h.b_eta*ps_m(i,j); + for (int k = 0; k < nlev; ++k) { + const auto ed_true = ((i-j)*h.etam[k] + 0.3)/den; + if (std::abs(ed.r(i,j,k) - ed_true) > tol*(10/den)) ++nerr; + } + } + } + + return nerr; +} + +int test_calc_eta_dot_ref_mid (TestData& td) { + int nerr = 0; + + // calc_eta_dot_ref_mid calls several routines that are all tested + // mathematically. calc_eta_dot_ref_mid itself is too complicated to test + // mathematically. But we can still test it for s/w properties like + // determinism. + + //todo + + return nerr; +} + +int test_interp_departure_points_to_floating_level_midpoints (TestData& td) { + int nerr = 0; + //todo test case of ed = 0 + return nerr; +} + +static int test1_init_velocity_record ( + const int dtf, const int drf, const int nsub, const int nvel) +{ + const auto eps = std::numeric_limits::epsilon(); + int e = 0; + + if (dtf % drf != 0) { + printf("Testing erro: dtf %% drf == 0 is required: %d %d\n", dtf, drf); + ++e; + } + + const CTI::VelocityRecord v(dtf, drf, nsub, nvel); + if (v.dtf() != dtf) ++e; + if (v.nsub() != nsub) ++e; + + // Check that t_vel is monotonically increasing. + for (int n = 1; n < v.nvel(); ++n) + if (v.t_vel(n) <= v.t_vel(n-1)) + ++e; + + // Check that obs_slots does not reference end points. This should not happen + // b/c nvel <= navail and observations are uniformly spaced. + for (int n = 0; n < dtf; ++n) + for (int i = 0; i < 2; ++i) + if (v.obs_slots(n,i) == 0 or v.obs_slots(n,i) == dtf) + ++e; + + // Check that weights sum to 1. + std::vector ys(dtf); + for (int n = 0; n < dtf; ++n) + for (int i = 0; i < 2; ++i) + if (v.obs_slots(n,i) >= 0) + ys[v.obs_slots(n,i)] += v.obs_wts(n,i); + for (int i = 1; i < v.nvel()-1; ++i) + if (std::abs(ys[i] - 1) > 1e3*eps) + ++e; + + // Test for exact interp of an affine function. + const auto tfn = [] (const Real x) { return 7.1*x - 11.5; }; + // Observe data forward in time. + Real endslots[2]; + endslots[0] = tfn(0); + endslots[1] = tfn(dtf); + ys[0] = -1000; // unused + for (int i = 1; i < dtf; ++i) ys[i] = 0; + for (int n = 1; n < dtf; ++n) { + if (n % drf != 0) continue; + const Real y = tfn(n); + for (int i = 0; i < 2; ++i) { + if (v.obs_slots(n,i) < 0) continue; + ys[v.obs_slots(n,i)] += v.obs_wts(n,i)*y; + } + } + // Use the data backward in time. + for (int n = 0; n < nsub; ++n) { + // Each segment orders the data forward in time. Thus, data are always + // ordered forward in time but used backward. + Real xsup[2], ysup[2]; + for (int i = 0; i < 2; ++i) { + int k = nsub - (n+1) + i; + xsup[i] = (k*v.t_vel(v.nvel()-1))/nsub; + k = v.run_step(nsub-i); + const Real + y0 = k == 1 ? endslots[0] : ys[k-1], + y1 = k == v.nvel()-1 ? endslots[2] : ys[k]; + ysup[i] = (((v.t_vel(k) - xsup[i])*y0 + (xsup[i] - v.t_vel(k-1))*y1) / + (v.t_vel(k) - v.t_vel(k-1))); + } + for (int i = 0; i <= 10; ++i) { + const Real + a = Real(i)/10, + x = (1-a)*xsup[0] + a*xsup[1], + y = (1-a)*ysup[0] + a*ysup[1]; + if (std::abs(y - tfn(x)) > 1e3*eps) { + printf("n %d i %2d x %7.3f y %7.3f t %7.3f\n", n, i, x, y, tfn(x)); + ++e; + } + } + } + + if (e) { + printf("ERROR e %d\n", e); + printf("dtf %d drf %d nsub %d nvel %d v.nvel %d\n", + dtf, drf, nsub, nvel, v.nvel()); + printf(" t_vel:"); + for (int i = 0; i < v.nvel(); ++i) printf(" %1.3f", v.t_vel(i)); + printf("\n obs:\n"); + for (int n = 0; n <= dtf; ++n) + printf(" %2d %2d %2d %1.3f %1.3f\n", + n, v.obs_slots(n,0), v.obs_slots(n,1), v.obs_wts(n,0), + v.obs_wts(n,1)); + printf(" run_step:\n"); + for (int n = 0; n <= nsub; ++n) printf(" %2d %2d\n", n, v.run_step(n)); + } + + return e; +} + +int test_init_velocity_record (TestData& td) { + int dtf, drf, nsub, nvel, nerr; + + nerr = 0; + + const auto f = [&] () { + const int e = test1_init_velocity_record(dtf, drf, nsub, nvel); + if (e > 0) ++nerr; + }; + + nerr = 0; + dtf = 6; + drf = 2; + nsub = 3; + nvel = 4; + f(); + nvel = 3; + f(); + drf = 3; + nvel = 6; + f(); + drf = 1; + nsub = 5; + f(); + dtf = 12; + drf = 2; + nsub = 3; + nvel = -1; + f(); + nsub = 5; + nvel = 5; + f(); + dtf = 27; + drf = 3; + nsub = 51; + nvel = 99; + f(); + + return nerr; +} + +} // namespace anon + +#define comunittest(f) do { \ + ne = f(td); \ + if (ne) printf(#f " ne %d\n", ne); \ + nerr += ne; \ + } while (0) + +int ComposeTransportImpl::run_enhanced_trajectory_unit_tests () { + int nerr = 0, ne; + TestData td(*this); + comunittest(test_find_support); + comunittest(test_linterp); + comunittest(test_eta_interp); + comunittest(test_eta_to_dp); + comunittest(test_deta_caas); + comunittest(test_limit_etam); + comunittest(test_calc_ps); + comunittest(test_calc_etadotmid_from_etadotdpdnint); + comunittest(test_calc_eta_dot_ref_mid); + comunittest(test_interp_departure_points_to_floating_level_midpoints); + comunittest(test_init_velocity_record); + return nerr; +} + +#undef comunittest + +} // namespace Homme + +#endif // HOMME_ENABLE_COMPOSE diff --git a/components/homme/src/share/cxx/ComposeTransportImplGeneral.cpp b/components/homme/src/share/cxx/ComposeTransportImplGeneral.cpp index ad62ca3904f..bbffbeb8e48 100644 --- a/components/homme/src/share/cxx/ComposeTransportImplGeneral.cpp +++ b/components/homme/src/share/cxx/ComposeTransportImplGeneral.cpp @@ -12,7 +12,8 @@ extern "C" void sl_get_params(double* nu_q, double* hv_scaling, int* hv_q, int* hv_subcycle_q, - int* limiter_option, int* cdr_check, int* geometry_type); + int* limiter_option, int* cdr_check, int* geometry_type, + int* trajectory_nsubstep); namespace Homme { @@ -46,6 +47,8 @@ void ComposeTransportImpl::setup () { m_sphere_ops = Context::singleton().get(); set_dp_tol(); + setup_enhanced_trajectory(); + nslot = calc_nslot(m_geometry.num_elems()); } @@ -53,6 +56,11 @@ void ComposeTransportImpl::reset (const SimulationParams& params) { const auto num_elems = Context::singleton().get().get_num_local_elements(); const bool independent_time_steps = params.dt_tracer_factor > params.dt_remap_factor; + + sl_get_params(&m_data.nu_q, &m_data.hv_scaling, &m_data.hv_q, &m_data.hv_subcycle_q, + &m_data.limiter_option, &m_data.cdr_check, &m_data.geometry_type, + &m_data.trajectory_nsubstep); + if (independent_time_steps != m_data.independent_time_steps || m_data.nelemd != num_elems || m_data.qsize != params.qsize) { const auto& g = m_geometry; @@ -61,7 +69,14 @@ void ComposeTransportImpl::reset (const SimulationParams& params) { const auto& d = m_derived; const auto nel = num_elems; const auto nlev = NUM_LEV*packn; - m_data.dep_pts = DeparturePoints("dep_pts", nel); + const int ndim = (m_data.trajectory_nsubstep == 0 ? + 3 : + (independent_time_steps ? 4 : 3)); + m_data.dep_pts = DeparturePoints("dep_pts", nel, num_phys_lev, np, np, ndim); + if (m_data.trajectory_nsubstep > 0) + m_data.vnode = DeparturePoints("vnode", nel, num_phys_lev, np, np, ndim); + if (m_data.trajectory_nsubstep > 1) + m_data.vdep = DeparturePoints("vdep" , nel, num_phys_lev, np, np, ndim); homme::compose::set_views( g.m_spheremp, homme::compose::SetView (reinterpret_cast(d.m_dp.data()), @@ -76,8 +91,9 @@ void ComposeTransportImpl::reset (const SimulationParams& params) { nel, t.qdp.extent_int(1), t.qdp.extent_int(2), np, np, nlev), homme::compose::SetView (reinterpret_cast(t.Q.data()), nel, t.Q.extent_int(1), np, np, nlev), - m_data.dep_pts); + m_data.dep_pts, m_data.vnode, m_data.vdep, ndim); } + m_data.independent_time_steps = independent_time_steps; if (m_data.nelemd == num_elems && m_data.qsize == params.qsize) return; @@ -86,8 +102,6 @@ void ComposeTransportImpl::reset (const SimulationParams& params) { "SL transport requires qsize > 0; if qsize == 0, use Eulerian."); m_data.nelemd = num_elems; - sl_get_params(&m_data.nu_q, &m_data.hv_scaling, &m_data.hv_q, &m_data.hv_subcycle_q, - &m_data.limiter_option, &m_data.cdr_check, &m_data.geometry_type); Errors::runtime_check(m_data.hv_q >= 0 && m_data.hv_q <= m_data.qsize, "semi_lagrange_hv_q should be in [0, qsize]."); Errors::runtime_check(m_data.hv_subcycle_q >= 0, @@ -113,17 +127,18 @@ void ComposeTransportImpl::reset (const SimulationParams& params) { int ComposeTransportImpl::requested_buffer_size () const { // FunctorsBuffersManager wants the size in terms of sizeof(Real). - return (3*Buf1::shmem_size(nslot) + - 2*Buf2::shmem_size(nslot))/sizeof(Real); + return (m_data.n_buf1*Buf1Alloc::shmem_size(nslot) + + m_data.n_buf2*Buf2::shmem_size(nslot))/sizeof(Real); } void ComposeTransportImpl::init_buffers (const FunctorsBuffersManager& fbm) { Scalar* mem = reinterpret_cast(fbm.get_memory()); - for (int i = 0; i < 3; ++i) { - m_data.buf1[i] = Buf1(mem, nslot); - mem += Buf1::shmem_size(nslot)/sizeof(Scalar); + for (int i = 0; i < m_data.n_buf1; ++i) { + m_data.buf1o[i] = Buf1o(mem, nslot); + m_data.buf1e[i] = Buf1e(mem, nslot); // use the same memory + mem += Buf1Alloc::shmem_size(nslot)/sizeof(Scalar); } - for (int i = 0; i < 2; ++i) { + for (int i = 0; i < m_data.n_buf2; ++i) { m_data.buf2[i] = Buf2(mem, nslot); mem += Buf2::shmem_size(nslot)/sizeof(Scalar); } @@ -148,16 +163,29 @@ void ComposeTransportImpl::init_boundary_exchanges () { be->registration_completed(); } - for (int i = 0; i < 2; ++i) { - m_v_dss_be[i] = std::make_shared(); - auto be = m_v_dss_be[i]; - be->set_label(std::string("ComposeTransport-v-DSS-" + std::to_string(i))); - be->set_diagnostics_level(sp.internal_diagnostics_level); - be->set_buffers_manager(bm_exchange); - be->set_num_fields(0, 0, 2 + (i ? 1 : 0)); - be->register_field(m_derived.m_vstar, 2, 0); - if (i) be->register_field(m_derived.m_divdp); - be->registration_completed(); + if (m_data.trajectory_nsubstep == 0) { + for (int i = 0; i < 2; ++i) { + m_v_dss_be[i] = std::make_shared(); + auto be = m_v_dss_be[i]; + be->set_label(std::string("ComposeTransport-v-DSS-" + std::to_string(i))); + be->set_diagnostics_level(sp.internal_diagnostics_level); + be->set_buffers_manager(bm_exchange); + be->set_num_fields(0, 0, 2+i); + be->register_field(m_derived.m_vstar, 2, 0); + if (i) be->register_field(m_derived.m_divdp); + be->registration_completed(); + } + } else { + for (int i = 0; i < 2; ++i) { + m_v_dss_be[i] = std::make_shared(); + auto be = m_v_dss_be[i]; + be->set_label(std::string("ComposeTransport-v-DSS-" + std::to_string(i))); + be->set_diagnostics_level(sp.internal_diagnostics_level); + be->set_buffers_manager(bm_exchange); + be->set_num_fields(0, 0, 3+i); + be->register_field(m_tracers.qtens_biharmonic, 3+i, 0); + be->registration_completed(); + } } // For optional HV applied to q. @@ -181,10 +209,14 @@ void ComposeTransportImpl::init_boundary_exchanges () { void ComposeTransportImpl::run (const TimeLevel& tl, const Real dt) { GPTLstart("compose_transport"); - calc_trajectory(tl.np1, dt); + if (m_data.trajectory_nsubstep == 0) + calc_trajectory(tl.np1, dt); + else + calc_enhanced_trajectory(tl.np1, dt); GPTLstart("compose_isl"); homme::compose::advect(tl.np1, tl.n0_qdp, tl.np1_qdp); + Kokkos::fence(); GPTLstop("compose_isl"); if (m_data.hv_q > 0 && m_data.nu_q > 0) { diff --git a/components/homme/src/share/cxx/ComposeTransportImplTrajectory.cpp b/components/homme/src/share/cxx/ComposeTransportImplTrajectory.cpp index aa91c752a7c..197ec7528a4 100644 --- a/components/homme/src/share/cxx/ComposeTransportImplTrajectory.cpp +++ b/components/homme/src/share/cxx/ComposeTransportImplTrajectory.cpp @@ -14,75 +14,19 @@ namespace Homme { using cti = ComposeTransportImpl; - -KOKKOS_FUNCTION -static void ugradv_sphere ( - const SphereOperators& sphere_ops, const KernelVariables& kv, - const typename ViewConst >::type& vec_sphere2cart, - // velocity, latlon - const typename ViewConst >::type& u, - const typename ViewConst >::type& v, - const ExecViewUnmanaged& v_cart, - const ExecViewUnmanaged& ugradv_cart, - // [u dot grad] v, latlon - const ExecViewUnmanaged& ugradv) -{ - for (int d_cart = 0; d_cart < 3; ++d_cart) { - const auto f1 = [&] (const int i, const int j, const int k) { - v_cart(i,j,k) = (vec_sphere2cart(0,d_cart,i,j) * v(0,i,j,k) + - vec_sphere2cart(1,d_cart,i,j) * v(1,i,j,k)); - }; - cti::loop_ijk(kv, f1); - kv.team_barrier(); - - sphere_ops.gradient_sphere(kv, v_cart, ugradv_cart); - - const auto f2 = [&] (const int i, const int j, const int k) { - if (d_cart == 0) ugradv(0,i,j,k) = ugradv(1,i,j,k) = 0; - for (int d_latlon = 0; d_latlon < 2; ++d_latlon) - ugradv(d_latlon,i,j,k) += - vec_sphere2cart(d_latlon,d_cart,i,j)* - (u(0,i,j,k) * ugradv_cart(0,i,j,k) + u(1,i,j,k) * ugradv_cart(1,i,j,k)); - }; - cti::loop_ijk(kv, f2); - } -} - -typedef typename ViewConst >::type CSNlev; -typedef typename ViewConst >::type CRNlev; -typedef typename ViewConst >::type CSNlevp; -typedef typename ViewConst >::type CRNlevp; -typedef typename ViewConst >::type CS2Nlev; -typedef ExecViewUnmanaged SNlev; -typedef ExecViewUnmanaged RNlev; -typedef ExecViewUnmanaged SNlevp; -typedef ExecViewUnmanaged RNlevp; -typedef ExecViewUnmanaged S2Nlev; -typedef ExecViewUnmanaged R2Nlev; -typedef ExecViewUnmanaged S2Nlevp; - -/* Form a 3rd-degree Lagrange polynomial over (x(k-1:k+1), y(k-1:k+1)) and set - yi(k) to its derivative at x(k). yps(:,:,0) is not written. - */ -KOKKOS_FUNCTION static void approx_derivative ( - const KernelVariables& kv, const CSNlevp& xs, const CSNlevp& ys, - const SNlev& yps) // yps(:,:,0) is undefined -{ - CRNlevp x(cti::cpack2real(xs)); - CRNlevp y(cti::cpack2real(ys)); - RNlev yp(cti::pack2real(yps)); - const auto f = [&] (const int i, const int j, const int k) { - if (k == 0) return; - const auto& xkm1 = x(i,j,k-1); - const auto& xk = x(i,j,k ); // also the interpolation point - const auto& xkp1 = x(i,j,k+1); - yp(i,j,k) = (y(i,j,k-1)*(( 1 /(xkm1 - xk ))*((xk - xkp1)/(xkm1 - xkp1))) + - y(i,j,k )*(( 1 /(xk - xkm1))*((xk - xkp1)/(xk - xkp1)) + - ((xk - xkm1)/(xk - xkm1))*( 1 /(xk - xkp1))) + - y(i,j,k+1)*(((xk - xkm1)/(xkp1 - xkm1))*( 1 /(xkp1 - xk )))); - }; - cti::loop_ijk(kv, f); -} +using CSNlev = cti::CSNlev; +using CRNlev = cti::CRNlev; +using CSNlevp = cti::CSNlevp; +using CRNlevp = cti::CRNlevp; +using CS2Nlev = cti::CS2Nlev; +using CR2Nlev = cti::CR2Nlev; +using SNlev = cti::SNlev; +using RNlev = cti::RNlev; +using SNlevp = cti::SNlevp; +using RNlevp = cti::RNlevp; +using S2Nlev = cti::S2Nlev; +using R2Nlev = cti::R2Nlev; +using S2Nlevp = cti::S2Nlevp; // Pad by an amount ~ smallest level to keep the computed dp > 0. void ComposeTransportImpl::set_dp_tol () { @@ -234,31 +178,11 @@ KOKKOS_FUNCTION static void calc_vertically_lagrangian_levels ( }; cti::loop_ijk(kv, f); } - + kv.team_barrier(); sphere_ops.divergence_sphere(kv, vdp, divdp); - + kv.team_barrier(); RNlevp edds(cti::pack2real(edd)), divdps(cti::pack2real(divdp)); - const auto f = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto r = [&] (const int k, Real& dps, const bool final) { - assert(k != 0 || dps == 0); - if (final) edds(i,j,k) = dps; - dps += divdps(i,j,k); - }; - Dispatch<>::parallel_scan(kv.team, cti::num_phys_lev, r); - const int kend = cti::num_phys_lev - 1; - const Real dps = edds(i,j,kend) + divdps(i,j,kend); - assert(hybrid_bi(0)[0] == 0); - const auto s = [&] (const int kp) { - edd(i,j,kp) = hybrid_bi(kp)*dps - edd(i,j,kp); - if (kp == 0) edd(i,j,kp)[0] = 0; - }; - parallel_for(tvr, s); - assert(edds(i,j,0) == 0); - const int bottom = cti::num_phys_lev; - edds(i,j,bottom) = 0; - }; - parallel_for(ttr, f); + cti::calc_eta_dot_dpdn(kv, hybrid_bi, divdps, edd, edds); } // Use p0 as the reference coordinate system. p0 differs from p1 by B(eta) @@ -278,11 +202,11 @@ KOKKOS_FUNCTION static void calc_vertically_lagrangian_levels ( // Gradient of eta_dot_dpdn = p_eta deta/dt at final time w.r.t. p at initial // time. const auto& ptp0 = dprecon; - approx_derivative(kv, pref, *eta_dot_dpdn[1], ptp0); + cti::approx_derivative(kv, pref, *eta_dot_dpdn[1], ptp0); { const auto& edd = *eta_dot_dpdn[0]; - const R2Nlev vstars(cti::pack2real(vstar)); + const CR2Nlev vstars(cti::cpack2real(vstar)); const auto f_v = [&] (const int i, const int j, const int kp) { // Horizontal velocity at initial time. Scalar v[2]; @@ -353,9 +277,9 @@ void ComposeTransportImpl::calc_trajectory (const int np1, const Real dt) { const auto m_vstar = m_derived.m_vstar; const auto tu_ne = m_tu_ne; { // Calculate midpoint velocity. - const auto buf1a = m_data.buf1[0]; const auto buf1b = m_data.buf1[1]; - const auto buf1c = m_data.buf1[2]; const auto buf2a = m_data.buf2[0]; - const auto buf2b = m_data.buf2[1]; + const auto buf1a = m_data.buf1o[0]; const auto buf1b = m_data.buf1o[1]; + const auto buf1c = m_data.buf1o[2]; + const auto buf2a = m_data.buf2[0]; const auto buf2b = m_data.buf2[1]; const auto m_spheremp = geo.m_spheremp; const auto m_rspheremp = geo.m_rspheremp; const auto m_v = m_state.m_v; @@ -457,7 +381,7 @@ void ComposeTransportImpl::calc_trajectory (const int np1, const Real dt) { const auto vstar = Homme::subview(m_vstar, ie); const auto vec_sphere2cart = Homme::subview(m_vec_sph2cart, ie); const auto sphere_cart = Homme::subview(m_sphere_cart, ie); - const auto dep_pts = Homme::subview(m_dep_pts, ie); + const auto dep_pts = m_dep_pts; const auto f = [&] (const int i, const int j, const int k) { // dp = p1 - dt v/scale_factor Scalar dp[3]; @@ -476,7 +400,7 @@ void ComposeTransportImpl::calc_trajectory (const int np1, const Real dt) { // No vec call for sqrt. const auto r = is_sphere ? std::sqrt(r2[s]) : 1; for (int d = 0; d < 3; ++d) - dep_pts(oss,i,j,d) = dp[d][s]/r; + dep_pts(ie,oss,i,j,d) = dp[d][s]/r; } }; cti::loop_ijk(kv, f); @@ -511,7 +435,7 @@ static int test_approx_derivative () { { // Run approx_derivative. const auto f = KOKKOS_LAMBDA (const cti::MT& team) { KernelVariables kv(team); - approx_derivative(kv, xp, yp, yip); + cti::approx_derivative(kv, xp, yp, yip); }; Kokkos::fence(); Kokkos::parallel_for(policy, f); diff --git a/components/homme/src/share/cxx/GllFvRemapImpl.hpp b/components/homme/src/share/cxx/GllFvRemapImpl.hpp index 11738b2bf45..38899fcf499 100644 --- a/components/homme/src/share/cxx/GllFvRemapImpl.hpp +++ b/components/homme/src/share/cxx/GllFvRemapImpl.hpp @@ -39,7 +39,6 @@ struct GllFvRemapImpl { enum : int { num_lev_aligned = num_lev_pack*packn }; enum : int { num_levp_aligned = max_num_lev_pack*packn }; enum : int { num_phys_lev = NUM_PHYSICAL_LEV }; - enum : int { num_work = 12 }; typedef GllFvRemap::Phys1T Phys1T; typedef GllFvRemap::Phys2T Phys2T; diff --git a/components/homme/src/share/cxx/Tracers.cpp b/components/homme/src/share/cxx/Tracers.cpp index cac9b3b15d7..7d338229d51 100644 --- a/components/homme/src/share/cxx/Tracers.cpp +++ b/components/homme/src/share/cxx/Tracers.cpp @@ -32,7 +32,10 @@ void Tracers::init(const int num_elems, const int num_tracers) nt = num_tracers; qdp = decltype(qdp)("tracers mass", num_elems); - qtens_biharmonic = decltype(qtens_biharmonic)("qtens(_biharmonic)", num_elems); + // Also used in ComposeTransportImplEnhancedTrajectory for communication, + // where 4 slots are needed. + qtens_biharmonic = decltype(qtens_biharmonic)( + "qtens(_biharmonic)", num_elems, std::max(4, num_tracers)); qlim = decltype(qlim)("qlim", num_elems); Q = decltype(Q)("tracers concentration", num_elems,num_tracers); diff --git a/components/homme/src/share/cxx/Tracers.hpp b/components/homme/src/share/cxx/Tracers.hpp index 78f93c06a70..592350894ab 100644 --- a/components/homme/src/share/cxx/Tracers.hpp +++ b/components/homme/src/share/cxx/Tracers.hpp @@ -35,8 +35,8 @@ struct Tracers { bool inited () const { return m_inited; } ExecViewManaged qdp; - ExecViewManaged qtens_biharmonic; // Also doubles as just qtens. - ExecViewManaged qlim; + ExecViewManaged qtens_biharmonic; // Also doubles as just qtens. + ExecViewManaged qlim; ExecViewManaged Q; ExecViewManaged fq; diff --git a/components/homme/src/share/cxx/utilities/SubviewUtils.hpp b/components/homme/src/share/cxx/utilities/SubviewUtils.hpp index 76171a1432c..c78517a3b82 100644 --- a/components/homme/src/share/cxx/utilities/SubviewUtils.hpp +++ b/components/homme/src/share/cxx/utilities/SubviewUtils.hpp @@ -352,6 +352,21 @@ subview(ViewType +KOKKOS_INLINE_FUNCTION ViewUnmanaged +subview(ViewType v_in, + int ie, int idim0) { + assert(v_in.data() != nullptr); + assert(ie < v_in.extent_int(0)); + assert(ie >= 0); + assert(idim0 < v_in.extent_int(1)); + assert(idim0 >= 0); + return ViewUnmanaged( + &v_in.impl_map().reference(ie, idim0, 0, 0, 0, 0)); +} + // Force a subview to be const template KOKKOS_INLINE_FUNCTION diff --git a/components/homme/src/share/cxx/vector/vector_pragmas.hpp b/components/homme/src/share/cxx/vector/vector_pragmas.hpp index b23788a8ccf..fc58b819a29 100644 --- a/components/homme/src/share/cxx/vector/vector_pragmas.hpp +++ b/components/homme/src/share/cxx/vector/vector_pragmas.hpp @@ -7,11 +7,18 @@ #ifndef HOMMEXX_VECTOR_PRAGMAS_HPP #define HOMMEXX_VECTOR_PRAGMAS_HPP +#include "Config.hpp" + #if defined(__INTEL_COMPILER) || defined(__INTEL_CLANG_COMPILER) || defined(__INTEL_LLVM_COMPILER) #define VECTOR_IVDEP_LOOP _Pragma("ivdep") #define ALWAYS_VECTORIZE_LOOP _Pragma("vector always") #define VECTOR_SIMD_LOOP _Pragma("omp simd") +#if HOMMEXX_VECTOR_SIZE == 1 +# define VECTOR_SIMD_LOOP +#else +# define VECTOR_SIMD_LOOP _Pragma("omp simd") +#endif #elif defined(__GNUG__) && !defined(__NVCC__) #if(__GNUG__ == 4 && __GNUC_MINOR__ >= 9) || __GNUG__ > 4 diff --git a/components/homme/src/share/namelist_mod.F90 b/components/homme/src/share/namelist_mod.F90 index c8825b3e554..8f3eff70e3e 100644 --- a/components/homme/src/share/namelist_mod.F90 +++ b/components/homme/src/share/namelist_mod.F90 @@ -46,6 +46,10 @@ module namelist_mod semi_lagrange_cdr_check, & semi_lagrange_hv_q, & semi_lagrange_nearest_point_lev, & + semi_lagrange_halo, & + semi_lagrange_trajectory_nsubstep, & + semi_lagrange_trajectory_nvelocity, & + semi_lagrange_diagnostics, & tstep_type, & cubed_sphere_map, & qsplit, & @@ -272,6 +276,11 @@ subroutine readnl(par) semi_lagrange_cdr_check, & semi_lagrange_hv_q, & semi_lagrange_nearest_point_lev, & + semi_lagrange_halo, & + semi_lagrange_trajectory_nsubstep, & + semi_lagrange_trajectory_nvelocity, & + semi_lagrange_diagnostics, & + semi_lagrange_hv_q, & tstep_type, & cubed_sphere_map, & qsplit, & @@ -453,6 +462,10 @@ subroutine readnl(par) semi_lagrange_cdr_check = .false. semi_lagrange_hv_q = 1 semi_lagrange_nearest_point_lev = 256 + semi_lagrange_halo = 2 + semi_lagrange_trajectory_nsubstep = 0 + semi_lagrange_trajectory_nvelocity = -1 + semi_lagrange_diagnostics = 0 disable_diagnostics = .false. se_fv_phys_remap_alg = 1 internal_diagnostics_level = 0 @@ -863,6 +876,10 @@ subroutine readnl(par) call MPI_bcast(semi_lagrange_cdr_check ,1,MPIlogical_t,par%root,par%comm,ierr) call MPI_bcast(semi_lagrange_hv_q ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(semi_lagrange_nearest_point_lev ,1,MPIinteger_t,par%root,par%comm,ierr) + call MPI_bcast(semi_lagrange_halo ,1,MPIinteger_t,par%root,par%comm,ierr) + call MPI_bcast(semi_lagrange_trajectory_nsubstep ,1,MPIinteger_t,par%root,par%comm,ierr) + call MPI_bcast(semi_lagrange_trajectory_nvelocity ,1,MPIinteger_t,par%root,par%comm,ierr) + call MPI_bcast(semi_lagrange_diagnostics ,1,MPIinteger_t,par%root,par%comm,ierr) call MPI_bcast(tstep_type,1,MPIinteger_t ,par%root,par%comm,ierr) call MPI_bcast(cubed_sphere_map,1,MPIinteger_t ,par%root,par%comm,ierr) call MPI_bcast(qsplit,1,MPIinteger_t ,par%root,par%comm,ierr) @@ -1179,6 +1196,10 @@ subroutine readnl(par) write(iulog,*)"readnl: semi_lagrange_cdr_check = ",semi_lagrange_cdr_check write(iulog,*)"readnl: semi_lagrange_hv_q = ",semi_lagrange_hv_q write(iulog,*)"readnl: semi_lagrange_nearest_point_lev = ",semi_lagrange_nearest_point_lev + write(iulog,*)"readnl: semi_lagrange_halo = ",semi_lagrange_halo + write(iulog,*)"readnl: semi_lagrange_trajectory_nsubstep = ",semi_lagrange_trajectory_nsubstep + write(iulog,*)"readnl: semi_lagrange_trajectory_nvelocity = ",semi_lagrange_trajectory_nvelocity + write(iulog,*)"readnl: semi_lagrange_diagnostics = ",semi_lagrange_diagnostics write(iulog,*)"readnl: tstep_type = ",tstep_type write(iulog,*)"readnl: theta_advect_form = ",theta_advect_form write(iulog,*)"readnl: vtheta_thresh = ",vtheta_thresh diff --git a/components/homme/src/share/prim_driver_base.F90 b/components/homme/src/share/prim_driver_base.F90 index df83e1cc386..9e036347320 100644 --- a/components/homme/src/share/prim_driver_base.F90 +++ b/components/homme/src/share/prim_driver_base.F90 @@ -46,6 +46,8 @@ module prim_driver_base public :: applyCAMforcing_tracers + public :: set_tracer_transport_derived_values + ! Service variables used to partition the mesh. ! Note: GridEdge and MeshVertex are public, cause kokkos targets need to access them type (GridVertex_t), pointer :: GridVertex(:) @@ -1316,7 +1318,7 @@ subroutine prim_step_flexible(hybrid, elem, nets, nete, dt, tl, hvcoord, compute use hybvcoord_mod, only: hvcoord_t use parallel_mod, only: abortmp use prim_advance_mod, only: prim_advance_exp, applycamforcing_dynamics - use prim_advection_mod, only: prim_advec_tracers_remap + use prim_advection_mod, only: prim_advec_tracers_observe_velocity, prim_advec_tracers_remap use reduction_mod, only: parallelmax use time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp use prim_state_mod, only: prim_printstate @@ -1334,7 +1336,7 @@ subroutine prim_step_flexible(hybrid, elem, nets, nete, dt, tl, hvcoord, compute real(kind=real_kind) :: dt_q, dt_remap, dp(np,np,nlev) integer :: ie, q, k, n, n0_qdp, np1_qdp - logical :: compute_diagnostics_it, apply_forcing + logical :: compute_diagnostics_it, apply_forcing, observe dt_q = dt*dt_tracer_factor if (dt_remap_factor == 0) then @@ -1392,11 +1394,13 @@ subroutine prim_step_flexible(hybrid, elem, nets, nete, dt, tl, hvcoord, compute call prim_advance_exp(elem, deriv1, hvcoord, hybrid, dt, tl, nets, nete, & compute_diagnostics_it) + observe = .false. if (dt_remap_factor == 0) then ! Set np1_qdp to -1. Since dt_remap == 0, the only part of ! vertical_remap that is active is the updates to ! ps_v(:,:,np1) and dp3d(:,:,:,np1). call vertical_remap(hybrid, elem, hvcoord, dt_remap, tl%np1, -1, nets, nete) + observe = .true. else if (modulo(n, dt_remap_factor) == 0) then if (compute_diagnostics) call run_diagnostics(elem,hvcoord,tl,4,.false.,nets,nete) @@ -1417,8 +1421,10 @@ subroutine prim_step_flexible(hybrid, elem, nets, nete, dt, tl, hvcoord, compute ! not tracers. call vertical_remap(hybrid, elem, hvcoord, dt_remap, tl%np1, -1, nets, nete) end if + observe = .true. end if end if + if (observe) call Prim_Advec_Tracers_observe_velocity(elem, tl, n, nets, nete) ! defer final timelevel update until after Q update. enddo call t_stopf("prim_step_dyn") diff --git a/components/homme/src/share/reduction_mod.F90 b/components/homme/src/share/reduction_mod.F90 index 83232478ef3..72e0e89231f 100644 --- a/components/homme/src/share/reduction_mod.F90 +++ b/components/homme/src/share/reduction_mod.F90 @@ -25,7 +25,7 @@ module reduction_mod integer :: ctr end type ReductionBuffer_ordered_1d_t - public :: ParallelMin,ParallelMax + public :: ParallelMin,ParallelMax,ParallelSum !type (ReductionBuffer_ordered_1d_t), public :: red_sum type (ReductionBuffer_int_1d_t), public :: red_max_int @@ -51,6 +51,9 @@ module reduction_mod module procedure ParallelMax0d module procedure ParallelMax0d_int end interface + interface ParallelSum + module procedure ParallelSum0d_int + end interface interface pmax_mt module procedure pmax_mt_int_1d @@ -61,6 +64,10 @@ module reduction_mod module procedure pmin_mt_r_1d end interface + interface psum_mt + module procedure psum_mt_int_1d + end interface + interface InitReductionBuffer module procedure InitReductionBuffer_int_1d module procedure InitReductionBuffer_r_1d @@ -179,7 +186,19 @@ function ParallelMax0d_int(data,hybrid) result(pmax) end function ParallelMax0d_int + !**************************************************************** + function ParallelSum0d_int(data,hybrid) result(psum) + use hybrid_mod, only : hybrid_t + implicit none + integer , intent(in) :: data + type (hybrid_t), intent(in) :: hybrid + integer :: psum + integer :: tmp(1) + tmp(1)=data + call psum_mt(red_sum_int,tmp,1,hybrid) + psum = red_sum_int%buf(1) + end function ParallelSum0d_int !**************************************************************** subroutine InitReductionBuffer_int_1d(red,len) @@ -486,7 +505,53 @@ subroutine pmin_mt_r_1d(red,redp,len,hybrid) !$OMP BARRIER end subroutine pmin_mt_r_1d + ! ======================================= + ! psum_mt: + ! + ! thread safe, parallel reduce sum of a + ! one dimensional INTEGER reduction vector + ! ======================================= + subroutine psum_mt_int_1d(red,redp,len,hybrid) + use hybrid_mod, only : hybrid_t +#ifdef _MPI + use parallel_mod, only: mpi_sum, mpiinteger_t +#endif + use parallel_mod, only: abortmp + + type (ReductionBuffer_int_1d_t) :: red ! shared memory reduction buffer struct + integer, intent(in) :: len ! buffer length + integer, intent(inout) :: redp(len) ! thread private vector of partial sum + type (hybrid_t), intent(in) :: hybrid ! parallel handle + + ! Local variables + integer ierr, k + + if (len>red%len) call abortmp('ERROR: threadsafe reduction buffer too small') + + !$OMP BARRIER + ! the first and fastest thread performs initializing copy + !$OMP SINGLE + red%buf(1:len) = redp(1:len) + red%ctr = hybrid%ithr + !$OMP END SINGLE + !$OMP CRITICAL (CRITMAXINT) + if (hybrid%ithr /= red%ctr) then + do k=1,len + red%buf(k) = red%buf(k) + redp(k) + enddo + end if + !$OMP END CRITICAL (CRITMAXINT) +#ifdef _MPI + !$OMP BARRIER + if (hybrid%ithr==0) then + call MPI_Allreduce(red%buf(1),redp,len,MPIinteger_t, & + MPI_SUM,hybrid%par%comm,ierr) + red%buf(1:len)=redp(1:len) + end if +#endif + !$OMP BARRIER + end subroutine psum_mt_int_1d ! ======================================= subroutine ElementSum_1d(res,variable,type,hybrid) diff --git a/components/homme/src/share/sl_advection.F90 b/components/homme/src/share/sl_advection.F90 index 3f6544953b6..2549da8f5ae 100644 --- a/components/homme/src/share/sl_advection.F90 +++ b/components/homme/src/share/sl_advection.F90 @@ -5,12 +5,12 @@ module sl_advection use kinds, only : real_kind, int_kind use dimensions_mod, only : nlev, nlevp, np, qsize, qsize_d - use derivative_mod, only : derivative_t, gradient_sphere, divergence_sphere + use derivative_mod, only : derivative_t, gradient_sphere, divergence_sphere, ugradv_sphere use element_mod, only : element_t use hybvcoord_mod, only : hvcoord_t use time_mod, only : TimeLevel_t, TimeLevel_Qdp - use control_mod, only : integration, test_case, hypervis_order, transport_alg, limiter_option,& - vert_remap_q_alg + use control_mod, only : integration, test_case, hypervis_order, transport_alg, & + & limiter_option, vert_remap_q_alg, semi_lagrange_diagnostics use edge_mod, only : edgevpack_nlyr, edgevunpack_nlyr, edge_g use edgetype_mod, only : EdgeDescriptor_t, EdgeBuffer_t use hybrid_mod, only : hybrid_t @@ -26,18 +26,20 @@ module sl_advection private + ! Constants real(real_kind), parameter :: zero = 0.0_real_kind, fourth = 0.25_real_kind, & half = 0.5_real_kind, one = 1.0_real_kind, two = 2.0_real_kind, & eps = epsilon(1.0_real_kind) - type (cartesian3D_t), allocatable :: dep_points_all(:,:,:,:) ! (np,np,nlev,nelemd) - real(kind=real_kind), dimension(:,:,:,:,:), allocatable :: minq, maxq ! (np,np,nlev,qsize,nelemd) - logical :: is_sphere + ! Configuration. + logical :: is_sphere, enhanced_trajectory + integer :: dep_points_ndim - ! For use in make_positive. - real(kind=real_kind) :: dp_tol + ! For use in make_positive. Set at initialization to a function of hvcoord%dp0. + real(kind=real_kind) :: dp_tol, deta_tol - public :: prim_advec_tracers_remap_ALE, sl_init1, sl_vertically_remap_tracers, sl_unittest + public :: prim_advec_tracers_observe_velocity_ALE, prim_advec_tracers_remap_ALE, & + & sl_init1, sl_vertically_remap_tracers, sl_unittest ! For testing public :: calc_trajectory, dep_points_all, sphere2cart @@ -45,8 +47,36 @@ module sl_advection ! For C++ public :: sl_get_params + ! Barrier for performance analysis. Should be false in production runs. logical, parameter :: barrier = .false. + ! Bounds for shape preservation. + real(kind=real_kind), dimension(:,:,:,:,:), allocatable :: minq, maxq ! (np,np,nlev,qsize,nelemd) + + ! Trajectory velocity data. + real(kind=real_kind), dimension(:,:,:,:,:), allocatable :: vnode, vdep ! (ndim,np,np,nlev,nelemd) + real(kind=real_kind), allocatable :: dep_points_all(:,:,:,:,:) ! (ndim,np,np,nlev,nelemd) + + type :: velocity_record_t + integer :: nvel + ! Times to which velocity slots correspond, in reference time [0,dtf]. + real(kind=real_kind), allocatable :: t_vel(:) ! 1:nvel + ! For n = 1:dtf, obs_slots(n,:) = [slot1, slot2], -1 if unused. These are + ! the slots to which velocity sample n contributes. obs_slots(dtf,:) is + ! always -1. + integer, allocatable :: obs_slots(:,:) + ! obs_wts(n,:) = [wt1, wt2], 0 if unused. + real(kind=real_kind), allocatable :: obs_wts(:,:) + ! Substep end point n in 0:nsub uses velocity slots run_step(n), + ! run_step(n)-1. + integer, allocatable :: run_step(:) + ! Store state%v and state%dp3d at t_vel points. + real(kind=real_kind), allocatable :: vel(:,:,:,:,:,:) ! (np,np,2,nlev,nss,nelemd) + real(kind=real_kind), allocatable :: dp (:,:, :,:,:) ! (np,np, nlev,nss,nelemd) + end type velocity_record_t + + type(velocity_record_t) :: vrec + contains !=================================================================================================! @@ -87,7 +117,9 @@ end subroutine sphere2cart subroutine sl_init1(par, elem) use interpolate_mod, only : interpolate_tracers_init use control_mod, only : transport_alg, semi_lagrange_cdr_alg, cubed_sphere_map, & - nu_q, semi_lagrange_hv_q, semi_lagrange_cdr_check, geometry + nu_q, semi_lagrange_hv_q, semi_lagrange_cdr_check, semi_lagrange_trajectory_nsubstep, & + semi_lagrange_trajectory_nvelocity, geometry, dt_remap_factor, dt_tracer_factor, & + semi_lagrange_halo use element_state, only : timelevels use coordinate_systems_mod, only : cartesian3D_t use perf_mod, only: t_startf, t_stopf @@ -102,14 +134,13 @@ subroutine sl_init1(par, elem) #ifdef HOMME_ENABLE_COMPOSE call t_startf('sl_init1') if (transport_alg > 0) then - call sl_parse_transport_alg(transport_alg, slmm, cisl, qos, sl_test, independent_time_steps) - if (par%masterproc .and. nu_q > 0 .and. semi_lagrange_hv_q > 0) & - write(iulog,*) 'COMPOSE> use HV; nu_q, all:', nu_q, semi_lagrange_hv_q + call sl_parse_transport_alg(transport_alg, slmm, cisl, qos, sl_test, & + independent_time_steps) is_sphere = trim(geometry) /= 'plane' + enhanced_trajectory = semi_lagrange_trajectory_nsubstep > 0 + dep_points_ndim = 3 + if (enhanced_trajectory .and. independent_time_steps) dep_points_ndim = 4 nslots = nlev*qsize - ! Technically a memory leak, but the array persists for the entire - ! run, so not a big deal for now. - allocate(dep_points_all(np,np,nlev,size(elem))) do ie = 1, size(elem) ! Provide a point inside the target element. call sphere2cart(elem(ie)%spherep(2,2), pinside) @@ -130,21 +161,45 @@ subroutine sl_init1(par, elem) need_conservation = 1 call cedr_sl_init(np, nlev, qsize, qsize_d, timelevels, need_conservation) end if - allocate(minq(np,np,nlev,qsize,size(elem)), maxq(np,np,nlev,qsize,size(elem))) + allocate(minq(np,np,nlev,qsize,size(elem)), maxq(np,np,nlev,qsize,size(elem)), & + & dep_points_all(dep_points_ndim,np,np,nlev,size(elem))) + if (enhanced_trajectory) then + allocate(vnode(dep_points_ndim,np,np,nlev,size(elem)), & + & vdep (dep_points_ndim,np,np,nlev,size(elem))) + end if + call init_velocity_record(size(elem), dt_tracer_factor, dt_remap_factor, & + semi_lagrange_trajectory_nsubstep, semi_lagrange_trajectory_nvelocity, & + vrec, i) dp_tol = -one + deta_tol = -one + if (par%masterproc) then + if (nu_q > 0 .and. semi_lagrange_hv_q > 0) then + write(iulog,'(a,es13.4,i3)') 'COMPOSE> use HV; nu_q, hv_q:', & + nu_q, semi_lagrange_hv_q + end if + if (enhanced_trajectory) then + write(iulog,'(a,i3,i3,i3)') & + 'COMPOSE> dt_tracer_factor, dt_remap_factor, halo:', & + dt_tracer_factor, dt_remap_factor, semi_lagrange_halo + write(iulog,'(a,i3,i3)') & + 'COMPOSE> use enhanced trajectory; nsub, nvel:', & + semi_lagrange_trajectory_nsubstep, vrec%nvel + end if + end if endif call t_stopf('sl_init1') #endif end subroutine sl_init1 subroutine sl_get_params(nu_q_out, hv_scaling, hv_q, hv_subcycle_q, limiter_option_out, & - cdr_check, geometry_type) bind(c) + cdr_check, geometry_type, trajectory_nsubstep) bind(c) use control_mod, only: semi_lagrange_hv_q, hypervis_subcycle_q, semi_lagrange_cdr_check, & - nu_q, hypervis_scaling, limiter_option, geometry + nu_q, hypervis_scaling, limiter_option, geometry, semi_lagrange_trajectory_nsubstep use iso_c_binding, only: c_int, c_double real(c_double), intent(out) :: nu_q_out, hv_scaling - integer(c_int), intent(out) :: hv_q, hv_subcycle_q, limiter_option_out, cdr_check, geometry_type + integer(c_int), intent(out) :: hv_q, hv_subcycle_q, limiter_option_out, cdr_check, & + geometry_type, trajectory_nsubstep nu_q_out = nu_q hv_scaling = hypervis_scaling @@ -155,21 +210,143 @@ subroutine sl_get_params(nu_q_out, hv_scaling, hv_q, hv_subcycle_q, limiter_opti if (semi_lagrange_cdr_check) cdr_check = 1 geometry_type = 0 ! sphere if (trim(geometry) == "plane") geometry_type = 1 - + trajectory_nsubstep = semi_lagrange_trajectory_nsubstep end subroutine sl_get_params + subroutine init_velocity_record(nelemd, dtf, drf_param, nsub, nvel_param, v, error) + integer, intent(in) :: nelemd, dtf, drf_param, nsub, nvel_param + type (velocity_record_t), intent(out) :: v + integer, intent(out) :: error + + real(kind=real_kind) :: t_avail(0:dtf), time + integer :: nvel, drf, navail, n, i, iav + + error = 0 + drf = drf_param + if (drf == 0) drf = 1 ! drf = 0 if vertically Eulerian + nvel = nvel_param + if (nvel == -1) nvel = 2 + ((nsub-1) / 2) + nvel = min(nvel, nsub+1) + navail = dtf/drf + 1 + nvel = min(nvel, navail) + + ! nsub <= 1: No substepping. + ! nvel <= 2: Save velocity only at endpoints, as always occurs. + if (nsub <= 1 .or. nvel <= 2) then + v%nvel = 2 + return + end if + + v%nvel = nvel + allocate(v%t_vel(nvel), v%obs_slots(dtf,2), v%obs_wts(dtf,2), v%run_step(0:nsub), & + & v%vel(np,np,2,nlev,2:nvel-1,nelemd), v%dp(np,np,nlev,2:nvel-1,nelemd)) + + ! Times at which velocity data are available. + t_avail(0) = 0 + i = 1 + do n = 1, dtf + if (modulo(n, drf) == 0) then + t_avail(i) = n + i = i + 1 + end if + end do + if (i /= navail) error = 1 + + ! Times to which we associate velocity data. + do n = 1, nvel + if (modulo((n-1)*dtf, nvel-1) == 0) then + ! Cast integer values at end of calculation. + v%t_vel(n) = ((n-1)*dtf)/(nvel-1) + else + v%t_vel(n) = real((n-1)*dtf, real_kind)/(nvel-1) + end if + end do + + ! Build the tables mapping n in 1:dtf to velocity slots to accumulate into. + do n = 1, dtf-1 + v%obs_slots(n,:) = -1 + v%obs_wts(n,:) = 0 + if (modulo(n, drf) /= 0) cycle + time = n + do i = 1, navail-1 + if (time == t_avail(i)) exit + end do + iav = i + if (iav > navail-1) error = 2 + do i = 2, nvel-1 + if (t_avail(iav-1) < v%t_vel(i) .and. time > v%t_vel(i)) then + v%obs_slots(n,1) = i + v%obs_wts(n,1) = (v%t_vel(i) - t_avail(iav-1))/(t_avail(iav) - t_avail(iav-1)) + end if + if (time <= v%t_vel(i) .and. t_avail(iav+1) > v%t_vel(i)) then + v%obs_slots(n,2) = i + v%obs_wts(n,2) = (t_avail(iav+1) - v%t_vel(i))/(t_avail(iav+1) - t_avail(iav)) + end if + end do + end do + v%obs_slots(dtf,:) = -1 + v%obs_wts(dtf,:) = 0 + + ! Build table mapping n to interval to use. The trajectories go backward in + ! time, and this table reflects that. + v%run_step(0) = nvel + v%run_step(nsub) = 2 + do n = 1, nsub-1 + time = real((nsub-n)*dtf, real_kind)/nsub + do i = 1, nvel-1 + if (v%t_vel(i) <= time .and. time <= v%t_vel(i+1)) exit + end do + if (i > nvel-1) error = 4 + v%run_step(n) = i+1 + end do + end subroutine init_velocity_record + + subroutine prim_advec_tracers_observe_velocity_ALE(elem, tl, n, nets, nete) + use control_mod, only: dt_remap_factor + + type (element_t) , intent(inout) :: elem(:) + type (TimeLevel_t) , intent(in ) :: tl + integer , intent(in ) :: n ! step in 1:dt_tracer_factor + integer , intent(in ) :: nets + integer , intent(in ) :: nete + + integer :: nstore, islot, slot, k, ie + + if (vrec%nvel == 2) return + + if (n == dt_remap_factor .or. (dt_remap_factor == 0 .and. n == 1)) then + ! First observation of the tracer time step: zero accumulated quantities. + do ie = nets, nete + do slot = 2, vrec%nvel-1 + vrec%vel(:,:,:,:,slot,ie) = 0 + vrec%dp (:,:, :,slot,ie) = 0 + end do + end do + end if + + do islot = 1, 2 + slot = vrec%obs_slots(n,islot) + if (slot == -1) cycle + do ie = nets, nete + do k = 1, nlev + vrec%vel(:,:,:,k,slot,ie) = vrec%vel(:,:,:,k,slot,ie) + & + vrec%obs_wts(n,islot) * elem(ie)%state%v(:,:,:,k,tl%np1) + vrec%dp (:,:, k,slot,ie) = vrec%dp (:,:, k,slot,ie) + & + vrec%obs_wts(n,islot) * elem(ie)%state%dp3d(:,:,k,tl%np1) + end do + end do + end do + end subroutine prim_advec_tracers_observe_velocity_ALE + subroutine prim_advec_tracers_remap_ALE(elem, deriv, hvcoord, hybrid, dt, tl, nets, nete) use coordinate_systems_mod, only : cartesian3D_t, cartesian2D_t use dimensions_mod, only : max_neigh_edges use interpolate_mod, only : interpolate_tracers, minmax_tracers use control_mod, only : dt_tracer_factor, nu_q, transport_alg, semi_lagrange_hv_q, & - semi_lagrange_cdr_alg, semi_lagrange_cdr_check + semi_lagrange_cdr_alg, semi_lagrange_cdr_check, semi_lagrange_trajectory_nsubstep ! For DCMIP16 supercell test case. use control_mod, only : dcmip16_mu_q use prim_advection_base, only : advance_physical_vis -#ifdef HOMME_ENABLE_COMPOSE - use compose_mod, only : compose_h2d, compose_d2h -#endif use iso_c_binding, only : c_bool implicit none @@ -182,8 +359,6 @@ subroutine prim_advec_tracers_remap_ALE(elem, deriv, hvcoord, hybrid, dt, tl, ne integer , intent(in ) :: nets integer , intent(in ) :: nete - type(cartesian3D_t) :: dep_points (np,np) - integer :: i,j,k,l,n,q,ie,n0_qdp,np1_qdp integer :: scalar_q_bounds, info logical :: slmm, cisl, qos, sl_test, independent_time_steps @@ -194,19 +369,18 @@ subroutine prim_advec_tracers_remap_ALE(elem, deriv, hvcoord, hybrid, dt, tl, ne call t_startf('Prim_Advec_Tracers_remap_ALE') call sl_parse_transport_alg(transport_alg, slmm, cisl, qos, sl_test, independent_time_steps) - ! Until I get the DSS onto GPU, always need to h<->d. - !h2d = hybrid%par%nprocs > 1 .or. semi_lagrange_cdr_check .or. & (semi_lagrange_hv_q > 0 .and. nu_q > 0) h2d = .true. -#ifdef HOMME_ENABLE_COMPOSE d2h = compose_d2h .or. h2d h2d = compose_h2d .or. h2d -#else - d2h = h2d -#endif call TimeLevel_Qdp(tl, dt_tracer_factor, n0_qdp, np1_qdp) - call calc_trajectory(elem, deriv, hvcoord, hybrid, dt, tl, & - independent_time_steps, nets, nete) + if (enhanced_trajectory) then + call calc_enhanced_trajectory(elem, deriv, hvcoord, hybrid, dt, tl, nets, nete, & + semi_lagrange_trajectory_nsubstep, independent_time_steps) + else + call calc_trajectory(elem, deriv, hvcoord, hybrid, dt, tl, & + independent_time_steps, nets, nete) + end if call t_startf('SLMM_csl') !todo Here and in the set-pointer loop for CEDR, do just in the first call. @@ -218,14 +392,14 @@ subroutine prim_advec_tracers_remap_ALE(elem, deriv, hvcoord, hybrid, dt, tl, ne h2d, d2h) end do ! edge_g buffers are shared by SLMM, CEDR, other places in HOMME, and - ! dp_coupling in EAM. Thus, we must take care to protected threaded - ! access. In the following, "No barrier needed" comments justify why a - ! barrier isn't needed. + ! dp_coupling in EAM. Thus, we must take care to protect threaded access. In + ! the following, "No barrier needed" comments justify why a barrier isn't + ! needed. ! No barrier needed: ale_rkdss has a horiz thread barrier at the end. - call slmm_csl(nets, nete, dep_points_all, minq, maxq, info) + call slmm_csl(nets, nete, dep_points_all, dep_points_ndim, minq, maxq, info) ! No barrier needed: slmm_csl has a horiz thread barrier at the end. if (info /= 0) then - call write_velocity_data(elem, nets, nete, hybrid, deriv, dt, tl) + call write_velocity_data(elem, nets, nete, hybrid, dt, tl) call abortmp('slmm_csl returned -1; see output above for more information.') end if if (barrier) call perf_barrier(hybrid) @@ -261,7 +435,7 @@ subroutine prim_advec_tracers_remap_ALE(elem, deriv, hvcoord, hybrid, dt, tl, ne call t_stopf('CEDR') call t_startf('CEDR_local') call cedr_sl_run_local(minq, maxq, nets, nete, scalar_q_bounds, limiter_option) - ! Barrier needed to protect edge_g buffers use in CEDR. + ! Barrier needed to protect edge_g buffers used in CEDR. #if (defined HORIZ_OPENMP) !$omp barrier #endif @@ -350,7 +524,7 @@ subroutine calc_trajectory(elem, deriv, hvcoord, hybrid, dt, tl, & !$omp parallel do private(k) #endif do k = 1, nlev - call ALE_departure_from_gll(dep_points_all(:,:,k,ie), & + call ALE_departure_from_gll(dep_points_all(:,:,:,k,ie), dep_points_ndim, & elem(ie)%derived%vstar(:,:,:,k), elem(ie), dt, normalize=is_sphere) end do end do @@ -361,7 +535,7 @@ end subroutine calc_trajectory !SUBROUTINE ALE_RKDSS ! AUTHOR: CHRISTOPH ERATH, MARK TAYLOR, 06. December 2012 ! - ! DESCRIPTION: ! create a runge kutta taylor serios mixture to calculate the departure grid + ! DESCRIPTION: ! create a runge kutta taylor series mixture to calculate the departure grid ! ! CALLS: ! INPUT: @@ -372,7 +546,6 @@ end subroutine calc_trajectory ! this will calculate the velocity at time t+1/2 along the trajectory s(t) given the velocities ! at the GLL points at time t and t+1 using a second order time accurate formulation. subroutine ALE_RKdss(elem, nets, nete, hy, deriv, dt, tl, independent_time_steps) - use derivative_mod, only : derivative_t, ugradv_sphere use edgetype_mod, only : EdgeBuffer_t use bndry_mod, only : bndry_exchangev use kinds, only : real_kind @@ -397,22 +570,20 @@ subroutine ALE_RKdss(elem, nets, nete, hy, deriv, dt, tl, independent_time_steps ! RK-SSP 2 stage 2nd order: ! x*(t+1) = x(t) + U(x(t),t) dt - ! x(t+1) = x(t) + 1/2 ( U(x*(t+1),t+1) + U(x(t),t) ) dt + ! x(t+1) = x(t) + 1/2 ( U(x*(t+1),t+1) + U(x(t),t) ) dt ! apply taylor series: - ! U(x*(t+1),t+1) = U(x(t),t+1) + (x*(t+1)-x(t)) gradU(x(t),t+1) - ! - ! x(t+1) = x(t) + 1/2 ( U(x(t),t+1) + (x*(t+1)-x(t)) gradU(x(t),t+1) + U(x(t),t) ) dt - ! (x(t+1) - x(t)) / dt = 1/2 ( U(x(t),t+1) + (x*(t+1)-x(t)) gradU(x(t),t+1) + U(x(t),t) ) - ! (x(t+1) - x(t)) / dt = 1/2 ( U(x(t),t+1) + U(x(t),t) + (x*(t+1)-x(t)) gradU(x(t),t+1) ) - ! (x(t+1) - x(t)) / dt = 1/2 ( U(x(t),t+1) + U(x(t),t) + U(x(t),t) dt gradU(x(t),t+1) ) + ! U(x*(t+1),t+1) = U(x(t),t+1) + (x*(t+1)-x(t)) gradU(x(t),t+1) ! + ! x(t+1) = x(t) + 1/2 ( U(x(t),t+1) + (x*(t+1)-x(t)) gradU(x(t),t+1) + U(x(t),t) ) dt + ! (x(t+1) - x(t)) / dt = 1/2 ( U(x(t),t+1) + (x*(t+1)-x(t)) gradU(x(t),t+1) + U(x(t),t) ) + ! = 1/2 ( U(x(t),t+1) + U(x(t),t) + (x*(t+1)-x(t)) gradU(x(t),t+1) ) + ! = 1/2 ( U(x(t),t+1) + U(x(t),t) + U(x(t),t) dt gradU(x(t),t+1) ) ! - ! (x(t+1)-x(t))/dt = 1/2(U(x(t),t+1) + U(x(t),t) + dt U(x(t),t) gradU(x(t),t+1)) + ! => (x(t+1)-x(t))/dt = 1/2 (U(x(t),t+1) + U(x(t),t) + dt U(x(t),t) gradU(x(t),t+1)) ! ! suppose dt = -ts (we go backward) - ! (x(t-ts)-x(t))/-ts = 1/2( U(x(t),t-ts)+U(x(t),t)) - ts 1/2 U(x(t),t) gradU(x(t),t-ts) - ! - ! x(t-ts) = x(t)) -ts * [ 1/2( U(x(t),t-ts)+U(x(t),t)) - ts 1/2 U(x(t),t) gradU(x(t),t-ts) ] + ! (x(t-ts)-x(t))/-ts = 1/2 (U(x(t),t-ts)+U(x(t),t)) - ts 1/2 U(x(t),t) gradU(x(t),t-ts) + ! x(t-ts) = x(t)) - ts * [1/2 (U(x(t),t-ts)+U(x(t),t)) - ts 1/2 U(x(t),t) gradU(x(t),t-ts)] nlyr = 2*nlev if (independent_time_steps) nlyr = nlyr + nlev @@ -451,7 +622,7 @@ subroutine ALE_RKdss(elem, nets, nete, hy, deriv, dt, tl, independent_time_steps do ie = nets,nete call edgeVunpack_nlyr(edge_g,elem(ie)%desc,elem(ie)%derived%vstar,2*nlev,0,nlyr) if (independent_time_steps) then - call edgeVunpack_nlyr(edge_g,elem(ie)%desc,elem(ie)%derived%divdp,nlevp,2*nlev,nlyr) + call edgeVunpack_nlyr(edge_g,elem(ie)%desc,elem(ie)%derived%divdp,nlev,2*nlev,nlyr) end if end do @@ -460,8 +631,7 @@ subroutine ALE_RKdss(elem, nets, nete, hy, deriv, dt, tl, independent_time_steps #endif end subroutine ALE_RKdss - subroutine write_velocity_data(elem, nets, nete, hy, deriv, dt, tl) - use derivative_mod, only : derivative_t, ugradv_sphere + subroutine write_velocity_data(elem, nets, nete, hy, dt, tl) use edgetype_mod, only : EdgeBuffer_t use bndry_mod, only : bndry_exchangev use kinds, only : real_kind @@ -474,7 +644,6 @@ subroutine write_velocity_data(elem, nets, nete, hy, deriv, dt, tl) integer , intent(in) :: nets integer , intent(in) :: nete type (hybrid_t) , intent(in) :: hy - type (derivative_t) , intent(in) :: deriv real (kind=real_kind), intent(in) :: dt type (TimeLevel_t) , intent(in) :: tl @@ -507,7 +676,7 @@ end subroutine write_velocity_data ! ! OUTPUT: !-----------------------------------------------------------------------------------! - subroutine ALE_departure_from_gll(acart, vstar, elem, dt, normalize) + subroutine ALE_departure_from_gll(acart, ndim, vstar, elem, dt, normalize) use physical_constants, only : scale_factor use coordinate_systems_mod, only : spherical_polar_t, cartesian3D_t use time_mod, only : timelevel_t @@ -517,14 +686,15 @@ subroutine ALE_departure_from_gll(acart, vstar, elem, dt, normalize) implicit none - type (cartesian3D_t) ,intent(out) :: acart(np,np) + integer ,intent(in) :: ndim + real (kind=real_kind) ,intent(out) :: acart(ndim,np,np) real (kind=real_kind) ,intent(in) :: vstar(np,np,2) type (element_t) ,intent(in) :: elem real (kind=real_kind) ,intent(in) :: dt - logical, intent(in) :: normalize - - integer :: i,j + logical ,intent(in) :: normalize + integer :: i,j, d + type (cartesian3D_t) :: c3d real (kind=real_kind) :: uxyz (np,np,3), norm ! convert velocity from lat/lon to cartesian 3D @@ -539,16 +709,14 @@ subroutine ALE_departure_from_gll(acart, vstar, elem, dt, normalize) ! crude, 1st order accurate approximation. to be improved do i=1,np do j=1,np - call sphere2cart(elem%spherep(i,j), acart(i,j)) - acart(i,j)%x = acart(i,j)%x - dt*uxyz(i,j,1)/scale_factor - acart(i,j)%y = acart(i,j)%y - dt*uxyz(i,j,2)/scale_factor - acart(i,j)%z = acart(i,j)%z - dt*uxyz(i,j,3)/scale_factor + call sphere2cart(elem%spherep(i,j), c3d) + acart(1,i,j) = c3d%x - dt*uxyz(i,j,1)/scale_factor + acart(2,i,j) = c3d%y - dt*uxyz(i,j,2)/scale_factor + acart(3,i,j) = c3d%z - dt*uxyz(i,j,3)/scale_factor if (normalize) then - norm = sqrt(acart(i,j)%x*acart(i,j)%x + acart(i,j)%y*acart(i,j)%y + & - acart(i,j)%z*acart(i,j)%z) - acart(i,j)%x = acart(i,j)%x / norm - acart(i,j)%y = acart(i,j)%y / norm - acart(i,j)%z = acart(i,j)%z / norm + norm = sqrt(acart(1,i,j)*acart(1,i,j) + acart(2,i,j)*acart(2,i,j) + & + acart(3,i,j)*acart(3,i,j)) + acart(1:3,i,j) = acart(1:3,i,j)/norm end if enddo enddo @@ -801,7 +969,8 @@ subroutine calc_vertically_lagrangian_levels( & ! x1 - x0 = dt u(p0,t0) + O(dt^2) ! z1 - z0 = dt w(p0,t0) + O(dt^2) ! z1 = z0 + dt/2 (w(p0,t0) + w(p0,t1) + - ! dt (w_x(p0,t1) u(p0,t0) + w_z(p0,t1) w(p0,t0))) + O(dt^3) (*) + ! dt (w_x(p0,t1) u(p0,t0) + w_z(p0,t1) w(p0,t0))) + ! + O(dt^3). (*) ! Now we compute z(x0,t1). First, we need ! x0 - x1 = -dt u(p0,t0) + O(dt^2) ! and @@ -826,7 +995,7 @@ subroutine calc_vertically_lagrangian_levels( & ! - dt^2 w_x(p0,t1) u(p0,t0) + O(dt^3) ! = z0 + dt/2 (w(p0,t0) + w(p0,t1) + ! dt (-w_x(p0,t1) u(p0,t0) + w_z(p0,t1) w(p0,t0))) - ! + O(dt^3) + ! + O(dt^3). ! This is locally accurate to O(dt^3) and so globally 2nd-order ! accurate. Notably, compared with (*), this formula differs only in a ! sign. Note also that a straightforward first-order accurate formula is @@ -884,8 +1053,7 @@ subroutine calc_vertically_lagrangian_levels( & end do ! Use p0 as the reference coordinate system. p0 differs from p1 by B(eta) - ! (ps1 - ps0); dp3d already accounts for this term - ! w.r.t. derived%dp. Recall + ! (ps1 - ps0); dp3d already accounts for this term w.r.t. derived%dp. Recall ! eta_dot_dpdn = p_eta eta_dot = (A_eta p0 + B_eta ps) deta/dt, ! except that in the code eta_dot_dpdn is actually dp deta/dt rather than ! dp/deta deta/dt. eta_dot_dpdn is the motion of a pressure level excluding @@ -1158,18 +1326,1045 @@ function test_reconstruct_and_limit_dp() result(nerr) end do end function test_reconstruct_and_limit_dp - subroutine sl_unittest(par) + subroutine calc_enhanced_trajectory(elem, deriv, hvcoord, hybrid, dt, tl, & + nets, nete, nsubstep, independent_time_steps) + ! Top-level routine for new enhanced trajectory method. This new method + ! permits multiple substeps, optionally using more reference-grid velocity + ! snapshots. + + use reduction_mod, only: ParallelSum use kinds, only: iulog + + type (element_t), intent(inout) :: elem(:) + type (derivative_t), intent(in) :: deriv + type (hvcoord_t), intent(in) :: hvcoord + type (hybrid_t), intent(in) :: hybrid + real(real_kind), intent(in) :: dt + type (TimeLevel_t), intent(in) :: tl + integer, intent(in) :: nets, nete, nsubstep + logical, intent(in) :: independent_time_steps - type (parallel_t), intent(in) :: par +#ifdef HOMME_ENABLE_COMPOSE + integer :: step, ie, info, limiter_active_count + real(real_kind) :: alpha(2), dtsub + + call t_startf('SLMM_trajectory') + + call slmm_set_hvcoord(hvcoord%etai(1), hvcoord%etai(nlevp), hvcoord%etam) + + ! Set dep_points_all to level-midpoint arrival points. + call init_dep_points_all(elem, hvcoord, nets, nete, independent_time_steps) + + limiter_active_count = 0 + dtsub = dt / nsubstep + do step = 1, nsubstep + ! Fill vnode. + if (vrec%nvel == 2) then + alpha(1) = real(nsubstep - step , real_kind)/nsubstep + alpha(2) = real(nsubstep - step + 1, real_kind)/nsubstep + do ie = nets, nete + call calc_nodal_velocities(elem(ie), deriv, hvcoord, tl, & + independent_time_steps, dtsub, alpha, & + elem(ie)%derived%vstar, elem(ie)%derived%dp, & + elem(ie)%state%v(:,:,:,:,tl%np1), elem(ie)%state%dp3d(:,:,:,tl%np1), & + vnode(:,:,:,:,ie)) + end do + else + call calc_nodal_velocities_using_vrec(elem, deriv, hvcoord, tl, & + independent_time_steps, dtsub, nsubstep, step, nets, nete) + end if + + call dss_vnode(elem, nets, nete, hybrid, vnode) + + if (step == 1) then + call update_dep_points_all(independent_time_steps, dtsub, nets, nete, vnode) + else + ! Fill vdep. + call slmm_calc_v_departure(nets, nete, step, dtsub, dep_points_all, & + & dep_points_ndim, vnode, vdep, info) + + ! Using vdep, update dep_points_all to departure points. + call update_dep_points_all(independent_time_steps, dtsub, nets, nete, vdep) + end if + end do + + if (independent_time_steps) then + call interp_departure_points_to_floating_level_midpoints( & + elem, nets, nete, tl, hvcoord, dep_points_all, limiter_active_count) + ! Not needed in practice. Corner cases will be cleaned up by dss_Qdp. + !call dss_divdp(elem, nets, nete, hybrid) + if (iand(semi_lagrange_diagnostics, 1) /= 0) then + limiter_active_count = ParallelSum(limiter_active_count, hybrid) + if (limiter_active_count > 0 .and. hybrid%masterthread) then + write(iulog, '(a,i11)') 'COMPOSE> limiter_active_count', & + limiter_active_count + end if + end if + end if + + call t_stopf('SLMM_trajectory') +#endif + end subroutine calc_enhanced_trajectory + + subroutine init_dep_points_all(elem, hvcoord, nets, nete, independent_time_steps) + ! Initialize dep_points_all to the Eulerian coordinates. + + type (element_t), intent(inout) :: elem(:) + type (hvcoord_t), intent(in) :: hvcoord + integer, intent(in) :: nets, nete + logical, intent(in) :: independent_time_steps + + type (cartesian3D_t) :: c3d + integer :: ie, i, j, k + + do ie = nets, nete + do j = 1, np + do i = 1, np + call sphere2cart(elem(ie)%spherep(i,j), c3d) + dep_points_all(1,i,j,1,ie) = c3d%x + dep_points_all(2,i,j,1,ie) = c3d%y + dep_points_all(3,i,j,1,ie) = c3d%z + do k = 2, nlev + dep_points_all(1:3,i,j,k,ie) = dep_points_all(1:3,i,j,1,ie) + end do + if (independent_time_steps) then + do k = 1, nlev + dep_points_all(4,i,j,k,ie) = hvcoord%etam(k) + end do + end if + end do + end do + end do + end subroutine init_dep_points_all + + subroutine calc_nodal_velocities_using_vrec(elem, deriv, hvcoord, tl, & + independent_time_steps, dtsub, nsubstep, step, nets, nete) + + ! Wrapper to calc_nodal_velocities that orchestrates the use of the various + ! sources of velocity data. + + type (element_t), intent(in) :: elem(:) + type (derivative_t), intent(in) :: deriv + type (hvcoord_t), intent(in) :: hvcoord + type (TimeLevel_t), intent(in) :: tl + logical, intent(in) :: independent_time_steps + real(real_kind), intent(in) :: dtsub + integer, intent(in) :: nsubstep, step, nets, nete + + integer :: ie, i, k, os + real(real_kind) :: time, alpha(2), vs(np,np,2,nlev,3), dps(np,np,nlev,3) + + do ie = nets, nete + do i = 1, 2 + k = nsubstep - step + (i-1) + time = (k*vrec%t_vel(vrec%nvel))/nsubstep + os = i-1 + k = vrec%run_step(step+1-i) + if (k == 2) then + vs(:,:,:,:,os+1) = elem(ie)%derived%vstar + dps(:,:,:,os+1) = elem(ie)%derived%dp + else + vs(:,:,:,:,os+1) = vrec%vel(:,:,:,:,k-1,ie) + dps(:,:,:,os+1) = vrec%dp(:,:,:,k-1,ie) + end if + if (k == vrec%nvel) then + vs(:,:,:,:,os+2) = elem(ie)%state%v(:,:,:,:,tl%np1) + dps(:,:,:,os+2) = elem(ie)%state%dp3d(:,:,:,tl%np1) + else + vs(:,:,:,:,os+2) = vrec%vel(:,:,:,:,k,ie) + dps(:,:,:,os+2) = vrec%dp(:,:,:,k,ie) + end if + alpha(1) = (vrec%t_vel(k) - time)/(vrec%t_vel(k) - vrec%t_vel(k-1)) + alpha(2) = 1 - alpha(1) + vs(:,:,:,:,os+1) = alpha(1)*vs(:,:,:,:,os+1) + alpha(2)*vs(:,:,:,:,os+2) + dps(:,:,:, os+1) = alpha(1)*dps(:,:,:, os+1) + alpha(2)*dps(:,:,:, os+2) + end do + alpha(1) = 0 + alpha(2) = 1 + call calc_nodal_velocities(elem(ie), deriv, hvcoord, tl, & + independent_time_steps, dtsub, alpha, & + vs(:,:,:,:,1), dps(:,:,:,1), vs(:,:,:,:,2), dps(:,:,:,2), & + vnode(:,:,:,:,ie)) + end do + end subroutine calc_nodal_velocities_using_vrec + + subroutine calc_nodal_velocities(elem, deriv, hvcoord, tl, & + independent_time_steps, dtsub, alpha, v1, dp1, v2, dp2, vnode) + ! Evaluate a formula to provide an estimate of nodal velocities that + ! are use to create a 2nd-order update to the trajectory. The + ! fundamental formula for the update in position p from arrival point + ! p1 to departure point p0 is + ! p0 = p1 - dt/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). + ! Here we compute the velocity estimate at the nodes: + ! 1/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). + + type (element_t), intent(in) :: elem + type (derivative_t), intent(in) :: deriv + type (hvcoord_t), intent(in) :: hvcoord + type (TimeLevel_t), intent(in) :: tl + logical, intent(in) :: independent_time_steps + real(real_kind), intent(in) :: dtsub, alpha(2) + real(real_kind), dimension(np,np,2,nlev), intent(in) :: v1, v2 + real(real_kind), dimension(np,np,nlev), intent(in) :: dp1, dp2 + real(real_kind), intent(out) :: vnode(:,:,:,:) + + real(real_kind) :: vsph(np,np,2,nlev,2), eta_dot(np,np,nlevp,2) + integer :: t + + if (independent_time_steps) then + call calc_eta_dot_ref_mid(elem, deriv, tl, hvcoord, alpha, & + & v1, dp1, v2, dp2, eta_dot) + else + eta_dot = zero + end if + + ! Collect the horizontal nodal velocities. v1,2 are on Eulerian levels. v1 + ! is from time t1 < t2. + do t = 1, 2 + vsph(:,:,:,:,t) = (1 - alpha(t))*v1 + alpha(t)*v2 + end do + + ! Given the vertical and horizontal nodal velocities at time + ! endpoints, evaluate the velocity estimate formula, providing the + ! final horizontal and vertical velocity estimates at midpoint nodes. + call calc_vel_horiz_formula_node_ref_mid( & + & elem, deriv, hvcoord, dtsub, vsph, eta_dot, vnode) + if (independent_time_steps) then + call calc_eta_dot_formula_node_ref_mid( & + elem, deriv, hvcoord, dtsub, vsph, eta_dot, vnode) + end if + end subroutine calc_nodal_velocities + + subroutine calc_eta_dot_ref_mid(elem, deriv, tl, hvcoord, alpha, v1, dp1, v2, dp2, eta_dot) + ! Compute eta_dot at midpoint nodes at the start and end of the substep. + + type (element_t), intent(in) :: elem + type (derivative_t), intent(in) :: deriv + type (TimeLevel_t), intent(in) :: tl + type (hvcoord_t), intent(in) :: hvcoord + real(real_kind), intent(in) :: alpha(2) + real(real_kind), dimension(np,np,2,nlev), intent(in) :: v1, v2 + real(real_kind), dimension(np,np,nlev), intent(in) :: dp1, dp2 + real(real_kind), intent(out) :: eta_dot(np,np,nlevp,2) + + real(real_kind) :: vdp(np,np,2), w1(np,np) + integer :: t, k, d + + do t = 1,2 + ! eta_dot_dpdn at interface nodes. + eta_dot(:,:,1,t) = zero + do k = 1,nlev + do d = 1,2 + vdp(:,:,d) = (1 - alpha(t))*v1(:,:,d,k)*dp1(:,:,k) + & + & alpha(t) *v2(:,:,d,k)*dp2(:,:,k) + end do + w1 = divergence_sphere(vdp, deriv, elem) + eta_dot(:,:,k+1,t) = eta_dot(:,:,k,t) + w1 + end do + w1 = eta_dot(:,:,nlevp,t) + eta_dot(:,:,nlevp,t) = zero + do k = 2,nlev + eta_dot(:,:,k,t) = hvcoord%hybi(k)*w1 - eta_dot(:,:,k,t) + end do + ! Transform eta_dot_dpdn at interfaces to eta_dot at midpoints using the + ! formula + ! eta_dot = eta_dot_dpdn/(A_eta p0 + B_eta ps). + ! a= eta_dot_dpdn diff(eta)/(diff(A) p0 + diff(B) ps). + ! Compute ps. + w1 = hvcoord%hyai(1)*hvcoord%ps0 + & + & (1 - alpha(t))*sum(dp1, 3) + & + & alpha(t) *sum(dp2, 3) + do k = 1,nlev + eta_dot(:,:,k,t) = half*(eta_dot(:,:,k,t) + eta_dot(:,:,k+1,t)) & + & * (hvcoord%etai(k+1) - hvcoord%etai(k)) & + & / ( (hvcoord%hyai(k+1) - hvcoord%hyai(k))*hvcoord%ps0 & + & + (hvcoord%hybi(k+1) - hvcoord%hybi(k))*w1) + end do + end do + end subroutine calc_eta_dot_ref_mid + + subroutine calc_vel_horiz_formula_node_ref_mid( & + elem, deriv, hvcoord, dtsub, vsph, eta_dot, vnode) + + type (element_t), intent(in) :: elem + type (derivative_t), intent(in) :: deriv + type (hvcoord_t), intent(in) :: hvcoord + real(real_kind), intent(in) :: dtsub, vsph(np,np,2,nlev,2), eta_dot(np,np,nlevp,2) + real(real_kind), intent(inout) :: vnode(:,:,:,:) + + integer, parameter :: t0 = 1, t1 = 2 + + real(real_kind) :: vfsph(np,np,2), w1(np,np), w2(np,np), w3(np,np,3) + integer :: k, d, i, k1, k2 + + do k = 1, nlev + ! Horizontal terms. + vfsph = ugradv_sphere(vsph(:,:,:,k,t1), vsph(:,:,:,k,t0), deriv, elem) + vfsph = vsph(:,:,:,k,t0) + vsph(:,:,:,k,t1) - dtsub*vfsph + ! Vertical term. + do d = 1, 2 ! horiz vel dims + if (k == 1 .or. k == nlev) then + if (k == 1) then + k1 = 1; k2 = 2 + else + k1 = nlev-1; k2 = nlev + end if + w1 = (vsph(:,:,d,k2,t0) - vsph(:,:,d,k1,t0)) / & + (hvcoord%etam(k2) - hvcoord%etam(k1)) + else + do i = 1, 3 + w3(:,:,i) = hvcoord%etam(k-2+i) ! interp support + end do + w2 = hvcoord%etam(k) ! derivative at this eta value + call eval_lagrange_poly_derivative(3, w3, vsph(:,:,d,k-1:k+1,t0), w2, w1) + end if + vfsph(:,:,d) = vfsph(:,:,d) - dtsub*eta_dot(:,:,k,t1)*w1 + end do + ! Finish the formula. + vfsph = half*vfsph + ! Transform to Cartesian. + do d = 1, 3 + vnode(d,:,:,k) = sum(elem%vec_sphere2cart(:,:,d,:)*vfsph, 3) + end do + end do + end subroutine calc_vel_horiz_formula_node_ref_mid + + subroutine calc_eta_dot_formula_node_ref_mid( & + elem, deriv, hvcoord, dtsub, vsph, eta_dot, vnode) + type (element_t), intent(in) :: elem + type (derivative_t), intent(in) :: deriv + type (hvcoord_t), intent(in) :: hvcoord + real(real_kind), intent(in) :: dtsub, vsph(np,np,2,nlev,2), eta_dot(np,np,nlevp,2) + real(real_kind), intent(inout) :: vnode(:,:,:,:) + + integer, parameter :: t0 = 1, t1 = 2 + + real(real_kind) :: vfsph(np,np,2), w1(np,np), w2(np,np), w3(np,np,3), w4(np,np,3) + integer :: k, d, i, k1, k2 + + do k = 1, nlev + w2 = hvcoord%etam(k) + if (k == 1 .or. k == nlev) then + if (k == 1) then + w3(:,:,1) = hvcoord%etai(1) + w4(:,:,1) = zero + do i = 1, 2 + w3(:,:,i+1) = hvcoord%etam(i) + w4(:,:,i+1) = eta_dot(:,:,i,t0) + end do + else + do i = 1, 2 + w3(:,:,i) = hvcoord%etam(nlev-2+i) + w4(:,:,i) = eta_dot(:,:,nlev-2+i,t0) + end do + w3(:,:,3) = hvcoord%etai(nlevp) + w4(:,:,3) = zero + end if + call eval_lagrange_poly_derivative(3, w3, w4, w2, w1) + else + k1 = k-1 + k2 = k+1 + do i = 1, 3 + w3(:,:,i) = hvcoord%etam(k1-1+i) + end do + call eval_lagrange_poly_derivative(k2-k1+1, w3, eta_dot(:,:,k1:k2,t0), w2, w1) + end if + w3(:,:,1:2) = gradient_sphere(eta_dot(:,:,k,t0), deriv, elem%Dinv) + vnode(4,:,:,k) = & + half*(eta_dot(:,:,k,t0) + eta_dot(:,:,k,t1) & + & - dtsub*(vsph(:,:,1,k,t1)*w3(:,:,1) + vsph(:,:,2,k,t1)*w3(:,:,2) & + & + eta_dot(:,:,k,t1)*w1)) + end do + end subroutine calc_eta_dot_formula_node_ref_mid + + subroutine update_dep_points_all(independent_time_steps, dtsub, nets, nete, vdep) + ! Determine the departure points corresponding to the reference grid's + ! arrival midpoints. Reads and writes dep_points_all. Reads vdep. + + use physical_constants, only: scale_factor + + logical, intent(in) :: independent_time_steps + real(real_kind), intent(in) :: dtsub + integer, intent(in) :: nets, nete + real(real_kind), intent(in) :: vdep(:,:,:,:,:) + + real(real_kind) :: norm, p(3) + integer :: ie, k, j, i + + do ie = nets, nete + do k = 1, nlev + do j = 1, np + do i = 1, np + ! Update horizontal position. + p = dep_points_all(1:3,i,j,k,ie) + p = p - dtsub*vdep(1:3,i,j,k,ie)/scale_factor + if (is_sphere) then + norm = sqrt(p(1)*p(1) + p(2)*p(2) + p(3)*p(3)) + p = p/norm + end if + dep_points_all(1:3,i,j,k,ie) = p + if (independent_time_steps) then + ! Update vertical position. + dep_points_all(4,i,j,k,ie) = dep_points_all(4,i,j,k,ie) - & + & dtsub*vdep(4,i,j,k,ie) + end if + end do + end do + end do + end do + end subroutine update_dep_points_all + + subroutine interp_departure_points_to_floating_level_midpoints( & + elem, nets, nete, tl, hvcoord, dep_points_all, limcnt) + ! Determine the departure points corresponding to the vertically Lagragnian + ! grid's arrival midpoints, where the floating levels are those that evolve + ! over the course of the full tracer time step. Also compute + ! elem%derived%divdp, which holds the floating levels' dp values for later + ! use in vertical remap. + + type (element_t), intent(inout) :: elem(:) + integer, intent(in) :: nets, nete + type (hvcoord_t), intent(in) :: hvcoord + type (TimeLevel_t), intent(in) :: tl + real(real_kind), intent(inout) :: dep_points_all(:,:,:,:,:) + integer, intent(inout) :: limcnt + + real(real_kind) :: deta_ref(nlevp), w1(np,np), v1(np,np,nlev), & + & v2(np,np,nlevp), p(3) + integer :: ie, i, j, k, d + + call set_deta_tol(hvcoord) + + deta_ref(1) = hvcoord%etam(1) - hvcoord%etai(1) + do k = 2, nlev + deta_ref(k) = hvcoord%etam(k) - hvcoord%etam(k-1) + end do + deta_ref(nlevp) = hvcoord%etai(nlevp) - hvcoord%etam(nlev) + + do ie = nets, nete + ! Surface pressure. + w1 = hvcoord%hyai(1)*hvcoord%ps0 + sum(elem(ie)%state%dp3d(:,:,:,tl%np1), 3) + + ! Reconstruct Lagrangian levels at t1 on arrival column: + ! eta_arr_int = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_int) + call limit_etam(hvcoord, deta_ref, dep_points_all(4,:,:,:,ie), v1, limcnt) + v2(:,:,1) = hvcoord%etai(1) + v2(:,:,nlevp) = hvcoord%etai(nlevp) + call eta_interp_eta(hvcoord, v1, hvcoord%etam, & + & nlevp-2, hvcoord%etai(2:nlev), v2(:,:,2:nlev)) + call eta_to_dp(hvcoord, w1, v2, elem(ie)%derived%divdp) + + ! Compute Lagrangian level midpoints at t1 on arrival column: + ! eta_arr_mid = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_mid) + call eta_interp_eta(hvcoord, v1, hvcoord%etam, & + & nlev, hvcoord%etam, v2(:,:,1:nlev)) + dep_points_all(4,:,:,:,ie) = v2(:,:,1:nlev) + + ! Compute departure horizontal points corresponding to arrival + ! Lagrangian level midpoints: + ! p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid) + do d = 1, 3 + v1 = dep_points_all(d,:,:,:,ie) + call eta_interp_horiz(hvcoord, hvcoord%etam, v1, & + & v2(:,:,1:nlev), dep_points_all(d,:,:,:,ie)) + end do + if (is_sphere) then + ! Normalize p = (x,y,z). + do k = 1, nlev + do j = 1, np + do i = 1, np + p = dep_points_all(1:3,i,j,k,ie) + p = p/sqrt(p(1)*p(1) + p(2)*p(2) + p(3)*p(3)) + dep_points_all(1:3,i,j,k,ie) = p + end do + end do + end do + end if + end do + end subroutine interp_departure_points_to_floating_level_midpoints + + subroutine set_deta_tol(hvcoord) + type (hvcoord_t), intent(in) :: hvcoord + + real(real_kind) :: deta_ave + integer :: k + + if (deta_tol >= 0) return + + ! Benign write race condition. A thread might see eta_tol < 0 and set it + ! here even as another thread does the same. But because there is no read + ! and only one value to write, the redundant writes don't matter. + + deta_ave = (hvcoord%etai(nlev+1) - hvcoord%etai(1)) / nlev + deta_tol = 10_real_kind*eps*deta_ave + end subroutine set_deta_tol + + subroutine limit_etam(hvcoord, deta_ref, eta, eta_lim, cnt) + type (hvcoord_t), intent(in) :: hvcoord + real(real_kind), intent(in) :: deta_ref(nlevp), eta(np,np,nlev) + real(real_kind), intent(out) :: eta_lim(np,np,nlev) + integer, intent(inout) :: cnt + + real(real_kind) :: deta(nlevp) + integer :: i, j, k + logical :: ok + + do j = 1, np + do i = 1, np + ! Check nonmonotonicity in eta. + ok = eta(i,j,1) - hvcoord%etai(1) >= deta_tol + if (ok) then + do k = 2, nlev + if (eta(i,j,k) - eta(i,j,k-1) < deta_tol) then + ok = .false. + exit + end if + end do + if (ok) then + ok = hvcoord%etai(nlevp) - eta(i,j,nlev) >= deta_tol + end if + end if + ! eta is monotonically increasing, so don't need to do anything + ! further. + if (ok) then + eta_lim(i,j,:) = eta(i,j,:) + cycle + end if + + deta(1) = eta(i,j,1) - hvcoord%etai(1) + do k = 2, nlev + deta(k) = eta(i,j,k) - eta(i,j,k-1) + end do + deta(nlevp) = hvcoord%etai(nlevp) - eta(i,j,nlev) + ! [0, etam(1)] and [etam(nlev),1] are half levels, but deta_tol is so + ! small there's no reason not to use it as a lower bound for these. + cnt = cnt + 1 + call deta_caas(nlevp, deta_ref, deta_tol, deta) + eta_lim(i,j,1) = hvcoord%etai(1) + deta(1) + do k = 2, nlev + eta_lim(i,j,k) = eta_lim(i,j,k-1) + deta(k) + end do + end do + end do + end subroutine limit_etam + + subroutine deta_caas(nlp, deta_ref, lo, deta) + integer, intent(in) :: nlp + real(real_kind), intent(in) :: deta_ref(nlp), lo + real(real_kind), intent(inout) :: deta(nlp) + + real(real_kind) :: nerr, w(nlp) + integer :: k + + nerr = zero + do k = 1, nlp + if (deta(k) < lo) then + nerr = nerr + (deta(k) - lo) + deta(k) = lo + w(k) = zero + else + if (deta(k) > deta_ref(k)) then + ! Only pull mass from intervals that are larger than their + ! reference value. This concentrates changes to intervals that, by + ! having a lot more mass than usual, drive other levels negative. + w(k) = deta(k) - deta_ref(k) + else + w(k) = zero + end if + end if + end do + if (nerr /= zero) deta = deta + nerr*(w/sum(w)) + end subroutine deta_caas + + subroutine linterp(n, x, y, ni, xi, yi, caller) + ! Linear interpolant: yi = I[y(x)](xi). + ! x and xi must be in ascending order. + ! xi(1) must be >= x(1) and xi(ni) must be <= x(n). + + use kinds, only: iulog + + integer, intent(in) :: n, ni + real(real_kind), intent(in) :: x(n), y(n), xi(ni) + real(real_kind), intent(out) :: yi(ni) + character(len=*), intent(in) :: caller + + integer :: k, ki + real(real_kind) :: a + + if (xi(1) < x(1) .or. xi(ni) > x(n)) then + write(iulog,*) 'x', x + write(iulog,*) 'xi', xi + call abortmp('sl_vertically_remap_tracers> linterp xi out of bounds: ' & + // trim(caller)) + end if + + k = 2 + do ki = 1, ni + do while (x(k) < xi(ki)) + k = k + 1 + end do + a = (xi(ki) - x(k-1))/(x(k) - x(k-1)) + yi(ki) = (1 - a)*y(k-1) + a*y(k) + end do + end subroutine linterp + + subroutine eta_interp_eta(hvcoord, x, y, ni, xi, yi) + type (hvcoord_t), intent(in) :: hvcoord + real(real_kind), intent(in) :: x(np,np,nlev), y(nlev) + integer, intent(in) :: ni + real(real_kind), intent(in) :: xi(ni) + real(real_kind), intent(out) :: yi(np,np,ni) + + real(real_kind) :: x01(nlev+2), y01(nlev+2) + integer :: i, j + + x01(1) = hvcoord%etai(1) + x01(nlev+2) = hvcoord%etai(nlevp) + y01(1) = hvcoord%etai(1) + y01(2:nlev+1) = y + y01(nlev+2) = hvcoord%etai(nlevp) + do j = 1, np + do i = 1, np + x01(2:nlev+1) = x(i,j,:) + call linterp(nlev+2, x01, y01, & + & ni, xi, yi(i,j,:), & + & 'eta_interp_eta') + end do + end do + end subroutine eta_interp_eta + + subroutine eta_interp_horiz(hvcoord, x, y, xi, yi) + type (hvcoord_t), intent(in) :: hvcoord + real(real_kind), intent(in) :: x(nlev), y(np,np,nlev), xi(np,np,nlev) + real(real_kind), intent(out) :: yi(np,np,nlev) + + real(real_kind) :: xbdy(nlev+2), ybdy(nlev+2) + integer :: i, j + + xbdy(1) = hvcoord%etai(1) + xbdy(2:nlev+1) = x + xbdy(nlev+2) = hvcoord%etai(nlevp) + do j = 1, np + do i = 1, np + ! Do constant interp outside of the etam support. + ybdy(1) = y(i,j,1) + ybdy(2:nlev+1) = y(i,j,:) + ybdy(nlev+2) = y(i,j,nlev) + call linterp(nlev+2, xbdy, ybdy, & + & nlev, xi(i,j,:), yi(i,j,:), & + & 'eta_interp_horiz') + end do + end do + end subroutine eta_interp_horiz + + subroutine eta_to_dp(hvcoord, ps, etai, dp) + ! e = A(e) + B(e) + ! p(e) = A(e) p0 + B(e) ps + ! = e p0 + B(e) (ps - p0) + ! a= e p0 + I[Bi(eref)](e) (ps - p0) + + type (hvcoord_t), intent(in) :: hvcoord + real(real_kind), intent(in) :: ps(np,np), etai(np,np,nlevp) + real(real_kind), intent(out) :: dp(np,np,nlev) + + real(real_kind) :: Bi(nlevp), dps + integer :: i, j, k + + do j = 1, np + do i = 1, np + call linterp(nlevp, hvcoord%etai, hvcoord%hybi, & + & nlevp, etai(i,j,:), Bi, & + & 'eta_to_dp') + dps = ps(i,j) - hvcoord%ps0 + do k = 1, nlev + dp(i,j,k) = (etai(i,j,k+1) - etai(i,j,k))*hvcoord%ps0 + & + & (Bi(k+1) - Bi(k))*dps + end do + end do + end do + end subroutine eta_to_dp + + subroutine dss_vnode(elem, nets, nete, hybrid, vnode) + type (element_t), intent(in) :: elem(:) + type (hybrid_t), intent(in) :: hybrid + integer, intent(in) :: nets, nete + real(real_kind) :: vnode(:,:,:,:,:) + + integer :: nd, nlyr, ie, k, d + + nd = size(vnode, 1) + nlyr = nd*nlev + + do ie = nets, nete + do k = 1, nlev + do d = 1, nd + vnode(d,:,:,k,ie) = vnode(d,:,:,k,ie)* & + & elem(ie)%spheremp*elem(ie)%rspheremp + end do + end do + do d = 1, nd + call edgeVpack_nlyr(edge_g, elem(ie)%desc, vnode(d,:,:,:,ie), & + & nlev, nlev*(d-1), nlyr) + end do + end do + + call t_startf('SLMM_bexchV') + call bndry_exchangeV(hybrid, edge_g) + call t_stopf('SLMM_bexchV') + + do ie = nets, nete + do d = 1, nd + call edgeVunpack_nlyr(edge_g, elem(ie)%desc, vnode(d,:,:,:,ie), & + & nlev, nlev*(d-1), nlyr) + end do + end do + +#if (defined HORIZ_OPENMP) + !$omp barrier +#endif + end subroutine dss_vnode + + subroutine dss_divdp(elem, nets, nete, hybrid) + type (element_t), intent(inout) :: elem(:) + type (hybrid_t), intent(in) :: hybrid + integer, intent(in) :: nets, nete + + integer :: ie, k + + do ie = nets, nete + do k = 1, nlev + elem(ie)%derived%divdp(:,:,k) = elem(ie)%derived%divdp(:,:,k)* & + & elem(ie)%spheremp*elem(ie)%rspheremp + end do + call edgeVpack_nlyr(edge_g, elem(ie)%desc, elem(ie)%derived%divdp, & + & nlev, 0, nlev) + end do + + call t_startf('SLMM_bexchV') + call bndry_exchangeV(hybrid, edge_g) + call t_stopf('SLMM_bexchV') + + do ie = nets, nete + call edgeVunpack_nlyr(edge_g, elem(ie)%desc, elem(ie)%derived%divdp, & + & nlev, 0, nlev) + end do + +#if (defined HORIZ_OPENMP) + !$omp barrier +#endif + end subroutine dss_divdp + + function assert(b, msg) result(nerr) + use kinds, only: iulog + + logical, intent(in) :: b + character(*), optional, intent(in) :: msg + + character(len=128) :: s integer :: nerr nerr = 0 - nerr = nerr + test_lagrange() - nerr = nerr + test_reconstruct_and_limit_dp() + if (b) return - if (nerr > 0 .and. par%masterproc) write(iulog,'(a,i3)') 'sl_unittest FAIL', nerr + s = '' + if (present(msg)) s = msg + write(iulog,'(a,a)') 'COMPOSE> sl_advection ASSERT: ', trim(s) + nerr = 1 + end function assert + + function test_linterp() result (nerr) + integer, parameter :: n = 128, ni = 111 + + real(real_kind) :: x(n), y(n), xi(ni), yi(ni), yin(n), a + integer :: k, nerr + + call random_number(x) + do k = 2, n + x(k) = x(k) + x(k-1) + end do + y = 3*x + + do k = 1, ni + a = real(k, real_kind)/(ni+1) + xi(k) = (1 - a)*x(1) + a*x(n) + end do + + call linterp(n, x, y, ni, xi, yi, 'test_linterp 1') + nerr = assert(maxval(abs( yi - 3*xi)) < 100*eps*x(n), 'linterp 1') + + call linterp(n, x, y, n, x, yin, 'test_linterp 2') + nerr = nerr + assert(maxval(abs(yin - y)) < 10*eps, 'linterp 2') + end function test_linterp + + function test_eta_to_dp(hvcoord) result(nerr) + type (hvcoord_t), intent(in) :: hvcoord + + real(real_kind) :: ps(np,np), etai(np,np,nlevp), dp1(np,np,nlev), & + & dp2(np,np,nlev) + integer :: nerr, i, j, k + + nerr = 0 + + call random_number(ps) + ps = (one + 0.2*(ps - 0.5))*hvcoord%ps0 + + do k = 1, nlev + dp1(:,:,k) = (hvcoord%hyai(k+1) - hvcoord%hyai(k))*hvcoord%ps0 + & + & (hvcoord%hybi(k+1) - hvcoord%hybi(k))*ps + end do + + ! Test that for etai_ref we get the same as the usual formula. + do j = 1, np + do i = 1, np + etai(i,j,:) = hvcoord%etai + end do + end do + call eta_to_dp(hvcoord, ps, etai, dp2) + nerr = nerr + assert(maxval(abs(dp2-dp1)) < 100*eps*maxval(dp1), 'eta_to_dp 1') + end function test_eta_to_dp + + function test_deta_caas() result(nerr) + integer, parameter :: nl = 128, nlp = nl+1 + + real(real_kind) :: deta_ref(nlp), etam_ref(nl), deta_tol, etam(nl), & + & deta(nlp) + integer :: i, k, nerr + + nerr = 0 + + call random_number(deta_ref) + deta_ref = deta_ref + 0.1 + deta_ref = deta_ref/sum(deta_ref) + + deta_tol = 10_real_kind*eps*sum(deta_ref)/size(deta_ref) + nerr = nerr + assert(deta_tol < minval(deta_ref), 'deta_caas 1') + + ! Test: Input not touched. + deta = deta_ref + call deta_caas(nlp, deta_ref, deta_tol, deta) + nerr = nerr + assert(maxval(abs(deta-deta_ref)) == zero, 'deta_caas 2') + + etam_ref(1) = deta_ref(1) + do k = 2, nl + etam_ref(k) = etam_ref(k-1) + deta_ref(k) + end do + + ! Test: Modify one etam and only adjacent intervals change beyond eps. + do i = 1, 2 + etam = etam_ref + if (i == 1) then + etam(11) = etam(11) + 1.1 + else + etam(11) = etam(11) - 13.1 + end if + deta(1) = etam(1) + do k = 2, nl + deta(k) = etam(k) - etam(k-1) + end do + deta(nlp) = one - etam(nl) + nerr = nerr + assert(minval(deta) < deta_tol, 'deta_caas 3') + call deta_caas(nlp, deta_ref, deta_tol, deta) + nerr = nerr + assert(minval(deta) == deta_tol, 'deta_caas 4') + nerr = nerr + assert(abs(sum(deta) - one) < 100*eps, 'deta_caas 5') + deta = abs(deta - deta_ref) + nerr = nerr + assert(maxval(deta(:10)) < 100*eps, 'deta_caas 6') + nerr = nerr + assert(maxval(deta(13:)) < 100*eps, 'deta_caas 7') + end do + + ! Test: Completely messed up levels. + call random_number(deta) + deta = deta - 0.5_real_kind + if (sum(deta) < 0.1) deta = deta + (0.1 - sum(deta))/nlp + deta = deta/sum(deta) + call deta_caas(nlp, deta_ref, deta_tol, deta) + nerr = nerr + assert(minval(deta) == deta_tol, 'deta_caas 8') + nerr = nerr + assert(abs(sum(deta) - one) < 1000*eps, 'deta_caas 9') + end function test_deta_caas + + function test_init_velocity_record() result(error) + integer :: dtf, drf, nsub, nvel, e, error + type (velocity_record_t) :: v + + error = 0 + dtf = 6 + drf = 2 + nsub = 3 + nvel = 4 + call init_velocity_record(1, dtf, drf, nsub, nvel, v, e) + call test(dtf, drf, nsub, nvel, v, e) + if (e > 0) error = 1 + call cleanup(v) + nvel = 3 + call init_velocity_record(1, dtf, drf, nsub, nvel, v, e) + call test(dtf, drf, nsub, nvel, v, e) + if (e > 0) error = 1 + call cleanup(v) + drf = 3 + nvel = 6 + call init_velocity_record(1, dtf, drf, nsub, nvel, v, e) + call test(dtf, drf, nsub, nvel, v, e) + if (e > 0) error = 1 + call cleanup(v) + drf = 1 + nsub = 5 + call init_velocity_record(1, dtf, drf, nsub, nvel, v, e) + call test(dtf, drf, nsub, nvel, v, e) + if (e > 0) error = 1 + call cleanup(v) + dtf = 12 + drf = 2 + nsub = 3 + nvel = -1 + call init_velocity_record(1, dtf, drf, nsub, nvel, v, e) + call test(dtf, drf, nsub, nvel, v, e) + if (e > 0) error = 1 + call cleanup(v) + nsub = 5 + nvel = 5 + call init_velocity_record(1, dtf, drf, nsub, nvel, v, e) + call test(dtf, drf, nsub, nvel, v, e) + if (e > 0) error = 1 + call cleanup(v) + dtf = 27 + drf = 3 + nsub = 51 + nvel = 99 + call init_velocity_record(1, dtf, drf, nsub, nvel, v, e) + call test(dtf, drf, nsub, nvel, v, e) + if (e > 0) error = 1 + call cleanup(v) + + contains + subroutine test(dtf, drf, nsub, nvel, v, error) + integer, intent(in) :: dtf, drf, nsub, nvel + integer, intent(inout) :: error + type (velocity_record_t), intent(in) :: v + + real(kind=real_kind) :: endslots(2), ys(dtf), a, x, y, y0, y1, & + & xsup(2), ysup(2) + integer :: n, e, i, k + + e = 0 + + if (modulo(dtf, drf) /= 0) then + print *, 'TESTING ERROR: dtf % drf == 0 is required:', dtf, drf + end if + + ! Check that t_vel is monotonically increasing. + do n = 2, v%nvel + if (v%t_vel(n) <= v%t_vel(n-1)) e = 1 + end do + + ! Check that obs_slots does not reference end points. This should not + ! happen b/c nvel <= navail and observations are uniformly spaced. + do n = 1, dtf + do i = 1, 2 + if (v%obs_slots(n,i) == 0 .or. v%obs_slots(n,i) == dtf) e = 11 + end do + end do + + ! Check that weights sum to 1. + ys = 0 + do n = 1, dtf + do i = 1, 2 + if (v%obs_slots(n,i) > 0) then + ys(v%obs_slots(n,i)) = ys(v%obs_slots(n,i)) + v%obs_wts(n,i) + end if + end do + end do + do i = 2, v%nvel-1 + if (abs(ys(i) - 1) > 1e3*eps) e = 12 + end do + + ! Test for exact interp of an affine function. + ! Observe data forward in time. + endslots(1) = tfn(0.d0) + endslots(2) = tfn(real(dtf, real_kind)) + ys(:) = 0 + do n = 1, dtf + if (modulo(n, drf) /= 0) cycle + y = tfn(real(n, real_kind)) + do i = 1, 2 + if (v%obs_slots(n,i) == -1) cycle + ys(v%obs_slots(n,i)) = ys(v%obs_slots(n,i)) + v%obs_wts(n,i)*y + end do + end do + ! Use the data backward in time. + do n = 1, nsub + ! Each segment orders the data forward in time. Thus, data are always + ! ordered forward in time but used backward. + do i = 1, 2 + k = nsub - n + (i-1) + xsup(i) = (k*v%t_vel(v%nvel))/nsub + k = v%run_step(n+1-i) + if (k == 2) then + y0 = endslots(1) + else + y0 = ys(k-1) + end if + if (k == v%nvel) then + y1 = endslots(2) + else + y1 = ys(k) + end if + ysup(i) = ((v%t_vel(k) - xsup(i))*y0 + (xsup(i) - v%t_vel(k-1))*y1) / & + & (v%t_vel(k) - v%t_vel(k-1)) + end do + do i = 0, 10 + a = real(i, real_kind)/10 + x = (1-a)*xsup(1) + a*xsup(2) + y = (1-a)*ysup(1) + a*ysup(2) + if (abs(y - tfn(x)) > 1e3*eps) e = 2 + end do + end do + + if (error > 0 .or. e > 0) then + print *, 'ERROR', error, e + print '(a,i3,a,i3,a,i3,a,i3,a,i3)', 'dtf',dtf,' drf',drf,' nsub',nsub, & + ' nvel',nvel,' v%nvel',v%nvel + print '(a,99es11.3)', ' t_vel', (v%t_vel(n),n=1,v%nvel) + do n = 1, dtf-1 + print '(3i3,2f5.2)', n, v%obs_slots(n,:), v%obs_wts(n,:) + end do + do n = 0, nsub + print '(i3,i3)', n, v%run_step(n) + end do + error = 1 + end if + end subroutine test + + function tfn(x) result(y) + real(kind=real_kind), intent(in) :: x + real(kind=real_kind) :: y + + y = 7.1*x - 11.5 + end function tfn + + subroutine cleanup(v) + type (velocity_record_t), intent(inout) :: v + deallocate(v%t_vel, v%obs_slots, v%obs_wts, v%run_step, v%vel, v%dp) + end subroutine cleanup + end function test_init_velocity_record + + subroutine sl_unittest(par, hvcoord) + use kinds, only: iulog + + type (parallel_t), intent(in) :: par + type (hvcoord_t), intent(in) :: hvcoord + + integer :: n(6) + + n(1) = test_lagrange() + n(2) = test_reconstruct_and_limit_dp() + n(3) = test_deta_caas() + n(4) = test_linterp() + n(5) = test_eta_to_dp(hvcoord) + n(6) = test_init_velocity_record() + + if (sum(n) > 0 .and. par%masterproc) then + write(iulog,'(a,6i2)') 'COMPOSE> sl_unittest FAIL ', n + end if end subroutine sl_unittest end module sl_advection diff --git a/components/homme/src/test_mod.F90 b/components/homme/src/test_mod.F90 index 361465218e5..0f5220282cc 100644 --- a/components/homme/src/test_mod.F90 +++ b/components/homme/src/test_mod.F90 @@ -21,7 +21,7 @@ module test_mod use baroclinic_inst_mod, only: binst_init_state, jw_baroclinic use dcmip12_wrapper, only: dcmip2012_test1_1, dcmip2012_test1_2, dcmip2012_test1_3,& dcmip2012_test2_0, dcmip2012_test2_x, dcmip2012_test3, & - dcmip2012_test4_init, mtest_init, dcmip2012_test1_1_conv + dcmip2012_test4_init, mtest_init, dcmip2012_test1_conv use dcmip16_wrapper, only: dcmip2016_test1, dcmip2016_test2, dcmip2016_test3, & dcmip2016_test1_forcing, dcmip2016_test2_forcing, dcmip2016_test3_forcing, & dcmip2016_pg_init, dcmip2016_test1_pg, dcmip2016_test1_pg_forcing, dcmip2016_init @@ -68,7 +68,8 @@ subroutine set_test_initial_conditions(elem, deriv, hybrid, hvcoord, tl, nets, n case('asp_tracer'); case('baroclinic'); case('dcmip2012_test1_1'); - case('dcmip2012_test1_1_conv'); + case('dcmip2012_test1_3a_conv', 'dcmip2012_test1_3b_conv', 'dcmip2012_test1_3c_conv', & + 'dcmip2012_test1_3d_conv', 'dcmip2012_test1_3e_conv', 'dcmip2012_test1_3f_conv') case('dcmip2012_test1_2'); case('dcmip2012_test1_3'); case('dcmip2012_test2_0'); @@ -118,9 +119,10 @@ subroutine set_test_initial_conditions(elem, deriv, hybrid, hvcoord, tl, nets, n case('asp_tracer'); call asp_tracer (elem,hybrid,hvcoord,nets,nete) case('baroclinic'); call binst_init_state (elem,hybrid, nets, nete, hvcoord) case('dcmip2012_test1_1'); call dcmip2012_test1_1(elem,hybrid,hvcoord,nets,nete,0.0d0,1,timelevels) - case('dcmip2012_test1_1_conv') + case('dcmip2012_test1_3a_conv', 'dcmip2012_test1_3b_conv', 'dcmip2012_test1_3c_conv', & + 'dcmip2012_test1_3d_conv', 'dcmip2012_test1_3e_conv', 'dcmip2012_test1_3f_conv') midpoint_eta_dot_dpdn = .true. - call dcmip2012_test1_1_conv(elem,hybrid,hvcoord,nets,nete,0.0d0,1,timelevels) + call dcmip2012_test1_conv(test_case,elem,hybrid,hvcoord,deriv,nets,nete,0.0d0,1,timelevels) case('dcmip2012_test1_2'); call dcmip2012_test1_2(elem,hybrid,hvcoord,nets,nete,0.0d0,1,timelevels) case('dcmip2012_test1_3'); call dcmip2012_test1_3(elem,hybrid,hvcoord,nets,nete,0.0d0,1,timelevels,deriv) case('dcmip2012_test2_0'); call dcmip2012_test2_0(elem,hybrid,hvcoord,nets,nete) @@ -197,7 +199,9 @@ subroutine set_test_prescribed_wind(elem, deriv, hybrid, hvcoord, dt, tl, nets, ! set prescribed quantities at timelevel np1 select case(test_case) case('dcmip2012_test1_1'); call dcmip2012_test1_1(elem,hybrid,hvcoord,nets,nete,time,np1,np1) - case('dcmip2012_test1_1_conv'); call dcmip2012_test1_1_conv(elem,hybrid,hvcoord,nets,nete,time,np1,np1) + case('dcmip2012_test1_3a_conv', 'dcmip2012_test1_3b_conv', 'dcmip2012_test1_3c_conv', & + 'dcmip2012_test1_3d_conv', 'dcmip2012_test1_3e_conv', 'dcmip2012_test1_3f_conv') + call dcmip2012_test1_conv(test_case,elem,hybrid,hvcoord,deriv,nets,nete,time,np1,np1) case('dcmip2012_test1_2'); call dcmip2012_test1_2(elem,hybrid,hvcoord,nets,nete,time,np1,np1) case('dcmip2012_test1_3'); call dcmip2012_test1_3(elem,hybrid,hvcoord,nets,nete,time,np1,np1,deriv) endselect @@ -358,7 +362,9 @@ subroutine print_test_results(elem, tl, hvcoord, par) type(parallel_t), intent(in) :: par select case(test_case) - case('dcmip2012_test1_1_conv'); call dcmip2012_print_test1_conv_results(elem, tl, hvcoord, par, 1) + case('dcmip2012_test1_3a_conv', 'dcmip2012_test1_3b_conv', 'dcmip2012_test1_3c_conv', & + 'dcmip2012_test1_3d_conv', 'dcmip2012_test1_3e_conv', 'dcmip2012_test1_3f_conv') + call dcmip2012_print_test1_conv_results(test_case, elem, tl, hvcoord, par, 1) end select end subroutine print_test_results diff --git a/components/homme/src/test_src/dcmip12_wrapper.F90 b/components/homme/src/test_src/dcmip12_wrapper.F90 index bd4da6eff78..2325137f391 100644 --- a/components/homme/src/test_src/dcmip12_wrapper.F90 +++ b/components/homme/src/test_src/dcmip12_wrapper.F90 @@ -12,7 +12,7 @@ module dcmip12_wrapper use control_mod, only: test_case, dcmip4_moist, dcmip4_X, vanalytic use dcmip2012_test1_2_3, only: test1_advection_deformation, test1_advection_hadley, test1_advection_orography, & test2_steady_state_mountain, test2_schaer_mountain,test3_gravity_wave -use dcmip2012_test1_conv, only: test1_conv_advection_deformation +use dcmip2012_test1_conv_mod, only: test1_conv_advection, test1_conv_print_results use dcmip2012_test4, only: test4_baroclinic_wave use mtests, only: mtest_state use derivative_mod, only: derivative_t, gradient_sphere @@ -116,82 +116,6 @@ subroutine dcmip2012_test1_1(elem,hybrid,hvcoord,nets,nete,time,n0,n1) end subroutine -!_____________________________________________________________________ -subroutine dcmip2012_test1_1_conv(elem,hybrid,hvcoord,nets,nete,time,n0,n1) - - ! 3d deformational flow - - ! Use physical constants consistent with HOMME - use physical_constants, only: Rd => Rgas, p0 - - type(element_t), intent(inout), target :: elem(:) ! element array - type(hybrid_t), intent(in) :: hybrid ! hybrid parallel structure - type(hvcoord_t), intent(inout) :: hvcoord ! hybrid vertical coordinates - integer, intent(in) :: nets,nete ! start, end element index - real(rl), intent(in) :: time ! current time - integer, intent(in) :: n0,n1 ! time level indices - - logical :: initialized = .false. - - integer, parameter :: zcoords = 0 ! we are not using z coords - logical, parameter :: use_eta = .true. ! we are using hybrid eta coords - real(rl), parameter :: & - T0 = 300.d0, & ! temperature (K) - ztop = 12000.d0, & ! model top (m) - H = Rd * T0 / g ! scale height - - integer :: i,j,k,ie ! loop indices - real(rl):: lon,lat ! pointwise coordiantes - real(rl):: p,z,phis,u,v,w,T,phis_ps,ps,rho,q(4),dp,eta_dot,dp_dn ! pointwise field values - - ! set analytic vertical coordinates at t=0 - if(.not. initialized) then - !$omp barrier - !$omp master - if (hybrid%masterthread) write(iulog,*) 'initializing dcmip2012 test 1-1: 3d deformational flow' - call get_evenly_spaced_p(zi,zm,0.0_rl,ztop,H) ! get evenly spaced p levels - hvcoord%etai = exp(-zi/H) ! set eta levels from z - call set_hybrid_coefficients(hvcoord,hybrid, hvcoord%etai(1),1.0_rl)! set hybrid A and B from eta levels - call set_layer_locations(hvcoord, .true., hybrid%masterthread) - initialized = .true. - !$omp end master - !$omp barrier - endif - - ! set prescribed state at level midpoints - do ie = nets,nete; do k=1,nlev; do j=1,np; do i=1,np - lon = elem(ie)%spherep(i,j)%lon; lat = elem(ie)%spherep(i,j)%lat - z = H * log(1.0d0/hvcoord%etam(k)) - p = p0 * hvcoord%etam(k) - call test1_conv_advection_deformation(time,lon,lat,p,z,zcoords,u,v,w,T,phis,ps,rho,q(1),q(2),q(3),q(4)) - - dp = pressure_thickness(ps,k,hvcoord) - call set_state(u,v,w,T,ps,phis,p,dp,zm(k),g, i,j,k,elem(ie),n0,n1) - if(time==0) call set_tracers(q,qsize,dp,i,j,k,lat,lon,elem(ie)) - - enddo; enddo; enddo; enddo - - ! set prescribed state at level interfaces - do ie = nets,nete; do k=1,nlevp; do j=1,np; do i=1,np - lon = elem(ie)%spherep(i,j)%lon; lat = elem(ie)%spherep(i,j)%lat - z = H * log(1.0d0/hvcoord%etai(k)) - p = p0 * hvcoord%etai(k) - call test1_conv_advection_deformation(time,lon,lat,p,z,zcoords,u,v,w,T,phis,ps,rho,q(1),q(2),q(3),q(4)) - call set_state_i(u,v,w,T,ps,phis,p,zi(k),g, i,j,k,elem(ie),n0,n1) - - ! get vertical derivative of p at point i,j,k - dp_dn = ddn_hyai(k)*p0 + ddn_hybi(k)*ps - - ! get vertical eta velocity at point i,j,k - eta_dot = -g*rho*w/p0 - - ! store vertical mass flux - elem(ie)%derived%eta_dot_dpdn_prescribed(i,j,k) = eta_dot * dp_dn - - enddo; enddo; enddo; enddo - -end subroutine - !_____________________________________________________________________ subroutine dcmip2012_test1_2(elem,hybrid,hvcoord,nets,nete,time,n0,n1) @@ -333,6 +257,105 @@ subroutine dcmip2012_test1_3(elem,hybrid,hvcoord,nets,nete,time,n0,n1,deriv) end subroutine +!_____________________________________________________________________ +subroutine dcmip2012_test1_conv(test_case,elem,hybrid,hvcoord,deriv,nets,nete,time,n0,n1) + + ! 3D tracer transport tests, modified to permit good convergence testing. + + ! Use physical constants consistent with HOMME + use physical_constants, only: Rd => Rgas, p0 + + character(len=*), intent(in) :: test_case + type(element_t), intent(inout), target :: elem(:) ! element array + type(hybrid_t), intent(in) :: hybrid ! hybrid parallel structure + type(hvcoord_t), intent(inout) :: hvcoord ! hybrid vertical coordinates + type (derivative_t),intent(in) :: deriv + integer, intent(in) :: nets,nete ! start, end element index + real(rl), intent(in) :: time ! current time + integer, intent(in) :: n0,n1 ! time level indices + + logical :: initialized = .false. + + real(rl), parameter :: & + T0 = 300.d0, & ! temperature (K) + ztop = 12000.d0, & ! model top (m) + H = Rd * T0 / g ! scale height + + integer :: i,j,k,ie ! loop indices + real(rl):: lon,lat,hyai,hyam,hybi,hybm ! pointwise coordiantes + real(rl):: p,z,phis,u,v,w,T,phis_ps,ps,rho,q(5),dp,eta_dot,dp_dn ! pointwise field values + logical :: use_w + real(rl):: grad_p(np,np,2),p_i(np,np),u_i(np,np),v_i(np,np) + + ! set analytic vertical coordinates at t=0 + if (.not. initialized) then + !$omp barrier + !$omp master + if (hybrid%masterthread) then + write(iulog,*) 'initializing dcmip2012 test 3(a-e): & + &modified 3d deformational flows for convergence testing' + end if + call get_evenly_spaced_z(zi,zm,0.0_rl,ztop) ! get evenly spaced z levels + hvcoord%etai = exp(-zi/H) ! set eta levels from z + call set_hybrid_coefficients(hvcoord,hybrid,hvcoord%etai(1),1.0_rl)! set hybrid A and B from eta levels + call set_layer_locations(hvcoord, .true., hybrid%masterthread) + initialized = .true. + !$omp end master + !$omp barrier + endif + + ! set prescribed state at level midpoints + do ie = nets,nete; do k=1,nlev; do j=1,np; do i=1,np + hyam = hvcoord%hyam(k); hybm = hvcoord%hybm(k) + lon = elem(ie)%spherep(i,j)%lon; lat = elem(ie)%spherep(i,j)%lat + z = H * log(1.0d0/hvcoord%etam(k)) + p = p0 * hvcoord%etam(k) + call test1_conv_advection(test_case,time,lon,lat,hyam,hybm,p,z,u,v,w,use_w, & + & T,phis,ps,rho,q) + dp = pressure_thickness(ps,k,hvcoord) + call set_state(u,v,w,T,ps,phis,p,dp,zm(k),g, i,j,k,elem(ie),n0,n1) + if (time==0) call set_tracers(q,qsize,dp,i,j,k,lat,lon,elem(ie)) + enddo; enddo; enddo; enddo + + ! set prescribed state at level interfaces + do ie = nets,nete + do k = 1,nlevp + do j = 1,np + do i = 1,np + hyai = hvcoord%hyai(k); hybi = hvcoord%hybi(k) + lon = elem(ie)%spherep(i,j)%lon; lat = elem(ie)%spherep(i,j)%lat + z = H * log(1.0d0/hvcoord%etai(k)) + p = p0 * hvcoord%etai(k) + call test1_conv_advection(test_case,time,lon,lat,hyai,hybi,p,z,u,v,w,use_w, & + & T,phis,ps,rho,q) + call set_state_i(u,v,w,T,ps,phis,p,zi(k),g,i,j,k,elem(ie),n0,n1) + if (use_w) then + ! get vertical derivative of p at point i,j,k + dp_dn = ddn_hyai(k)*p0 + ddn_hybi(k)*ps + ! get vertical eta velocity at point i,j,k + eta_dot = -g*rho*w/p0 + ! store vertical mass flux + elem(ie)%derived%eta_dot_dpdn_prescribed(i,j,k) = eta_dot * dp_dn + else + p_i(i,j) = p + u_i(i,j) = u + v_i(i,j) = v + end if + enddo + enddo + if (.not. use_w) then + ! get vertical mass flux + grad_p = gradient_sphere(p_i,deriv,elem(ie)%Dinv) + elem(ie)%derived%eta_dot_dpdn_prescribed(:,:,k) = -u_i*grad_p(:,:,1) - v_i*grad_p(:,:,2) + end if + enddo + if (.not. use_w) then + elem(ie)%derived%eta_dot_dpdn_prescribed(:,:,1) = 0 + elem(ie)%derived%eta_dot_dpdn_prescribed(:,:,nlevp) = 0 + end if + enddo +end subroutine dcmip2012_test1_conv + !_____________________________________________________________________ subroutine dcmip2012_test2_0(elem,hybrid,hvcoord,nets,nete) @@ -814,67 +837,18 @@ subroutine set_tracers(q,nq, dp,i,j,k,lat,lon,elem) end subroutine -subroutine dcmip2012_print_test1_conv_results(elem, tl, hvcoord, par, subnum) +subroutine dcmip2012_print_test1_conv_results(test_case, elem, tl, hvcoord, par, subnum) use time_mod, only: timelevel_t use parallel_mod, only: parallel_t - use dimensions_mod, only: nelemd, nlev, qsize - use parallel_mod, only: global_shared_buf, global_shared_sum - use global_norms_mod, only: wrap_repro_sum - use physical_constants, only: Rd => Rgas, p0 + character(len=*), intent(in) :: test_case type(element_t), intent(in) :: elem(:) type(timelevel_t), intent(in) :: tl type(hvcoord_t), intent(in) :: hvcoord type(parallel_t), intent(in) :: par integer, intent(in) :: subnum - integer, parameter :: zcoords = 0 - real(rl), parameter :: & - T0 = 300.d0, & ! temperature (K) - ztop = 12000.d0, & ! model top (m) - H = Rd * T0 / g ! scale height - - real(rl) :: q(np,np,4), lon, lat, z, p, phis, u, v, w, T, phis_ps, ps, rho, time, & - a, b, reldif - integer :: ie, k, iq, i, j - - ! Set time to 0 to get the initial conditions. - time = 0._rl - - do ie = 1,nelemd - global_shared_buf(ie,:2*qsize) = 0._rl - do k = 1,nlev - z = H * log(1.0d0/hvcoord%etam(k)) - p = p0 * hvcoord%etam(k) - do j = 1,np - do i = 1,np - lon = elem(ie)%spherep(i,j)%lon - lat = elem(ie)%spherep(i,j)%lat - select case(subnum) - case (1) - call test1_conv_advection_deformation( & - time,lon,lat,p,z,zcoords,u,v,w,T,phis,ps,rho, & - q(i,j,1),q(i,j,2),q(i,j,3),q(i,j,4)) - end select - end do - end do - do iq = 1,qsize - global_shared_buf(ie,2*iq-1) = global_shared_buf(ie,2*iq-1) + & - sum(elem(ie)%spheremp*(elem(ie)%state%Q(:,:,k,iq) - q(:,:,iq))**2) - global_shared_buf(ie,2*iq) = global_shared_buf(ie,2*iq) + & - sum(elem(ie)%spheremp*q(:,:,iq)**2) - end do - end do - end do - call wrap_repro_sum(nvars=2*qsize, comm=par%comm) - if (par%masterproc) then - do iq = 1,qsize - a = global_shared_sum(2*iq-1) - b = global_shared_sum(2*iq) - reldif = sqrt(a/b) - print '(a,i2,es24.16)', 'test1_conv> Q', iq, reldif - end do - end if + call test1_conv_print_results(test_case, elem, tl, hvcoord, par, subnum) end subroutine dcmip2012_print_test1_conv_results end module dcmip12_wrapper diff --git a/components/homme/src/test_src/dcmip2012_test1_conv.F90 b/components/homme/src/test_src/dcmip2012_test1_conv.F90 deleted file mode 100644 index 274dfcacb58..00000000000 --- a/components/homme/src/test_src/dcmip2012_test1_conv.F90 +++ /dev/null @@ -1,175 +0,0 @@ -module dcmip2012_test1_conv - implicit none - -contains - -SUBROUTINE test1_conv_advection_deformation (time,lon,lat,p,z,zcoords,u,v,w,t,phis,ps,rho,q1,q2,q3,q4) -!----------------------------------------------------------------------- -! input/output params parameters at given location -!----------------------------------------------------------------------- - - ! Use physical constants consistent with HOMME - use physical_constants, only: a=>rearth0, Rd => Rgas, g, cp, pi=>dd_pi, p0 - - real(8), intent(in) :: time ! simulation time (s) - real(8), intent(in) :: lon ! Longitude (radians) - real(8), intent(in) :: lat ! Latitude (radians) - real(8), intent(in) :: z ! Height (m) - real(8), intent(inout) :: p ! Pressure (Pa) - integer, intent(in) :: zcoords ! 0 or 1 see below - real(8), intent(out) :: u ! Zonal wind (m s^-1) - real(8), intent(out) :: v ! Meridional wind (m s^-1) - real(8), intent(out) :: w ! Vertical Velocity (m s^-1) - real(8), intent(out) :: T ! Temperature (K) - real(8), intent(out) :: phis ! Surface Geopotential (m^2 s^-2) - real(8), intent(out) :: ps ! Surface Pressure (Pa) - real(8), intent(out) :: rho ! density (kg m^-3) - real(8), intent(out) :: q1 ! Tracer q1 (kg/kg) - real(8), intent(out) :: q2 ! Tracer q2 (kg/kg) - real(8), intent(out) :: q3 ! Tracer q3 (kg/kg) - real(8), intent(out) :: q4 ! Tracer q4 (kg/kg) - - ! if zcoords = 1, then we use z and output p - ! if zcoords = 0, then we use p - -!----------------------------------------------------------------------- -! test case parameters -!----------------------------------------------------------------------- - real(8), parameter :: & - tau = 12.d0 * 86400.d0, & ! period of motion 12 days - u0 = (2.d0*pi*a)/tau, & ! 2 pi a / 12 days - k0 = (10.d0*a)/tau, & ! velocity magnitude - omega0 = (2*23000.d0*pi)/tau, & ! velocity magnitude - T0 = 300.d0, & ! temperature - H = Rd * T0 / g, & ! scale height - RR = 1.d0/2.d0, & ! horizontal half width divided by 'a' - ZZ = 1000.d0, & ! vertical half width - z0 = 5000.d0, & ! center point in z - lambda0 = 5.d0*pi/6.d0, & ! center point in longitudes - lambda1 = 7.d0*pi/6.d0, & ! center point in longitudes - phi0 = 0.d0, & ! center point in latitudes - phi1 = 0.d0, & - ztop = 12000.d0 - - real(8) :: height ! The height of the model levels - real(8) :: ptop ! model top in p - real(8) :: sin_tmp, cos_tmp, sin_tmp2, cos_tmp2 ! Calculate great circle distances - real(8) :: d1, d2, r, r2, d3, d4 ! For tracer calculations - real(8) :: s, bs, s_p ! Shape function, and parameter - real(8) :: lonp ! Translational longitude, depends on time - real(8) :: ud ! Divergent part of u - real(8) :: x,y,zeta,tmp - - !--------------------------------------------------------------------- - ! HEIGHT AND PRESSURE - !--------------------------------------------------------------------- - - ! height and pressure are aligned (p = p0 exp(-z/H)) - if (zcoords .eq. 1) then - height = z - p = p0 * exp(-z/H) - else - height = H * log(p0/p) - endif - - ! model top in p - ptop = p0*exp(-ztop/H) - - !--------------------------------------------------------------------- - ! THE VELOCITIES ARE TIME DEPENDENT AND THEREFORE MUST BE UPDATED - ! IN THE DYNAMICAL CORE - !--------------------------------------------------------------------- - - ! shape function - bs = 1.0d0 - s = 1.0 + exp((ptop-p0)/(bs*ptop)) - exp((p-p0)/(bs*ptop)) - exp((ptop-p)/(bs*ptop)) - s_p = (-exp((p-p0)/(bs*ptop)) + exp((ptop-p)/(bs*ptop)))/(bs*ptop) - - ! translational longitude - lonp = lon - 2.d0*pi*time/tau - - ! zonal velocity - ud = (omega0*a) * cos(lonp) * (cos(lat)**2.0) * cos(pi*time/tau) * s_p - - u = k0*sin(lonp)*sin(lonp)*sin(2.d0*lat)*cos(pi*time/tau) + u0*cos(lat) + ud - - ! meridional velocity - v = k0*sin(2.d0*lonp)*cos(lat)*cos(pi*time/tau) - - ! vertical velocity - can be changed to vertical pressure velocity by - ! omega = -(g*p)/(Rd*T0)*w - - w = -((Rd*T0)/(g*p))*omega0*sin(lonp)*cos(lat)*cos(pi*time/tau)*s - - !----------------------------------------------------------------------- - ! TEMPERATURE IS CONSTANT 300 K - !----------------------------------------------------------------------- - t = T0 - - !----------------------------------------------------------------------- - ! PHIS (surface geopotential) - !----------------------------------------------------------------------- - phis = 0.d0 - - !----------------------------------------------------------------------- - ! PS (surface pressure) - !----------------------------------------------------------------------- - ps = p0 - - !----------------------------------------------------------------------- - ! RHO (density) - !----------------------------------------------------------------------- - rho = p/(Rd*t) - - !----------------------------------------------------------------------- - ! initialize Q, set to zero - !----------------------------------------------------------------------- - ! q = 0.d0 - - !----------------------------------------------------------------------- - ! initialize tracers - !----------------------------------------------------------------------- - ! tracer 1 - a C^inf tracer field for order of accuracy analysis - - x = cos(lat)*cos(lon) - y = cos(lat)*sin(lon) - zeta = sin(lat) - q1 = 0.3d0*(1.1 + sin(0.25d0*pi*x)*sin(0.3d0*pi*y)*sin(0.25d0*pi*zeta)*sin(pi*(p-ptop)/(p0-ptop))) - - ! tracer 2 - correlated with 1 - q2 = 0.9d0 - 0.8d0*q1**2 - - ! tracer 3 - slotted ellipse - - sin_tmp = sin(lat) * sin(phi0) - cos_tmp = cos(lat) * cos(phi0) - sin_tmp2 = sin(lat) * sin(phi1) - cos_tmp2 = cos(lat) * cos(phi1) - - ! great circle distance without 'a' - r = ACOS (sin_tmp + cos_tmp*cos(lon-lambda0)) - r2 = ACOS (sin_tmp2 + cos_tmp2*cos(lon-lambda1)) - d1 = min( 1.d0, (r/RR)**2 + ((height-z0)/ZZ)**2 ) - d2 = min( 1.d0, (r2/RR)**2 + ((height-z0)/ZZ)**2 ) - - ! make the ellipse - if (d1 .le. RR) then - q3 = 1.d0 - elseif (d2 .le. RR) then - q3 = 1.d0 - else - q3 = 0.1d0 - endif - - ! put in the slot - if (height .gt. z0 .and. abs(lat) .lt. 0.125d0) then - q3 = 0.1d0 - endif - - ! tracer 4: q4 is chosen so that, in combination with the other three tracer - ! fields with weight (3/10), the sum is equal to one - q4 = 1.d0 - 0.3d0*(q1+q2+q3) - -END SUBROUTINE test1_conv_advection_deformation - -end module dcmip2012_test1_conv diff --git a/components/homme/src/test_src/dcmip2012_test1_conv_mod.F90 b/components/homme/src/test_src/dcmip2012_test1_conv_mod.F90 new file mode 100644 index 00000000000..b8805e4486e --- /dev/null +++ b/components/homme/src/test_src/dcmip2012_test1_conv_mod.F90 @@ -0,0 +1,548 @@ +module dcmip2012_test1_conv_mod + + ! Based on DCMIP 2012 tests 1-1,2,3. + + use parallel_mod, only: abortmp + ! Use physical constants consistent with HOMME + use physical_constants, only: a => rearth0, Rd => Rgas, g, cp, pi => dd_pi, p0 + + implicit none + private + + integer, parameter :: rt = 8 + + real(rt), parameter :: & + tau = 12.d0 * 86400.d0, & ! period of motion 12 days + T0 = 300.d0, & ! temperature (K) + ztop = 12000.d0, & ! model top (m) + H = Rd * T0 / g ! scale height + + ! For tracers. + real(rt), parameter :: qlon1 = 5.d0*(pi/6.d0), qlat1 = 0, & + & qlon2 = -qlon1, qlat2 = 0, & + & qsc_min = 0.1d0 + + real(rt), parameter :: zero = 0.d0, one = 1.d0, two = 2.d0 + + public :: test1_conv_advection, test1_conv_print_results + +contains + + subroutine get_nondiv2d_uv(time, lon, lat, u, v) + ! Classic 2D nondivergent flow field. + + real(rt), intent(in ) :: time, lon, lat + real(rt), intent(out) :: u, v + + real(rt), parameter :: & + u0 = (2.d0*pi*a)/tau, & ! 2 pi a / 12 days + k0 = (10.d0*a)/tau ! velocity magnitude + + real(rt) :: lonp + + ! translational longitude + lonp = lon - 2.d0*pi*time/tau + ! zonal velocity + u = k0*sin(lonp)*sin(lonp)*sin(2.d0*lat)*cos(pi*time/tau) + u0*cos(lat) + ! meridional velocity + v = k0*sin(2.d0*lonp)*cos(lat)*cos(pi*time/tau) + end subroutine get_nondiv2d_uv + + subroutine get_nondiv3d_uv(bs, pbot, ptop, zbot, ztop, ztaper, time, lon, lat, p, z, u, v, w) + real(rt), intent(in ) :: bs, pbot, ptop, zbot, ztop, ztaper, time, lon, lat, p, z + real(rt), intent(out) :: u, v, w + + real(rt), parameter :: omega0 = (2*23000.d0*pi)/tau + + real(rt) :: s, s_p, lonp, ud, c, arg + + ! This is essentially the test 1-1 flow. The key difference in this flow + ! removes the factor of 2 in ud and w cos-time factors. The 2 in the + ! original code makes trajectories not return to their initial points. + + ! Shape function in p. + if (p >= pbot .or. p <= ptop) then + s = 0 + s_p = 0 + else + c = 0.3d0 + arg = pi*(p - ptop)/(pbot - ptop) + s = c*sin(arg)**3 + s_p = (3*c*pi/(pbot - ptop))*sin(arg)**2*cos(arg) + end if + ! Translational longitude. + lonp = lon - 2.d0*pi*time/tau + ! Nondivergent 2D flow. + call get_nondiv2d_uv(time, lon, lat, u, v) + ! Taper the 2D nondiv (u,v) flow in the z direction. This does not induce + ! any w, and the 2D field remains nondivergent at each z. + u = u*ztaper + v = v*ztaper + ! Divergent flow. + ud = (omega0*a)*cos(lonp)*(cos(lat)**2.0)*cos(pi*time/tau)*s_p + u = u + ud + w = -((Rd*T0)/(g*p))*omega0*sin(lonp)*cos(lat)*cos(pi*time/tau)*s + end subroutine get_nondiv3d_uv + + function get_2d_cinf_tracer(lon, lat) result(q) + real(rt), intent(in) :: lon, lat + + real(rt) :: q + + real(rt) :: x, y, zeta + + x = cos(lat)*cos(lon) + y = cos(lat)*sin(lon) + zeta = sin(lat) + q = 1.5d0*(1 + sin(pi*x)*sin(pi*y)*sin(pi*zeta)) + end function get_2d_cinf_tracer + + subroutine ll2xyz(lon, lat, x, y, z) + ! Unit sphere. + + real(rt), intent(in) :: lon, lat + real(rt), intent(out) :: x, y, z + + real(rt) :: sinl, cosl + + sinl = sin(lat) + cosl = cos(lat) + x = cos(lon)*cosl + y = sin(lon)*cosl + z = sinl + end subroutine ll2xyz + + function great_circle_dist(lon1, lat1, lon2, lat2) result(d) + ! Unit sphere. + + real(rt), intent(in) :: lon1, lat1, lon2, lat2 + real(rt) :: d + + real(rt) xA, yA, zA, xB, yB, zB, cp1, cp2, cp3, cpnorm, dotprod + + call ll2xyz(lon1, lat1, xA, yA, zA) + call ll2xyz(lon2, lat2, xB, yB, zB) + cp1 = yA*zB - yB*zA + cp2 = xB*zA - xA*zB + cp3 = xA*yB - xB*yA + cpnorm = sqrt(cp1*cp1 + cp2*cp2 + cp3*cp3) + dotprod = xA*xB + yA*yB + zA*zB + d = atan2(cpnorm, dotprod) + end function great_circle_dist + + function q_gh(x, y, z, xi, yi, zi) result(q) + real(rt), intent(in) :: x, y, z, xi, yi, zi + real(rt) :: q + + real(rt), parameter :: h_max = 0.95d0, b = 5.d0 + real(rt) :: r2 + + r2 = (x - xi)**2 + (y - yi)**2 + (z - zi)**2 + q = h_max*exp(-b*r2) + end function q_gh + + function q_cb(r, ri) result(q) + real(rt), intent(in) :: r, ri + real(rt) :: q + + real(rt), parameter :: h_max = one + + q = 0.5d0*h_max*(1 + cos(pi*ri/r)) + end function q_cb + + function q_sc(clon_in, clat, lon, lat, up_slot) result(q) + real(rt), intent(in) :: clon_in, clat, lon, lat + logical, intent(in) :: up_slot + real(rt) :: q + + real(rt), parameter :: b = qsc_min, c = one, r = 0.5d0, & + & lon_thr = r/6.d0, lat_thr = 5*(r/12.d0) + + real(rt) :: clon, ri + + clon = clon_in + if (clon < zero) clon = clon + two*pi + + ri = great_circle_dist(lon, lat, clon, clat) + q = b + if (ri <= r) then + if (abs(lon - clon) >= lon_thr) then + q = c + return + else + if (up_slot) then + if (lat - clat < -lat_thr) then + q = c + return + end if + else + if (lat - clat > lat_thr) then + q = c + return + end if + end if + end if + end if + end function q_sc + + function get_2d_gaussian_hills(lon, lat) result(q) + real(rt), intent(in) :: lon, lat + real(rt) :: q + + real(rt) :: x1, y1, z1, x2, y2, z2, x, y, z + + call ll2xyz(qlon1, qlat1, x1, y1, z1) + call ll2xyz(qlon2, qlat2, x2, y2, z2) + call ll2xyz(lon, lat, x, y, z) + q = q_gh(x, y, z, x1, y1, z1) + q_gh(x, y, z, x2, y2, z2) + end function get_2d_gaussian_hills + + function get_2d_cosine_bells(lon, lat) result(q) + real(rt), intent(in) :: lon, lat + real(rt) :: q + + real(rt), parameter :: r = 0.5d0, b = 0.1d0, c = 0.9d0 + real(rt) :: h, ri + + h = 0 + ri = great_circle_dist(lon, lat, qlon1, qlat1) + if (ri < r) then + h = q_cb(r, ri) + else + ri = great_circle_dist(lon, lat, qlon2, qlat2) + if (ri < r) h = q_cb(r, ri) + end if + q = b + c*h + end function get_2d_cosine_bells + + function get_2d_correlated_cosine_bells(lon, lat) result(q) + real(rt), intent(in) :: lon, lat + real(rt) :: q + + real(rt), parameter :: a = -0.8d0, b = 0.9d0 + + q = get_2d_cosine_bells(lon, lat) + q = a*q + b + end function get_2d_correlated_cosine_bells + + function get_2d_slotted_cylinders(lon, lat) result(q) + real(rt), intent(in) :: lon, lat + real(rt) :: q + + q = q_sc(qlon1, qlat1, lon, lat, .true.) + if (q < 0.5d0) q = q_sc(qlon2, qlat2, lon, lat, .false.) + end function get_2d_slotted_cylinders + + subroutine test1_conv_advection_orography( & + test_minor,time,lon,lat,p,z,zcoords,cfv,hybrid_eta,hya,hyb,u,v,w,t,phis,ps,rho,q1,q2,q3,q4) + + character(len=1), intent(in) :: test_minor ! a, b, c, d, or e + real(rt), intent(in) :: time ! simulation time (s) + real(rt), intent(in) :: lon ! Longitude (radians) + real(rt), intent(in) :: lat ! Latitude (radians) + real(rt), intent(in) :: hya ! A coefficient for hybrid-eta coordinate + real(rt), intent(in) :: hyb ! B coefficient for hybrid-eta coordinate + + logical, intent(in) :: hybrid_eta ! flag to indicate whether the hybrid sigma-p (eta) coordinate is used + + real(rt), intent(out) :: p ! Pressure (Pa) + real(rt), intent(out) :: z ! Height (m) + + integer , intent(in) :: zcoords ! 0 or 1 see below + integer , intent(in) :: cfv ! 0, 1 or 2 see below + real(rt), intent(out) :: u ! Zonal wind (m s^-1) + real(rt), intent(out) :: v ! Meridional wind (m s^-1) + real(rt), intent(out) :: w ! Vertical Velocity (m s^-1) + real(rt), intent(out) :: t ! Temperature (K) + real(rt), intent(out) :: phis ! Surface Geopotential (m^2 s^-2) + real(rt), intent(out) :: ps ! Surface Pressure (Pa) + real(rt), intent(out) :: rho ! density (kg m^-3) + real(rt), intent(out) :: q1 ! Tracer q1 (kg/kg) + real(rt), intent(out) :: q2 ! Tracer q2 (kg/kg) + real(rt), intent(out) :: q3 ! Tracer q3 (kg/kg) + real(rt), intent(out) :: q4 ! Tracer q4 (kg/kg) + + real(rt), parameter :: & + u0 = 2.d0*pi*a/tau, & ! Velocity Magnitude (m/s) + alpha = pi/6.d0, & ! rotation angle (radians), 30 degrees + lambdam = 3.d0*pi/2.d0, & ! mountain longitude center point (radians) + phim = zero, & ! mountain latitude center point (radians) + h0 = 2000.d0, & ! peak height of the mountain range (m) + Rm = 3.d0*pi/4.d0, & ! mountain radius (radians) + ztop_t = 2000.d0, & ! transition layer + zbot_q = ztop_t + 500.d0, & ! bottom of tracers; below, all q = 0 + lon_offset = 0.5d0*pi, & ! longitudinal translation of std 2d test flow and qs + ! For Hadley-like flow. Multiply w and tracer vertical extent by (ztop + ! - ztop_t)/ztop to compensate for smaller domain. + tau_h = 86400.d0, & ! period of motion 1 day (in s) + z1_h = ztop_t + 1000.d0, & ! position of lower tracer bound (m) + z2_h = z1_h + 6000.d0, & ! position of upper tracer bound (m) + z0_h = 0.5d0*(z1_h+z2_h), & ! midpoint (m) + u0_h = 250.d0, & ! Zonal velocity magnitude (m/s) + ! w0_h is the main parameter to modify to make the test easier (smaller + ! w0_h) or harder (larger). + w0_h = 0.05d0, & ! Vertical velocity magnitude (m/s) + ! For 3D deformational flow. + bs_a = 1.0d0 ! shape function smoothness + + real(rt) :: r, height, zs, zetam, ztaper, rho0, z_q_shape, ptop, ptop_t, & + & c0, fl, fl_lat, gz, gz_z, fz, fz_z, delta, lambdam_t, u_topo_fac, & + & u0_topo, tau_topo + logical :: ps_timedep + + if (cfv /= 0) call abortmp('test1_conv_advection_orography does not support cfv != 0') + if (.not. hybrid_eta) call abortmp('test1_conv_advection_orography does not support !hybrid_eta') + if (zcoords /= 0) call abortmp('test1_conv_advection_orography does not support zcoords != 0') + + ! Mountain oscillation half-width (radians). + zetam = pi/14.d0 + ! Smooth mountains for very less resource-intensive convergence testing. + if (test_minor == 'c') zetam = pi/2.d0 + ! Smoother than default but still fairly rough. + if (test_minor == 'd' .or. test_minor == 'f') zetam = pi/6.d0 + + ps_timedep = test_minor == 'e' .or. test_minor == 'f' + lambdam_t = lambdam + if (ps_timedep) then + ! Move the topography to make ps depend on time. + u0_topo = u0 + tau_topo = tau + if (test_minor == 'e') then + u0_topo = u0_h + tau_topo = tau_h + end if + u_topo_fac = -u0_topo/two + lambdam_t = lambdam_t + & + & sin(pi*time/tau_topo)*(tau_topo/pi)*u_topo_fac & ! integral of u at lat = 0 + & /a ! to radians + end if + r = great_circle_dist(lambdam_t, phim, lon, lat) + if (r .lt. Rm) then + zs = (h0/2.d0)*(one+cos(pi*r/Rm))*cos(pi*r/zetam)**2.d0 + else + zs = zero + endif + if (test_minor == 'a') zs = zero + zs = -zs ! holes instead of mountains + phis = g*zs + ps = p0 * exp(-zs/H) + + p = hya*p0 + hyb*ps + height = H * log(p0/p) + z = height + + T = T0 + + rho = p/(Rd*T) + rho0 = p0/(Rd*T) + + if (z <= 0) then + ztaper = 0 + elseif (z >= ztop_t) then + ztaper = 1 + else + ztaper = (1 + cos(pi*(1 + z/ztop_t)))/2 + end if + + w = zero + + select case(test_minor) + case('z') ! currently unused + ! Solid body rotation + ! Zonal Velocity + u = u0*(cos(lat)*cos(alpha)+sin(lat)*cos(lon)*sin(alpha)) + ! Meridional Velocity + v = -u0*(sin(lon)*sin(alpha)) + u = u*ztaper + v = v*ztaper + case('b') + ! 2D nondiv flow in each layer. + call get_nondiv2d_uv(time, lon + lon_offset, lat, u, v) + u = u*ztaper + v = v*ztaper + case('a', 'c', 'd', 'f') + ! 3D nondiv flow. + ptop_t = p0*exp(-ztop_t/H) + ptop = p0*exp(-ztop/H) + call get_nondiv3d_uv(bs_a, ptop_t, ptop, ztop_t, ztop, ztaper, & + & time, lon + lon_offset, lat, p, z, u, v, w) + case('e') + ! Similar to Hadley-like flow but with more smoothness in derivatives. + u = u0_h*cos(lat)*cos(pi*time/tau_h)*ztaper + fl = cos(lat)**2 + fl_lat = -2*cos(lat)*sin(lat) + if (z <= 0) then + fz = 0 + fz_z = 0 + else + gz = pi*z/ztop + gz_z = pi/ztop + fz = -sin(gz)**3 + fz_z = -3*sin(gz)**2*cos(gz)*gz_z + end if + c0 = w0_h*(rho0/rho)*cos(pi*time/tau_h) + w = c0*(cos(lat)*fl_lat - 2*sin(lat)*fl)*fz + v = -a*c0*(cos(lat)*fl )*fz_z + case default + call abortmp('test1_conv_advection_orography: invalid case') + end select + + if (ps_timedep) then + ! Low-level solid-body rotational wind for consistency with the moving ps + ! field. + u = u + cos(pi*time/tau_topo)*u_topo_fac*(1 - ztaper)*cos(lat) + end if + + if (time > 0) then + q1 = 0; q2 = 0; q3 = 0; q4 = 0 + return + end if + + z_q_shape = 0.5d0*(1 - cos(2*pi*(z - zbot_q)/(ztop - zbot_q))) + if (z < zbot_q .or. z > ztop) z_q_shape = zero + + select case(test_minor) + case('e') + if (height < z2_h .and. height > z1_h) then + q1 = 0.5d0 * (one + cos(2.d0*pi*(z-z0_h)/(z2_h-z1_h))) + else + q1 = zero + end if + q2 = q1 * get_2d_cinf_tracer(lon, lat) + q3 = q1 * get_2d_gaussian_hills(lon - lon_offset, lat) + q4 = q1 * get_2d_cosine_bells(lon - lon_offset, lat) + + case default + q1 = z_q_shape * get_2d_gaussian_hills(lon - lon_offset, lat) + q2 = z_q_shape * get_2d_cosine_bells(lon - lon_offset, lat) + q4 = z_q_shape * get_2d_correlated_cosine_bells(lon - lon_offset, lat) + ! Tracer discontinuous in 3D. + q3 = qsc_min + delta = z2_h - z1_h + if ( (z >= z1_h .and. z <= z1_h + 0.25d0*delta) .or. & + (z >= z1_h + 0.4d0 *delta .and. z <= z2_h - 0.4d0 *delta) .or. & + (z <= z2_h .and. z >= z2_h - 0.25d0*delta)) then + q3 = get_2d_slotted_cylinders(lon - lon_offset, lat) + end if + end select + end subroutine test1_conv_advection_orography + + subroutine test1_conv_advection(test_case,time,lon,lat,hya,hyb,p,z,u,v,w,use_w,t,phis,ps,rho,q) + character(len=*), intent(in) :: test_case ! dcmip2012_test1_{3a-f}_conv + real(rt), intent(in) :: time ! simulation time (s) + real(rt), intent(in) :: lon, lat ! Longitude, latitude (radians) + real(rt), intent(in) :: hya, hyb ! Hybrid a, b coefficients + real(rt), intent(inout) :: z ! Height (m) + real(rt), intent(inout) :: p ! Pressure (Pa) + real(rt), intent(out) :: u ! Zonal wind (m s^-1) + real(rt), intent(out) :: v ! Meridional wind (m s^-1) + real(rt), intent(out) :: w ! Vertical Velocity (m s^-1) + logical , intent(out) :: use_w ! Should caller use w or instead div(u,v)? + real(rt), intent(out) :: T ! Temperature (K) + real(rt), intent(out) :: phis ! Surface Geopotential (m^2 s^-2) + real(rt), intent(out) :: ps ! Surface Pressure (Pa) + real(rt), intent(out) :: rho ! density (kg m^-3) + real(rt), intent(out) :: q(5) ! Tracer q1 (kg/kg) + + integer, parameter :: cfv = 0, zcoords = 0 + logical, parameter :: use_eta = .true. + + character(len=1) :: test_major, test_minor + + test_major = test_case(17:17) + if (test_major == '3') test_minor = test_case(18:18) + + use_w = .false. + select case(test_major) + case('3') + call test1_conv_advection_orography( & + test_minor,time,lon,lat,p,z,zcoords,cfv,use_eta,hya,hyb,u,v,w,t,phis,ps,rho, & + q(1),q(2),q(3),q(4)) + end select + end subroutine test1_conv_advection + + subroutine test1_conv_print_results(test_case, elem, tl, hvcoord, par, subnum) + use element_mod, only: element_t + use time_mod, only: timelevel_t + use hybvcoord_mod, only: hvcoord_t + use parallel_mod, only: parallel_t, pmax_1d + use dimensions_mod, only: nelemd, nlev, qsize, np + use parallel_mod, only: global_shared_buf, global_shared_sum + use global_norms_mod, only: wrap_repro_sum + use physical_constants, only: Rd => Rgas, p0 + + character(len=*), intent(in) :: test_case + type(element_t), intent(in) :: elem(:) + type(timelevel_t), intent(in) :: tl + type(hvcoord_t), intent(in) :: hvcoord + type(parallel_t), intent(in) :: par + integer, intent(in) :: subnum + + real(rt) :: q(np,np,5), lon, lat, z, p, phis, u, v, w, T, phis_ps, ps, rho, time, & + hya, hyb, a, b, reldif, linf_num(qsize), linf_den(qsize) + integer :: ie, k, iq, i, j + logical :: use_w + + ! Set time to 0 to get the initial conditions. + time = 0._rt + + linf_num = 0 + linf_den = 0 + do ie = 1,nelemd + global_shared_buf(ie,:2*qsize) = 0._rt + do k = 1,nlev + ! test1_conv_advection_orography uses these: + hya = hvcoord%hyam(k) + hyb = hvcoord%hybm(k) + ! test1_advection_deformation uses these, in which ps = p0: + p = p0 * hvcoord%etam(k) + z = H * log(1.0d0/hvcoord%etam(k)) + + ! Normwise relative errors. We weight the horizontal direction by + ! sphereme but do not weight the vertical direction; each vertical + ! level in a column has equal weight. + + do j = 1,np + do i = 1,np + lon = elem(ie)%spherep(i,j)%lon + lat = elem(ie)%spherep(i,j)%lat + select case(subnum) + case (1) + call test1_conv_advection( & + test_case,time,lon,lat,hya,hyb,p,z,u,v,w,use_w,T,phis,ps,rho,q(i,j,:)) + end select + end do + end do + + do iq = 1,qsize + global_shared_buf(ie,2*iq-1) = global_shared_buf(ie,2*iq-1) + & + sum(elem(ie)%spheremp*(elem(ie)%state%Q(:,:,k,iq) - q(:,:,iq))**2) + global_shared_buf(ie,2*iq) = global_shared_buf(ie,2*iq) + & + sum(elem(ie)%spheremp*q(:,:,iq)**2) + linf_num(iq) = max(linf_num(iq), & + maxval(abs(elem(ie)%state%Q(:,:,k,iq) - q(:,:,iq)))) + linf_den(iq) = max(linf_den(iq), & + maxval(abs(q(:,:,iq)))) + end do + end do + end do + + call wrap_repro_sum(nvars=2*qsize, comm=par%comm) + do iq = 1, qsize + linf_num(iq) = pmax_1d(linf_num(iq:iq), par) + linf_den(iq) = pmax_1d(linf_den(iq:iq), par) + end do + + if (par%masterproc) then + print '(a)', 'test1_conv> l2 linf' + do iq = 1,qsize + a = global_shared_sum(2*iq-1) + b = global_shared_sum(2*iq) + reldif = sqrt(a/b) + print '(a,i2,es24.16,es24.16)', 'test1_conv> Q', & + iq, reldif, linf_num(iq)/linf_den(iq) + end do + end if + end subroutine test1_conv_print_results + +end module dcmip2012_test1_conv_mod diff --git a/components/homme/src/theta-l/share/prim_advection_mod.F90 b/components/homme/src/theta-l/share/prim_advection_mod.F90 index f5941519adb..e8c6b68f0f9 100644 --- a/components/homme/src/theta-l/share/prim_advection_mod.F90 +++ b/components/homme/src/theta-l/share/prim_advection_mod.F90 @@ -13,7 +13,8 @@ module prim_advection_mod use time_mod, only : TimeLevel_t use hybrid_mod, only : hybrid_t use control_mod, only : transport_alg - use sl_advection, only : prim_advec_tracers_remap_ALE, sl_init1 + use sl_advection, only : prim_advec_tracers_observe_velocity_ale, & + prim_advec_tracers_remap_ALE, sl_init1 use prim_advection_base, only: prim_advec_init2, prim_advec_init1_rk2, & prim_advec_tracers_remap_rk2 @@ -40,6 +41,16 @@ subroutine Prim_Advec_Init1(par, elem) end subroutine Prim_Advec_Init1 + subroutine Prim_Advec_Tracers_observe_velocity(elem, tl, n, nets, nete) + type (element_t) , intent(inout) :: elem(:) + type (TimeLevel_t) , intent(in ) :: tl + integer , intent(in ) :: n ! step in 1:dt_tracer_factor + integer , intent(in ) :: nets + integer , intent(in ) :: nete + + if (transport_alg /= 0) call Prim_Advec_Tracers_observe_velocity_ALE(elem, tl, n, nets, nete) + end subroutine Prim_Advec_Tracers_observe_velocity + subroutine Prim_Advec_Tracers_remap( elem , deriv , hvcoord , hybrid , dt , tl , nets , nete ) implicit none type (element_t) , intent(inout) :: elem(:) diff --git a/components/homme/src/theta-l_kokkos/CMakeLists.txt b/components/homme/src/theta-l_kokkos/CMakeLists.txt index a585090ea76..ab9e648d467 100644 --- a/components/homme/src/theta-l_kokkos/CMakeLists.txt +++ b/components/homme/src/theta-l_kokkos/CMakeLists.txt @@ -119,7 +119,7 @@ MACRO(THETAL_KOKKOS_SETUP) ${TEST_SRC_DIR}/baroclinic_inst_mod.F90 ${TEST_SRC_DIR}/dcmip12_wrapper.F90 ${TEST_SRC_DIR}/dcmip16_wrapper.F90 - ${TEST_SRC_DIR}/dcmip2012_test1_conv.F90 + ${TEST_SRC_DIR}/dcmip2012_test1_conv_mod.F90 ${TEST_SRC_DIR}/dcmip2012_test1_2_3.F90 ${TEST_SRC_DIR}/dcmip2012_test4.F90 ${TEST_SRC_DIR}/dcmip2016-baroclinic.F90 @@ -161,6 +161,7 @@ MACRO(THETAL_KOKKOS_SETUP) ${SRC_SHARE_DIR}/cxx/ComposeTransport.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplGeneral.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplTrajectory.cpp + ${SRC_SHARE_DIR}/cxx/ComposeTransportImplEnhancedTrajectory.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplVerticalRemap.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplHypervis.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplTest2D.cpp diff --git a/components/homme/src/theta-l_kokkos/cxx/prim_advance_exp.cpp b/components/homme/src/theta-l_kokkos/cxx/prim_advance_exp.cpp index f0c0c1c728a..8f7fc13d315 100644 --- a/components/homme/src/theta-l_kokkos/cxx/prim_advance_exp.cpp +++ b/components/homme/src/theta-l_kokkos/cxx/prim_advance_exp.cpp @@ -26,6 +26,9 @@ void ttype7_imex_timestep (const TimeLevel& tl, const Real dt, const Real eta_av void ttype9_imex_timestep (const TimeLevel& tl, const Real dt, const Real eta_ave_w); void ttype10_imex_timestep(const TimeLevel& tl, const Real dt, const Real eta_ave_w); +// Prescribed-wind F90-C++ bridge. Test inputs are all implemented in F90. +extern "C" void set_prescribed_wind_f_bridge(int n0, int np1, int nstep, Real dt); + // -------------- IMPLEMENTATIONS -------------- // void prim_advance_exp (TimeLevel& tl, const Real dt, const bool compute_diagnostics) @@ -72,10 +75,12 @@ void prim_advance_exp (TimeLevel& tl, const Real dt, const bool compute_diagnost } #if !defined(CAM) && !defined(SCREAM) - // If prescribed wind, the dynamics was set explicitly in - // prim_driver_mod::prim_run_subcycle; skip time-integration. - if (params.prescribed_wind) + // If prescribed wind, set the dynamics explicitly and skip time-integration. + if (params.prescribed_wind) { + set_prescribed_wind_f_bridge(tl.n0, tl.np1, tl.nstep, dt); + GPTLstop("tl-ae prim_advance_exp"); return; + } #endif switch (params.time_step_type) { diff --git a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 index e7cc245a2bd..e43719616e1 100644 --- a/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 +++ b/components/homme/src/theta-l_kokkos/prim_driver_mod.F90 @@ -11,7 +11,11 @@ module prim_driver_mod use prim_driver_base, only : deriv1, smooth_topo_datasets use prim_cxx_driver_base, only : prim_init1, prim_finalize use physical_constants, only : scale_factor, laplacian_rigid_factor - + use hybrid_mod, only : hybrid_t + use hybvcoord_mod, only : hvcoord_t + use derivative_mod, only : derivative_t + use time_mod, only : timelevel_t + implicit none public :: prim_init2 @@ -23,10 +27,19 @@ module prim_driver_mod public :: prim_init_ref_states_views public :: prim_init_diags_views + type, private :: PrescribedWind_t + type (element_t), pointer :: elem(:) + type (hybrid_t) :: hybrid + type (hvcoord_t) :: hvcoord + type (derivative_t) :: deriv + integer :: nets, nete + end type PrescribedWind_t + + type (PrescribedWind_t), private :: prescribed_wind_args + contains subroutine prim_init2(elem, hybrid, nets, nete, tl, hvcoord) - use hybrid_mod, only : hybrid_t use hybvcoord_mod, only : hvcoord_t use time_mod, only : timelevel_t use prim_driver_base, only : deriv1, prim_init2_base => prim_init2 @@ -46,10 +59,6 @@ subroutine prim_init2(elem, hybrid, nets, nete, tl, hvcoord) ! Call the base version of prim_init2 call prim_init2_base(elem,hybrid,nets,nete,tl,hvcoord) - if (prescribed_wind == 1) then - call init_standalone_test(elem,deriv1,hybrid,hvcoord,tl,nets,nete) - end if - ! Init the c data structures call prim_create_c_data_structures(tl,hvcoord,elem(1)%mp) @@ -61,6 +70,10 @@ subroutine prim_init2(elem, hybrid, nets, nete, tl, hvcoord) ! Initialize dp3d from ps_v call initialize_dp3d_from_ps_c () + + if (prescribed_wind == 1) then + call init_standalone_test(elem,deriv1,hybrid,hvcoord,tl,nets,nete) + end if end subroutine prim_init2 subroutine prim_create_c_data_structures (tl, hvcoord, mp) @@ -461,8 +474,8 @@ subroutine prim_run_subcycle(elem, hybrid, nets, nete, dt, single_column, tl, hv elem_derived_FPHI, elem_derived_FQ) call t_stopf('push_to_cxx') end if - if (prescribed_wind == 1) then ! standalone Homme - call set_prescribed_wind_f(elem,deriv1,hybrid,hvcoord,dt,tl,nets,nete) + if (prescribed_wind == 1) then + call init_prescribed_wind_subcycle(elem,nets,nete,tl) end if call prim_run_subcycle_c(dt,nstep_c,nm1_c,n0_c,np1_c,nextOutputStep,nsplit_iteration) @@ -616,7 +629,7 @@ subroutine init_standalone_test(elem,deriv,hybrid,hvcoord,tl,nets,nete) use element_mod, only : element_t use derivative_mod, only : derivative_t #if !defined(CAM) && !defined(SCREAM) - use test_mod, only : set_prescribed_wind + use test_mod, only : set_test_initial_conditions #endif type (element_t), intent(inout), target :: elem(:) @@ -628,11 +641,18 @@ subroutine init_standalone_test(elem,deriv,hybrid,hvcoord,tl,nets,nete) integer , intent(in) :: nete #if !defined(CAM) && !defined(SCREAM) - real(kind=real_kind) :: dt, eta_ave_w - - dt = 0 ! value unused in initialization - eta_ave_w = 0 ! same - call set_prescribed_wind(elem,deriv,hybrid,hvcoord,dt,tl,nets,nete,eta_ave_w) + ! Already called in prim_driver_base::prim_init2: + ! call set_test_initial_conditions(elem,deriv,hybrid,hvcoord,tl,nets,nete) + ! Also already taken care of: + ! call push_test_state_to_c_wrapper() + + ! Save arguments for the C++-F90 bridge for prescribed winds. + prescribed_wind_args%elem => elem + prescribed_wind_args%hybrid = hybrid + prescribed_wind_args%hvcoord = hvcoord + prescribed_wind_args%deriv = deriv + prescribed_wind_args%nets = nets + prescribed_wind_args%nete = nete #endif end subroutine init_standalone_test @@ -657,8 +677,77 @@ subroutine compute_test_forcing_f(elem,hybrid,hvcoord,nt,ntQ,dt,nets,nete,tl) #endif end subroutine compute_test_forcing_f + subroutine push_test_state_to_c_wrapper() +#if !defined(CAM) && !defined(SCREAM) + use iso_c_binding, only : c_ptr, c_loc + use perf_mod, only : t_startf, t_stopf + use theta_f2c_mod, only : push_test_state_to_c + use element_state, only : elem_state_v, elem_state_w_i, elem_state_vtheta_dp, & + elem_state_phinh_i, elem_state_dp3d, elem_state_ps_v, & + elem_derived_eta_dot_dpdn, elem_derived_vn0 + + type (c_ptr) :: elem_state_v_ptr, elem_state_w_i_ptr, elem_state_vtheta_dp_ptr, elem_state_phinh_i_ptr + type (c_ptr) :: elem_state_dp3d_ptr, elem_state_Qdp_ptr, elem_state_Q_ptr, elem_state_ps_v_ptr + type (c_ptr) :: elem_derived_eta_dot_dpdn_ptr, elem_derived_vn0_ptr + + call t_startf('push_to_cxx') + elem_state_v_ptr = c_loc(elem_state_v) + elem_state_w_i_ptr = c_loc(elem_state_w_i) + elem_state_vtheta_dp_ptr = c_loc(elem_state_vtheta_dp) + elem_state_phinh_i_ptr = c_loc(elem_state_phinh_i) + elem_state_dp3d_ptr = c_loc(elem_state_dp3d) + elem_state_ps_v_ptr = c_loc(elem_state_ps_v) + elem_derived_vn0_ptr = c_loc(elem_derived_vn0) + elem_derived_eta_dot_dpdn_ptr = c_loc(elem_derived_eta_dot_dpdn) + call push_test_state_to_c(elem_state_ps_v_ptr, elem_state_dp3d_ptr, & + elem_state_vtheta_dp_ptr, elem_state_phinh_i_ptr, elem_state_v_ptr, & + elem_state_w_i_ptr, elem_derived_eta_dot_dpdn_ptr, elem_derived_vn0_ptr) + call t_stopf('push_to_cxx') +#endif + end subroutine push_test_state_to_c_wrapper + + subroutine init_prescribed_wind_subcycle(elem, nets, nete, tl) + ! Set the derived values used in tracer transport on the F90 side even + ! though most of the work is done on the C++ side. This is needed because + ! set_prescribed_wind accumulates certain derived quantities during + ! prim_advance_exp that get repeatedly copied from F90 to C++. Here we + ! initialize values for accumulation. + ! In summary: Call this before entering the prim_run_subcycle loop. + + use prim_driver_base, only: set_tracer_transport_derived_values + + type (element_t), intent(inout) :: elem(:) + integer, intent(in) :: nets, nete + type (timelevel_t) :: tl + + call set_tracer_transport_derived_values(elem, nets, nete, tl) + end subroutine init_prescribed_wind_subcycle + + subroutine set_prescribed_wind_f_bridge(n0, np1, nstep, dt) bind(c) + ! This routine is called from the C++ prim_advance_exp implementation inside + ! the prim_run_subcycle loop. + + use iso_c_binding, only: c_int, c_double + + integer(c_int), value, intent(in) :: n0, np1, nstep + real(c_double), value, intent(in) :: dt + + type (TimeLevel_t) :: tl + + ! Only these fields need to be valid. + tl%n0 = n0+1 + tl%np1 = np1+1 + tl%nstep = nstep + + call set_prescribed_wind_f(prescribed_wind_args%elem, prescribed_wind_args%deriv, & + prescribed_wind_args%hybrid, prescribed_wind_args%hvcoord, dt, tl, & + prescribed_wind_args%nets, prescribed_wind_args%nete) + end subroutine set_prescribed_wind_f_bridge + subroutine set_prescribed_wind_f(elem,deriv,hybrid,hvcoord,dt,tl,nets,nete) - use iso_c_binding, only : c_ptr, c_loc + ! Here we finally can compute the prescribed wind in F90 and then push the + ! data to C++. + use hybrid_mod, only : hybrid_t use hybvcoord_mod, only : hvcoord_t use time_mod, only : timelevel_t @@ -666,12 +755,7 @@ subroutine set_prescribed_wind_f(elem,deriv,hybrid,hvcoord,dt,tl,nets,nete) use derivative_mod, only : derivative_t #if !defined(CAM) && !defined(SCREAM) use control_mod, only : qsplit - use perf_mod, only : t_startf, t_stopf - use theta_f2c_mod, only : push_test_state_to_c use test_mod, only : set_prescribed_wind - use element_state, only : elem_state_v, elem_state_w_i, elem_state_vtheta_dp, & - elem_state_phinh_i, elem_state_dp3d, elem_state_ps_v, & - elem_derived_eta_dot_dpdn, elem_derived_vn0 #endif type (element_t), intent(inout), target :: elem(:) @@ -685,39 +769,17 @@ subroutine set_prescribed_wind_f(elem,deriv,hybrid,hvcoord,dt,tl,nets,nete) #if !defined(CAM) && !defined(SCREAM) type (hvcoord_t) :: hv - type (c_ptr) :: elem_state_v_ptr, elem_state_w_i_ptr, elem_state_vtheta_dp_ptr, elem_state_phinh_i_ptr - type (c_ptr) :: elem_state_dp3d_ptr, elem_state_Qdp_ptr, elem_state_Q_ptr, elem_state_ps_v_ptr - type (c_ptr) :: elem_derived_eta_dot_dpdn_ptr, elem_derived_vn0_ptr real(kind=real_kind) :: eta_ave_w ! We need to set up an hvcoord_t that can be passed as intent(inout), even ! though at this point, it won't be changed in the set_prescribed_wind call. - hv%ps0 = hvcoord%ps0 - hv%hyai = hvcoord%hyai - hv%hyam = hvcoord%hyam - hv%hybi = hvcoord%hybi - hv%hybm = hvcoord%hybm - hv%etam = hvcoord%etam - hv%etai = hvcoord%etai - hv%dp0 = hvcoord%dp0 + hv = hvcoord eta_ave_w = 1d0/qsplit call set_prescribed_wind(elem,deriv,hybrid,hv,dt,tl,nets,nete,eta_ave_w) - call t_startf('push_to_cxx') - elem_state_v_ptr = c_loc(elem_state_v) - elem_state_w_i_ptr = c_loc(elem_state_w_i) - elem_state_vtheta_dp_ptr = c_loc(elem_state_vtheta_dp) - elem_state_phinh_i_ptr = c_loc(elem_state_phinh_i) - elem_state_dp3d_ptr = c_loc(elem_state_dp3d) - elem_state_ps_v_ptr = c_loc(elem_state_ps_v) - elem_derived_vn0_ptr = c_loc(elem_derived_vn0) - elem_derived_eta_dot_dpdn_ptr = c_loc(elem_derived_eta_dot_dpdn) - call push_test_state_to_c(elem_state_ps_v_ptr, elem_state_dp3d_ptr, & - elem_state_vtheta_dp_ptr, elem_state_phinh_i_ptr, elem_state_v_ptr, & - elem_state_w_i_ptr, elem_derived_eta_dot_dpdn_ptr, elem_derived_vn0_ptr) - call t_stopf('push_to_cxx') + call push_test_state_to_c_wrapper() #endif end subroutine set_prescribed_wind_f diff --git a/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r0t1-cdr30-rrm.nl b/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r0t1-cdr30-rrm.nl index 564ea8be17b..5b7e987bd0b 100644 --- a/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r0t1-cdr30-rrm.nl +++ b/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r0t1-cdr30-rrm.nl @@ -2,7 +2,7 @@ nthreads = -1 ! use OMP_NUM_THREADS partmethod = 4 ! mesh parition method: 4 = space filling curve topology = "cube" ! mesh type: cubed sphere - test_case = "dcmip2012_test1_1_conv" ! test identifier + test_case = "dcmip2012_test1_3a_conv" ! test identifier prescribed_wind = 1 mesh_file = 'mountain_10_x2.g' qsize = 4 ! num tracer fields diff --git a/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r1t2-cdr20.nl b/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r1t2-cdr20.nl index 484d3612dd0..c6a7bfb2b1c 100644 --- a/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r1t2-cdr20.nl +++ b/components/homme/test/reg_test/namelists/thetah-sl-test11conv-r1t2-cdr20.nl @@ -2,7 +2,7 @@ nthreads = -1 ! use OMP_NUM_THREADS partmethod = 4 ! mesh parition method: 4 = space filling curve topology = "cube" ! mesh type: cubed sphere - test_case = "dcmip2012_test1_1_conv" ! test identifier + test_case = "dcmip2012_test1_3a_conv" ! test identifier prescribed_wind = 1 ne = 5 ! number of elements per cube face qsize = 4 ! num tracer fields diff --git a/components/homme/test/reg_test/namelists/thetah-sl-testconv-3e.nl b/components/homme/test/reg_test/namelists/thetah-sl-testconv-3e.nl new file mode 100644 index 00000000000..d140d689ac0 --- /dev/null +++ b/components/homme/test/reg_test/namelists/thetah-sl-testconv-3e.nl @@ -0,0 +1,62 @@ +&ctl_nl + nthreads = -1 + partmethod = 4 + topology = "cube" + test_case = 'dcmip2012_test1_3e_conv' + prescribed_wind = 1 + qsize = 4 + ndays = 1 + statefreq = 240 + restartfreq = -1 + runtype = 0 + ne = 20 + integration = 'explicit' + tstep_type = 1 + smooth = 0 + nu = 1.585e13 ! nu values are irrelevant + nu_s = 1.585e13 + nu_p = 42 ! to satisfy kokkos exe + se_ftype = -1 + limiter_option = 9 + hypervis_order = 2 + hypervis_subcycle = 1 + moisture = 'dry' + theta_hydrostatic_mode = .true. + dcmip16_prec_type = 1 + dcmip16_pbl_type = -1 + transport_alg = 12 + semi_lagrange_cdr_alg = 3 + semi_lagrange_cdr_check = .false. + semi_lagrange_hv_q = 0 + semi_lagrange_nearest_point_lev = 0 + semi_lagrange_halo = 2 + dt_remap_factor = 0 + dt_tracer_factor = 4 + tstep = 200.0 + semi_lagrange_trajectory_nsubstep = 2 + semi_lagrange_trajectory_nvelocity = 3 + semi_lagrange_diagnostics = 1 + hypervis_subcycle_q = 0 + limiter_option = 9 + vert_remap_q_alg = 10 +/ +&vert_nl + vanalytic = 1 + vtop = 0.2549944 +/ +&analysis_nl + output_dir = "./movies/" + output_timeunits = 2, ! 1=days, 2=hours, 0=timesteps + output_frequency = 2, + output_varnames1 = 'ps','Q','u','v' + interp_type = 0 + output_type = 'netcdf' + num_io_procs = 16 + interp_nlon = 180 + interp_nlat = 91 + interp_gridtype = 2 +/ +&prof_inparm + profile_outpe_num = 100 + profile_single_file = .true. +/ diff --git a/components/homme/test/reg_test/run_tests/test-list.cmake b/components/homme/test/reg_test/run_tests/test-list.cmake index dbb0fc4f98e..884a785d843 100644 --- a/components/homme/test/reg_test/run_tests/test-list.cmake +++ b/components/homme/test/reg_test/run_tests/test-list.cmake @@ -47,7 +47,7 @@ IF (HOMME_ENABLE_COMPOSE) thetah-sl-test11conv-r1t2-cdr20.cmake thetah-sl-test11conv-r0t1-cdr30-rrm.cmake thetah-sl-dcmip16_test1pg2.cmake - ) + thetah-sl-testconv-3e.cmake) ENDIF() SET(HOMME_RUN_TESTS_DIR ${HOMME_SOURCE_DIR}/test/reg_test/run_tests) @@ -92,7 +92,9 @@ ENDIF() IF (BUILD_HOMME_THETA_KOKKOS) # Various one-off tests. IF (HOMME_ENABLE_COMPOSE) - LIST(APPEND HOMME_TESTS thetah-sl-test11conv-r0t1-cdr30-rrm-kokkos.cmake) + LIST(APPEND HOMME_TESTS + thetah-sl-test11conv-r0t1-cdr30-rrm-kokkos.cmake + thetah-sl-testconv-3e-kokkos.cmake) IF (HOMMEXX_BFB_TESTING) LIST(APPEND HOMME_ONEOFF_CVF_TESTS thetah-sl-test11conv-r0t1-cdr30-rrm) diff --git a/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm-kokkos.cmake b/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm-kokkos.cmake index 0bf617bcdb7..fb7e41a3d04 100644 --- a/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm-kokkos.cmake +++ b/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm-kokkos.cmake @@ -11,4 +11,4 @@ SET(MESH_FILES ${HOMME_ROOT}/test/mesh_files/mountain_10_x2.g) # compare all of these files against baselines: SET(NC_OUTPUT_FILES - dcmip2012_test1_1_conv1.nc) + dcmip2012_test1_3a_conv1.nc) diff --git a/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm.cmake b/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm.cmake index 62387e9474b..688b946ed59 100644 --- a/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm.cmake +++ b/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r0t1-cdr30-rrm.cmake @@ -11,4 +11,4 @@ SET(MESH_FILES ${HOMME_ROOT}/test/mesh_files/mountain_10_x2.g) # compare all of these files against baselines: SET(NC_OUTPUT_FILES - dcmip2012_test1_1_conv1.nc) + dcmip2012_test1_3a_conv1.nc) diff --git a/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r1t2-cdr20.cmake b/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r1t2-cdr20.cmake index 8dacd43d872..ca0245833b6 100644 --- a/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r1t2-cdr20.cmake +++ b/components/homme/test/reg_test/run_tests/thetah-sl-test11conv-r1t2-cdr20.cmake @@ -9,4 +9,4 @@ SET(NAMELIST_FILES ${HOMME_ROOT}/test/reg_test/namelists/thetah-sl-test11conv-r1 # compare all of these files against baselines: SET(NC_OUTPUT_FILES - dcmip2012_test1_1_conv1.nc) + dcmip2012_test1_3a_conv1.nc) diff --git a/components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e-kokkos.cmake b/components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e-kokkos.cmake new file mode 100644 index 00000000000..4d87d00d655 --- /dev/null +++ b/components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e-kokkos.cmake @@ -0,0 +1,11 @@ +# The name of this test (should be the basename of this file) +SET(TEST_NAME thetah-sl-testconv-3e-kokkos) +# The specifically compiled executable that this test uses +SET(EXEC_NAME theta-l-nlev30-kokkos) + +SET(NUM_CPUS 16) + +SET(NAMELIST_FILES ${HOMME_ROOT}/test/reg_test/namelists/thetah-sl-testconv-3e.nl) + +# compare all of these files against baselines: +SET(NC_OUTPUT_FILES dcmip2012_test1_3e_conv1.nc) diff --git a/components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e.cmake b/components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e.cmake new file mode 100644 index 00000000000..6eaff42f94d --- /dev/null +++ b/components/homme/test/reg_test/run_tests/thetah-sl-testconv-3e.cmake @@ -0,0 +1,11 @@ +# The name of this test (should be the basename of this file) +SET(TEST_NAME thetah-sl-testconv-3e) +# The specifically compiled executable that this test uses +SET(EXEC_NAME theta-l-nlev30) + +SET(NUM_CPUS 16) + +SET(NAMELIST_FILES ${HOMME_ROOT}/test/reg_test/namelists/thetah-sl-testconv-3e.nl) + +# compare all of these files against baselines: +SET(NC_OUTPUT_FILES dcmip2012_test1_3e_conv1.nc) diff --git a/components/homme/test/unit_tests/tester.cpp b/components/homme/test/unit_tests/tester.cpp index 826257930e8..0acce65a41d 100644 --- a/components/homme/test/unit_tests/tester.cpp +++ b/components/homme/test/unit_tests/tester.cpp @@ -25,13 +25,13 @@ int main(int argc, char **argv) { Homme::initialize_hommexx_session(); // Filter arguments so catch2 doesn't try to interpret hommexx-specific ones. - hommexx_catch2_argc = argc; + hommexx_catch2_argc = 0; hommexx_catch2_argv = argv; for (int i = 1; i < argc; ++i) { if (std::string(argv[i]) == "hommexx") { - argc = i; - hommexx_catch2_argc -= i + 1; + hommexx_catch2_argc = argc - (i + 1); hommexx_catch2_argv = argv + i + 1; + argc = i; break; } } diff --git a/components/homme/test_execs/CMakeLists.txt b/components/homme/test_execs/CMakeLists.txt index a007a5532b6..12a55d64025 100644 --- a/components/homme/test_execs/CMakeLists.txt +++ b/components/homme/test_execs/CMakeLists.txt @@ -195,9 +195,6 @@ IF(${BUILD_HOMME_PREQX}) IF(${BUILD_HOMME_PREQX_ACC}) ADD_SUBDIRECTORY(baroCam-acc) ENDIF() - IF(${HOMME_ENABLE_COMPOSE}) - ADD_SUBDIRECTORY(stt) - ENDIF() ENDIF() # Add the test exec subdirs for the prim executable @@ -222,6 +219,8 @@ IF(${BUILD_HOMME_THETA}) # ADD_SUBDIRECTORY(theta-l-nlev200-native) # ADD_SUBDIRECTORY(theta-l-nlev256-native) # ADD_SUBDIRECTORY(theta-l-nlev300-native) + # Special test for -DHOMME_WITHOUT_PIOLIBRARY. + ADD_SUBDIRECTORY(stt) ENDIF() IF (${BUILD_HOMME_THETA_KOKKOS}) diff --git a/components/homme/test_execs/stt/CMakeLists.txt b/components/homme/test_execs/stt/CMakeLists.txt index c0268957730..93b083ca1c5 100644 --- a/components/homme/test_execs/stt/CMakeLists.txt +++ b/components/homme/test_execs/stt/CMakeLists.txt @@ -1,7 +1,7 @@ -preqx_setup() +thetal_setup() ADD_DEFINITIONS(-DHOMME_WITHOUT_PIOLIBRARY) # Set the variables for this test executable # NP NC PLEV USE_PIO WITH_ENERGY QSIZE_D -createTestExec(stt preqx 4 4 3 FALSE TRUE 5) +createTestExec(stt theta-l 4 4 3 FALSE TRUE 5) diff --git a/components/homme/test_execs/thetal_kokkos_ut/compose_interface.F90 b/components/homme/test_execs/thetal_kokkos_ut/compose_interface.F90 index 4296b6609a0..a34d5411e95 100644 --- a/components/homme/test_execs/thetal_kokkos_ut/compose_interface.F90 +++ b/components/homme/test_execs/thetal_kokkos_ut/compose_interface.F90 @@ -8,7 +8,7 @@ module compose_interface contains subroutine init_compose_f90(ne, hyai, hybi, hyam, hybm, ps0, dvv, mp, qsize_in, hv_q, & - lim, cdr_check, is_sphere) bind(c) + lim, cdr_check, is_sphere, nearest_point, halo, traj_nsubstep) bind(c) use hybvcoord_mod, only: set_layer_locations use thetal_test_interface, only: init_f90 use theta_f2c_mod, only: init_elements_c @@ -16,7 +16,8 @@ subroutine init_compose_f90(ne, hyai, hybi, hyam, hybm, ps0, dvv, mp, qsize_in, use control_mod, only: transport_alg, semi_lagrange_cdr_alg, semi_lagrange_cdr_check, & semi_lagrange_hv_q, limiter_option, nu_q, hypervis_subcycle_q, hypervis_order, & vert_remap_q_alg, qsplit, rsplit, dt_remap_factor, dt_tracer_factor, & - theta_hydrostatic_mode + theta_hydrostatic_mode, semi_lagrange_nearest_point_lev, semi_lagrange_halo, & + semi_lagrange_trajectory_nsubstep use geometry_interface_mod, only: GridVertex use bndry_mod, only: sort_neighbor_buffer_mapping use reduction_mod, only: initreductionbuffer, red_sum, red_min, red_max @@ -25,17 +26,17 @@ subroutine init_compose_f90(ne, hyai, hybi, hyam, hybm, ps0, dvv, mp, qsize_in, use sl_advection, only: sl_init1 real (real_kind), intent(in) :: hyai(nlevp), hybi(nlevp), hyam(nlev), hybm(nlev) - integer (c_int), value, intent(in) :: ne, qsize_in, hv_q, lim + integer (c_int), value, intent(in) :: ne, qsize_in, hv_q, lim, halo, traj_nsubstep real (real_kind), value, intent(in) :: ps0 real (real_kind), intent(out) :: dvv(np,np), mp(np,np) - logical (c_bool), value, intent(in) :: cdr_check, is_sphere + logical (c_bool), value, intent(in) :: cdr_check, is_sphere, nearest_point integer :: ie, edgesz if (.not. is_sphere) print *, "NOT IMPL'ED YET" transport_alg = 12 - semi_lagrange_cdr_alg = 30 + semi_lagrange_cdr_alg = 3 semi_lagrange_cdr_check = cdr_check qsize = qsize_in limiter_option = lim @@ -45,6 +46,10 @@ subroutine init_compose_f90(ne, hyai, hybi, hyam, hybm, ps0, dvv, mp, qsize_in, dt_tracer_factor = -1 dt_remap_factor = -1 theta_hydrostatic_mode = .true. + semi_lagrange_nearest_point_lev = -1 + if (nearest_point) semi_lagrange_nearest_point_lev = 100000 + semi_lagrange_halo = halo + semi_lagrange_trajectory_nsubstep = traj_nsubstep hypervis_order = 2 semi_lagrange_hv_q = hv_q @@ -148,7 +153,7 @@ subroutine run_compose_standalone_test_f90(nmax_out, eval) bind(c) use thread_mod, only: hthreads, vthreads use dimensions_mod, only: nlev, qsize - integer(c_int), intent(out) :: nmax_out + integer(c_int), intent(inout) :: nmax_out real(c_double), intent(out) :: eval((nlev+1)*qsize) type (domain1d_t), pointer :: dom_mt(:) @@ -162,8 +167,12 @@ subroutine run_compose_standalone_test_f90(nmax_out, eval) bind(c) dom_mt(0)%start = 1 dom_mt(0)%end = nelemd transport_alg = 19 - nmax = 7*ne - nmax_out = nmax + if (nmax_out <= 1) then + nmax = 7*ne + nmax_out = nmax + else + nmax = nmax_out + end if statefreq = 2*ne call compose_test(par, hvcoord, dom_mt, elem, buf) do i = 1,size(buf) @@ -190,7 +199,7 @@ subroutine run_trajectory_f90(t0, t1, independent_time_steps, dep, dprecon) bind type (timelevel_t) :: tl type (hybrid_t) :: hybrid real(real_kind) :: dt - integer :: ie, i, j, k, testno, geometry_type + integer :: ie, i, j, k, d, testno, geometry_type logical :: its call timelevel_init_default(tl) @@ -216,9 +225,9 @@ subroutine run_trajectory_f90(t0, t1, independent_time_steps, dep, dprecon) bind do k = 1,nlev do j = 1,np do i = 1,np - dep(1,i,j,k,ie) = dep_points_all(i,j,k,ie)%x - dep(2,i,j,k,ie) = dep_points_all(i,j,k,ie)%y - dep(3,i,j,k,ie) = dep_points_all(i,j,k,ie)%z + do d = 1, 3 + dep(d,i,j,k,ie) = dep_points_all(d,i,j,k,ie) + end do dprecon(i,j,k,ie) = elem(ie)%derived%divdp(i,j,k) end do end do diff --git a/components/homme/test_execs/thetal_kokkos_ut/compose_ut.cpp b/components/homme/test_execs/thetal_kokkos_ut/compose_ut.cpp index 0c0d06cff67..85a30056766 100644 --- a/components/homme/test_execs/thetal_kokkos_ut/compose_ut.cpp +++ b/components/homme/test_execs/thetal_kokkos_ut/compose_ut.cpp @@ -37,7 +37,8 @@ extern char** hommexx_catch2_argv; extern "C" { void init_compose_f90(int ne, const Real* hyai, const Real* hybi, const Real* hyam, const Real* hybm, Real ps0, Real* dvv, Real* mp, int qsize, - int hv_q, int limiter_option, bool cdr_check, bool is_sphere); + int hv_q, int limiter_option, bool cdr_check, bool is_sphere, + bool nearest_point, int halo, int traj_nsubstep); void init_geometry_f90(); void cleanup_compose_f90(); void run_compose_standalone_test_f90(int* nmax, Real* eval); @@ -99,8 +100,8 @@ void fill (Random& r, const V& a, } struct Session { - int ne, hv_q; - bool cdr_check, is_sphere; + int ne, hv_q, nmax, halo, traj_nsubstep; + bool cdr_check, is_sphere, run_only_advection_test, nearest_point; HybridVCoord h; Random r; std::shared_ptr e; @@ -113,6 +114,11 @@ struct Session { const auto seed = r.gen_seed(); printf("seed %u\n", seed); + nlev = NUM_PHYSICAL_LEV; + assert(nlev > 0); + np = NP; + assert(np == 4); + assert(QSIZE_D >= 4); parse_command_line(); assert(is_sphere); // planar isn't available in Hxx yet @@ -141,11 +147,12 @@ struct Session { const auto hybi = cmvdc(h.hybrid_bi); const auto hyam = cmvdc(h.hybrid_am); const auto hybm = cmvdc(h.hybrid_bm); + auto& ref_FE = c.create(); std::vector dvv(NP*NP), mp(NP*NP); init_compose_f90(ne, hyai.data(), hybi.data(), &hyam(0)[0], &hybm(0)[0], h.ps0, dvv.data(), mp.data(), qsize, hv_q, p.limiter_option, cdr_check, - is_sphere); + is_sphere, nearest_point, halo, traj_nsubstep); ref_FE.init_mass(mp.data()); ref_FE.init_deriv(dvv.data()); @@ -168,11 +175,6 @@ struct Session { ct.init_buffers(fbm); ct.init_boundary_exchanges(); - nlev = NUM_PHYSICAL_LEV; - assert(nlev > 0); - np = NP; - assert(np == 4); - c.create(); } @@ -203,37 +205,87 @@ struct Session { // compose_ut hommexx -ne NE -qsize QSIZE -hvq HV_Q -cdrcheck void parse_command_line () { - const bool am_root = get_comm().root(); ne = 2; qsize = QSIZE_D; hv_q = 1; cdr_check = false; is_sphere = true; + run_only_advection_test = false; + nmax = -1; + halo = 2; + traj_nsubstep = 0; + nearest_point = true; + + const bool am_root = get_comm().root(); bool ok = true; int i; for (i = 0; i < hommexx_catch2_argc; ++i) { const std::string tok(hommexx_catch2_argv[i]); if (tok == "-ne") { - if (i+1 == hommexx_catch2_argc) { ok = false; break; } + if (i+1 == hommexx_catch2_argc) ok = false; ne = std::atoi(hommexx_catch2_argv[++i]); + if (ne < 2) { + printf("ne must be >= 2\n"); + ok = false; + } } else if (tok == "-qsize") { - if (i+1 == hommexx_catch2_argc) { ok = false; break; } + if (i+1 == hommexx_catch2_argc) ok = false; qsize = std::atoi(hommexx_catch2_argv[++i]); + if (qsize > QSIZE_D || qsize < 1) { + printf("qsize must be >= 1 and <= QSIZE_D\n"); + ok = false; + } } else if (tok == "-hvq") { - if (i+1 == hommexx_catch2_argc) { ok = false; break; } + if (i+1 == hommexx_catch2_argc) ok = false; hv_q = std::atoi(hommexx_catch2_argv[++i]); } else if (tok == "-cdrcheck") { cdr_check = true; } else if (tok == "-planar") { is_sphere = false; + } else if (tok == "-convergence") { + // When running this as a convergence-test driver, don't run any tests + // except the prescribed-flow one. + run_only_advection_test = true; + } else if (tok == "-nmax") { + if (i+1 == hommexx_catch2_argc) ok = false; + nmax = std::atoi(hommexx_catch2_argv[++i]); + if (nmax < 1) { + printf("nmax must be >= 1\n"); + ok = false; + } + } else if (tok == "-halo") { + if (i+1 == hommexx_catch2_argc) ok = false; + halo = std::atoi(hommexx_catch2_argv[++i]); + if (halo < 1) { + printf("halo must be >= 1"); + ok = false; + } + } else if (tok == "-trajnsubstep") { + if (i+1 == hommexx_catch2_argc) ok = false; + traj_nsubstep = std::atoi(hommexx_catch2_argv[++i]); + if (traj_nsubstep < 0) { + printf("traj_nsubstep must be >= 0\n"); + ok = false; + } + } else if (tok == "-nonearest") { + nearest_point = false; + } else { + printf("unrecognized token %s\n", tok.c_str()); + ok = false; } + if ( ! ok) break; } - ne = std::max(2, std::min(128, ne)); + + ne = std::max(2, ne); qsize = std::max(1, std::min(QSIZE_D, qsize)); hv_q = std::max(0, std::min(qsize, hv_q)); - if ( ! ok && am_root) + + if ( ! ok && am_root) { printf("compose_ut> Failed to parse command line, starting with: %s\n", hommexx_catch2_argv[i]); + Homme::Errors::runtime_abort("compose_ut invalid command line"); + } + if (am_root) { const int bfb = #ifdef HOMMEXX_BFB_TESTING @@ -241,8 +293,10 @@ struct Session { #else 0; #endif - printf("compose_ut> bfb %d ne %d qsize %d hv_q %d cdr_check %d\n", - bfb, ne, qsize, hv_q, cdr_check ? 1 : 0); + printf("compose_ut> sphere %d bfb %d ne %d qsize %d hv_q %d cdr_check %d " + "halo %d traj_nsubstep %d nearest %d\n", + int(is_sphere), bfb, ne, qsize, hv_q, cdr_check ? 1 : 0, halo, + traj_nsubstep, int(nearest_point)); } } }; @@ -337,10 +391,19 @@ TEST_CASE ("compose_transport_testing") { static constexpr Real tol = std::numeric_limits::epsilon(); auto& s = Session::singleton(); try { + do { // breakable + + if (s.run_only_advection_test) { + int nmax = s.nmax; + std::vector eval_f((s.nlev+1)*s.qsize); + run_compose_standalone_test_f90(&nmax, eval_f.data()); + break; + } // unit tests REQUIRE(compose::test::slmm_unittest() == 0); REQUIRE(compose::test::cedr_unittest() == 0); + REQUIRE(compose::test::interpolate_unittest() == 0); REQUIRE(compose::test::cedr_unittest(s.get_comm().mpi_comm()) == 0); auto& ct = Context::singleton().get(); @@ -349,33 +412,35 @@ TEST_CASE ("compose_transport_testing") { REQUIRE(fails.empty()); // trajectory BFB - for (const bool independent_time_steps : {false, true}) { - printf("independent_time_steps %d\n", independent_time_steps); - const Real twelve_days = 3600 * 24 * 12; - const Real t0 = 0.13*twelve_days; - const Real t1 = independent_time_steps ? t0 + 1800 : 0.22*twelve_days; - CA5d depf("depf", s.nelemd, s.nlev, s.np, s.np, 3); - CA4d dpreconf("dpreconf", s.nelemd, s.nlev, s.np, s.np); - run_trajectory_f90(t0, t1, independent_time_steps, depf.data(), - dpreconf.data()); - const auto depc = ct.test_trajectory(t0, t1, independent_time_steps); - REQUIRE(depc.extent_int(0) == s.nelemd); - REQUIRE(depc.extent_int(2) == s.np); - REQUIRE(depc.extent_int(4) == 3); - if (independent_time_steps) { - const auto dpreconc = cmvdc(RNlev(pack2real(s.e->m_derived.m_divdp), s.nelemd)); + if (s.traj_nsubstep == 0) { + for (const bool independent_time_steps : {false, true}) { + printf("independent_time_steps %d\n", independent_time_steps); + const Real twelve_days = 3600 * 24 * 12; + const Real t0 = 0.13*twelve_days; + const Real t1 = independent_time_steps ? t0 + 1800 : 0.22*twelve_days; + CA5d depf("depf", s.nelemd, s.nlev, s.np, s.np, 3); + CA4d dpreconf("dpreconf", s.nelemd, s.nlev, s.np, s.np); + run_trajectory_f90(t0, t1, independent_time_steps, depf.data(), + dpreconf.data()); + const auto depc = ct.test_trajectory(t0, t1, independent_time_steps); + REQUIRE(depc.extent_int(0) == s.nelemd); + REQUIRE(depc.extent_int(2) == s.np); + REQUIRE(depc.extent_int(4) == 3); + if (independent_time_steps) { + const auto dpreconc = cmvdc(RNlev(pack2real(s.e->m_derived.m_divdp), s.nelemd)); + for (int ie = 0; ie < s.nelemd; ++ie) + for (int lev = 0; lev < s.nlev; ++lev) + for (int i = 0; i < s.np; ++i) + for (int j = 0; j < s.np; ++j) + REQUIRE(equal(dpreconf(ie,lev,i,j), dpreconc(ie,i,j,lev), 100*tol)); + } for (int ie = 0; ie < s.nelemd; ++ie) for (int lev = 0; lev < s.nlev; ++lev) for (int i = 0; i < s.np; ++i) for (int j = 0; j < s.np; ++j) - REQUIRE(equal(dpreconf(ie,lev,i,j), dpreconc(ie,i,j,lev), 10*tol)); + for (int d = 0; d < 3; ++d) + REQUIRE(equal(depf(ie,lev,i,j,d), depc(ie,lev,i,j,d), 100*tol)); } - for (int ie = 0; ie < s.nelemd; ++ie) - for (int lev = 0; lev < s.nlev; ++lev) - for (int i = 0; i < s.np; ++i) - for (int j = 0; j < s.np; ++j) - for (int d = 0; d < 3; ++d) - REQUIRE(equal(depf(ie,lev,i,j,d), depc(ie,lev,i,j,d), 10*tol)); } { // q vertical remap @@ -386,7 +451,7 @@ TEST_CASE ("compose_transport_testing") { } { // 2D SL BFB - int nmax; + int nmax = s.nmax; std::vector eval_f((s.nlev+1)*s.qsize), eval_c(eval_f.size()); run_compose_standalone_test_f90(&nmax, eval_f.data()); for (const bool bfb : {false, true}) { @@ -397,9 +462,10 @@ TEST_CASE ("compose_transport_testing") { if (s.get_comm().root()) { const Real f = bfb ? 0 : 1; const int n = s.nlev*s.qsize; - // When not a BFB build, still expect l2 error to be the same to a few digits. - for (int i = 0; i < n; ++i) REQUIRE(almost_equal(eval_f[i], eval_c[i], f*1e-3)); - // Mass conservation error should be within a factor of 10 of each other. + // When not a BFB build, still expect l2 error to be the same to several digits. + for (int i = 0; i < n; ++i) REQUIRE(almost_equal(eval_f[i], eval_c[i], f*1e5*tol)); + // Mass conservation error should be within a factor of 10 of each + // other. for (int i = n; i < n + s.qsize; ++i) REQUIRE(almost_equal(eval_f[i], eval_c[i], f*10)); // And mass conservation itself should be small. for (int i = n; i < n + s.qsize; ++i) REQUIRE(std::abs(eval_f[i]) <= 20*tol); @@ -409,6 +475,7 @@ TEST_CASE ("compose_transport_testing") { } } + } while (false); // do } catch (...) {} Session::delete_singleton(); } From 37ec52bc4aa23558b31274d6dfc2a95abf792f90 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Mon, 2 Dec 2024 16:15:39 -0600 Subject: [PATCH 480/529] Hommexx: Rework skipping timers in first step. Make this a cmake define triggered by 'SYCL_BUILD'. Move it outside of the threaded region for consistency with t_dis/enablef usage. Switch based on nstep==0. Use a local boolean to avoid repeated calls to t_enablef. (The define prevents any of this code from mattering in all cases except the intended application.) --- components/homme/CMakeLists.txt | 5 ++++- components/homme/src/prim_main.F90 | 19 ++++++++++++++----- .../src/theta-l_kokkos/config.h.cmake.in | 4 ++++ 3 files changed, 22 insertions(+), 6 deletions(-) diff --git a/components/homme/CMakeLists.txt b/components/homme/CMakeLists.txt index ec291d8bd26..4bbfb3d73ac 100644 --- a/components/homme/CMakeLists.txt +++ b/components/homme/CMakeLists.txt @@ -321,7 +321,10 @@ IF (HOMME_USE_KOKKOS) IF (CUDA_BUILD OR HIP_BUILD OR SYCL_BUILD) SET (DEFAULT_VECTOR_SIZE 1) SET (HOMMEXX_ENABLE_GPU TRUE) - SET (HOMMEXX_ENABLE_GPU_F90 TRUE) + SET (HOMMEXX_ENABLE_GPU_F90 TRUE) + IF (SYCL_BUILD) + SET (DISABLE_TIMERS_IN_FIRST_STEP TRUE) + ENDIF() ELSE () SET (DEFAULT_VECTOR_SIZE 8) ENDIF() diff --git a/components/homme/src/prim_main.F90 b/components/homme/src/prim_main.F90 index d6901151d36..a1f94cf8ae6 100644 --- a/components/homme/src/prim_main.F90 +++ b/components/homme/src/prim_main.F90 @@ -68,6 +68,7 @@ end subroutine finalize_kokkos_f90 character (len=20) :: numtrac_char logical :: dir_e ! boolean existence of directory where output netcdf goes + logical :: call_enablef ! ===================================================== ! Begin executable code set distributed memory world... @@ -228,7 +229,20 @@ end subroutine finalize_kokkos_f90 if(par%masterproc) print *,"Entering main timestepping loop" call t_startf('prim_main_loop') + call_enablef = .false. do while(tl%nstep < nEndStep) +#ifdef DISABLE_TIMERS_IN_FIRST_STEP + ! Certain compilers, e.g., for Intel GPU, do just-in-time compilation. Turn + ! off timers in the first step to avoid counting that cost. + if (tl%nstep == 0) then + call t_disablef() + call_enablef = .true. + elseif (call_enablef) then + call t_enablef() + call_enablef = .false. + end if +#endif + #if (defined HORIZ_OPENMP) !$OMP PARALLEL NUM_THREADS(hthreads), DEFAULT(SHARED), PRIVATE(ithr,nets,nete,hybrid) call omp_set_num_threads(vthreads) @@ -240,11 +254,6 @@ end subroutine finalize_kokkos_f90 nstep = nextoutputstep(tl) do while(tl%nstep= 2) call t_enablef() call t_startf('prim_run') call prim_run_subcycle(elem, hybrid,nets,nete, tstep, .false., tl, hvcoord,1) call t_stopf('prim_run') diff --git a/components/homme/src/theta-l_kokkos/config.h.cmake.in b/components/homme/src/theta-l_kokkos/config.h.cmake.in index 7e378c1b795..5215d7bc641 100644 --- a/components/homme/src/theta-l_kokkos/config.h.cmake.in +++ b/components/homme/src/theta-l_kokkos/config.h.cmake.in @@ -77,3 +77,7 @@ /* Detect whether COMPOSE passive tracer transport is enabled */ #cmakedefine HOMME_ENABLE_COMPOSE + +/* For just-in-time compilation (e.g., SYCL compilers), disable timers at the */ +/* first prim_run level when nstep == 1. */ +#cmakedefine DISABLE_TIMERS_IN_FIRST_STEP From 4d1bddb82c839da65c74536b75c211afc3de2706 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Thu, 19 Dec 2024 17:16:17 -0600 Subject: [PATCH 481/529] EAM(xx): Add CIME EAM and EAMxx tests for SL enhanced trajectory method. Also add parameters to namelist definition file. --- cime_config/tests.py | 4 ++- .../namelist_files/namelist_definition.xml | 30 +++++++++++++++++++ .../eam/thetahy_sl_nsubstep2/user_nl_eam | 3 ++ .../scream/sl_nsubstep2/shell_commands | 3 ++ 4 files changed, 39 insertions(+), 1 deletion(-) create mode 100644 components/eam/cime_config/testdefs/testmods_dirs/eam/thetahy_sl_nsubstep2/user_nl_eam create mode 100644 components/eamxx/cime_config/testdefs/testmods_dirs/scream/sl_nsubstep2/shell_commands diff --git a/cime_config/tests.py b/cime_config/tests.py index 2bcc07f4d1b..aa1e699f6c0 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -532,6 +532,7 @@ "SMS.ne4pg2_oQU480.F2010.eam-thetanh_ftype2", "SMS.ne4pg2_oQU480.F2010.eam-thetanh_ftype4", "SMS.ne4pg2_oQU480.F2010.eam-thetahy_sl", + "ERS.ne4pg2_oQU480.F2010.eam-thetahy_sl_nsubstep2", "ERS.ne4pg2_oQU480.F2010.eam-thetahy_ftype2", "ERS.ne4pg2_oQU480.F2010.eam-thetanh_ftype2", ) @@ -722,7 +723,8 @@ "ERS_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-small_kernels--scream-output-preset-5", "ERP_Ln22.conusx4v1pg2_r05_oECv3.F2010-SCREAMv1-noAero.scream-bfbhash--scream-output-preset-6", "ERS_Ln22.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-L128--scream-output-preset-4", - "REP_Ld5.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-L128--scream-output-preset-6" + "REP_Ld5.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-L128--scream-output-preset-6", + "ERS_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-L128--scream-sl_nsubstep2", ) }, diff --git a/components/eam/bld/namelist_files/namelist_definition.xml b/components/eam/bld/namelist_files/namelist_definition.xml index 2fc33d291cf..848e43425b1 100644 --- a/components/eam/bld/namelist_files/namelist_definition.xml +++ b/components/eam/bld/namelist_files/namelist_definition.xml @@ -6809,6 +6809,36 @@ example, to apply hyperviscosity to moisture, the first tracer, set the value to Default: (set by dycore) + +Number of element haloes to include in trajectory search. -1 triggers an +automatic calculation of max(1, dt_tracer_factor/3). This is based on the +advective CFL condition that governs the dynamics time step. +Default: -1 (set by dycore) + + + +Number of substeps to take in computing semi-Lagrangian transport +trajectories. 0 triggers the original algorithm; 1 or larger triggers the +enhanced-trajectory algorithm. +Default: 0 (set by dycore) + + + +Number of velocity snapshots to store for use when computing the enhanced +trajectories. -1 triggers an automatic calculation. 0, 1, 2 all become 2, the +minimum. +Default: -1 (set by dycore) + + + +Optional diagnostic output from transport module. +Default: 0 (set by dycore) + + Date: Mon, 16 Dec 2024 22:12:11 -0800 Subject: [PATCH 482/529] fast-forward mam4xx submodule to fix non-determinism in amicphys test --- .../eamxx/src/physics/mam/eamxx_mam_aci_functions.hpp | 5 +++++ .../physics/mam/eamxx_mam_wetscav_process_interface.cpp | 9 ++++++++- externals/mam4xx | 2 +- 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/components/eamxx/src/physics/mam/eamxx_mam_aci_functions.hpp b/components/eamxx/src/physics/mam/eamxx_mam_aci_functions.hpp index 8bb52c918d2..9dbe97a4ae7 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_aci_functions.hpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_aci_functions.hpp @@ -406,6 +406,10 @@ void call_function_dropmixnuc( } }); team.team_barrier(); + // HACK: dropmixnuc() requires the parameter enable_aero_vertical_mix, + // so we define it here until we have a better idea of where it + // might come from + const bool enable_aero_vertical_mix = true; mam4::ndrop::dropmixnuc( team, dt, ekat::subview(T_mid, icol), ekat::subview(p_mid, icol), ekat::subview(p_int, icol), ekat::subview(pdel, icol), @@ -417,6 +421,7 @@ void call_function_dropmixnuc( spechygro, lmassptr_amode, num2vol_ratio_min_nmodes, num2vol_ratio_max_nmodes, numptr_amode, nspec_amode, exp45logsig, alogsig, aten, mam_idx, mam_cnst_idx, + enable_aero_vertical_mix, ekat::subview(qcld, icol), // out ekat::subview(wsub, icol), // in ekat::subview(cloud_frac_prev, icol), // in diff --git a/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp index 863da8021dd..0295a23cb4d 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_wetscav_process_interface.cpp @@ -539,12 +539,19 @@ void MAMWetscav::run_impl(const double dt) { auto wetdens_icol = ekat::subview(wetdens, icol); const auto prain_icol = ekat::subview(prain, icol); + Real scavimptblnum[mam4::aero_model::nimptblgrow_total] + [mam4::AeroConfig::num_modes()]; + Real scavimptblvol[mam4::aero_model::nimptblgrow_total] + [mam4::AeroConfig::num_modes()]; + + mam4::wetdep::init_scavimptbl(scavimptblvol, scavimptblnum); + mam4::wetdep::aero_model_wetdep( team, atm, progs, tends, dt, // inputs cldt_icol, rprdsh_icol, rprddp_icol, evapcdp_icol, evapcsh_icol, dp_frac_icol, sh_frac_icol, icwmrdp_col, icwmrsh_icol, nevapr_icol, - dlf_icol, prain_icol, + dlf_icol, prain_icol, scavimptblnum, scavimptblvol, // outputs wet_diameter_icol, dry_diameter_icol, qaerwat_icol, wetdens_icol, aerdepwetis_icol, aerdepwetcw_icol, work_icol); diff --git a/externals/mam4xx b/externals/mam4xx index fdbb0816c5c..524d7ff80cb 160000 --- a/externals/mam4xx +++ b/externals/mam4xx @@ -1 +1 @@ -Subproject commit fdbb0816c5c0c541265ec17f544908da935d8af6 +Subproject commit 524d7ff80cb0f9964d48634050a91665fe15acd5 From 0e00c5df824468aeea37ea33f21a9bdf30e926c4 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 7 Jan 2025 10:34:43 -0700 Subject: [PATCH 483/529] Update PAM submodule --- components/eam/src/physics/crm/pam/external | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/crm/pam/external b/components/eam/src/physics/crm/pam/external index 5d9046ae254..6b162a8892e 160000 --- a/components/eam/src/physics/crm/pam/external +++ b/components/eam/src/physics/crm/pam/external @@ -1 +1 @@ -Subproject commit 5d9046ae254f4db71f2c11202ebdc127c6ac27f4 +Subproject commit 6b162a8892e788d0a672d519374a3c82a0de2a5b From b2666f4b5ed13cf364990cc3e63b859490afdb9c Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 7 Jan 2025 14:03:50 -0700 Subject: [PATCH 484/529] GPU fixes: need to use host views for init stuff --- .../src/physics/p3/impl/p3_init_impl.hpp | 41 +++++++++++++++---- 1 file changed, 33 insertions(+), 8 deletions(-) diff --git a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp index 2082b9fbf96..dff58ba3301 100644 --- a/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp +++ b/components/eamxx/src/physics/p3/impl/p3_init_impl.hpp @@ -97,6 +97,12 @@ void compute_tables(const bool masterproc, MuRT& mu_r_table_vals, VNT& vn_table_ VMT_NC vm_table_vals_nc("vm_table_vals"); RevapT_NC revap_table_vals_nc("revap_table_vals"); + // Get host views + auto mu_r_table_vals_h = Kokkos::create_mirror_view(mu_r_table_vals_nc); + auto revap_table_vals_h = Kokkos::create_mirror_view(revap_table_vals_nc); + auto vn_table_vals_h = Kokkos::create_mirror_view(vn_table_vals_nc); + auto vm_table_vals_h = Kokkos::create_mirror_view(vm_table_vals_nc); + if (masterproc) { std::cout << "Recomputing lookup (non-ice) tables" << std::endl; } @@ -112,7 +118,7 @@ void compute_tables(const bool masterproc, MuRT& mu_r_table_vals, VNT& vn_table_ // AaronDonahue: Switching to table ver 4 means switching to a constand mu_r, // so this section is commented out. - Kokkos::deep_copy(mu_r_table_vals_nc, 1); // mu_r_constant =1. In other places, this is runtime_options.constant_mu_rain + Kokkos::deep_copy(mu_r_table_vals_h, 1); // mu_r_constant =1. In other places, this is runtime_options.constant_mu_rain static constexpr S thrd = 1./3; static constexpr S small = 1.e-30; @@ -178,12 +184,17 @@ void compute_tables(const bool masterproc, MuRT& mu_r_table_vals, VNT& vn_table_ dum4 = std::max(dum4, small); // to prevent divide-by-zero below dum5 = std::max(dum5, small); // to prevent log10-of-zero below - vn_table_vals_nc(jj-1,ii-1) = dum1/dum2; - vm_table_vals_nc(jj-1,ii-1) = dum3/dum4; - revap_table_vals_nc(jj-1,ii-1) = std::pow(10, std::log10(dum5) + (mu_r+1)*std::log10(lamr) - (3*mu_r)); + vn_table_vals_h(jj-1,ii-1) = dum1/dum2; + vm_table_vals_h(jj-1,ii-1) = dum3/dum4; + revap_table_vals_h(jj-1,ii-1) = std::pow(10, std::log10(dum5) + (mu_r+1)*std::log10(lamr) - (3*mu_r)); } } + Kokkos::deep_copy(mu_r_table_vals_nc, mu_r_table_vals_h); + Kokkos::deep_copy(revap_table_vals_nc, revap_table_vals_h); + Kokkos::deep_copy(vn_table_vals_nc, vn_table_vals_h); + Kokkos::deep_copy(vm_table_vals_nc, vm_table_vals_h); + mu_r_table_vals = mu_r_table_vals_nc; vn_table_vals = vn_table_vals_nc; vm_table_vals = vm_table_vals_nc; @@ -218,6 +229,12 @@ void io_impl(const bool masterproc, const char* dir, MuRT& mu_r_table_vals, VNT& const char* rw_flag = IsRead ? "r" : "w"; + // Get host views + auto mu_r_table_vals_h = Kokkos::create_mirror_view(mu_r_table_vals); + auto revap_table_vals_h = Kokkos::create_mirror_view(revap_table_vals); + auto vn_table_vals_h = Kokkos::create_mirror_view(vn_table_vals); + auto vm_table_vals_h = Kokkos::create_mirror_view(vm_table_vals); + // Add v2 because these tables are not identical to v1 due to roundoff differences // caused by doing the math in C++ instead of f90. std::string mu_r_filename = std::string(dir) + "/mu_r_table_vals_v2.dat" + extension; @@ -231,10 +248,18 @@ void io_impl(const bool masterproc, const char* dir, MuRT& mu_r_table_vals, VNT& ekat::FILEPtr vm_file(fopen(vm_filename.c_str(), rw_flag)); // Read files - action(mu_r_file, mu_r_table_vals.data(), mu_r_table_vals.size()); - action(revap_file, revap_table_vals.data(), revap_table_vals.size()); - action(vn_file, vn_table_vals.data(), vn_table_vals.size()); - action(vm_file, vm_table_vals.data(), vm_table_vals.size()); + action(mu_r_file, mu_r_table_vals_h.data(), mu_r_table_vals.size()); + action(revap_file, revap_table_vals_h.data(), revap_table_vals.size()); + action(vn_file, vn_table_vals_h.data(), vn_table_vals.size()); + action(vm_file, vm_table_vals_h.data(), vm_table_vals.size()); + + // Copy back to device + if constexpr (IsRead) { + Kokkos::deep_copy(mu_r_table_vals, mu_r_table_vals_h); + Kokkos::deep_copy(revap_table_vals, revap_table_vals_h); + Kokkos::deep_copy(vn_table_vals, vn_table_vals_h); + Kokkos::deep_copy(vm_table_vals, vm_table_vals_h); + } } template From 2da1a3b9739b45fc1012c36a156e9c6470aed767 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Tue, 7 Jan 2025 15:52:03 -0600 Subject: [PATCH 485/529] Hommexx: Add a timer for vertical_remap of dynamics variables. --- components/homme/src/share/cxx/prim_step.cpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/homme/src/share/cxx/prim_step.cpp b/components/homme/src/share/cxx/prim_step.cpp index 9e6afdec0d1..c5c75e54a35 100644 --- a/components/homme/src/share/cxx/prim_step.cpp +++ b/components/homme/src/share/cxx/prim_step.cpp @@ -183,7 +183,9 @@ void prim_step_flexible (const Real dt, const bool compute_diagnostics) { Errors::err_not_implemented); } else { // Remap dynamics variables but not tracers. + GPTLstart("tl-sc vertical_remap"); vertical_remap(dt_remap); + GPTLstop("tl-sc vertical_remap"); } } } From 71346983c9e26126f72a9b3688d7db8b94b0ecb5 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 7 Jan 2025 16:25:16 -0700 Subject: [PATCH 486/529] EAMxx: create rrtmgp allsky baseline target with CreateUnitTest utility The cmake utility links (indirectly) against scream_io, which avoids link errors in case of shared libraries. The errors are due to the fact that scream_share does use scream_io stuff, but the rrtmgp executable was not linking against it. Since the exec was indeed not using ANY of the scream_io symbols, static linking is fine, but dynamic linking is not. --- .../eamxx/src/physics/rrtmgp/tests/CMakeLists.txt | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/components/eamxx/src/physics/rrtmgp/tests/CMakeLists.txt b/components/eamxx/src/physics/rrtmgp/tests/CMakeLists.txt index c6fcfae76f8..ee8e4a383c4 100644 --- a/components/eamxx/src/physics/rrtmgp/tests/CMakeLists.txt +++ b/components/eamxx/src/physics/rrtmgp/tests/CMakeLists.txt @@ -1,14 +1,12 @@ if (SCREAM_ONLY_GENERATE_BASELINES) - # Build baseline code - add_executable(generate_baseline generate_baseline.cpp) - target_link_libraries(generate_baseline PUBLIC scream_rrtmgp rrtmgp_test_utils) - - # Generate allsky baseline with the usual cmake custom command-target pair pattern + # Generate allsky baseline # Note: these "baselines" are not to compare scream with a previous version, but # rather to compare scream::rrtmgp with raw rrtmgp. - CreateUnitTestFromExec( - rrtmgp-allsky-baseline generate_baseline + CreateUnitTest ( + rrtmgp-allsky-baseline generate_baseline.cpp + LIBS scream_rrtmgp rrtmgp_test_utils LABELS baseline_gen rrtmgp + EXCLUDE_MAIN_CPP EXE_ARGS "${SCREAM_DATA_DIR}/init/rrtmgp-allsky.nc ${SCREAM_BASELINES_DIR}/data/rrtmgp-allsky-baseline.nc" ) From be41c72365d2c17537c3e3cbcbe51199e0d0aa67 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Tue, 7 Jan 2025 17:44:07 -0600 Subject: [PATCH 487/529] Homme/SL: Adjust auto-setting of halo. --- components/homme/src/share/compose_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/homme/src/share/compose_mod.F90 b/components/homme/src/share/compose_mod.F90 index ba10ab7b5c0..6085eaf1238 100644 --- a/components/homme/src/share/compose_mod.F90 +++ b/components/homme/src/share/compose_mod.F90 @@ -304,7 +304,7 @@ subroutine compose_init(par, elem, GridVertex, init_kokkos) ! a parcel can cross a cell in three time steps. Since this is closely ! related to the dynamics' tstep, dt_tracer_factor is meaningful, ! implying: - semi_lagrange_halo = dt_tracer_factor / 3 + semi_lagrange_halo = (dt_tracer_factor + 2) / 3 if (semi_lagrange_halo < 1) semi_lagrange_halo = 1 end if From 26f3200509b68911dfa026996d216418f0f7424d Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 7 Jan 2025 20:51:45 -0600 Subject: [PATCH 488/529] Add ocn_c2_glctf to seq_infodata as in mct coupler add ocn_c2_glctf to seq_infodata_PutData_explicit and getData as was done for mct coupler. Needed to build with current MPAS --- driver-moab/shr/seq_infodata_mod.F90 | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/driver-moab/shr/seq_infodata_mod.F90 b/driver-moab/shr/seq_infodata_mod.F90 index 749edc2fdaa..d9e92f368ad 100644 --- a/driver-moab/shr/seq_infodata_mod.F90 +++ b/driver-moab/shr/seq_infodata_mod.F90 @@ -198,6 +198,7 @@ MODULE seq_infodata_mod logical :: ocn_prognostic ! does component model need input data from driver logical :: ocnrof_prognostic ! does component need rof data logical :: ocn_c2_glcshelf ! will ocn component send data for ice shelf fluxes in driver + logical :: ocn_c2_glctf ! will ocn component send data for thermal forcing in driver logical :: ice_present ! does component model exist logical :: ice_prognostic ! does component model need input data from driver logical :: iceberg_prognostic ! does the ice model support icebergs @@ -764,6 +765,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%ocn_prognostic = .false. infodata%ocnrof_prognostic = .false. infodata%ocn_c2_glcshelf = .false. + infodata%ocn_c2_glctf = .false. infodata%ice_prognostic = .false. infodata%glc_prognostic = .false. ! It's safest to assume glc_coupled_fluxes = .true. if it's not set elsewhere, @@ -1013,7 +1015,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, rofocn_prognostic, & - ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & + ocn_present, ocn_prognostic, ocnrof_prognostic, & + ocn_c2_glcshelf, ocn_c2_glctf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & iac_present, iac_prognostic, & @@ -1187,6 +1190,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: ocn_prognostic logical, optional, intent(OUT) :: ocnrof_prognostic logical, optional, intent(OUT) :: ocn_c2_glcshelf + logical, optional, intent(OUT) :: ocn_c2_glctf logical, optional, intent(OUT) :: ice_present logical, optional, intent(OUT) :: ice_prognostic logical, optional, intent(OUT) :: iceberg_prognostic @@ -1379,6 +1383,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(ocn_prognostic) ) ocn_prognostic = infodata%ocn_prognostic if ( present(ocnrof_prognostic) ) ocnrof_prognostic = infodata%ocnrof_prognostic if ( present(ocn_c2_glcshelf) ) ocn_c2_glcshelf = infodata%ocn_c2_glcshelf + if ( present(ocn_c2_glctf) ) ocn_c2_glctf = infodata%ocn_c2_glctf if ( present(ice_present) ) ice_present = infodata%ice_present if ( present(ice_prognostic) ) ice_prognostic = infodata%ice_prognostic if ( present(iceberg_prognostic)) iceberg_prognostic = infodata%iceberg_prognostic @@ -1578,7 +1583,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ atm_present, atm_prognostic, & lnd_present, lnd_prognostic, & rof_present, rof_prognostic, rofocn_prognostic, & - ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & + ocn_present, ocn_prognostic, ocnrof_prognostic, & + ocn_c2_glcshelf, ocn_c2_glctf, & ice_present, ice_prognostic, & glc_present, glc_prognostic, & glc_coupled_fluxes, & @@ -1753,6 +1759,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: ocn_prognostic logical, optional, intent(IN) :: ocnrof_prognostic logical, optional, intent(IN) :: ocn_c2_glcshelf + logical, optional, intent(IN) :: ocn_c2_glctf logical, optional, intent(IN) :: ice_present logical, optional, intent(IN) :: ice_prognostic logical, optional, intent(IN) :: iceberg_prognostic @@ -1944,6 +1951,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(ocn_prognostic) ) infodata%ocn_prognostic = ocn_prognostic if ( present(ocnrof_prognostic)) infodata%ocnrof_prognostic = ocnrof_prognostic if ( present(ocn_c2_glcshelf)) infodata%ocn_c2_glcshelf = ocn_c2_glcshelf + if ( present(ocn_c2_glctf)) infodata%ocn_c2_glctf = ocn_c2_glctf if ( present(ice_present) ) infodata%ice_present = ice_present if ( present(ice_prognostic) ) infodata%ice_prognostic = ice_prognostic if ( present(iceberg_prognostic)) infodata%iceberg_prognostic = iceberg_prognostic @@ -2258,6 +2266,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom) call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom) + call shr_mpi_bcast(infodata%ocn_c2_glctf, mpicom) call shr_mpi_bcast(infodata%ice_present, mpicom) call shr_mpi_bcast(infodata%ice_prognostic, mpicom) call shr_mpi_bcast(infodata%iceberg_prognostic, mpicom) @@ -2554,6 +2563,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%ocn_c2_glctf, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_ny, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_domain, mpicom, pebcast=cmppe) @@ -2632,6 +2642,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%ocn_c2_glctf, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ice_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ice_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%iceberg_prognostic, mpicom, pebcast=cplpe) @@ -2984,6 +2995,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'ocn_prognostic = ', infodata%ocn_prognostic write(logunit,F0L) subname,'ocnrof_prognostic = ', infodata%ocnrof_prognostic write(logunit,F0L) subname,'ocn_c2_glcshelf = ', infodata%ocn_c2_glcshelf + write(logunit,F0L) subname,'ocn_c2_glctf = ', infodata%ocn_c2_glctf write(logunit,F0L) subname,'ice_present = ', infodata%ice_present write(logunit,F0L) subname,'ice_prognostic = ', infodata%ice_prognostic write(logunit,F0L) subname,'iceberg_prognostic = ', infodata%iceberg_prognostic From 1a38005dfdcd25b52d67f144273d1719cd656876 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Mon, 25 Nov 2024 18:59:05 -0600 Subject: [PATCH 489/529] Add ATM2ICE_FMAPNAME_NONLINEAR to moab coupler Add ATM2ICE_FMAPNAME_NONLINEAR to moab coupler. Needed to create ne30 cases. --- driver-moab/cime_config/config_component.xml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/driver-moab/cime_config/config_component.xml b/driver-moab/cime_config/config_component.xml index ac9e46a476e..a32fb9bd529 100644 --- a/driver-moab/cime_config/config_component.xml +++ b/driver-moab/cime_config/config_component.xml @@ -1375,6 +1375,14 @@ atm2ocn flux mapping file + + char + idmap_ignore + run_domain + env_run.xml + atm2ice flux mapping file + + char idmap From e1911a216f80ee308beb928c068f5c5213537af2 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 7 Jan 2025 21:09:40 -0600 Subject: [PATCH 490/529] Update config_component_e3sm.xml from v3.0 Update config_component_e3sm.xml from v3.0 driver-mct --- .../cime_config/config_component_e3sm.xml | 31 +++++++++++++++++-- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/driver-moab/cime_config/config_component_e3sm.xml b/driver-moab/cime_config/config_component_e3sm.xml index 044cc1e9f9d..c16a493f045 100644 --- a/driver-moab/cime_config/config_component_e3sm.xml +++ b/driver-moab/cime_config/config_component_e3sm.xml @@ -185,6 +185,18 @@ Turn on the passing of polar fields through the coupler + + logical + TRUE,FALSE + FALSE + + TRUE + + run_flags + env_run.xml + Turn on the passing of ocean thermal forcing fields through the coupler + + char minus1p8,linear_salt,mushy @@ -245,6 +257,7 @@ CESM1_MOD CESM1_MOD RASM_OPTION1 + RASM_OPTION2 run_coupling env_run.xml @@ -275,7 +288,7 @@ none CO2C CO2A - CO2A + CO2A CO2A CO2A CO2A @@ -383,6 +396,10 @@ 24 48 48 + 180 + 360 + 720 + 1440 48 48 96 @@ -407,6 +424,7 @@ 144 432 864 + 864 144 96 48 @@ -446,6 +464,7 @@ 1 $ATM_NCPL 48 + $ATM_NCPL $ATM_NCPL 12 96 @@ -747,8 +766,13 @@ 312.821 388.717 388.717 - 0.000001 - 0.000001 + 284.317 + 284.317 + 284.317 + 284.317 + 284.317 + 284.317 + 0.000001 284.317 284.317 284.317 @@ -851,6 +875,7 @@ 1 2 + 2 shr_dust_nl env_run.xml From a251c5a41b207588c29769034b01edcb7025da41 Mon Sep 17 00:00:00 2001 From: Robert Jacob Date: Tue, 7 Jan 2025 21:12:56 -0600 Subject: [PATCH 491/529] Add tri grid case to moab suite Add fully coupled tri grid case to moab suite in addition to bi-grid --- cime_config/tests.py | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/tests.py b/cime_config/tests.py index e46b4c192ab..63682e70aa0 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -781,6 +781,7 @@ "e3sm_moab_dev" : { "time" : "01:00:00", "tests" : ( + "ERS_Vmoab_Ld3.ne4pg2_r05_oQU480.WCYCL1850NS", "ERS_Vmoab_Ld3.ne4pg2_oQU480.WCYCL1850NS", "ERS_Vmoab_Ld3.ne4pg2_oQU480.F1850", "ERS_Vmoab_Ld3.ne4pg2_ne4pg2.I1850CNPRDCTCBCTOP", From b2e5219849388542e8e77d8f939eac53f378cc24 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 8 Jan 2025 12:17:34 -0700 Subject: [PATCH 492/529] adjust type specification for RSO mode --- .../data_comps/docn/src/docn_comp_mod.F90 | 20 +++++++++---------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/components/data_comps/docn/src/docn_comp_mod.F90 b/components/data_comps/docn/src/docn_comp_mod.F90 index fa3d684eca3..5ea14ce368a 100644 --- a/components/data_comps/docn/src/docn_comp_mod.F90 +++ b/components/data_comps/docn/src/docn_comp_mod.F90 @@ -580,8 +580,6 @@ subroutine docn_comp_run(EClock, x2o, o2x, & real(R8) :: RSO_Tdeep ! deep water temperature [K] real(R8) :: RSO_dT_o ! scaling temperature gradient real(R8) :: RSO_h_o ! scaling mixed layer depth - ! real(R8) :: RSO_relax_tau ! relaxation timescale [sec] - ! real(R8) :: RSO_fixed_MLD ! globally fixed mixed layer depth (MLD) real(R8) :: u10 ! 10 m wind character(len=18) :: date_str character(len=CL) :: local_case_name @@ -819,16 +817,16 @@ subroutine docn_comp_run(EClock, x2o, o2x, & u10 = SQRT(x2o%rAttr(k10uu,n)) !******************************************************************* ! RSO parameter values - RSO_slab_option = 0 ! Option for setting RSO_X_cool - RSO_R_cool = 11.75/86400 ! base cooling rate [K/s] - RSO_Tdeep = 271.00 ! deep water temperature [K] - RSO_dT_o = 27.0 ! scaling temperature gradient - RSO_h_o = 30.0 ! scaling mixed layer depth + RSO_slab_option = 0 ! Option for setting RSO_X_cool + RSO_R_cool = 11.75_r8/86400._r8 ! base cooling rate [K/s] + RSO_Tdeep = 271.00 ! deep water temperature [K] + RSO_dT_o = 27.0 ! scaling temperature gradient + RSO_h_o = 30.0 ! scaling mixed layer depth !******************************************************************* ! Calculate scaling function - see Eq 3 in Zarzycki (2016) - if (RSO_slab_option==0) RSO_X_cool = 1/(1+EXP(-0.5*(u10-30)) ) ! SLAB1 - if (RSO_slab_option==1) RSO_X_cool =(1/(1+EXP(-0.2*(u10-30)) ))*(u10*2.4/80) ! SLAB2 - if (RSO_slab_option==2) RSO_X_cool = 0.0 ! THERMO + if (RSO_slab_option==0) RSO_X_cool = 1._r8/(1._r8+EXP(-0.5_r8*(u10-30._r8)) ) ! SLAB1 + if (RSO_slab_option==1) RSO_X_cool =(1._r8/(1._r8+EXP(-0.2_r8*(u10-30._r8)) ))*(u10*2.4_r8/80._r8) ! SLAB2 + if (RSO_slab_option==2) RSO_X_cool = 0.0 ! THERMO !******************************************************************* ! compute new ocean surface temperature o2x%rAttr(kt,n) = somtp(n) & @@ -842,7 +840,7 @@ subroutine docn_comp_run(EClock, x2o, o2x, & -x2o%rAttr(krofi ,n)*latice & ! latent heat from runoff ) * dt/(cpsw*rhosw*hn) & - RSO_X_cool*RSO_R_cool*((somtp(n)-RSO_Tdeep)/RSO_dT_o)*(RSO_h_o/hn)*dt & ! Turb mixing - + (1/RSO_relax_tau)*(RSO_bckgrd_sst - somtp(n))*dt ! Newtonian Relaxation + + (1_r8/RSO_relax_tau)*(RSO_bckgrd_sst - somtp(n))*dt ! Newtonian Relaxation !******************************************************************* ! Ignore ice formed or melt potential o2x%rAttr(kq,n) = 0.0 From 182326bbcf44eaeb1ffbe7ab82e3f7ad6e529845 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Wed, 8 Jan 2025 20:09:16 +0000 Subject: [PATCH 493/529] trying to bring sunspot entry in match with auroras --- cime_config/machines/config_machines.xml | 103 ++++++++++++----------- 1 file changed, 55 insertions(+), 48 deletions(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index 2d36ae36b28..ac8ac9c2423 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3028,35 +3028,32 @@ commented out until "*** No rule to make target '.../libadios2pio-nm-lib.a'" iss -np {{ total_tasks }} --label -ppn {{ tasks_per_node }} - --cpu-bind=list:0-7:8-15:16-23:24-31:32-39:40-47:52-59:60-67:68-75:76-83:84-91:92-99 -envall + --no-vni --cpu-bind $ENV{RANKS_BIND} -envall -d $ENV{OMP_NUM_THREADS} $ENV{GPU_TILE_COMPACT} - + - /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/sh /usr/share/lmod/lmod/init/csh /usr/share/lmod/lmod/init/env_modules_python.py module module /usr/share/lmod/lmod/libexec/lmod python - - - spack-pe-gcc/0.7.0-24.086.0 cmake python/3.10.11 - + + /soft/modulefiles + /soft/restricted/CNDA/updates/modulefiles + spack-pe-gcc/0.7.0-24.086.0 cmake + python/3.10.11 - oneapi/eng-compiler/2024.04.15.002 - mpich/icc-all-pmix-gpu/20231026 - - + oneapi/eng-compiler/2024.07.30.002 mpich/icc-all-pmix-gpu/20240717 - cray-pals - - libfabric/1.15.2.0 - + cray-pals/1.4.0 + libfabric/1.20.1 + $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld @@ -3067,58 +3064,68 @@ commented out until "*** No rule to make target '.../libadios2pio-nm-lib.a'" iss /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/lib:$ENV{LD_LIBRARY_PATH} /lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf/bin:$ENV{PATH} - list:0-7:8-15:16-23:24-31:32-39:40-47:52-59:60-67:68-75:76-83:84-91:92-99 - + list:0-7,104-111:8-15,112-119:16-23,120-127:24-31,128-135:32-39,136-143:40-47,144-151:52-59,156-163:60-67,164-171:68-75,172-179:76-83,180-187:84-91,188-195:92-99,196-203 + 1 - - + --> - 1 - - - - 1 - recursive_doubling - + 1 + 0 + + 1 + 1 + 1 + + 131072 + 20 + cxi + disabled + 8388608 - 1 - 1 + 240 + 240 - disable - disable + disable + disable - - 0 + level_zero:gpu + 1 - 4000MB + 4000MB 0 - /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh + /soft/tools/mpi_wrapper_utils/gpu_tile_compact.sh - 131072 - 20 - memhooks - warn + - + verbose,granularity=thread,balanced 128M From 29ebfc8c025896d1ad8a69202db815e923a3a506 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 8 Jan 2025 13:18:13 -0700 Subject: [PATCH 494/529] further r8 updates and set fixed values as parameters --- .../data_comps/docn/src/docn_comp_mod.F90 | 23 ++++++++----------- 1 file changed, 9 insertions(+), 14 deletions(-) diff --git a/components/data_comps/docn/src/docn_comp_mod.F90 b/components/data_comps/docn/src/docn_comp_mod.F90 index 5ea14ce368a..00a7ef4338c 100644 --- a/components/data_comps/docn/src/docn_comp_mod.F90 +++ b/components/data_comps/docn/src/docn_comp_mod.F90 @@ -572,15 +572,17 @@ subroutine docn_comp_run(EClock, x2o, o2x, & real(R8) :: dt ! timestep integer(IN) :: nu ! unit number real(R8) :: hn ! h field - mixed layer depth (MLD) - ! fields for relaxed slab ocean mode - integer :: RSO_slab_option ! Option for setting RSO_X_cool + ! relaxed slab ocean mode variables real(R8) :: RSO_bckgrd_sst ! background SST real(R8) :: RSO_X_cool ! logistics function weight - real(R8) :: RSO_R_cool ! base cooling rate [K/s] - real(R8) :: RSO_Tdeep ! deep water temperature [K] - real(R8) :: RSO_dT_o ! scaling temperature gradient - real(R8) :: RSO_h_o ! scaling mixed layer depth real(R8) :: u10 ! 10 m wind + ! relaxed slab ocean fixed parameters + integer, parameter :: RSO_slab_option = 0 ! Option for setting RSO_X_cool + real(R8), parameter :: RSO_R_cool = 11.75_r8/86400._r8 ! base cooling rate [K/s] + real(R8), parameter :: RSO_Tdeep = 271.0_r8 ! deep water temperature [K] + real(R8), parameter :: RSO_dT_o = 27.0_r8 ! scaling temperature gradient + real(R8), parameter :: RSO_h_o = 30.0_r8 ! scaling mixed layer depth + character(len=18) :: date_str character(len=CL) :: local_case_name real(R8), parameter :: & @@ -816,17 +818,10 @@ subroutine docn_comp_run(EClock, x2o, o2x, & RSO_bckgrd_sst = avstrm%rAttr(kRSO_bckgrd_sst,n) + TkFrz u10 = SQRT(x2o%rAttr(k10uu,n)) !******************************************************************* - ! RSO parameter values - RSO_slab_option = 0 ! Option for setting RSO_X_cool - RSO_R_cool = 11.75_r8/86400._r8 ! base cooling rate [K/s] - RSO_Tdeep = 271.00 ! deep water temperature [K] - RSO_dT_o = 27.0 ! scaling temperature gradient - RSO_h_o = 30.0 ! scaling mixed layer depth - !******************************************************************* ! Calculate scaling function - see Eq 3 in Zarzycki (2016) if (RSO_slab_option==0) RSO_X_cool = 1._r8/(1._r8+EXP(-0.5_r8*(u10-30._r8)) ) ! SLAB1 if (RSO_slab_option==1) RSO_X_cool =(1._r8/(1._r8+EXP(-0.2_r8*(u10-30._r8)) ))*(u10*2.4_r8/80._r8) ! SLAB2 - if (RSO_slab_option==2) RSO_X_cool = 0.0 ! THERMO + if (RSO_slab_option==2) RSO_X_cool = 0.0_r8 ! THERMO !******************************************************************* ! compute new ocean surface temperature o2x%rAttr(kt,n) = somtp(n) & From 199604844b1c75fe3c75e5a525829691f4fcc6c9 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 8 Jan 2025 13:28:43 -0700 Subject: [PATCH 495/529] fix data comp docs error --- components/data_comps/docs/user-guide/data-ocean.md | 4 ++-- components/data_comps/mkdocs.yml | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/components/data_comps/docs/user-guide/data-ocean.md b/components/data_comps/docs/user-guide/data-ocean.md index e7fa0505eb4..de232d665e8 100644 --- a/components/data_comps/docs/user-guide/data-ocean.md +++ b/components/data_comps/docs/user-guide/data-ocean.md @@ -95,11 +95,11 @@ In addition to the analytic SST modes the user can also specify an idealized aqu A slab ocean model (SOM) allows responsive SSTs to address the "infinite heat source" problem associated with prescribed SSTs, but is much cheaper than running with a full ocean model. The traditional SOM appraoch requires special inputs, such as a specified mixed layer depth pattern that can vary in time and a prescribed heat flux to account for the missing effects of ocean dynamics often referred to as "Q-flux". The Q-flux data is often estimated from a fully coupled simulation with active ocean and sea-ice so that the SOM simulation will resemble the full model. -Currently, we do not have Q-flux data to drive the SOM in E3SM. An alternative appraoch is to use a "relaxed" slab ocean (RSO) in which a specified relaxation time scale is used to bring the SST field back to a target SST field. The RSO mode is much simpler to use, but carries caveats that the user should be aware of before using. See [Data Ocean - Relaxed Slab Ocean](data-ocean-RSO.md) for more information. +Currently, we do not have Q-flux data to drive the SOM in E3SM. An alternative appraoch is to use a "relaxed" slab ocean (RSO) in which a specified relaxation time scale is used to bring the SST field back to a target SST field. The RSO mode is much simpler to use, but carries caveats that the user should be aware of before using. See [Data Ocean - Relaxed Slab Ocean](#relaxed-slab-ocean) for more information. ## Relaxed Slab Ocean -The relaxed slab ocean (RSO) is similar in many ways to the [traditional slab ocean model](data-ocean-SOM.md), but uses a specified relaxation time scale to avoid the need for specified "Q-flux" data to represent the effects of ocean transport. The RSO implementation in E3SM was inspired by Zarzycki (2016)[@Zarzycki_TC-ocn-cpl_2016]. +The relaxed slab ocean (RSO) is similar in many ways to the [traditional slab ocean model](#traditional-slab-ocean-model), but uses a specified relaxation time scale to avoid the need for specified "Q-flux" data to represent the effects of ocean transport. The RSO implementation in E3SM was inspired by Zarzycki (2016)[@Zarzycki_TC-ocn-cpl_2016]. A key consideration for the user is whether they need to use a realistic distribution of mixed layer depths (MLD), or whether their use case can benefit from the simplicity of a globally uniform MLD. diff --git a/components/data_comps/mkdocs.yml b/components/data_comps/mkdocs.yml index 226144e6bb8..89f5e6dca7b 100644 --- a/components/data_comps/mkdocs.yml +++ b/components/data_comps/mkdocs.yml @@ -2,6 +2,6 @@ site_name: Data-Models nav: - Introduction: 'index.md' - - Atmosphere: user-guide/data-atmos-main.md - - Land: user-guide/data-land-main.md - - Ocean: user-guide/data-ocean-main.md + - Atmosphere: user-guide/data-atmos.md + - Land: user-guide/data-land.md + - Ocean: user-guide/data-ocean.md From f61b41f5cf6a2103779daa2ddd9e994ff68d937f Mon Sep 17 00:00:00 2001 From: Michael J Schmidt Date: Wed, 4 Sep 2024 18:39:51 -0600 Subject: [PATCH 496/529] improve handling of initial condition and add formatting to DAG indicating as such fixed minor bug--still an issue with 2 fields in p3 for pg2 cases print formatting fix for dag remove 2 intermediate DAGs add descriptor box for IC fields --- .../eamxx/src/control/atmosphere_driver.cpp | 62 +++-- .../eamxx/src/control/atmosphere_driver.hpp | 2 + .../atm_process/atmosphere_process_dag.cpp | 230 ++++++++++++++---- .../atm_process/atmosphere_process_dag.hpp | 6 + 4 files changed, 229 insertions(+), 71 deletions(-) diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index f29c686eadb..03d8a4636d4 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -685,6 +685,21 @@ void AtmosphereDriver::create_fields() fm->add_to_group(fid.name(),"RESTART"); } + auto& driver_options_pl = m_atm_params.sublist("driver_options"); + const int verb_lvl = driver_options_pl.get("atmosphere_dag_verbosity_level",-1); + if (verb_lvl>0) { + // now that we've got fields, generate a DAG with fields and dependencies + // NOTE: at this point, fields provided by initial conditions may (will) + // appear as unmet dependencies + AtmProcDAG dag; + // First, add all atm processes + dag.create_dag(*m_atm_process_group); + // Write a dot file for visualization + if (m_atm_comm.am_i_root()) { + dag.write_dag("scream_atm_createField_dag.dot", std::max(verb_lvl,0)); + } + } + m_ad_status |= s_fields_created; // If the user requested it, we can save a dictionary of the FM fields to file @@ -902,28 +917,6 @@ initialize_fields () TraceGasesWorkaround::singleton().run_type = m_run_type; } - // See if we need to print a DAG. We do this first, cause if any input - // field is missing from the initial condition file, an error will be thrown. - // By printing the DAG first, we give the user the possibility of seeing - // what fields are inputs to the atm time step, so he/she can fix the i.c. file. - // TODO: would be nice to do the IC input first, and mark the fields in the - // DAG node "Begin of atm time step" in red if there's no initialization - // mechanism set for them. That is, allow field XYZ to not be found in - // the IC file, and throw an error when the dag is created. - - auto& driver_options_pl = m_atm_params.sublist("driver_options"); - const int verb_lvl = driver_options_pl.get("atmosphere_dag_verbosity_level",-1); - if (verb_lvl>0) { - // Check the atm DAG for missing stuff - AtmProcDAG dag; - - // First, add all atm processes - dag.create_dag(*m_atm_process_group); - - // Write a dot file for visualization - dag.write_dag("scream_atm_dag.dot",std::max(verb_lvl,0)); - } - // Initialize fields if (m_run_type==RunType::Restart) { restart_model (); @@ -1146,7 +1139,7 @@ void AtmosphereDriver::set_initial_conditions () grid_name == "Point Grid") { this_grid_topo_file_fnames.push_back("PHIS_d"); this_grid_topo_eamxx_fnames.push_back(fname); - fields_inited[grid_name].push_back(fname); + m_fields_inited[grid_name].push_back(fname); } else { EKAT_ERROR_MSG ("Error! Requesting phis on an unknown grid: " + grid_name + ".\n"); } @@ -1158,7 +1151,7 @@ void AtmosphereDriver::set_initial_conditions () " topo file only has sgh30 for Physics PG2.\n"); topography_file_fields_names[grid_name].push_back("SGH30"); topography_eamxx_fields_names[grid_name].push_back(fname); - fields_inited[grid_name].push_back(fname); + m_fields_inited[grid_name].push_back(fname); } } else if (not (fvphyshack and grid_name == "Physics PG2")) { // The IC file is written for the GLL grid, so we only load @@ -1170,7 +1163,7 @@ void AtmosphereDriver::set_initial_conditions () // If this field is the parent of other subfields, we only read from file the subfields. if (not ekat::contains(this_grid_ic_fnames,fname)) { this_grid_ic_fnames.push_back(fname); - fields_inited[grid_name].push_back(fname); + m_fields_inited[grid_name].push_back(fname); } } else if (fvphyshack and grid_name == "Physics GLL") { // [CGLL ICs in pg2] I tried doing something like this in @@ -1187,7 +1180,7 @@ void AtmosphereDriver::set_initial_conditions () } else { this_grid_ic_fnames.push_back(fname); } - fields_inited[grid_name].push_back(fname); + m_fields_inited[grid_name].push_back(fname); } } } @@ -1655,6 +1648,23 @@ void AtmosphereDriver::initialize_atm_procs () m_atm_logger->info("[EAMxx] initialize_atm_procs ... done!"); report_res_dep_memory_footprint (); + + auto& driver_options_pl = m_atm_params.sublist("driver_options"); + const int verb_lvl = driver_options_pl.get("atmosphere_dag_verbosity_level",-1); + if (verb_lvl>0) { + // now that we've got fields, generate a DAG with fields and dependencies + // NOTE: at this point, fields provided by initial conditions may (will) + // appear as unmet dependencies + AtmProcDAG dag; + // First, add all atm processes + dag.create_dag(*m_atm_process_group); + // process the initial conditions to maybe fulfill unmet dependencies + dag.process_initial_conditions(m_fields_inited); + // Write a dot file for visualization + if (m_atm_comm.am_i_root()) { + dag.write_dag("scream_atm_initProc_dag.dot", std::max(verb_lvl,0)); + } + } } void AtmosphereDriver:: diff --git a/components/eamxx/src/control/atmosphere_driver.hpp b/components/eamxx/src/control/atmosphere_driver.hpp index a3acfba5d94..49eb6cb8f11 100644 --- a/components/eamxx/src/control/atmosphere_driver.hpp +++ b/components/eamxx/src/control/atmosphere_driver.hpp @@ -264,6 +264,8 @@ class AtmosphereDriver // Current simulation casename std::string m_casename; + // maps grid name to a vector of its initialized fields + std::map> m_fields_inited; }; } // namespace control diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp index 7b6fc218a0b..532ba456b69 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp @@ -171,64 +171,117 @@ void AtmProcDAG::write_dag (const std::string& fname, const int verbosity) const ofile.open (fname.c_str()); ofile << "strict digraph G {\n" - << "rankdir=\"LR\""; + << "rankdir=\"LR\"\n"; + bool has_IC_field = false; for (const auto& n : m_nodes) { const auto& unmet = m_unmet_deps.at(n.id); + std::string box_fmt; + int id_IC = -1; + int id_begin = -1; + int id_end = -1; + if (n.name == "Begin of atm time step") { + id_begin = n.id; + box_fmt = " color=\"#00667E\"\n fontcolor=\"#00667E\"\n style=filled\n" + " fillcolor=\"#b9d4dc\"\n"; + } else if (n.name == "Initial Conditions") { + id_IC = n.id; + box_fmt = " color=\"#006219\"\n fontcolor=\"#006219\"\n style=filled\n" + " fillcolor=\"#b9dcc2\"\n"; + } else if (n.name == "End of atm time step") { + id_end = n.id; + box_fmt = " color=\"#88621e\"\n fontcolor=\"#88621e\"\n style=filled\n" + " fillcolor=\"#dccfb9\"\n"; + } + // Write node, with computed/required fields ofile << n.id << " [\n" << " shape=box\n" + << box_fmt + << " penwidth=4\n" + << " fontsize=30\n" << " label=<\n" << " \n" - << " "; - if (verbosity>1) { + << " \n"; + + int sz_comp = n.computed.size(), sz_req = n.required.size(), + sz_grcomp = n.gr_computed.size(), sz_grreq = n.gr_required.size(); + int nfield = sz_comp + sz_req + sz_grcomp + sz_grreq; + if (verbosity > 1 && nfield > 0) { // FieldIntentifier prints bare min with verb 0. // DAG starts printing fids with verb 2, so fid verb is verb-2; int fid_verb = verbosity-2; - ofile << "
\n"; + ofile << "
\n"; + + if (sz_comp > 0) { + // Computed fields + if (n.id == id_begin) { + ofile << " \n"; + } else if (n.id == id_IC) { + ofile << " \n"; + } else if (n.id != id_end) { + ofile << " \n"; + } - // Computed fields - if (n.name=="Begin of atm time step") { - ofile << " \n"; - } else if (n.name!="End of atm time step"){ - ofile << " \n"; - } - for (const auto& fid : n.computed) { - std::string fc = " "; - ofile << " \n"; + for (const auto& fid : n.computed) { + std::string fc = " "; + ofile << " \n"; + } } - // Required fields - if (n.name=="End of atm time step") { - ofile << " \n"; - } else if (n.name!="Begin of atm time step") { - ofile << " \n"; - } - for (const auto& fid : n.required) { - std::string fc = " "; - ofile << " \n"; + } else if (n.id != id_begin && n.id != id_IC) { + ofile << " \n"; + } + for (const auto& fid : n.required) { + std::string fc = " "; + ofile << " \n"; } - ofile << "\n"; } // Computed groups - if (n.gr_computed.size()>0) { - if (n.name=="Begin of atm time step") { - ofile << " \n"; - } else if (n.name!="End of atm time step"){ - ofile << " \n"; + if (sz_grcomp > 0) { + if (n.id == id_begin) { + ofile << " \n"; + } else if (n.id != id_end){ + ofile << " \n"; } for (const auto& gr_fid : n.gr_computed) { std::string fc = " "; ofile << " \n"; @@ -242,10 +295,8 @@ void AtmProcDAG::write_dag (const std::string& fname, const int verbosity) const size_t i = 0; for (const auto& fn : members_names) { const auto f = members.at(fn); - const auto& mfid = f->get_header().get_identifier(); - const auto mfid_id = get_fid_index(mfid); std::string mfc = ""; if (len>0) { ofile << ","; @@ -269,18 +320,18 @@ void AtmProcDAG::write_dag (const std::string& fname, const int verbosity) const } // Required groups - if (n.gr_required.size()>0) { + if (sz_grreq > 0) { if (n.name=="End of atm time step") { - ofile << " \n"; + ofile << " \n"; } else if (n.name!="Begin of atm time step") { - ofile << " \n"; + ofile << " \n"; } for (const auto& gr_fid : n.gr_required) { std::string fc = " "; ofile << " \n"; @@ -327,10 +378,45 @@ void AtmProcDAG::write_dag (const std::string& fname, const int verbosity) const // Write all outgoing edges for (const auto c : n.children) { - ofile << n.id << "->" << c << "\n"; + ofile << n.id << "->" << c << "[penwidth=4];\n"; } } + if (!m_IC_processed && m_has_unmet_deps) { + int this_node_id = m_nodes.size() + 1; + ofile << this_node_id << " [\n" + << " shape=box\n" + << " color=\"#605d57\"\n" + << " fontcolor=\"#034a4a\"\n" + << " penwidth=8\n" + << " fontsize=40\n" + << " style=filled\n" + << " fillcolor=\"#999999\"\n" + << " align=\"center\"\n" + << " label=<NOTE: " + "Fields marked missing may be
provided by " + "the as-yet-unprocessed
initial condition>\n" + << "];\n"; + } + + if (m_IC_processed && has_IC_field) { + int this_node_id = m_nodes.size() + 1; + ofile << this_node_id << " [\n" + << " shape=box\n" + << " color=\"#605d57\"\n" + << " fontcolor=\"#031576\"\n" + << " penwidth=8\n" + << " fontsize=40\n" + << " style=filled\n" + << " fillcolor=\"#cccccc\"\n" + << " align=\"center\"\n" + << " label=<NOTE: Fields denoted " + "with green text " + "
indicate the field was provided by the " + "
initial conditions and never updated>\n" + << "];\n"; + } + // Close the file ofile << "}"; ofile.close(); @@ -341,6 +427,7 @@ void AtmProcDAG::cleanup () { m_fid_to_last_provider.clear(); m_unmet_deps.clear(); m_has_unmet_deps = false; + m_IC_processed = false; } void AtmProcDAG:: @@ -364,10 +451,9 @@ add_nodes (const group_type& atm_procs) add_nodes(*group); } else { // Create a node for the process - // Node& node = m_nodes[proc->name()]; int id = m_nodes.size(); m_nodes.push_back(Node()); - Node& node = m_nodes.back();; + Node& node = m_nodes.back(); node.id = id; node.name = proc->name(); m_unmet_deps[id].clear(); // Ensures an entry for this id is in the map @@ -507,6 +593,60 @@ void AtmProcDAG::add_edges () { } } +void AtmProcDAG::process_initial_conditions(const grid_field_map &ic_inited) { + // First, add the fields that were determined to come from the previous time + // step => IC for t = 0 + // get the begin_node since the IC is identical at first + const Node &begin_node = m_nodes[m_nodes.size() - 2]; + int id = m_nodes.size(); + // Create a node for the ICs by copying the begin_node + m_nodes.push_back(Node(begin_node)); + Node& ic_node = m_nodes.back(); + // now set/clear the basic data for the ic_node + ic_node.id = id; + ic_node.name = "Initial Conditions"; + m_unmet_deps[id].clear(); + ic_node.children.clear(); + // now add the begin_node as a child of the ic_node + ic_node.children.push_back(begin_node.id); + // return if there's nothing to process in the ic_inited vector + if (ic_inited.size() == 0) { + return; + } + for (auto &node : m_nodes) { + if (m_unmet_deps.at(node.id).empty()) { + continue; + } else { + // NOTE: node_unmet_fields is a std::set + auto &node_unmet_fields = m_unmet_deps.at(node.id); + // add the current node as a child of the IC node + ic_node.children.push_back(node.id); + for (auto um_fid : node_unmet_fields) { + for (auto &it1 : ic_inited) { + const auto &grid_name = it1.first; + // if this unmet-dependency field's name is in the ic_inited map for + // the provided grid_name key, then we flip its value negative and + // break from the for (ic_inited) and for (node_unmet_fields) loops; + // otherwise, keep trying for the next grid_name + if (ekat::contains(ic_inited.at(grid_name), m_fids[um_fid].name())) { + auto id_now_met = node_unmet_fields.extract(um_fid); + id_now_met.value() = -id_now_met.value(); + node_unmet_fields.insert(std::move(id_now_met)); + // add the fid of the formerly unmet dep to the initial condition + // node's computed list + ic_node.computed.insert(um_fid); + goto endloop; + } else { + continue; + } + } + endloop:; + } + } + } + m_IC_processed = true; +} + int AtmProcDAG::add_fid (const FieldIdentifier& fid) { auto it = ekat::find(m_fids,fid); if (it==m_fids.end()) { diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_dag.hpp b/components/eamxx/src/share/atm_process/atmosphere_process_dag.hpp index 1a88381ecc8..52a0f9d8cd9 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_dag.hpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_dag.hpp @@ -16,6 +16,11 @@ class AtmProcDAG { void create_dag (const group_type& atm_procs); + using grid_field_map = std::map>; + void process_initial_conditions(const grid_field_map &ic_inited); + + void init_atm_proc_nodes(const group_type& atm_procs); + void add_surface_coupling (const std::set& imports, const std::set& exports); @@ -66,6 +71,7 @@ class AtmProcDAG { // Map a node id to a set of unmet field dependencies std::map> m_unmet_deps; bool m_has_unmet_deps; + bool m_IC_processed; // The nodes in the atm DAG std::vector m_nodes; From 651927eb377d1241b22af287054b1bf5a865910a Mon Sep 17 00:00:00 2001 From: Michael J Schmidt Date: Mon, 2 Dec 2024 22:44:02 -0700 Subject: [PATCH 497/529] rebase and fix conflicting variable usage regarding (m_)fields_inited --- .../eamxx/src/control/atmosphere_driver.cpp | 27 ++++++++++------ .../atm_process/atmosphere_process_dag.cpp | 32 +++++++++++-------- 2 files changed, 37 insertions(+), 22 deletions(-) diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp index 03d8a4636d4..dde92c5083c 100644 --- a/components/eamxx/src/control/atmosphere_driver.cpp +++ b/components/eamxx/src/control/atmosphere_driver.cpp @@ -4,6 +4,7 @@ #include "physics/share/physics_constants.hpp" +#include "share/scream_config.hpp" #include "share/atm_process/atmosphere_process_group.hpp" #include "share/atm_process/atmosphere_process_dag.hpp" #include "share/field/field_utils.hpp" @@ -694,16 +695,20 @@ void AtmosphereDriver::create_fields() AtmProcDAG dag; // First, add all atm processes dag.create_dag(*m_atm_process_group); - // Write a dot file for visualization + // Write a dot file for visualizing the DAG if (m_atm_comm.am_i_root()) { - dag.write_dag("scream_atm_createField_dag.dot", std::max(verb_lvl,0)); + std::string filename = "scream_atm_createField_dag"; + if (is_scream_standalone()) { + filename += ".np" + std::to_string(m_atm_comm.size()); + } + filename += ".dot"; + dag.write_dag(filename, verb_lvl); } } m_ad_status |= s_fields_created; // If the user requested it, we can save a dictionary of the FM fields to file - auto& driver_options_pl = m_atm_params.sublist("driver_options"); if (driver_options_pl.get("save_field_manager_content",false)) { auto pg = m_grids_manager->get_grid("Physics"); const auto& fm = m_field_mgrs.at(pg->name()); @@ -1094,7 +1099,6 @@ void AtmosphereDriver::set_initial_conditions () // Check which fields need to have an initial condition. std::map> ic_fields_names; std::vector ic_fields_to_copy; - std::map> fields_inited; // Check which fields should be loaded from the topography file std::map> topography_file_fields_names; @@ -1123,7 +1127,7 @@ void AtmosphereDriver::set_initial_conditions () EKAT_ERROR_MSG ("ERROR: invalid assignment for variable " + fname + ", only scalar " "double or string, or vector double arguments are allowed"); } - fields_inited[grid_name].push_back(fname); + m_fields_inited[grid_name].push_back(fname); } else if (fname == "phis" or fname == "sgh30") { // Both phis and sgh30 need to be loaded from the topography file auto& this_grid_topo_file_fnames = topography_file_fields_names[grid_name]; @@ -1226,7 +1230,7 @@ void AtmosphereDriver::set_initial_conditions () auto p = f.get_header().get_parent().lock(); if (p) { const auto& pname = p->get_identifier().name(); - if (ekat::contains(fields_inited[grid_name],pname)) { + if (ekat::contains(m_fields_inited[grid_name],pname)) { // The parent is already inited. No need to init this field as well. names.erase(it2); run_again = true; @@ -1449,7 +1453,7 @@ void AtmosphereDriver::set_initial_conditions () // Loop through fields and apply perturbation. for (size_t f=0; fget_grid()->name()], fname), + EKAT_REQUIRE_MSG(ekat::contains(m_fields_inited[fm->get_grid()->name()], fname), "Error! Attempting to apply perturbation to field not in initial_conditions.\n" " - Field: "+fname+"\n" " - Grid: "+fm->get_grid()->name()+"\n"); @@ -1660,9 +1664,14 @@ void AtmosphereDriver::initialize_atm_procs () dag.create_dag(*m_atm_process_group); // process the initial conditions to maybe fulfill unmet dependencies dag.process_initial_conditions(m_fields_inited); - // Write a dot file for visualization + // Write a dot file for visualizing the DAG if (m_atm_comm.am_i_root()) { - dag.write_dag("scream_atm_initProc_dag.dot", std::max(verb_lvl,0)); + std::string filename = "scream_atm_initProc_dag"; + if (is_scream_standalone()) { + filename += ".np" + std::to_string(m_atm_comm.size()); + } + filename += ".dot"; + dag.write_dag(filename, verb_lvl); } } } diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp index 532ba456b69..50d89d9916a 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp @@ -231,10 +231,11 @@ void AtmProcDAG::write_dag (const std::string& fname, const int verbosity) const for (const auto& fid : n.computed) { std::string fc = " "; ofile << " \n"; } } @@ -279,9 +280,6 @@ void AtmProcDAG::write_dag (const std::string& fname, const int verbosity) const for (const auto& gr_fid : n.gr_computed) { std::string fc = " "; ofile << " \n"; @@ -613,6 +611,7 @@ void AtmProcDAG::process_initial_conditions(const grid_field_map &ic_inited) { if (ic_inited.size() == 0) { return; } + std::set to_be_marked; for (auto &node : m_nodes) { if (m_unmet_deps.at(node.id).empty()) { continue; @@ -621,32 +620,39 @@ void AtmProcDAG::process_initial_conditions(const grid_field_map &ic_inited) { auto &node_unmet_fields = m_unmet_deps.at(node.id); // add the current node as a child of the IC node ic_node.children.push_back(node.id); - for (auto um_fid : node_unmet_fields) { + for (auto &um_fid : node_unmet_fields) { for (auto &it1 : ic_inited) { const auto &grid_name = it1.first; // if this unmet-dependency field's name is in the ic_inited map for - // the provided grid_name key, then we flip its value negative and - // break from the for (ic_inited) and for (node_unmet_fields) loops; - // otherwise, keep trying for the next grid_name + // the provided grid_name key, we record the field id in to_be_marked + // (because changing it messes up the iterator) if (ekat::contains(ic_inited.at(grid_name), m_fids[um_fid].name())) { - auto id_now_met = node_unmet_fields.extract(um_fid); - id_now_met.value() = -id_now_met.value(); - node_unmet_fields.insert(std::move(id_now_met)); + to_be_marked.insert(um_fid); // add the fid of the formerly unmet dep to the initial condition // node's computed list ic_node.computed.insert(um_fid); - goto endloop; } else { continue; } } - endloop:; + } + if (to_be_marked.empty()) { + continue; + } else { + // change the previously unmet dependency's field id to be negative, + // indicating that it is now met and provided by the initial condition + for (auto &fid : to_be_marked) { + node_unmet_fields.erase(fid); + node_unmet_fields.insert(-fid); + } } } } m_IC_processed = true; } + + int AtmProcDAG::add_fid (const FieldIdentifier& fid) { auto it = ekat::find(m_fids,fid); if (it==m_fids.end()) { From b5ea77583b1062ae1d72144fe722e0a7e4104680 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 7 Jan 2025 16:54:24 -0700 Subject: [PATCH 498/529] EAMxx: fix a couple of bugs related to time stamp * The curr_month_beg method was using the wront time of day * The next_write_ts method was not considering a corner case for month/year frequence. Resetting to what was previously in master. --- .../eamxx/src/share/io/scream_io_control.hpp | 28 ++++++++++++------- .../src/share/util/scream_time_stamp.cpp | 2 +- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/components/eamxx/src/share/io/scream_io_control.hpp b/components/eamxx/src/share/io/scream_io_control.hpp index 8e553907c55..07e60b4f24d 100644 --- a/components/eamxx/src/share/io/scream_io_control.hpp +++ b/components/eamxx/src/share/io/scream_io_control.hpp @@ -89,17 +89,25 @@ struct IOControl { } else if (frequency_units=="ndays") { next_write_ts += frequency*86400; } else if (frequency_units=="nmonths") { - for (int im=0; im Date: Thu, 19 Dec 2024 16:46:21 -0700 Subject: [PATCH 499/529] ff mam4xx to agree with interface fix work array pointers in mam4::wetdep::aero_model_wetdep update input.yaml for standalone microphys minor changes to get things running --- ...mxx_mam_microphysics_process_interface.cpp | 285 +++++++++++++----- ...mxx_mam_microphysics_process_interface.hpp | 1 + .../mam/aero_microphys/input.yaml | 9 + externals/mam4xx | 2 +- 4 files changed, 226 insertions(+), 71 deletions(-) diff --git a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp index 4a674fb094d..1c0053a87b9 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.cpp @@ -1,10 +1,10 @@ +#include #include - // impl namespace for some driver level functions for microphysics -#include "readfiles/photo_table_utils.cpp" -#include "readfiles/find_season_index_utils.hpp" #include "physics/rrtmgp/shr_orb_mod_c2f.hpp" +#include "readfiles/find_season_index_utils.hpp" +#include "readfiles/photo_table_utils.cpp" namespace scream { @@ -36,7 +36,7 @@ MAMMicrophysics::MAMMicrophysics(const ekat::Comm &comm, config_.linoz.o3_lbl = m_params.get("mam4_o3_lbl"); config_.linoz.o3_tau = m_params.get("mam4_o3_tau"); config_.linoz.o3_sfc = m_params.get("mam4_o3_sfc"); - config_.linoz.psc_T = m_params.get("mam4_psc_T"); + config_.linoz.psc_T = m_params.get("mam4_psc_T"); } AtmosphereProcessType MAMMicrophysics::type() const { @@ -70,6 +70,9 @@ void MAMMicrophysics::set_grids( const FieldLayout scalar3d_mid = grid_->get_3d_scalar_layout(true); const FieldLayout scalar3d_int = grid_->get_3d_scalar_layout(false); + // For U and V components of wind + const FieldLayout vector3d = grid_->get_3d_vector_layout(true, 2); + using namespace ekat::units; constexpr auto q_unit = kg / kg; // units of mass mixing ratios of tracers constexpr auto n_unit = 1 / kg; // units of number mixing ratios of tracers @@ -81,19 +84,20 @@ void MAMMicrophysics::set_grids( // ----------- Atmospheric quantities ------------- // Specific humidity [kg/kg](Require only for building DS) - add_tracer("qv", grid_, kg/kg); // specific humidity + add_tracer("qv", grid_, kg / kg); // specific humidity // Cloud liquid mass mixing ratio [kg/kg](Require only for building DS) - add_tracer("qc", grid_, kg/kg); // cloud liquid wet mixing ratio + add_tracer("qc", grid_, kg / kg); // cloud liquid wet mixing ratio // Cloud ice mass mixing ratio [kg/kg](Require only for building DS) - add_tracer("qi", grid_, kg/kg); // ice wet mixing ratio + add_tracer("qi", grid_, kg / kg); // ice wet mixing ratio // Cloud liquid number mixing ratio [1/kg](Require only for building DS) - add_tracer("nc", grid_, n_unit); // cloud liquid wet number mixing ratio + add_tracer("nc", grid_, + n_unit); // cloud liquid wet number mixing ratio // Cloud ice number mixing ratio [1/kg](Require only for building DS) - add_tracer("ni", grid_, n_unit); // ice number mixing ratio + add_tracer("ni", grid_, n_unit); // ice number mixing ratio // Temperature[K] at midpoints add_field("T_mid", scalar3d_mid, K, grid_name); @@ -120,11 +124,30 @@ void MAMMicrophysics::set_grids( // Surface geopotential [m2/s2] add_field("phis", scalar2d, m2 / s2, grid_name); + // Surface pressure [Pa] + add_field("ps", scalar2d, Pa, grid_name); + + // U and V components of the wind[m/s] + add_field("horiz_winds", vector3d, m / s, grid_name); + //----------- Variables from microphysics scheme ------------- constexpr auto nondim = ekat::units::Units::nondimensional(); // Total cloud fraction [fraction] add_field("cldfrac_liq", scalar3d_mid, nondim, grid_name); + // Evaporation from stratiform rain [kg/kg/s] + add_field("nevapr", scalar3d_mid, kg / kg / s, grid_name); + + // Stratiform rain production rate [kg/kg/s] + add_field("precip_total_tend", scalar3d_mid, kg / kg / s, + grid_name); + + // precipitation liquid mass [kg/m2] + add_field("precip_liq_surf_mass", scalar3d_mid, kg / m2, grid_name); + + // precipitation ice mass [kg/m2] + add_field("precip_ice_surf_mass", scalar3d_mid, kg / m2, grid_name); + //----------- Variables from other mam4xx processes ------------ // Number of modes constexpr int nmodes = mam4::AeroConfig::num_modes(); @@ -142,18 +165,26 @@ void MAMMicrophysics::set_grids( // Wet density of interstitial aerosol [kg/m3] add_field("wetdens", scalar3d_mid_nmodes, kg / m3, grid_name); - //----------- Variables from coupler (land component)--------- + // For fractional land use + const FieldLayout vector2d_class = + grid_->get_2d_vector_layout(mam4::mo_drydep::n_land_type, "class"); + + // Fractional land use [fraction] + add_field("fraction_landuse", vector2d_class, nondim, grid_name); + + //----------- Variables from the coupler --------- // surface albedo shortwave, direct add_field("sfc_alb_dir_vis", scalar2d, nondim, grid_name); - //----------- Variables from microphysics scheme ------------- + // Surface temperature[K] + add_field("surf_radiative_T", scalar2d, K, grid_name); - // Evaporation from stratiform rain [kg/kg/s] - add_field("nevapr", scalar3d_mid, kg / kg / s, grid_name); + // snow depth land [m] + add_field("snow_depth_land", scalar2d, m, grid_name); - // Stratiform rain production rate [kg/kg/s] - add_field("precip_total_tend", scalar3d_mid, kg / kg / s, - grid_name); + //----------- Variables from the RRTMGP radiation --------- + // Downwelling solar flux at the surface [w/m2] + add_field("SW_flux_dn", scalar3d_int, W / m2, grid_name); // --------------------------------------------------------------------- // These variables are "updated" or inputs/outputs for the process @@ -170,7 +201,7 @@ void MAMMicrophysics::set_grids( mam_coupling::int_aero_mmr_field_name(m, a); if(strlen(int_mmr_field_name) > 0) { - add_tracer(int_mmr_field_name, grid_, kg/kg); + add_tracer(int_mmr_field_name, grid_, kg / kg); } } // for loop species } // for loop nmodes interstitial @@ -192,8 +223,16 @@ void MAMMicrophysics::set_grids( // aerosol-related gases: mass mixing ratios for(int g = 0; g < mam_coupling::num_aero_gases(); ++g) { const char *gas_mmr_field_name = mam_coupling::gas_mmr_field_name(g); - add_tracer(gas_mmr_field_name, grid_, kg/kg); + add_tracer(gas_mmr_field_name, grid_, kg / kg); } + //----------- Updated variables from other mam4xx processes ------------ + // layout for Constituent fluxes + FieldLayout scalar2d_pcnst = + grid_->get_2d_vector_layout(mam4::pcnst, "num_phys_constituents"); + + // Constituent fluxes of species in [kg/m2/s] + add_field("constituent_fluxes", scalar2d_pcnst, kg / m2 / s, + grid_name); // Creating a Linoz reader and setting Linoz parameters involves reading data // from a file and configuring the necessary parameters for the Linoz model. @@ -272,8 +311,10 @@ void MAMMicrophysics::set_grids( const auto file_name = m_params.get(item_name); elevated_emis_file_name_[var_name] = file_name; } - elevated_emis_var_names_["so2"] = {"BB", "ENE_ELEV", "IND_ELEV", "contvolc"}; - elevated_emis_var_names_["so4_a1"] = {"BB", "ENE_ELEV", "IND_ELEV", "contvolc"}; + elevated_emis_var_names_["so2"] = {"BB", "ENE_ELEV", "IND_ELEV", + "contvolc"}; + elevated_emis_var_names_["so4_a1"] = {"BB", "ENE_ELEV", "IND_ELEV", + "contvolc"}; elevated_emis_var_names_["so4_a2"] = {"contvolc"}; elevated_emis_var_names_["pom_a4"] = {"BB"}; elevated_emis_var_names_["bc_a4"] = {"BB"}; @@ -285,8 +326,8 @@ void MAMMicrophysics::set_grids( // FIXME: why the sectors in this files are num_a1; // I guess this should be num_a4? Is this a bug in the orginal nc files? elevated_emis_var_names_["num_a4"] = {"num_a1_BC_ELEV_BB", - "num_a1_POM_ELEV_BB"}; - elevated_emis_var_names_["soag"] = {"SOAbb_src", "SOAbg_src", "SOAff_src"}; + "num_a1_POM_ELEV_BB"}; + elevated_emis_var_names_["soag"] = {"SOAbb_src", "SOAbg_src", "SOAff_src"}; int elevated_emiss_cyclical_ymd = m_params.get("elevated_emiss_ymd"); @@ -300,9 +341,8 @@ void MAMMicrophysics::set_grids( auto hor_rem = scream::mam_coupling::create_horiz_remapper( grid_, file_name, extfrc_map_file, var_names, data_tracer); - auto file_reader = - scream::mam_coupling::create_tracer_data_reader(hor_rem, file_name, - data_tracer.file_type); + auto file_reader = scream::mam_coupling::create_tracer_data_reader( + hor_rem, file_name, data_tracer.file_type); ElevatedEmissionsHorizInterp_.push_back(hor_rem); ElevatedEmissionsDataReader_.push_back(file_reader); elevated_emis_data_.push_back(data_tracer); @@ -317,8 +357,9 @@ void MAMMicrophysics::set_grids( forcings_[i].nsectors = nvars; // I am assuming the order of species in extfrc_lst_. // Indexing in mam4xx is fortran. - forcings_[i].frc_ndx = i + 1; - const auto io_grid_emis = ElevatedEmissionsHorizInterp_[i]->get_tgt_grid(); + forcings_[i].frc_ndx = i + 1; + const auto io_grid_emis = + ElevatedEmissionsHorizInterp_[i]->get_tgt_grid(); const int num_cols_io_emis = io_grid_emis->get_num_local_dofs(); // Number of columns on this rank const int num_levs_io_emis = @@ -344,11 +385,11 @@ void MAMMicrophysics::set_grids( } // Tracer external forcing data { - const std::string season_wes_file = m_params.get("mam4_season_wes_file"); - const auto& clat = col_latitudes_; - mam_coupling::find_season_index_reader(season_wes_file, - clat, - index_season_lai_); + const std::string season_wes_file = + m_params.get("mam4_season_wes_file"); + const auto &clat = col_latitudes_; + mam_coupling::find_season_index_reader(season_wes_file, clat, + index_season_lai_); } } // set_grids @@ -523,7 +564,7 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) { work_photo_table_ = view_2d("work_photo_table", ncol_, photo_table_len); const int sethet_work_len = mam4::mo_sethet::get_total_work_len_sethet(); work_set_het_ = view_2d("work_set_het_array", ncol_, sethet_work_len); - cmfdqr_ = view_1d("cmfdqr_", nlev_); + cmfdqr_ = view_1d("cmfdqr_", nlev_); // here's where we store per-column photolysis rates photo_rates_ = view_3d("photo_rates", ncol_, nlev_, mam4::mo_photo::phtcnt); @@ -541,8 +582,8 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) { for(int i = 0; i < static_cast(extfrc_lst_.size()); ++i) { scream::mam_coupling::update_tracer_data_from_file( - ElevatedEmissionsDataReader_[i], curr_month, *ElevatedEmissionsHorizInterp_[i], - elevated_emis_data_[i]); + ElevatedEmissionsDataReader_[i], curr_month, + *ElevatedEmissionsHorizInterp_[i], elevated_emis_data_[i]); } invariants_ = view_3d("invarians", ncol_, nlev_, mam4::gas_chemistry::nfs); @@ -568,22 +609,25 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) { // RUN_IMPL // ================================================================ void MAMMicrophysics::run_impl(const double dt) { + const int ncol = ncol_; + const int nlev = nlev_; const auto scan_policy = ekat::ExeSpaceUtils< - KT::ExeSpace>::get_thread_range_parallel_scan_team_policy(ncol_, nlev_); + KT::ExeSpace>::get_thread_range_parallel_scan_team_policy(ncol, nlev); const auto policy = - ekat::ExeSpaceUtils::get_default_team_policy(ncol_, nlev_); + ekat::ExeSpaceUtils::get_default_team_policy(ncol, nlev); // preprocess input -- needs a scan for the calculation of atm height Kokkos::parallel_for("preprocess", scan_policy, preprocess_); Kokkos::fence(); - //----------- Variables from microphysics scheme ------------- + //----------- Variables from microphysics scheme ------------- // Evaporation from stratiform rain [kg/kg/s] - const auto& nevapr = get_field_in("nevapr").get_view(); + const auto &nevapr = get_field_in("nevapr").get_view(); // Stratiform rain production rate [kg/kg/s] - const auto& prain = get_field_in("precip_total_tend").get_view(); + const auto &prain = + get_field_in("precip_total_tend").get_view(); const auto wet_geometric_mean_diameter_i = get_field_in("dgnumwet").get_view(); @@ -591,6 +635,46 @@ void MAMMicrophysics::run_impl(const double dt) { get_field_in("dgnum").get_view(); const auto wetdens = get_field_in("wetdens").get_view(); + // U wind component [m/s] + const const_view_2d u_wind = + get_field_in("horiz_winds").get_component(0).get_view(); + + // V wind component [m/s] + const const_view_2d v_wind = + get_field_in("horiz_winds").get_component(1).get_view(); + + // Liquid precip [kg/m2] + const const_view_2d precip_liq_surf_mass = + get_field_in("precip_liq_surf_mass").get_view(); + + // Ice precip [kg/m2] + const const_view_2d precip_ice_surf_mass = + get_field_in("precip_ice_surf_mass").get_view(); + + // Fractional land use [fraction] + const const_view_2d fraction_landuse = + get_field_in("fraction_landuse").get_view(); + + // Downwelling solar flux at the surface [w/m2] + const const_view_2d sw_flux_dn = + get_field_in("SW_flux_dn").get_view(); + + // Constituent fluxes of gas and aerosol species + view_2d constituent_fluxes = + get_field_out("constituent_fluxes").get_view(); + + // Surface temperature [K] + const const_view_1d sfc_temperature = + get_field_in("surf_radiative_T").get_view(); + + // Surface pressure [Pa] + const const_view_1d sfc_pressure = + get_field_in("ps").get_view(); + + // Snow depth on land [m] + const const_view_1d snow_depth_land = + get_field_in("snow_depth_land").get_view(); + // climatology data for linear stratospheric chemistry // ozone (climatology) [vmr] auto linoz_o3_clim = buffer_.scratch[0]; @@ -648,14 +732,15 @@ void MAMMicrophysics::run_impl(const double dt) { Kokkos::fence(); elevated_emiss_time_state_.t_now = ts.frac_of_year_in_days(); - int i = 0; + int i = 0; for(const auto &var_name : extfrc_lst_) { const auto file_name = elevated_emis_file_name_[var_name]; const auto var_names = elevated_emis_var_names_[var_name]; const int nsectors = int(var_names.size()); view_2d elevated_emis_output[nsectors]; for(int isp = 0; isp < nsectors; ++isp) { - elevated_emis_output[isp] = elevated_emis_output_[isp + forcings_[i].offset]; + elevated_emis_output[isp] = + elevated_emis_output_[isp + forcings_[i].offset]; } scream::mam_coupling::advance_tracer_data( ElevatedEmissionsDataReader_[i], *ElevatedEmissionsHorizInterp_[i], ts, @@ -722,7 +807,7 @@ void MAMMicrophysics::run_impl(const double dt) { // then deep copied to a device view. // Now use solar declination to calculate zenith angle for all points - for(int i = 0; i < ncol_; i++) { + for(int i = 0; i < ncol; i++) { Real lat = col_latitudes_host(i) * M_PI / 180.0; // Convert lat/lon to radians Real lon = col_longitudes_host(i) * M_PI / 180.0; @@ -735,10 +820,10 @@ void MAMMicrophysics::run_impl(const double dt) { const auto zenith_angle = acos_cosine_zenith_; constexpr int gas_pcnst = mam_coupling::gas_pcnst(); - const auto& elevated_emis_output = elevated_emis_output_; - const auto& extfrc = extfrc_; - const auto& forcings = forcings_; - constexpr int extcnt = mam4::gas_chemistry::extcnt; + const auto &elevated_emis_output = elevated_emis_output_; + const auto &extfrc = extfrc_; + const auto &forcings = forcings_; + constexpr int extcnt = mam4::gas_chemistry::extcnt; const int offset_aerosol = mam4::utils::gasses_start_ind(); Real adv_mass_kg_per_moles[gas_pcnst]; @@ -753,11 +838,18 @@ void MAMMicrophysics::run_impl(const double dt) { clsmap_4[i] = mam4::gas_chemistry::clsmap_4[i]; permute_4[i] = mam4::gas_chemistry::permute_4[i]; } - const auto& cmfdqr = cmfdqr_; - const auto& work_set_het =work_set_het_; + const auto &cmfdqr = cmfdqr_; + const auto &work_set_het = work_set_het_; + const mam4::seq_drydep::Data drydep_data = + mam4::seq_drydep::set_gas_drydep_data(); + const auto qv = wet_atm_.qv; + const int month = timestamp().get_month(); // 1-based + const int surface_lev = nlev - 1; // Surface level + // loop over atmosphere columns and compute aerosol microphyscs Kokkos::parallel_for( - policy, KOKKOS_LAMBDA(const ThreadTeam &team) { + "MAMMicrophysics::run_impl", policy, + KOKKOS_LAMBDA(const ThreadTeam &team) { const int icol = team.league_rank(); // column index const Real col_lat = col_latitudes(icol); // column latitude (degrees?) @@ -820,28 +912,81 @@ void MAMMicrophysics::run_impl(const double dt) { ekat::subview(linoz_dPmL_dO3col, icol); const auto linoz_cariolle_pscs_icol = ekat::subview(linoz_cariolle_pscs, icol); - const auto nevapr_icol = ekat::subview(nevapr, icol); - const auto prain_icol = ekat::subview(prain, icol); + const auto nevapr_icol = ekat::subview(nevapr, icol); + const auto prain_icol = ekat::subview(prain, icol); const auto work_set_het_icol = ekat::subview(work_set_het, icol); - // Note: All variables are inputs, except for progs, which is an - // input/output variable. + + // Surface temperature + const Real sfc_air_temp = atm.temperature(surface_lev); + + // Surface specific humidity + const Real sfc_spec_hum = atm.vapor_mixing_ratio(surface_lev); + + // Surface potential temperature + //(FIXME: We followed Fortran, compare it with MAM4xx's potential temp + // func) + const Real sfc_potential_temp = sfc_air_temp * (1.0 + sfc_spec_hum); + + // Surface pressure at 10m (Followed the fortran code) + const Real pressure_10m = dry_atm.p_mid(icol, surface_lev); + + // Wind speed at the surface + const Real wind_speed = + haero::sqrt(u_wind(icol, surface_lev) * u_wind(icol, surface_lev) + + v_wind(icol, surface_lev) * v_wind(icol, surface_lev)); + + // Total rain at the surface + const Real rain = precip_liq_surf_mass(icol, surface_lev) + + precip_ice_surf_mass(icol, surface_lev); + + // Snow depth on land [m] + const Real snow_height = snow_depth_land(icol); + + // Downwelling solar flux at the surface (value at interface) [w/m2] + const Real solar_flux = sw_flux_dn(icol, surface_lev + 1); + + Real fraction_landuse_icol[mam4::mo_drydep::n_land_type]; + for(int i = 0; i < mam4::mo_drydep::n_land_type; ++i) { + fraction_landuse_icol[i] = fraction_landuse(icol, i); + } + + // ????? FIXME: We should get its value after the rebase + const int col_index_season[mam4::mo_drydep::n_land_type] = { + 1, 2, 3, 4, 5, 6, 7, 8, 9}; + // These output values need to be put somewhere: + Real dvel[gas_pcnst] = {}; // deposition velocity [1/cm/s] + Real dflx[gas_pcnst] = {}; // deposition flux [1/cm^2/s] + + // Output: values are dvel, dvlx + // Input/Output: progs::stateq, progs::qqcw mam4::microphysics::perform_atmospheric_chemistry_and_microphysics( - team, dt, rlats, cnst_offline_icol, forcings_in, atm, progs, - photo_table, chlorine_loading, config.setsox, config.amicphys, - config.linoz.psc_T, zenith_angle(icol), d_sfc_alb_dir_vis(icol), - o3_col_dens_i, photo_rates_icol, extfrc_icol, invariants_icol, - work_photo_table_icol, linoz_o3_clim_icol, linoz_t_clim_icol, - linoz_o3col_clim_icol, linoz_PmL_clim_icol, linoz_dPmL_dO3_icol, - linoz_dPmL_dT_icol, linoz_dPmL_dO3col_icol, - linoz_cariolle_pscs_icol, eccf, adv_mass_kg_per_moles, clsmap_4, - permute_4, offset_aerosol, - config.linoz.o3_sfc, config.linoz.o3_tau, config.linoz.o3_lbl, - dry_diameter_icol, wet_diameter_icol, wetdens_icol, - dry_atm.phis(icol), - cmfdqr, - prain_icol, - nevapr_icol, - work_set_het_icol); + team, dt, rlats, month, sfc_temperature(icol), sfc_air_temp, + sfc_potential_temp, sfc_pressure(icol), pressure_10m, sfc_spec_hum, + wind_speed, rain, snow_height, solar_flux, cnst_offline_icol, + forcings_in, atm, photo_table, chlorine_loading, config.setsox, + config.amicphys, config.linoz.psc_T, zenith_angle(icol), + d_sfc_alb_dir_vis(icol), o3_col_dens_i, photo_rates_icol, + extfrc_icol, invariants_icol, work_photo_table_icol, + linoz_o3_clim_icol, linoz_t_clim_icol, linoz_o3col_clim_icol, + linoz_PmL_clim_icol, linoz_dPmL_dO3_icol, linoz_dPmL_dT_icol, + linoz_dPmL_dO3col_icol, linoz_cariolle_pscs_icol, eccf, + adv_mass_kg_per_moles, fraction_landuse_icol, + + col_index_season, // FIXME: Get it after Changes sync with E3SM + + clsmap_4, permute_4, offset_aerosol, config.linoz.o3_sfc, + config.linoz.o3_tau, config.linoz.o3_lbl, dry_diameter_icol, + wet_diameter_icol, wetdens_icol, dry_atm.phis(icol), cmfdqr, + prain_icol, nevapr_icol, work_set_het_icol, drydep_data, dvel, dflx, + progs); + + // Update constituent fluxes with gas drydep fluxes (dflx) + // FIXME: Possible units mismatch (dflx is in kg/cm2/s but + // constituent_fluxes is kg/m2/s) (Following mimics Fortran code + // behavior but we should look into it) + for(int ispc = offset_aerosol; ispc < mam4::pcnst; ++ispc) { + constituent_fluxes(icol, ispc) = dflx[ispc - offset_aerosol]; + } }); // parallel_for for the column loop Kokkos::fence(); diff --git a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp index 6ff846d0d0c..532e3042301 100644 --- a/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp +++ b/components/eamxx/src/physics/mam/eamxx_mam_microphysics_process_interface.hpp @@ -22,6 +22,7 @@ class MAMMicrophysics final : public scream::AtmosphereProcess { using view_2d = typename KT::template view_2d; using view_3d = typename KT::template view_3d; using const_view_1d = typename KT::template view_1d; + using const_view_2d = typename KT::template view_2d; using view_1d_host = typename KT::view_1d::HostMirror; diff --git a/components/eamxx/tests/single-process/mam/aero_microphys/input.yaml b/components/eamxx/tests/single-process/mam/aero_microphys/input.yaml index 7dd28a87f47..48070ee3b0d 100644 --- a/components/eamxx/tests/single-process/mam/aero_microphys/input.yaml +++ b/components/eamxx/tests/single-process/mam/aero_microphys/input.yaml @@ -60,6 +60,15 @@ initial_conditions: wetdens: [1038.67760516297, 1046.20002003441, 1031.74623165457, 1086.79731859184] nevapr: 0.0 precip_total_tend: 0.0 + surf_radiative_T: 288.0 + ps: 105000.0 + horiz_winds: [-0.24988988196194634E+000, -0.23959782871450760E+000] + precip_liq_surf_mass: 0.1 + precip_ice_surf_mass: 0.1 + snow_depth_land: 0.01 + fraction_landuse: 0.0 + SW_flux_dn: 500.0 + constituent_fluxes: 0.0 # The parameters for I/O control Scorpio: output_yaml_files: ["output.yaml"] diff --git a/externals/mam4xx b/externals/mam4xx index 524d7ff80cb..d71354ec9a6 160000 --- a/externals/mam4xx +++ b/externals/mam4xx @@ -1 +1 @@ -Subproject commit 524d7ff80cb0f9964d48634050a91665fe15acd5 +Subproject commit d71354ec9a6c2cecc3ca13cb5c3db3125743024b From 04d1673e38ee8a796085c193221c2e6fa2594331 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Thu, 9 Jan 2025 14:02:14 -0600 Subject: [PATCH 500/529] Homme/SL: Remove CAAS-point impl for now. I'll add this in a different PR. However, keep the generalized indexing changes and extra argument in the Homme interface because they are useful. --- .../src/share/compose/compose_cedr_cdr.hpp | 7 +- .../compose/compose_cedr_sl_run_global.cpp | 173 +++++------------- .../compose/compose_cedr_sl_run_local.cpp | 18 +- 3 files changed, 51 insertions(+), 147 deletions(-) diff --git a/components/homme/src/share/compose/compose_cedr_cdr.hpp b/components/homme/src/share/compose/compose_cedr_cdr.hpp index 2c73bd6de07..fd8e92bc703 100644 --- a/components/homme/src/share/compose/compose_cedr_cdr.hpp +++ b/components/homme/src/share/compose/compose_cedr_cdr.hpp @@ -9,7 +9,7 @@ namespace homme { struct Alg { enum Enum { qlt, qlt_super_level, qlt_super_level_local_caas, caas, - caas_super_level, caas_point }; + caas_super_level }; static Enum convert (int cdr_alg) { switch (cdr_alg) { case 2: return qlt; @@ -18,7 +18,6 @@ struct Alg { case 3: return caas; case 30: return caas_super_level; case 42: return caas_super_level; // actually none - case 5: return caas_point; default: cedr_throw_if(true, "cdr_alg " << cdr_alg << " is invalid."); } } @@ -27,10 +26,10 @@ struct Alg { e == qlt_super_level_local_caas); } static bool is_caas (Enum e) { - return e == caas || e == caas_super_level || e == caas_point; + return e == caas || e == caas_super_level; } static bool is_point (Enum e) { - return e == caas_point; + return false; } static bool is_suplev (Enum e) { return (e == qlt_super_level || e == caas_super_level || diff --git a/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp b/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp index 40348736167..69fab390726 100644 --- a/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp +++ b/components/homme/src/share/compose/compose_cedr_sl_run_global.cpp @@ -5,76 +5,6 @@ namespace homme { namespace sl { -template -void run_relaxed_local (CDR& cdr, const Data& d, Real* q_min_r, - const Real* q_max_r, const Int nets, const Int nete) { - const auto& ta = *d.ta; - cedr_assert(ta.np == np_); - static const Int np2 = np_*np_; - const Int nlev = ta.nlev, qsize = ta.qsize, nlevwrem = cdr.nsuplev*cdr.nsublev; -#ifdef COMPOSE_PORT - const auto& q_min = ta.q_min; - const auto& q_max = ta.q_max; -#else - const QExtremaH - q_min(q_min_r, ta.nelemd, ta.qsize, ta.nlev, np2); - const QExtremaHConst - q_max(q_max_r, ta.nelemd, ta.qsize, ta.nlev, np2); -#endif - const auto np1 = ta.np1; - const auto& spheremp = ta.spheremp; - const auto& dp3d_c = ta.dp3d; - const auto& q_c = ta.q; - const Int nsublev = cdr.nsublev; - const Int nsuplev = cdr.nsuplev; - const auto caas_in_suplev = cdr.caas_in_suplev; - cedr_assert( ! caas_in_suplev); - const auto is_point = Alg::is_point(cdr.alg); -#ifdef COMPOSE_PORT - const auto f = COMPOSE_LAMBDA (const Int& idx) { - const Int ie = nets + idx/(nsuplev*qsize); - const Int q = (idx / nsuplev) % qsize; - const Int spli = idx % nsuplev; -#else - for (Int ie = nets; ie <= nete; ++ie) { -#endif - const auto spheremp1 = subview_ie(ie, spheremp); - const auto dp3d_c1 = subview_ie(ie, dp3d_c); - const auto q_c1 = subview_ie(ie, q_c); -#ifndef COMPOSE_PORT - for (Int q = 0; q < qsize; ++q) - for (Int spli = 0; spli < nsuplev; ++spli) { -#endif - const Int k0 = nsublev*spli; - for (Int sbli = 0; sbli < nsublev; ++sbli) { - const Int k = k0 + sbli; - if (k >= nlev) break; - Real qlo[np2], qhi[np2], wa[np2], y[np2], x[np2], Qm = 0; - for (Int g = 0; g < np2; ++g) { - const auto del = 0.01*(qhi[g] - qlo[g]); - qlo[g] = idx_qext(q_min,ie,q,g,k) - del; - qhi[g] = idx_qext(q_max,ie,q,g,k) + del; - } - for (Int g = 0; g < np2; ++g) { - const Real rhomij = dp3d_c1(np1,g,k) * spheremp1(g); - wa[g] = rhomij; - y[g] = q_c1(q,g,k); - x[g] = y[g]; - Qm += rhomij*y[g]; - } - cedr::local::caas(np2, wa, Qm, qlo, qhi, y, x, false); - for (Int g = 0; g < np2; ++g) - q_c1(q,g,k) = x[g]; - } -#ifdef COMPOSE_PORT - }; - ko::fence(); - ko::parallel_for(ko::RangePolicy(0, (nete - nets + 1)*nsuplev*qsize), f); -#else - }} -#endif -} - template ko::EnableIfNotOnGpu warn_on_Qm_prev_negative ( Real Qm_prev, Int rank, Int ie, const Ie2gci& ie2gci, Int np2, Int spli, @@ -148,9 +78,6 @@ void run_global (CDR& cdr, CDRT* cedr_cdr_p, const Int nsublev = cdr.nsublev; const Int nsuplev = cdr.nsuplev; - const Int n_in_elem = Alg::is_point(cdr.alg) ? np2 : 1; - const Int g_outer_lim = n_in_elem; - const Int g_inner_lim = Alg::is_point(cdr.alg) ? 1 : np2; const auto rank = cdr.p->rank(); const auto cdr_over_super_levels = cdr.cdr_over_super_levels; const auto caas_in_suplev = cdr.caas_in_suplev; @@ -189,61 +116,58 @@ void run_global (CDR& cdr, CDRT* cedr_cdr_p, const Int k0 = nsublev*spli; const Int ti = cdr_over_super_levels ? q : spli*qsize + q; const bool nonneg = nonnegs[q]; - for (Int g_out = 0; g_out < g_outer_lim; ++g_out) { - Real Qm = 0, Qm_min = 0, Qm_max = 0, Qm_prev = 0, rhom = 0, volume = 0; - Int ie_idx; - if (caas_in_suplev) + Real Qm = 0, Qm_min = 0, Qm_max = 0, Qm_prev = 0, rhom = 0, volume = 0; + Int ie_idx; + if (caas_in_suplev) + ie_idx = (cdr_over_super_levels ? + nsuplev*ie + spli : + ie); + for (Int sbli = 0; sbli < nsublev; ++sbli) { + const auto k = k0 + sbli; + if ( ! caas_in_suplev) ie_idx = (cdr_over_super_levels ? - nsuplev*(n_in_elem*ie + g_out) + spli : - n_in_elem*ie + g_out); - for (Int sbli = 0; sbli < nsublev; ++sbli) { - const auto k = k0 + sbli; - if ( ! caas_in_suplev) - ie_idx = (cdr_over_super_levels ? - nlevwrem*(n_in_elem*ie + g_out) + k : - nsublev*(n_in_elem*ie + g_out) + sbli); - const auto lci = ie2lci[ie_idx]; - if ( ! caas_in_suplev) { - Qm = 0; Qm_min = 0; Qm_max = 0; Qm_prev = 0; - rhom = 0; - volume = 0; - } - if (k < nlev) { - for (Int g_in = 0; g_in < g_inner_lim; ++g_in) { - const Int g = g_out + g_in; - const auto smp = spheremp1(g); - volume += smp; - const Real rhomij = dp3d_c1(np1,g,k) * smp; - rhom += rhomij; - Qm += q_c1(q,g,k) * rhomij; - auto& q_min_val = idx_qext(q_min,ie,q,g,k); - if ( ! cedr::impl::OnGpu::value && nonneg) - q_min_val = ko::max(q_min_val, 0); - Qm_min += q_min_val * rhomij; - Qm_max += idx_qext(q_max,ie,q,g,k) * rhomij; - Qm_prev += qdp_p1(n0_qdp,q,g,k) * smp; - } - } - const bool write = ! caas_in_suplev || sbli == nsublev-1; - if (write) { - // For now, handle just one rhom. For feasible global problems, it's - // used only as a weight vector in QLT, so it's fine. In fact, use - // just the cell geometry, rather than total density, since in QLT - // this field is used as a weight vector. - //todo Generalize to one rhom field per level. Until then, we're not - // getting QLT's safety benefit. - if (ti == 0) cedr_cdr.set_rhom(lci, 0, volume); - cedr_cdr.set_Qm(lci, ti, Qm, Qm_min, Qm_max, Qm_prev); - if (Qm_prev < -0.5) - warn_on_Qm_prev_negative(Qm_prev, rank, ie, ie2gci, np2, spli, k0, q, - ti, sbli, lci, k, n0_qdp, np1, qdp_p, dp3d_c); + nlevwrem*ie + k : + nsublev*ie + sbli); + const auto lci = ie2lci[ie_idx]; + if ( ! caas_in_suplev) { + Qm = 0; Qm_min = 0; Qm_max = 0; Qm_prev = 0; + rhom = 0; + volume = 0; + } + if (k < nlev) { + for (Int g = 0; g < np2; ++g) { + const auto smp = spheremp1(g); + volume += smp; + const Real rhomij = dp3d_c1(np1,g,k) * smp; + rhom += rhomij; + Qm += q_c1(q,g,k) * rhomij; + auto& q_min_val = idx_qext(q_min,ie,q,g,k); + if ( ! cedr::impl::OnGpu::value && nonneg) + q_min_val = ko::max(q_min_val, 0); + Qm_min += q_min_val * rhomij; + Qm_max += idx_qext(q_max,ie,q,g,k) * rhomij; + Qm_prev += qdp_p1(n0_qdp,q,g,k) * smp; } } + const bool write = ! caas_in_suplev || sbli == nsublev-1; + if (write) { + // For now, handle just one rhom. For feasible global problems, + // it's used only as a weight vector in QLT, so it's fine. In fact, + // use just the cell geometry, rather than total density, since in QLT + // this field is used as a weight vector. + //todo Generalize to one rhom field per level. Until then, we're not + // getting QLT's safety benefit. + if (ti == 0) cedr_cdr.set_rhom(lci, 0, volume); + cedr_cdr.set_Qm(lci, ti, Qm, Qm_min, Qm_max, Qm_prev); + if (Qm_prev < -0.5) + warn_on_Qm_prev_negative(Qm_prev, rank, ie, ie2gci, np2, spli, k0, q, + ti, sbli, lci, k, n0_qdp, np1, qdp_p, dp3d_c); + } } #ifdef COMPOSE_PORT - }; - ko::fence(); - ko::parallel_for(ko::RangePolicy(0, (nete - nets + 1)*nsuplev*qsize), f); + }; + ko::fence(); + ko::parallel_for(ko::RangePolicy(0, (nete - nets + 1)*nsuplev*qsize), f); #else }} #endif @@ -252,9 +176,6 @@ void run_global (CDR& cdr, CDRT* cedr_cdr_p, template void run_global (CDR& cdr, const Data& d, Real* q_min_r, const Real* q_max_r, const Int nets, const Int nete) { - if (Alg::is_point(cdr.alg)) - run_relaxed_local<4, MT>(cdr, d, q_min_r, q_max_r, nets, nete); - ko::fence(); if (dynamic_cast::QLTT*>(cdr.cdr.get())) run_global<4, MT, typename CDR::QLTT>( cdr, dynamic_cast::QLTT*>(cdr.cdr.get()), diff --git a/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp b/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp index 3cd7e094dc3..393b3f943ec 100644 --- a/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp +++ b/components/homme/src/share/compose/compose_cedr_sl_run_local.cpp @@ -186,8 +186,6 @@ void run_local (CDR& cdr, CDRT* cedr_cdr_p, const Int nsuplev = cdr.nsuplev; const auto cdr_over_super_levels = cdr.cdr_over_super_levels; const auto caas_in_suplev = cdr.caas_in_suplev; - const auto is_point = Alg::is_point(cdr.alg); - const Int n_in_elem = is_point ? np2 : 1; const typename CDRT::DeviceOp #ifndef COMPOSE_PORT & @@ -213,21 +211,7 @@ void run_local (CDR& cdr, CDRT* cedr_cdr_p, #endif const Int k0 = nsublev*spli; const Int ti = cdr_over_super_levels ? q : spli*qsize + q; - if (is_point) { - for (Int g = 0; g < np2; ++g) - for (Int sbli = 0; sbli < nsublev; ++sbli) { - const Int k = k0 + sbli; - if (k >= nlev) break; - const auto ie_idx = (cdr_over_super_levels ? - nlevwrem*(n_in_elem*ie + g) + k : - nsublev*(n_in_elem*ie + g) + sbli); - const auto lci = ie2lci[ie_idx]; - const Real Qm = cedr_cdr.get_Qm(lci, ti); - const Real rhom = dp3d_c1(np1,g,k) * spheremp1(g); - q_c1(q,g,k) = Qm / rhom; - qdp_c1(n1_qdp,q,g,k) = q_c1(q,g,k) * dp3d_c1(np1,g,k); - } - } else if (caas_in_suplev) { + if (caas_in_suplev) { const auto ie_idx = (cdr_over_super_levels ? nsuplev*ie + spli : ie); From f7958a8a4b296f106b566e99e0c1a0b71196add6 Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Thu, 9 Jan 2025 14:27:15 -0600 Subject: [PATCH 501/529] Hommexx/SL: Break main impl file into three. --- ...ComposeTransportImplEnhancedTrajectory.cpp | 2153 +---------------- ...oseTransportImplEnhancedTrajectoryImpl.hpp | 996 ++++++++ ...seTransportImplEnhancedTrajectoryTests.cpp | 839 +++++++ .../homme/src/theta-l_kokkos/CMakeLists.txt | 1 + 4 files changed, 1837 insertions(+), 2152 deletions(-) create mode 100644 components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp create mode 100644 components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryTests.cpp diff --git a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp index a8b60805733..6d2050751b6 100644 --- a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp +++ b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp @@ -7,11 +7,7 @@ #include "Config.hpp" #ifdef HOMME_ENABLE_COMPOSE -#include "ComposeTransportImpl.hpp" - -#include "compose_hommexx.hpp" - -#include +#include "ComposeTransportImplEnhancedTrajectoryImpl.hpp" namespace Homme { @@ -45,1168 +41,6 @@ void ComposeTransportImpl::setup_enhanced_trajectory () { homme::compose::set_hvcoord(etai(0), etai(num_phys_lev), etam.data()); } -namespace { // anon - -using cti = ComposeTransportImpl; -using CTI = ComposeTransportImpl; -using CSelNlev = cti::CSNlev; -using CRelNlev = cti::CRNlev; -using CSelNlevp = cti::CSNlevp; -using CRelNlevp = cti::CRNlevp; -using CS2elNlev = cti::CS2Nlev; -using CR2elNlev = cti::CR2Nlev; -using SelNlev = cti::SNlev; -using RelNlev = cti::RNlev; -using SelNlevp = cti::SNlevp; -using RelNlevp = cti::RNlevp; -using S2elNlev = cti::S2Nlev; -using R2elNlev = cti::R2Nlev; -using S2elNlevp = cti::S2Nlevp; - -using RelV = ExecViewUnmanaged; -using CRelV = typename ViewConst::type; - -template using SelNV = ExecViewUnmanaged; -template using CSelNV = typename ViewConst>::type; - -template using RelNV = ExecViewUnmanaged; -template using CRelNV = typename ViewConst>::type; - -template using RNV = ExecViewUnmanaged; -template using CRNV = typename ViewConst>::type; -using RNlevp = RNV; -using CRNlevp = CRNV; - -using RnV = ExecViewUnmanaged; -using CRnV = ExecViewUnmanaged; -using SnV = ExecViewUnmanaged; -using CSnV = ExecViewUnmanaged; - -template using SNV = ExecViewUnmanaged; -template using CSNV = typename ViewConst>::type; - -using RelnV = ExecViewUnmanaged; -using CRelnV = ExecViewUnmanaged; -using SelnV = ExecViewUnmanaged; -using CSelnV = ExecViewUnmanaged; - -KOKKOS_INLINE_FUNCTION -static int calc_npack (const int nscal) { - return (nscal + cti::packn - 1) / VECTOR_SIZE; -} - -KOKKOS_INLINE_FUNCTION -static int calc_nscal (const int npack) { - return npack * VECTOR_SIZE; -} - -KOKKOS_INLINE_FUNCTION -RnV getcol (const RelnV& a, const int i, const int j) { - return Kokkos::subview(a,i,j,Kokkos::ALL); -} - -KOKKOS_INLINE_FUNCTION -CRnV getcolc (const CRelnV& a, const int i, const int j) { - return Kokkos::subview(a,i,j,Kokkos::ALL); -} - -KOKKOS_INLINE_FUNCTION -RelnV elp2r (const SelnV& p) { - return RelnV(cti::pack2real(p), NP, NP, calc_nscal(p.extent_int(2))); -} - -KOKKOS_INLINE_FUNCTION -CRelnV elp2r (const CSelnV& p) { - return CRelnV(cti::cpack2real(p), NP, NP, calc_nscal(p.extent_int(2))); -} - -KOKKOS_INLINE_FUNCTION -RelnV p2rel (Scalar* data, const int nlev) { - return RelnV(cti::pack2real(data), NP, NP, nlev); -} - -KOKKOS_INLINE_FUNCTION -void assert_eln (const CRelnV& a, const int nlev) { - assert(a.extent_int(0) >= NP); - assert(a.extent_int(1) >= NP); - assert(a.extent_int(2) >= nlev); -} - -KOKKOS_INLINE_FUNCTION -void assert_eln (const CSelnV& a, const int nlev) { - assert(a.extent_int(0) >= NP); - assert(a.extent_int(1) >= NP); - assert(calc_nscal(a.extent_int(2)) >= nlev); -} - -// For sorted ascending x[0:n] and x in [x[0], x[n-1]] with hint xi_idx, return -// i such that x[i] <= xi <= x[i+1]. -// This function is meant for the case that x_idx is very close to the -// support. If that isn't true, then this method is inefficient; binary search -// should be used instead. -template -KOKKOS_FUNCTION static -int find_support (const int n, const ConstRealArray& x, const int x_idx, - const Real xi) { - assert(xi >= x[0] and xi <= x[n-1]); - // Handle the most common case. - if (x_idx < n-1 and xi >= x[x_idx ] and xi <= x[x_idx+1]) return x_idx; - if (x_idx > 0 and xi >= x[x_idx-1] and xi <= x[x_idx ]) return x_idx-1; - // Move on to less common ones. - const int max_step = max(x_idx, n-1 - x_idx); - for (int step = 1; step <= max_step; ++step) { - if (x_idx < n-1-step and xi >= x[x_idx+step ] and xi <= x[x_idx+step+1]) - return x_idx+step; - if (x_idx > step and xi >= x[x_idx-step-1] and xi <= x[x_idx-step ]) - return x_idx-step-1; - } - assert(false); - return -1; -} - -// Linear interpolation core computation. -template -KOKKOS_FUNCTION Real -linterp (const int n, const XT& x, const YT& y, const int x_idx, const Real xi) { - const auto isup = find_support(n, x, x_idx, xi); - const Real a = (xi - x[isup])/(x[isup+1] - x[isup]); - return (1-a)*y[isup] + a*y[isup+1]; -} - -// Linear interpolation at the lowest level of team ||ism. -// Range provides this ||ism over index 0 <= k < ni. -// Interpolate y(x) to yi(xi). -// x_idx_offset is added to k in the call to find_support. -// Arrays should all have rank 1. -template -KOKKOS_FUNCTION void -linterp (const Range& range, - const int n , const XT& x , const YT& y, - const int ni, const XIT& xi, const YIT& yi, - const int x_idx_offset = 0, const char* const caller = nullptr) { -#ifndef NDEBUG - if (xi[0] < x[0] or xi[ni-1] > x[n-1]) { - if (caller) - printf("linterp: xi out of bounds: %s %1.15e %1.15e %1.15e %1.15e\n", - caller ? caller : "NONE", x[0], xi[0], xi[ni-1], x[n-1]); - assert(false); - } -#endif - assert(range.start == 0); - assert(range.end == ni); - const auto f = [&] (const int k) { - yi[k] = linterp(n, x, y, k + x_idx_offset, xi[k]); - }; - Kokkos::parallel_for(range, f); -} - -KOKKOS_FUNCTION void -eta_interp_eta (const KernelVariables& kv, const int nlev, - const CRnV& hy_etai, const CRelnV& x, const CRnV& y, - const RelnV& xwrk, const RnV& ywrk, - // Use xi(i_os:), yi(i,j,i_os:). - const int ni, const CRnV& xi, const RelnV& yi, const int i_os = 0) { - const auto& xbdy = xwrk; - const auto& ybdy = ywrk; - assert(hy_etai.extent_int(0) >= nlev+1); - assert_eln(x, nlev); - assert(y.extent_int(0) >= nlev); - assert_eln(xbdy, nlev+2); - assert(ybdy.extent_int(0) >= nlev+2); - assert(xi.extent_int(0) >= i_os + ni); - assert_eln(yi, i_os + ni); - const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); - const auto tvr_ni = Kokkos::ThreadVectorRange(kv.team, ni); - const auto tvr_nlevp2 = Kokkos::ThreadVectorRange(kv.team, nlev+2); - const auto f_y = [&] (const int k) { - ybdy(k) = (k == 0 ? hy_etai(0) : - k == nlev+1 ? hy_etai(nlev) : - /**/ y(k-1)); - }; - Kokkos::parallel_for(Kokkos::TeamVectorRange(kv.team, nlev+2), f_y); - kv.team_barrier(); - const auto f_x = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto g = [&] (const int k) { - xbdy(i,j,k) = (k == 0 ? hy_etai(0) : - k == nlev+1 ? hy_etai(nlev) : - /**/ x(i,j,k-1)); - }; - Kokkos::parallel_for(tvr_nlevp2, g); - }; - Kokkos::parallel_for(ttr, f_x); - kv.team_barrier(); - const auto f_linterp = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - linterp(tvr_ni, - nlev+2, getcolc(xbdy,i,j), ybdy, - ni, xi.data() + i_os, getcol(yi,i,j).data() + i_os, - 1, "eta_interp_eta"); - }; - Kokkos::parallel_for(ttr, f_linterp); -} - -KOKKOS_FUNCTION void -eta_interp_horiz (const KernelVariables& kv, const int nlev, - const CRnV& hy_etai, const CRnV& x, const CRelnV& y, - const RnV& xwrk, const RelnV& ywrk, - const CRelnV& xi, const RelnV& yi) { - const auto& xbdy = xwrk; - const auto& ybdy = ywrk; - assert(hy_etai.extent_int(0) >= nlev+1); - assert(x.extent_int(0) >= nlev); - assert_eln(y, nlev); - assert(xbdy.extent_int(0) >= nlev+2); - assert_eln(ybdy, nlev+2); - assert_eln(xi, nlev); - assert_eln(yi, nlev); - const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); - const auto tvr_nlev = Kokkos::ThreadVectorRange(kv.team, nlev); - const auto tvr_nlevp2 = Kokkos::ThreadVectorRange(kv.team, nlev+2); - const auto f_x = [&] (const int k) { - xbdy(k) = (k == 0 ? hy_etai(0) : - k == nlev+1 ? hy_etai(nlev) : - /**/ x(k-1)); - }; - Kokkos::parallel_for(Kokkos::TeamVectorRange(kv.team, nlev+2), f_x); - kv.team_barrier(); - const auto f_y = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto g = [&] (const int k) { - // Constant interp outside of the etam support. - ybdy(i,j,k) = (k == 0 ? y(i,j,0) : - k == nlev+1 ? y(i,j,nlev-1) : - /**/ y(i,j,k-1)); - }; - Kokkos::parallel_for(tvr_nlevp2, g); - }; - Kokkos::parallel_for(ttr, f_y); - kv.team_barrier(); - const auto f_linterp = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - linterp(tvr_nlev, - nlev+2, xbdy, getcolc(ybdy,i,j), - nlev, getcolc(xi,i,j), getcol(yi,i,j), - 1, "eta_interp_horiz"); - }; - Kokkos::parallel_for(ttr, f_linterp); -} - -/* Compute level pressure thickness given eta at interfaces using the following - approximation: - e = A(e) + B(e) - p(e) = A(e) p0 + B(e) ps - = e p0 + B(e) (ps - p0) - a= e p0 + I[Bi(eref)](e) (ps - p0). - Then dp = diff(p). -*/ -KOKKOS_FUNCTION void -eta_to_dp (const KernelVariables& kv, const int nlev, - const Real hy_ps0, const CRnV& hy_bi, const CRnV& hy_etai, - const CRelV& ps, const CRelnV& etai, const RelnV& wrk, - const RelnV& dp) { - const int nlevp = nlev + 1; - assert(hy_bi.extent_int(0) >= nlevp); - assert(hy_etai.extent_int(0) >= nlevp); - assert_eln(etai, nlevp); - assert_eln(wrk, nlevp); - assert_eln(dp, nlev); - const auto& bi = wrk; - const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); - const auto tvr_linterp = Kokkos::ThreadVectorRange(kv.team, nlevp); - const auto f_linterp = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - linterp(tvr_linterp, - nlevp, hy_etai, hy_bi, - nlevp, getcolc(etai,i,j), getcol(bi,i,j), - 0, "eta_to_dp"); - }; - Kokkos::parallel_for(ttr, f_linterp); - kv.team_barrier(); - const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlev); - const auto f = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto dps = ps(i,j) - hy_ps0; - const auto g = [&] (const int k) { - dp(i,j,k) = ((etai(i,j,k+1) - etai(i,j,k))*hy_ps0 + - (bi(i,j,k+1) - bi(i,j,k))*dps); - }; - Kokkos::parallel_for(tvr, g); - }; - Kokkos::parallel_for(ttr, f); -} - -/* Limit eta levels so their thicknesses, deta, are bounded below by 'low'. - - This method pulls mass only from intervals k that are larger than their - reference value (deta(k) > deta_ref(k)), and only down to their reference - value. This concentrates changes to intervals that, by having a lot more mass - than usual, drive other levels negative, leaving all the other intervals - unchanged. - - This selective use of mass provides enough to fulfill the needed mass. - Inputs: - m (deta): input mass - r (deta_ref): level mass reference. - Preconditions: - (1) 0 <= low <= min r(i) - (2) 1 = sum r(i) = sum(m(i)). - Rewrite (2) as - 1 = sum_{m(i) >= r(i)} m(i) + sum_{m(i) < r(i)} m(i) - and, thus, - 0 = sum_{m(i) >= r(i)} (m(i) - r(i)) + sum_{m(i) < r(i)} (m(i) - r(i)). - Then - sum_{m(i) >= r(i)} (m(i) - r(i)) (available mass to redistribute) - = -sum_{m(i) < r(i)} (m(i) - r(i)) - >= -sum_{m(i) < lo } (m(i) - r(i)) - >= -sum_{m(i) < lo } (m(i) - lo ) (mass to fill in). - Thus, if the preconditions hold, then there's enough mass to redistribute. - */ -template -KOKKOS_FUNCTION void -deta_caas (const KernelVariables& kv, const Range& tvr_nlevp, - const CRnV& deta_ref, const Real low, const RnV& w, - const RnV& deta) { - const auto g1 = [&] (const int k, Kokkos::Real2& sums) { - Real wk; - if (deta(k) < low) { - sums.v[0] += deta(k) - low; - deta(k) = low; - wk = 0; - } else { - wk = (deta(k) > deta_ref(k) ? - deta(k) - deta_ref(k) : - 0); - } - sums.v[1] += wk; - w(k) = wk; - }; - Kokkos::Real2 sums; - Dispatch<>::parallel_reduce(kv.team, tvr_nlevp, g1, sums); - const Real wneeded = sums.v[0]; - if (wneeded == 0) return; - // Remove what is needed from the donors. - const Real wavail = sums.v[1]; - const auto g2 = [&] (const int k) { - deta(k) += wneeded*(w(k)/wavail); - }; - Kokkos::parallel_for(tvr_nlevp, g2); -} - -KOKKOS_FUNCTION void -deta_caas (const KernelVariables& kv, const int nlevp, const CRnV& deta_ref, - const Real low, const RelnV& wrk, const RelnV& deta) { - assert(deta_ref.extent_int(0) >= nlevp); - assert_eln(wrk, nlevp); - assert_eln(deta, nlevp); - const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); - const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlevp); - const auto f = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - deta_caas(kv, tvr, deta_ref, low, getcol(wrk,i,j), getcol(deta,i,j)); - }; - Kokkos::parallel_for(ttr, f); -} - -// Wrapper to deta_caas. On input and output, eta contains the midpoint eta -// values. On output, deta_caas has been applied, if necessary, to -// diff(eta(i,j,:)). -KOKKOS_FUNCTION void -limit_etam (const KernelVariables& kv, const int nlev, const CRnV& hy_etai, - const CRnV& deta_ref, const Real deta_tol, const RelnV& wrk1, - const RelnV& wrk2, const RelnV& eta) { - assert(hy_etai.extent_int(0) >= nlev+1); - assert(deta_ref.extent_int(0) >= nlev+1); - const auto deta = wrk2; - assert_eln(wrk1, nlev+1); - assert_eln(deta, nlev+1); - assert_eln(eta , nlev ); - const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); - const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlev+1); - // eta -> deta; limit deta if needed. - const auto f1 = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto etaij = getcolc( eta,i,j); - const auto detaij = getcol(deta,i,j); - const auto g1 = [&] (const int k, int& nbad) { - const auto d = (k == 0 ? etaij(0) - hy_etai(0) : - k == nlev ? hy_etai(nlev) - etaij(nlev-1) : - /**/ etaij(k) - etaij(k-1)); - const bool ok = d >= deta_tol; - if (not ok) ++nbad; - detaij(k) = d; - }; - int nbad = 0; - Dispatch<>::parallel_reduce(kv.team, tvr, g1, nbad); - if (nbad == 0) { - // Signal this column is fine. - Kokkos::single(Kokkos::PerThread(kv.team), [&] () { detaij(0) = -1; }); - return; - }; - deta_caas(kv, tvr, deta_ref, deta_tol, getcol(wrk1,i,j), detaij); - }; - Kokkos::parallel_for(ttr, f1); - kv.team_barrier(); - // deta -> eta; ignore columns where limiting wasn't needed. - const auto f2 = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto etaij = getcol( eta,i,j); - const auto detaij = getcol(deta,i,j); - if (detaij(0) == -1) return; - const auto g = [&] (const int k, Real& accum, const bool final) { - assert(k != 0 or accum == 0); - const Real d = k == 0 ? hy_etai(0) + detaij(0) : detaij(k); - accum += d; - if (final) etaij(k) = accum; - }; - Dispatch<>::parallel_scan(kv.team, nlev, g); - }; - Kokkos::parallel_for(ttr, f2); -} - -KOKKOS_FUNCTION void calc_ps ( - const KernelVariables& kv, const int nlev, - const Real& ps0, const Real& hyai0, - const CSelnV& dp, - const ExecViewUnmanaged& ps) -{ - assert_eln(dp, nlev); - const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); - const auto tvr_snlev = Kokkos::ThreadVectorRange(kv.team, nlev); - const CRelnV dps = elp2r(dp); - const auto f1 = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto g = [&] (int k, Real& sum) { sum += dps(i,j,k); }; - Real sum; - Dispatch<>::parallel_reduce(kv.team, tvr_snlev, g, sum); - Kokkos::single(Kokkos::PerThread(kv.team), - [&] { ps(i,j) = hyai0*ps0 + sum; }); - }; - Kokkos::parallel_for(ttr, f1); -} - -KOKKOS_FUNCTION void calc_ps ( - const KernelVariables& kv, const int nlev, - const Real& ps0, const Real& hyai0, - const Real alpha[2], const CSelnV& dp1, const CSelnV& dp2, - const ExecViewUnmanaged& ps) -{ - assert_eln(dp1, nlev); - assert_eln(dp2, nlev); - const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); - const auto tvr_snlev = Kokkos::ThreadVectorRange(kv.team, nlev); - const CRelnV dps[] = {elp2r(dp1), elp2r(dp2)}; - const auto f1 = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - for (int t = 0; t < 2; ++t) { - const auto& dp = dps[t]; - const auto g = [&] (int k, Real& sum) { sum += dp(i,j,k); }; - Real sum; - Dispatch<>::parallel_reduce(kv.team, tvr_snlev, g, sum); - Kokkos::single(Kokkos::PerThread(kv.team), [&] { ps(t,i,j) = sum; }); - } - }; - Kokkos::parallel_for(ttr, f1); - kv.team_barrier(); - const auto f2 = [&] (const int idx) { - const int i = idx / NP, j = idx % NP; - const auto g = [&] () { - Real vals[2]; - for (int t = 0; t < 2; ++t) - vals[t] = (hyai0*ps0 + - (1 - alpha[t])*ps(0,i,j) + - /**/ alpha[t] *ps(1,i,j)); - for (int t = 0; t < 2; ++t) - ps(t,i,j) = vals[t]; - }; - Kokkos::single(Kokkos::PerThread(kv.team), g); - }; - Kokkos::parallel_for(ttr, f2); -} - -// Transform eta_dot_dpdn at interfaces to eta_dot at midpoints using the -// formula -// eta_dot = eta_dot_dpdn/(A_eta p0 + B_eta ps). -// a= eta_dot_dpdn diff(eta)/(diff(A) p0 + diff(B) ps). -KOKKOS_FUNCTION void calc_etadotmid_from_etadotdpdnint ( - const KernelVariables& kv, const int nlev, - const Real& ps0, const CSnV& hydai, const CSnV& hydbi, - const CSnV& hydetai, const CRelV& ps, const SelnV& wrk, - // in: eta_dot_dpdn at interfaces - // out: eta_dot at midpoints, final slot unused - const SelnV& ed) -{ - assert(calc_nscal(hydai.extent_int(0)) >= nlev); - assert(calc_nscal(hydbi.extent_int(0)) >= nlev); - assert(calc_nscal(hydetai.extent_int(0)) >= nlev); - assert_eln(wrk, nlev+1); - assert_eln(ed, nlev+1); - const auto& edd_mid = wrk; - { - const CRelnV edd(elp2r(ed)); - const RelnV tmp(elp2r(wrk)); - const auto f = [&] (const int i, const int j, const int k) { - tmp(i,j,k) = (edd(i,j,k) + edd(i,j,k+1))/2; - }; - cti::loop_ijk(nlev, kv, f); - } - kv.team_barrier(); - { - const auto f = [&] (const int i, const int j, const int kp) { - ed(i,j,kp) = (edd_mid(i,j,kp) - * hydetai(kp) - / (hydai(kp)*ps0 + hydbi(kp)*ps(i,j))); - }; - cti::loop_ijk(calc_npack(nlev), kv, f); - } -} - -KOKKOS_FUNCTION void calc_eta_dot_ref_mid ( - const KernelVariables& kv, const SphereOperators& sphere_ops, - const Real& ps0, const Real& hyai0, const CSNV& hybi, - const CSNV& hydai, const CSNV& hydbi, // delta ai, bi - const CSNV& hydetai, // delta etai - const Real alpha[2], - const CS2elNlev& v1, const CSelNlev& dp1, const CS2elNlev& v2, const CSelNlev& dp2, - const SelNlevp& wrk1, const SelNlevp& wrk2, const S2elNlevp& vwrk1, - // Holds interface levels as intermediate data but is midpoint data on output, - // with final slot unused. - const SelNlevp eta_dot[2]) -{ - using Kokkos::ALL; - const int nlev = NUM_PHYSICAL_LEV; - const SelNlev divdp(wrk1.data()); - const S2elNlev vdp(vwrk1.data()); - const ExecViewUnmanaged ps(cti::pack2real(wrk2)); - // Calc surface pressure for use at the end. - calc_ps(kv, nlev, - ps0, hyai0, - alpha, dp1, dp2, - ps); - kv.team_barrier(); - for (int t = 0; t < 2; ++t) { - // Compute divdp. - const auto f = [&] (const int i, const int j, const int kp) { - for (int d = 0; d < 2; ++d) - vdp(d,i,j,kp) = ((1 - alpha[t])*v1(d,i,j,kp)*dp1(i,j,kp) + - /**/ alpha[t] *v2(d,i,j,kp)*dp2(i,j,kp)); - }; - cti::loop_ijk(kv, f); - kv.team_barrier(); - sphere_ops.divergence_sphere(kv, vdp, divdp); - kv.team_barrier(); - // Compute eta_dot_dpdn at interface nodes. - const auto& edd = eta_dot[t]; - const RelNlevp edds(cti::pack2real(edd)); - const RelNlev divdps(cti::pack2real(wrk1)); - cti::calc_eta_dot_dpdn(kv, - hybi, - divdps, edd, - edds); - kv.team_barrier(); - calc_etadotmid_from_etadotdpdnint(kv, nlev, - ps0, hydai, hydbi, hydetai, - Kokkos::subview(ps,t,ALL,ALL), - wrk1, - edd); - // No team_barrier: wrk1 is protected in second iteration. - } -} - -KOKKOS_FUNCTION void calc_vel_horiz_formula_node_ref_mid ( - const KernelVariables& kv, const SphereOperators& sphere_ops, - const CSNV& hyetam, const ExecViewUnmanaged& vec_sph2cart, - // Velocities are at midpoints. Final eta_dot entry is ignored. - const Real dtsub, const CS2elNlev vsph[2], const CSelNlevp eta_dot[2], - const SelNlevp& wrk1, const S2elNlevp& vwrk1, const S2elNlevp& vwrk2, - const ExecViewUnmanaged& vnode) -{ - using Kokkos::ALL; - const S2elNlev vfsph(vwrk1.data()), vw2(vwrk2.data()); - const SelNlev w1(wrk1.data()); - const R2elNlev vfsphs(cti::pack2real(vfsph)); - const auto& vsph1 = vsph[0]; - const auto& vsph2 = vsph[1]; - { // Horizontal terms. - cti::ugradv_sphere(sphere_ops, kv, vec_sph2cart, vsph2, vsph1, w1, vw2, vfsph); - for (int d = 0; d < 2; ++d) { - const auto f = [&] (const int i, const int j, const int k) { - vfsph(d,i,j,k) = vsph1(d,i,j,k) + vsph2(d,i,j,k) - dtsub*vfsph(d,i,j,k); - }; - cti::loop_ijk(kv, f); - } - } - kv.team_barrier(); - { // Vertical terms. - const CRNV etams(cti::cpack2real(hyetam)); - const CR2elNlev vsph1s(cti::cpack2real(vsph1)); - const CRelNlevp eds(cti::cpack2real(eta_dot[1])); - for (int d = 0; d < 2; ++d) { - const auto f = [&] (const int i, const int j, const int k) { - Real deriv; - if (k == 0 or k+1 == NUM_PHYSICAL_LEV) { - const int k1 = k == 0 ? 0 : NUM_PHYSICAL_LEV-2; - const int k2 = k == 0 ? 1 : NUM_PHYSICAL_LEV-1; - deriv = ((vsph1s(d,i,j,k2) - vsph1s(d,i,j,k1)) / - (etams(k2) - etams(k1))); - } else { - deriv = cti::approx_derivative( - etams(k-1), etams(k), etams(k+1), - vsph1s(d,i,j,k-1), vsph1s(d,i,j,k), vsph1s(d,i,j,k+1)); - } - vfsphs(d,i,j,k) = (vfsphs(d,i,j,k) - dtsub*eds(i,j,k)*deriv)/2; - }; - cti::loop_ijk(kv, f); - } - } - { // Transform to Cartesian. - for (int d = 0; d < 3; ++d) { - const auto f = [&] (const int i, const int j, const int k) { - vnode(k,i,j,d) = (vec_sph2cart(0,d,i,j)*vfsphs(0,i,j,k) + - vec_sph2cart(1,d,i,j)*vfsphs(1,i,j,k)); - }; - cti::loop_ijk(kv, f); - } - } -} - -KOKKOS_FUNCTION void calc_eta_dot_formula_node_ref_mid ( - const KernelVariables& kv, const SphereOperators& sphere_ops, - const CRNV& hyetai, const CSNV& hyetam, - // Velocities are at midpoints. Final eta_dot entry is ignored. - const Real dtsub, const CS2elNlev vsph[2], const CSelNlevp eta_dot[2], - const SelNlevp& wrk1, const S2elNlevp& vwrk1, - const ExecViewUnmanaged& vnode) -{ - const SelNlev ed1_vderiv(wrk1.data()); - { - const CRNV etams(cti::cpack2real(hyetam)); - const CRelNlevp ed1s(cti::cpack2real(eta_dot[0])); - const RelNlev ed1_vderiv_s(cti::pack2real(ed1_vderiv)); - const auto f = [&] (const int i, const int j, const int k) { - Real deriv; - if (k == 0 or k+1 == NUM_PHYSICAL_LEV) { - deriv = cti::approx_derivative( - k == 0 ? hyetai(0) : etams(k-1), - etams(k), - k+1 == NUM_PHYSICAL_LEV ? hyetai(NUM_PHYSICAL_LEV) : etams(k+1), - k == 0 ? 0 : ed1s(i,j,k-1), - ed1s(i,j,k), - k+1 == NUM_PHYSICAL_LEV ? 0 : ed1s(i,j,k+1)); - } else { - deriv = cti::approx_derivative( - etams(k-1), etams(k), etams(k+1), - ed1s(i,j,k-1), ed1s(i,j,k), ed1s(i,j,k+1)); - } - ed1_vderiv_s(i,j,k) = deriv; - }; - cti::loop_ijk(kv, f); - } - kv.team_barrier(); - const S2elNlev ed1_hderiv(vwrk1.data()); - sphere_ops.gradient_sphere(kv, eta_dot[0], ed1_hderiv, NUM_LEV); - { - const auto& vsph2 = vsph[1]; - const auto& ed1 = eta_dot[0]; - const auto& ed2 = eta_dot[1]; - const auto f = [&] (const int i, const int j, const int k) { - const auto v = (ed1(i,j,k) + ed2(i,j,k) - - dtsub*( vsph2(0,i,j,k)*ed1_hderiv(0,i,j,k) - + vsph2(1,i,j,k)*ed1_hderiv(1,i,j,k) - + ed2( i,j,k)*ed1_vderiv( i,j,k)))/2; - for (int s = 0; s < VECTOR_SIZE; ++s) - vnode(VECTOR_SIZE*k+s, i,j,3) = v[s]; - }; - cti::loop_ijk(kv, f); - } -} - -// Set dep_points_all to level-midpoint arrival points. -void init_dep_points (const CTI& c, const cti::DeparturePoints& dep_pts) { - const auto independent_time_steps = c.m_data.independent_time_steps; - const auto& sphere_cart = c.m_geometry.m_sphere_cart; - const CRNV hyetam(cti::cpack2real(c.m_hvcoord.etam)); - assert(not independent_time_steps or dep_pts.extent_int(4) == 4); - const auto f = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - for (int d = 0; d < 3; ++d) - dep_pts(ie,lev,i,j,d) = sphere_cart(ie,i,j,d); - if (independent_time_steps) - dep_pts(ie,lev,i,j,3) = hyetam(lev); - }; - c.launch_ie_physlev_ij(f); -} - -void update_dep_points ( - const CTI& c, const Real dtsub, const cti::DeparturePoints& vdep, - const cti::DeparturePoints& dep_pts) -{ - const auto independent_time_steps = c.m_data.independent_time_steps; - const auto is_sphere = c.m_data.geometry_type == 0; - const auto scale_factor = c.m_geometry.m_scale_factor; - const auto f = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - // Update horizontal position. - Real p[3]; - for (int d = 0; d < 3; ++d) - p[d] = dep_pts(ie,lev,i,j,d) - dtsub*vdep(ie,lev,i,j,d)/scale_factor; - if (is_sphere) { - const auto norm = std::sqrt(square(p[0]) + square(p[1]) + square(p[2])); - for (int d = 0; d < 3; ++d) - p[d] /= norm; - } - for (int d = 0; d < 3; ++d) - dep_pts(ie,lev,i,j,d) = p[d]; - if (independent_time_steps) { - // Update vertical position. - dep_pts(ie,lev,i,j,3) -= dtsub*vdep(ie,lev,i,j,3); - } - }; - c.launch_ie_physlev_ij(f); -} - -/* Evaluate a formula to provide an estimate of nodal velocities that are use to - create a 2nd-order update to the trajectory. The fundamental formula for the - update in position p from arrival point p1 to departure point p0 is - p0 = p1 - dt/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). - Here we compute the velocity estimate at the nodes: - 1/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). -*/ -void calc_nodal_velocities ( - const CTI& c, const Real dtsub, const Real halpha[2], - const cti::CVSlot& v1, const cti::CDpSlot& dp1, const int idx1, - const cti::CVSlot& v2, const cti::CDpSlot& dp2, const int idx2, - const cti::DeparturePoints& vnode) -{ - using Kokkos::ALL; - const auto& d = c.m_data; - const auto& h = c.m_hvcoord; - const auto& sphere_ops = c.m_sphere_ops; - const auto& vec_sph2cart = c.m_geometry.m_vec_sph2cart; - const bool independent_time_steps = d.independent_time_steps; - const auto ps0 = h.ps0; - const auto hyai0 = h.hybrid_ai0; - const auto& hybi = h.hybrid_bi_packed; - const auto& hydai = h.hybrid_ai_delta; - const auto& hydbi = h.hybrid_bi_delta; - const auto& hyetam = h.etam; - const auto& hyetai = h.etai; - const auto& hydetai = d.hydetai; - const auto& buf1a = d.buf1o[0]; const auto& buf1b = d.buf1o[1]; - const auto& buf1c = d.buf1o[2]; const auto& buf1d = d.buf1o[3]; - const auto& buf2a = d.buf2 [0]; const auto& buf2b = d.buf2 [1]; - const auto& buf2c = d.buf2 [2]; const auto& buf2d = d.buf2 [3]; - const auto alpha0 = halpha[0], alpha1 = halpha[1]; - const auto f = KOKKOS_LAMBDA (const cti::MT& team) { - KernelVariables kv(team); - const int ie = kv.ie; - const auto wrk1 = Homme::subview(buf1a, kv.team_idx); - const auto wrk2 = Homme::subview(buf1b, kv.team_idx); - const auto vwrk1 = Homme::subview(buf2a, kv.team_idx); - const auto vwrk2 = Homme::subview(buf2b, kv.team_idx); - const auto v1_ie = Homme::subview(v1, ie, idx1); - const auto v2_ie = Homme::subview(v2, ie, idx2); - const Real alpha[] = {alpha0, alpha1}; - CSelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), - Homme::subview(buf1d, kv.team_idx)}; - { - SelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), - Homme::subview(buf1d, kv.team_idx)}; - if (independent_time_steps) { - const auto dp1_ie = Homme::subview(dp1, ie, idx1); - const auto dp2_ie = Homme::subview(dp2, ie, idx2); - calc_eta_dot_ref_mid(kv, sphere_ops, - ps0, hyai0, hybi, hydai, hydbi, hydetai, - alpha, v1_ie, dp1_ie, v2_ie, dp2_ie, - wrk1, wrk2, vwrk1, - eta_dot); - } else { - for (int t = 0; t < 2; ++t) { - const auto& ed = eta_dot[t]; - const auto f = [&] (const int i, const int j, const int k) { - ed(i,j,k) = 0; - }; - cti::loop_ijk(kv, f); - } - } - } - // Collect the horizontal nodal velocities. v1,2 are on Eulerian levels. v1 - // is from time t1 < t2. - auto* vm1 = Homme::subview(buf2c, kv.team_idx).data(); - auto* vm2 = Homme::subview(buf2d, kv.team_idx).data(); - CS2elNlev vsph[] = {CS2elNlev(vm1), CS2elNlev(vm2)}; - { - S2elNlev vsph[] = {S2elNlev(vm1), S2elNlev(vm2)}; - for (int t = 0; t < 2; ++t) { - const auto& v = vsph[t]; - for (int d = 0; d < 2; ++d) { - const auto f = [&] (const int i, const int j, const int k) { - v(d,i,j,k) = ((1 - alpha[t])*v1_ie(d,i,j,k) + - /**/ alpha[t] *v2_ie(d,i,j,k)); - }; - cti::loop_ijk(kv, f); - } - } - } - kv.team_barrier(); - // Given the vertical and horizontal nodal velocities at time endpoints, - // evaluate the velocity estimate formula, providing the final horizontal - // and vertical velocity estimates at midpoint nodes. - const auto vnode_ie = Kokkos::subview(vnode, ie, ALL,ALL,ALL,ALL); - const auto vec_sph2cart_ie = Homme::subview(vec_sph2cart, ie); - calc_vel_horiz_formula_node_ref_mid(kv, sphere_ops, - hyetam, vec_sph2cart_ie, - dtsub, vsph, eta_dot, - wrk1, vwrk1, vwrk2, - vnode_ie); - if (independent_time_steps) { - kv.team_barrier(); - calc_eta_dot_formula_node_ref_mid(kv, sphere_ops, - hyetai, hyetam, - dtsub, vsph, eta_dot, - wrk1, vwrk1, - vnode_ie); - } - }; - Kokkos::parallel_for(c.m_tp_ne, f); -} - -// Determine the departure points corresponding to the vertically Lagragnian -// grid's arrival midpoints, where the floating levels are those that evolve -// over the course of the full tracer time step. Also compute divdp, which holds -// the floating levels' dp values for later use in vertical remap. -void interp_departure_points_to_floating_level_midpoints (const CTI& c, const int np1) { - using Kokkos::ALL; - const int nlev = NUM_PHYSICAL_LEV, nlevp = nlev+1; - const auto is_sphere = c.m_data.geometry_type == 0; - const auto& d = c.m_data; - const auto& h = c.m_hvcoord; - const auto ps0 = h.ps0; - const auto hyai0 = h.hybrid_ai0; - const auto& hybi = h.hybrid_bi; - const auto& hyetai = h.etai; - const CRNV hyetam(cti::cpack2real(h.etam)); - const auto& detam_ref = d.hydetam_ref; - const auto deta_tol = d.deta_tol; - const auto& dep_pts = d.dep_pts; - const auto& dp3d = c.m_state.m_dp3d; - const auto& buf1a = d.buf1e[0]; const auto& buf1b = d.buf1e[1]; - const auto& buf1c = d.buf1e[2]; const auto& buf1d = d.buf1e[3]; - const auto& buf2a = d.buf2[0]; - const auto f = KOKKOS_LAMBDA (const cti::MT& team) { - KernelVariables kv(team); - const int ie = kv.ie; - const auto wrk1 = Homme::subview(buf1a, kv.team_idx); - const auto wrk2 = Homme::subview(buf1b, kv.team_idx); - const auto wrk3 = Homme::subview(buf1c, kv.team_idx); - const auto wrk4 = Homme::subview(buf1d, kv.team_idx); - const auto vwrk = Homme::subview(buf2a, kv.team_idx); - // Reconstruct Lagrangian levels at t1 on arrival column: - // eta_arr_int = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_int) - const auto etam = p2rel(wrk3.data(), nlev); - const auto f = [&] (const int i, const int j, const int k) { - etam(i,j,k) = dep_pts(ie,k,i,j,3); - }; - cti::loop_ijk(kv, f); - kv.team_barrier(); - limit_etam(kv, nlev, - hyetai, detam_ref, deta_tol, - p2rel(wrk1.data(), nlevp), p2rel(wrk2.data(), nlevp), - etam); - kv.team_barrier(); - { - // Compute eta_arr_int. - const auto etai_arr = p2rel(wrk4.data(), nlevp); - eta_interp_eta(kv, nlev, - hyetai, - etam, hyetam, - p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), - nlevp-2, hyetai, etai_arr, 1); - const auto f = [&] (const int i, const int j) { - etai_arr(i,j,0) = hyetai(0); - etai_arr(i,j,nlev) = hyetai(nlev); - }; - c.loop_ij(kv, f); - // Compute divdp. - const ExecViewUnmanaged ps(cti::pack2real(vwrk)); - calc_ps(kv, nlev, - ps0, hyai0, - Homme::subview(dp3d, ie, np1), - ps); - kv.team_barrier(); - eta_to_dp(kv, nlev, - ps0, hybi, hyetai, - ps, etai_arr, - p2rel(wrk2.data(), nlev+1), - RelnV(cti::pack2real(Homme::subview(c.m_derived.m_divdp, ie)), - NP, NP, NUM_LEV*VECTOR_SIZE)); - kv.team_barrier(); - } - // Compute Lagrangian level midpoints at t1 on arrival column: - // eta_arr_mid = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_mid) - const auto etam_arr = p2rel(wrk4.data(), nlev); - eta_interp_eta(kv, nlev, - hyetai, - etam, hyetam, - p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), - nlev, hyetam, etam_arr); - kv.team_barrier(); - // Compute departure horizontal points corresponding to arrival - // Lagrangian level midpoints: - // p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid) - { - const RelnV dpts_in(cti::pack2real(vwrk), NP, NP, nlev); - const RelnV dpts_out(dpts_in.data() + NP*NP*nlev, NP, NP, nlev); - for (int d = 0; d < 3; ++d) { - const auto f = [&] (const int i, const int j, const int k) { - dpts_in(i,j,k) = dep_pts(ie,k,i,j,d); - }; - c.loop_ijk(kv, f); - kv.team_barrier(); - eta_interp_horiz(kv, nlev, - hyetai, - hyetam, dpts_in, - RnV(cti::pack2real(wrk2), nlev+2), p2rel(wrk1.data(), nlev+2), - etam_arr, dpts_out); - kv.team_barrier(); - const auto g = [&] (const int i, const int j, const int k) { - dep_pts(ie,k,i,j,d) = dpts_out(i,j,k); - }; - c.loop_ijk(kv, g); - kv.team_barrier(); - } - if (is_sphere) { - // Normalize. - const auto h = [&] (const int i, const int j, const int k) { - Real norm = 0; - for (int d = 0; d < 3; ++d) norm += square(dep_pts(ie,k,i,j,d)); - norm = std::sqrt(norm); - for (int d = 0; d < 3; ++d) dep_pts(ie,k,i,j,d) /= norm; - }; - c.loop_ijk(kv, h); - } - } - }; - Kokkos::parallel_for(c.m_tp_ne, f); -} - -void dss_vnode (const CTI& c, const cti::DeparturePoints& vnode) { - const int ndim = c.m_data.independent_time_steps ? 4 : 3; - const auto& spheremp = c.m_geometry.m_spheremp; - const auto& rspheremp = c.m_geometry.m_rspheremp; - const auto& vp = c.m_tracers.qtens_biharmonic; - const ExecViewUnmanaged - v(cti::pack2real(vp), vp.extent_int(0), vp.extent_int(1)); - const auto f = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - for (int d = 0; d < ndim; ++d) - v(ie,d,i,j,lev) = vnode(ie,lev,i,j,d)*spheremp(ie,i,j)*rspheremp(ie,i,j); - }; - c.launch_ie_physlev_ij(f); - Kokkos::fence(); - const auto be = c.m_v_dss_be[c.m_data.independent_time_steps ? 1 : 0]; - be->exchange(); - Kokkos::fence(); - const auto g = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - for (int d = 0; d < ndim; ++d) - vnode(ie,lev,i,j,d) = v(ie,d,i,j,lev); - }; - c.launch_ie_physlev_ij(g); -} - -} // namespace anon - -// When nvelocity > 2, we need to do bookkeeping to (1) accumulate intermediate -// velocity data and (2) use these data. This struct does this bookkeeping. At -// init time, it builds small integer and real arrays with indices and -// weights. During time stepping, it provides these data to the -// velocity-accumulation function and the trajectory method. -// -// Parameter short names: -// dtf = dt_tracer_factor -// drf = dt_remap_factor -// nsub = semi_lagrange_trajectory_nsubstep -// nvel = semi_lagrange_trajectory_nvelocity -struct CTI::VelocityRecord { - VelocityRecord () {} - VelocityRecord (const int dtf, const int drf, const int nsub, const int nvel) - { init(dtf, drf, nsub, nvel); } - - void init(const int dtf, const int drf, const int nsub, const int nvel); - - int dtf () const { return _dtf; } - int drf () const { return _drf; } - int nsub () const { return _nsub; } - int nvel () const { return _nvel; } - - // Times to which velocity slots i in 0:nvel-1 correspond, in reference time - // [0,dtf]. - Real t_vel(const int i) const; - - // For n = 0:dtf, obs_slots(n,0:1) = [slot1, slot2], -1 if unused. These are - // the slots to which velocity sample n contributes. obs_slots(0 or dtf,:) are - // always -1. - int obs_slots(const int n, const int k) const; - - // For n = 0:dtf, obs_wts(n,0:1) = [wt1, wt2], 0 if unused. - Real obs_wts(const int n, const int k) const; - - // Substep end point i in 0:nsub uses velocity slots run_step(n), - // run_step(n)-1. - int run_step(const int i) const; - -private: - int _dtf = -1, _drf = -1, _nsub = -1, _nvel = -1; - std::vector _obs_slots, _run_step; - std::vector _t_vel, _obs_wts; - - Real& t_vel(const int i); - int& obs_slots(const int n, const int k); - Real& obs_wts(const int n, const int k); - int& run_step(const int i); -}; - -Real& CTI::VelocityRecord::t_vel (const int i) { - assert(_nvel > 2); - assert(i >= 0 and i < _nvel); - return _t_vel[i]; -} - -int& CTI::VelocityRecord::obs_slots (const int n, const int k) { - assert(_nvel > 2); - assert(n >= 0 and n <= _dtf); - assert(k >= 0 and k <= 1); - return _obs_slots[2*n+k]; -} - -Real& CTI::VelocityRecord::obs_wts (const int n, const int k) { - assert(_nvel > 2); - assert(n >= 0 and n <= _dtf); - assert(k >= 0 and k <= 1); - return _obs_wts[2*n+k]; -} - -int& CTI::VelocityRecord::run_step (const int i) { - assert(_nvel > 2); - assert(i >= 0 and i <= _nsub); - return _run_step[i]; -} - -Real CTI::VelocityRecord::t_vel (const int i) const { - return const_cast(this)->t_vel(i); -} - -int CTI::VelocityRecord::obs_slots (const int n, const int k) const { - return const_cast(this)->obs_slots(n,k); -} - -Real CTI::VelocityRecord::obs_wts (const int n, const int k) const { - return const_cast(this)->obs_wts(n,k); -} - -int CTI::VelocityRecord::run_step (const int i) const { - return const_cast(this)->run_step(i); -} - -void CTI::VelocityRecord -::init (const int dtf, const int drf_param, const int nsub, const int nvel_param) { - const int - drf = drf_param == 0 ? 1 : drf_param, - navail = dtf/drf + 1, - nvel = std::min(nvel_param == -1 ? - (2 + (nsub-1)/2) : // default value - nvel_param, - std::min(nsub+1, // can't use more than this - navail)); // this is the max available - - _dtf = dtf; _drf = drf; _nsub = nsub; _nvel = nvel; - - // nsub <= 1: No substepping. - // nvel <= 2: Save velocity only at endpoints, as always occurs. - if (nsub <= 1 or nvel <= 2) { - _nvel = 2; - return; - } - - _t_vel.resize(nvel); - _obs_slots.resize(2*(dtf+1)); _obs_wts.resize(2*(dtf+1)); - _run_step.resize(nsub+1); - - // Times at which velocity data are available. - std::vector t_avail(navail); { - int i = 0; - for (int n = 0; n <= dtf; ++n) { - if (n % drf != 0) continue; - t_avail[i] = n; - i = i + 1; - } - assert(i == navail); - assert(t_avail[navail-1] == dtf); - } - - // Times to which we associate velocity data. - for (int n = 0; n < nvel; ++n) { - t_vel(n) = ((n*dtf) % (nvel-1) == 0 ? - /**/ (n*dtf) / (nvel-1) : - Real (n*dtf) / (nvel-1)); - assert(t_vel(n) >= 0 and t_vel(n) <= dtf); - assert(n == 0 or t_vel(n) > t_vel(n-1)); - } - - // Build the tables mapping n in 0:dtf-1 to velocity slots to accumulate into. - for (int n = 0; n <= dtf; ++n) { - for (int k = 0; k < 2; ++k) { - obs_slots(n,k) = -1; - obs_wts(n,k) = 0; - } - if (n == 0 or n == dtf) continue; - if (n % drf != 0) continue; - const int time = n; - int iav = -1; - for (int i = 1; i < navail-1; ++i) - if (time == t_avail[i]) { - iav = i; - break; - } - assert(iav > 0 and iav < navail-1); - for (int i = 1; i < nvel-1; ++i) { - if (t_avail[iav-1] < t_vel(i) and time > t_vel(i)) { - obs_slots(n,0) = i; - obs_wts(n,0) = ((t_vel(i) - t_avail[iav-1]) / - (t_avail[iav] - t_avail[iav-1])); - } - if (time <= t_vel(i) and t_avail[iav+1] > t_vel(i)) { - obs_slots(n,1) = i; - obs_wts(n,1) = ((t_avail[iav+1] - t_vel(i)) / - (t_avail[iav+1] - t_avail[iav])); - } - } - } - - // Build table mapping n to interval to use. The trajectories go backward in - // time, and this table reflects that. - run_step(0) = nvel-1; - run_step(nsub) = 1; - for (int n = 1; n < nsub; ++n) { - const auto time = Real((nsub-n)*dtf)/nsub; - int ifnd = -1; - for (int i = 0; i < nvel-1; ++i) - if (t_vel(i) <= time and time <= t_vel(i+1)) { - ifnd = i; - break; - } - assert(ifnd >= 0 and ifnd < nvel-1); - run_step(n) = ifnd + 1; - } -} - -// Public function. - void ComposeTransportImpl::calc_enhanced_trajectory (const int np1, const Real dt) { GPTLstart("compose_calc_enhanced_trajectory"); @@ -1264,991 +98,6 @@ void ComposeTransportImpl::calc_enhanced_trajectory (const int np1, const Real d GPTLstop("compose_calc_enhanced_trajectory"); } -// Testing. - -namespace { // anon - -Kokkos::TeamPolicy -get_test_team_policy (const int nelem, const int nlev, const int ncol=NP*NP) { - ThreadPreferences tp; - tp.max_threads_usable = ncol; - tp.max_vectors_usable = nlev; - tp.prefer_threads = true; - tp.prefer_larger_team = true; - return Homme::get_default_team_policy(nelem, tp); -} - -struct TestData { - std::mt19937_64 engine; - static const Real eps; - const ComposeTransportImpl& cti; - - TestData (const CTI& cti_, const int seed = 0) - : cti(cti_), engine(seed == 0 ? std::random_device()() : seed) - {} - - Real urand (const Real lo = 0, const Real hi = 1) { - std::uniform_real_distribution urb(lo, hi); - return urb(engine); - } -}; - -// Data to deal with views of packs easily in tests. -struct ColData { - int npack; - ExecView d; - ExecView::HostMirror h; - ExecView::HostMirror r; - - ColData (const std::string& name, const int nlev) { - npack = calc_npack(nlev); - d = decltype(d)(name, npack); - h = Kokkos::create_mirror_view(d); - r = decltype(r)(cti::pack2real(h), calc_nscal(npack)); - } - - void h2d () { Kokkos::deep_copy(d, h); } -}; - -struct ElData { - int npack; - ExecView d; - ExecView::HostMirror h; - ExecView::HostMirror r; - - ElData (const std::string& name, const int nlev) { - npack = calc_npack(nlev); - d = decltype(d)(name, NP, NP, npack); - h = Kokkos::create_mirror_view(d); - r = decltype(r)(cti::pack2real(h), NP, NP, calc_nscal(npack)); - } - - void d2h () { Kokkos::deep_copy(h, d); } - void h2d () { Kokkos::deep_copy(d, h); } -}; - -const Real TestData::eps = std::numeric_limits::epsilon(); - -int test_find_support (TestData&) { - int ne = 0; - const int n = 97; - std::vector x(n); - for (int i = 0; i < n; ++i) x[i] = -11.7 + (i*i)/n; - const int ntest = 10000; - for (int i = 0; i < ntest; ++i) { - const Real xi = x[0] + (Real(i)/ntest)*(x[n-1] - x[0]); - for (int x_idx : {0, 1, n/3, n/2, n-2, n-1}) { - const int sup = find_support(n, x.data(), x_idx, xi); - if (sup > n-2) ++ne; - else if (xi < x[sup] or xi > x[sup+1]) ++ne; - } - } - return ne; -} - -void todev (const std::vector& h, const RnV& d) { - assert(h.size() <= d.size()); - const auto m = Kokkos::create_mirror_view(d); - for (size_t i = 0; i < h.size(); ++i) m(i) = h[i]; - Kokkos::deep_copy(d, m); -} - -void fillcols (const int n, const Real* const h, const RelnV::HostMirror& a) { - assert(n <= a.extent_int(2)); - for (int i = 0; i < a.extent_int(0); ++i) - for (int j = 0; j < a.extent_int(1); ++j) - for (size_t k = 0; k < n; ++k) - a(i,j,k) = h[k]; -} - -void todev (const int n, const Real* const h, const RelnV& d) { - const auto m = Kokkos::create_mirror_view(d); - fillcols(n, h, m) ; - Kokkos::deep_copy(d, m); -} - -void todev (const std::vector& h, const RelnV& d) { - todev(h.size(), h.data(), d); -} - -void tohost (const ExecView& d, std::vector& h) { - assert(h.size() <= d.size()); - const auto m = Kokkos::create_mirror_view(d); - Kokkos::deep_copy(m, d); - for (size_t i = 0; i < h.size(); ++i) h[i] = m(i); -} - -void run_linterp (const std::vector& x, const std::vector& y, - std::vector& xi, std::vector& yi) { - const auto n = x.size(), ni = xi.size(); - assert(y.size() == n); assert(yi.size() == ni); - // input -> device (test different sizes >= n) - ExecView xv("xv", n), yv("yv", n+1), xiv("xiv", ni+2), yiv("yiv", ni+3); - todev(x, xv); - todev(y, yv); - todev(xi, xiv); - // call linterp - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - const auto range = Kokkos::TeamVectorRange(team, ni); - linterp(range, n, xv, yv, ni, xiv, yiv, 0, "unittest"); - }; - Homme::ThreadPreferences tp; - tp.max_threads_usable = 1; - tp.max_vectors_usable = ni; - tp.prefer_threads = false; - tp.prefer_larger_team = true; - const auto policy = get_test_team_policy(1, n); - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - // output -> host - tohost(yiv, yi); -} - -void make_random_sorted (TestData& td, const int n, const Real xlo, const Real xhi, - std::vector& x) { - assert(n >= 2); - x.resize(n); - x[0] = xlo; - for (int i = 1; i < n-1; ++i) x[i] = td.urand(xlo, xhi); - x[n-1] = xhi; - std::sort(x.begin(), x.end()); -} - -int test_linterp (TestData& td) { - int nerr = 0; - { // xi == x => yi == y. - int ne = 0; - const int n = 30; - std::vector x(n), y(n), xi(n), yi(n); - make_random_sorted(td, n, -0.1, 1.2, x); - make_random_sorted(td, n, -3, -1, y); - for (int i = 0; i < n; ++i) xi[i] = x[i]; - run_linterp(x, y, xi, yi); - for (int i = 0; i < n; ++i) - if (yi[i] != y[i]) - ++ne; - nerr += ne; - } - { // Reconstruct a linear function exactly. - int ne = 0; - const int n = 56, ni = n-3; - const Real xlo = -1.2, xhi = 3.1; - const auto f = [&] (const Real x) { return -0.7 + 1.3*x; }; - std::vector x(n), y(n), xi(ni), yi(ni); - for (int trial = 0; trial < 4; ++trial) { - make_random_sorted(td, n, xlo, xhi, x); - make_random_sorted(td, ni, - xlo + (trial == 1 or trial == 3 ? 0.1 : 0), - xhi + (trial == 2 or trial == 3 ? -0.5 : 0), - xi); - for (int i = 0; i < n; ++i) y[i] = f(x[i]); - run_linterp(x, y, xi, yi); - for (int i = 0; i < ni; ++i) - if (std::abs(yi[i] - f(xi[i])) > 100*td.eps) - ++ne; - } - nerr += ne; - } - return nerr; -} - -int make_random_deta (TestData& td, const Real deta_tol, const int nlev, - Real* const deta) { - int nerr = 0; - Real sum = 0; - for (int k = 0; k < nlev; ++k) { - deta[k] = td.urand(0, 1) + 0.1; - sum += deta[k]; - } - for (int k = 0; k < nlev; ++k) { - deta[k] /= sum; - if (deta[k] < deta_tol) ++nerr; - } - return nerr; -} - -int make_random_deta (TestData& td, const Real deta_tol, const RnV& deta) { - int nerr = 0; - const int nlev = deta.extent_int(0); - const auto m = Kokkos::create_mirror_view(deta); - nerr = make_random_deta(td, deta_tol, nlev, &m(0)); - Kokkos::deep_copy(deta, m); - return nerr; -} - -int make_random_deta (TestData& td, const Real deta_tol, const RelnV& deta) { - int nerr = 0; - const int nlev = deta.extent_int(2); - const auto m = Kokkos::create_mirror_view(deta); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - nerr += make_random_deta(td, deta_tol, nlev, &m(i,j,0)); - Kokkos::deep_copy(deta, m); - return nerr; -} - -int test_deta_caas (TestData& td) { - int nerr = 0; - const Real tol = 100*td.eps; - - for (const int nlev : {15, 128, 161}) { - const Real deta_tol = 10*td.eps/nlev; - const auto err = [&] (const char* lbl) { - ++nerr; - printf("test_deta_caa nlev %d: %s\n", nlev, lbl); - }; - - // nlev+1 deltas: deta = diff([0, etam, 1]) - ExecView deta_ref("deta_ref", nlev+1); - ExecView deta("deta",NP,NP,nlev+1), wrk("wrk",NP,NP,nlev+1); - nerr += make_random_deta(td, deta_tol, deta_ref); - - const auto policy = get_test_team_policy(1, nlev); - const auto run = [&] (const RelnV& deta) { - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - KernelVariables kv(team); - deta_caas(kv, nlev+1, deta_ref, deta_tol, wrk, deta); - }; - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - }; - - { // Test that if all is OK, the input is not altered. - nerr += make_random_deta(td, deta_tol, deta); - ExecView::HostMirror copy("copy",NP,NP,nlev+1); - Kokkos::deep_copy(copy, deta); - run(deta); - const auto m = cti::cmvdc(deta); - bool diff = false; - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - for (int k = 0; k <= nlev; ++k) - if (m(i,j,k) != copy(i,j,k)) - diff = true; - if (diff) err("input not altered"); - } - - { // Modify one etam and test that only adjacent intervals change beyond eps. - // nlev midpoints - ExecView etam_ref("etam_ref",nlev); - const auto her = Kokkos::create_mirror_view(etam_ref); - const auto hder = cti::cmvdc(deta_ref); - { - her(0) = hder(0); - for (int k = 1; k < nlev; ++k) - her(k) = her(k-1) + hder(k); - Kokkos::deep_copy(etam_ref, her); - } - std::vector etam(nlev); - const auto hde = Kokkos::create_mirror_view(deta); - const auto get_idx = [&] (const int i, const int j) { - const int idx = static_cast(0.15*nlev); - return std::max(1, std::min(nlev-2, idx+NP*i+j)); - }; - for (int trial = 0; trial < 2; ++trial) { - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - for (int k = 0; k < nlev; ++k) etam[k] = her(k); - // Perturb one level. - const int idx = get_idx(i,j); - etam[idx] += trial == 0 ? 1.1 : -13.1; - hde(i,j,0) = etam[0]; - for (int k = 1; k < nlev; ++k) hde(i,j,k) = etam[k] - etam[k-1]; - hde(i,j,nlev) = 1 - etam[nlev-1]; - // Make sure we have a meaningful test. - Real minval = 1; - for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); - if (minval >= deta_tol) err("meaningful test"); - } - Kokkos::deep_copy(deta, hde); - run(deta); - Kokkos::deep_copy(hde, deta); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - const int idx = get_idx(i,j); - // Min val should be deta_tol. - Real minval = 1; - for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); - if (minval != deta_tol) err("min val"); - // Sum of levels should be 1. - Real sum = 0; - for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); - if (std::abs(sum - 1) > tol) err("sum 1"); - // Only two deltas should be affected. - Real maxdiff = 0; - for (int k = 0; k <= nlev; ++k) { - const auto diff = std::abs(hde(i,j,k) - hder(k)); - if (k == idx or k == idx+1) { - if (diff <= deta_tol) err("2 deltas a"); - } else { - maxdiff = std::max(maxdiff, diff); - } - } - if (maxdiff > tol) err("2 deltas b"); - } - } - } - - { // Test generally (and highly) perturbed levels. - const auto hde = Kokkos::create_mirror_view(deta); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - Real sum = 0; - for (int k = 0; k <= nlev; ++k) { - hde(i,j,k) = td.urand(-0.5, 0.5); - sum += hde(i,j,k); - } - // Make the column sum to 0.2 for safety in the next step. - const Real colsum = 0.2; - for (int k = 0; k <= nlev; ++k) hde(i,j,k) += (colsum - sum)/(nlev+1); - for (int k = 0; k <= nlev; ++k) hde(i,j,k) /= colsum; - sum = 0; - for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); - if (std::abs(sum - 1) > 10*tol) err("general sum 1"); - } - Kokkos::deep_copy(deta, hde); - run(deta); - Kokkos::deep_copy(hde, deta); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - Real sum = 0, minval = 1; - for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); - for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); - if (std::abs(sum - 1) > 1e3*td.eps) ++nerr; - if (minval != deta_tol) err("general minval"); - } - } - } - - return nerr; -} - -struct HybridLevels { - Real ps0, a_eta, b_eta; - std::vector ai, dai, bi, dbi, am, bm, etai, detai, etam, detam; -}; - -// Follow DCMIP2012 3D tracer transport specification for a, b, eta. -void fill (HybridLevels& h, const int n) { - h.ai.resize(n+1); h.bi.resize(n+1); - h.am.resize(n ); h.bm.resize(n ); - h.etai.resize(n+1); h.etam.resize(n); - - const auto Rd = PhysicalConstants::Rgas; - const auto T0 = 300; // K - const auto p0 = PhysicalConstants::p0; - const auto g = PhysicalConstants::g; - const Real ztop = 12e3; // m - - h.ps0 = p0; - - const auto calc_pressure = [&] (const Real z) { - return p0*std::exp(-g*z/(Rd*T0)); - }; - - const Real eta_top = calc_pressure(ztop)/p0; - assert(eta_top > 0); - for (int i = 0; i <= n; ++i) { - const auto z = (Real(n - i)/n)*ztop; - h.etai[i] = calc_pressure(z)/p0; - h.bi[i] = i == 0 ? 0 : (h.etai[i] - eta_top)/(1 - eta_top); - h.ai[i] = h.etai[i] - h.bi[i]; - assert(i == 0 or h.etai[i] > h.etai[i-1]); - } - assert(h.bi [0] == 0); // Real(n - i)/n is exactly 1, so exact = holds - assert(h.bi [n] == 1); // exp(0) is exactly 0, so exact = holds - assert(h.etai[n] == 1); // same - // b = (eta - eta_top)/(1 - eta_top) => b_eta = 1/(1 - eta_top) - // a = eta - b => a_eta = 1 - b_eta = -eta_top/(1 - eta_top) - // p_eta = a_eta p0 + b_eta ps - h.b_eta = 1/(1 - eta_top); - h.a_eta = 1 - h.b_eta; - - const auto tomid = [&] (const std::vector& in, std::vector& mi) { - for (int i = 0; i < n; ++i) mi[i] = (in[i] + in[i+1])/2; - }; - tomid(h.ai, h.am); - tomid(h.bi, h.bm); - tomid(h.etai, h.etam); - - const auto diff = [&] (const std::vector& ai, std::vector& dai) { - dai.resize(n); - for (int i = 0; i < n; ++i) dai[i] = ai[i+1] - ai[i]; - }; - diff(h.ai, h.dai); - diff(h.bi, h.dbi); - diff(h.etai, h.detai); - - h.detam.resize(n+1); - h.detam[0] = h.etam[0] - h.etai[0]; - for (int i = 1; i < n; ++i) h.detam[i] = h.etam[i] - h.etam[i-1]; - h.detam[n] = h.etai[n] - h.etam[n-1]; -} - -int test_limit_etam (TestData& td) { - int nerr = 0; - const Real tol = 100*td.eps; - - for (const int nlev : {143, 128, 81}) { - const Real deta_tol = 1e5*td.eps/nlev; - - ExecView hy_etai("hy_etai",nlev+1), detam("detam",nlev+1); - ExecView wrk1("wrk1",NP,NP,nlev+1), wrk2("wrk2",NP,NP,nlev+1); - ExecView etam("etam",NP,NP,nlev); - - HybridLevels h; - fill(h, nlev); - todev(h.etai, hy_etai); - todev(h.detam, detam); - - const auto he = Kokkos::create_mirror_view(etam); - - const auto policy = get_test_team_policy(1, nlev); - const auto run = [&] () { - Kokkos::deep_copy(etam, he); - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - KernelVariables kv(team); - limit_etam(kv, nlev, hy_etai, detam, deta_tol, wrk1, wrk2, etam); - }; - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - Kokkos::deep_copy(he, etam); - }; - - fillcols(h.etam.size(), h.etam.data(), he); - // Col 0 should be untouched. Cols 1 and 2 should have very specific changes. - const int col1_idx = static_cast(0.25*nlev); - he(0,1,col1_idx) += 0.3; - const int col2_idx = static_cast(0.8*nlev); - he(0,2,col2_idx) -= 5.3; - // The rest of the columns get wild changes. - for (int idx = 3; idx < NP*NP; ++idx) { - const int i = idx / NP, j = idx % NP; - for (int k = 0; k < nlev; ++k) - he(i,j,k) += td.urand(-1, 1)*(h.etai[k+1] - h.etai[k]); - } - run(); - bool ok = true; - for (int k = 0; k < nlev; ++k) - if (he(0,0,k) != h.etam[k]) ok = false; - for (int k = 0; k < nlev; ++k) { - if (k == col1_idx) continue; - if (std::abs(he(0,1,k) - h.etam[k]) > tol) ok = false; - } - for (int k = 0; k < nlev; ++k) { - if (k == col2_idx) continue; - if (std::abs(he(0,2,k) - h.etam[k]) > tol) ok = false; - } - Real mingap = 1; - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - mingap = std::min(mingap, he(i,j,0) - h.etai[0]); - for (int k = 1; k < nlev; ++k) - mingap = std::min(mingap, he(i,j,k) - he(i,j,k-1)); - mingap = std::min(mingap, h.etai[nlev] - he(i,j,nlev-1)); - } - // Test minimum level delta, with room for numerical error. - if (mingap < 0.8*deta_tol) ok = false; - if (not ok) ++nerr; - } - - return nerr; -} - -int test_eta_interp (TestData& td) { - int nerr = 0; - const Real tol = 100*td.eps; - - for (const int nlev : {15, 128, 161}) { - HybridLevels h; - fill(h, nlev); - - ExecView hy_etai("hy_etai",nlev+1); - ExecView x("x",NP,NP,nlev), y("y",NP,NP,nlev); - ExecView xi("xi",NP,NP,nlev+1), yi("yi",NP,NP,nlev+1); - ExecView xwrk("xwrk",NP,NP,nlev+2), ywrk("ywrk",NP,NP,nlev+2); - - todev(h.etai, hy_etai); - - const auto xh = Kokkos::create_mirror_view(x ); - const auto yh = Kokkos::create_mirror_view(y ); - const auto xih = Kokkos::create_mirror_view(xi); - const auto yih = Kokkos::create_mirror_view(yi); - - const auto policy = get_test_team_policy(1, nlev); - const auto run_eta = [&] (const int ni) { - Kokkos::deep_copy(x, xh); Kokkos::deep_copy(y, yh); - Kokkos::deep_copy(xi, xih); - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - KernelVariables kv(team); - eta_interp_eta(kv, nlev, hy_etai, - x, getcolc(y,0,0), - xwrk, getcol(ywrk,0,0), - ni, getcolc(xi,0,0), yi); - }; - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - Kokkos::deep_copy(yih, yi); - }; - const auto run_horiz = [&] () { - Kokkos::deep_copy(x, xh); Kokkos::deep_copy(y, yh); - Kokkos::deep_copy(xi, xih); - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - KernelVariables kv(team); - eta_interp_horiz(kv, nlev, hy_etai, - getcolc(x,0,0), y, - getcol(xwrk,0,0), ywrk, - xi, yi); - }; - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - Kokkos::deep_copy(yih, yi); - }; - - std::vector v; - const Real d = 1e-6, vlo = h.etai[0]+d, vhi = h.etai[nlev]-d; - - for (const int ni : {int(0.7*nlev), nlev-1, nlev, nlev+1}) { - make_random_sorted(td, nlev, vlo, vhi, v); - fillcols(nlev, v.data(), xh); - fillcols(nlev, v.data(), yh); - make_random_sorted(td, ni, vlo, vhi, v); - fillcols(ni, v.data(), xih); - run_eta(ni); - bool ok = true; - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - for (int k = 0; k < ni; ++k) - if (std::abs(yih(i,j,k) - xih(i,j,k)) > tol) - ok = false; - if (not ok) ++nerr; - } - - { // Test exact interp of line in the interior, const interp near the bdys. - make_random_sorted(td, nlev, vlo+0.05, vhi-0.1, v); - fillcols(nlev, v.data(), xh); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - for (int k = 0; k < nlev; ++k) - yh(i,j,k) = i*xh(0,0,k) - j; - make_random_sorted(td, nlev, vlo, vhi, v); - for (int k = 0; k < nlev; ++k) - xih(i,j,k) = v[k]; - } - run_horiz(); - bool ok = true; - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - for (int k = 0; k < nlev; ++k) { - if (xih(i,j,k) < xh(0,0,0)) { - if (std::abs(yih(i,j,k) - yih(i,j,0)) > tol) - ok = false; - } else if (xih(i,j,k) > xh(0,0,nlev-1)) { - if (std::abs(yih(i,j,k) - yih(i,j,nlev-1)) > tol) - ok = false; - } else { - if (std::abs(yih(i,j,k) - (i*xih(i,j,k) - j)) > tol) - ok = false; - } - } - if (not ok) ++nerr; - } - } - - return nerr; -} - -int test_eta_to_dp (TestData& td) { - int nerr = 0; - const Real tol = 100*td.eps; - - for (const int nlev : {143, 128, 81}) { - const auto err = [&] (const char* lbl) { - ++nerr; - printf("test_eta_to_dp nlev %d: %s\n", nlev, lbl); - }; - - HybridLevels h; - fill(h, nlev); - - ExecView hy_bi("hy_bi",nlev+1), hy_etai("hy_etai",nlev+1); - ExecView etai("etai",NP,NP,nlev+1), wrk("wrk",NP,NP,nlev+1); - ExecView dp("dp",NP,NP,nlev); - ExecView ps("ps"); - const Real hy_ps0 = h.ps0; - - todev(h.bi, hy_bi); - todev(h.etai, hy_etai); - - const auto psm = Kokkos::create_mirror_view(ps); - HostView dp1("dp1",NP,NP,nlev); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - psm(i,j) = (1 + 0.1*td.urand(-1, 1))*h.ps0; - Kokkos::deep_copy(ps, psm); - - const auto policy = get_test_team_policy(1, nlev); - const auto run = [&] () { - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - KernelVariables kv(team); - eta_to_dp(kv, nlev, hy_ps0, hy_bi, hy_etai, ps, etai, wrk, dp); - }; - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - }; - - { // Test that for etai_ref we get the same as the usual formula. - todev(h.etai, etai); - HostView dp1("dp1",NP,NP,nlev); - Real dp1_max = 0; - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - for (int k = 0; k < nlev; ++k) { - dp1(i,j,k) = ((h.ai[k+1] - h.ai[k])*h.ps0 + - (h.bi[k+1] - h.bi[k])*psm(i,j)); - dp1_max = std::max(dp1_max, std::abs(dp1(i,j,k))); - } - run(); - const auto dph = cti::cmvdc(dp); - Real err_max = 0; - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - for (int k = 0; k < nlev; ++k) - err_max = std::max(err_max, std::abs(dph(i,j,k) - dp1(i,j,k))); - if (err_max > tol*dp1_max) err("t1"); - } - - { // Test that sum(dp) = ps for random input etai. - std::vector etai_r; - make_random_sorted(td, nlev+1, h.etai[0], h.etai[nlev], etai_r); - todev(etai_r, etai); - run(); - const auto dph1 = cti::cmvdc(dp); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - Real ps = h.ai[0]*h.ps0; - for (int k = 0; k < nlev; ++k) - ps += dph1(i,j,k); - if (std::abs(ps - psm(i,j)) > tol*psm(i,j)) err("t2"); - } - // Test that values on input don't affect solution. - Kokkos::deep_copy(wrk, 0); - Kokkos::deep_copy(dp, 0); - run(); - const auto dph2 = cti::cmvdc(dp); - bool alleq = true; - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - for (int k = 0; k < nlev; ++k) - if (dph2(i,j,k) != dph1(i,j,k)) - alleq = false; - if (not alleq) err("t3"); - } - } - - return nerr; -} - -int test_calc_ps (TestData& td) { - int nerr = 0; - const Real tol = 100*td.eps; - - for (const int nlev : {15, 128, 161}) { - HybridLevels h; - fill(h, nlev); - const auto ps0 = h.ps0, hyai0 = h.ai[0]; - - ElData dp1("dp1", nlev), dp2("dp2", nlev); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) - for (int k = 0; k < nlev; ++k) { - dp1.r(i,j,k) = td.urand(0, 1000); - dp2.r(i,j,k) = td.urand(0, 1000); - } - dp1.h2d(); - dp2.h2d(); - - const Real alpha[] = {td.urand(0,1), td.urand(0,1)}; - - ExecView ps("ps"); - ExecView ps2("ps2"); - const auto policy = get_test_team_policy(1, nlev); - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - KernelVariables kv(team); - calc_ps(kv, nlev, ps0, hyai0, alpha, dp1.d, dp2.d, ps2); - calc_ps(kv, nlev, ps0, hyai0, dp1.d, ps); - }; - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - - const auto ps_h = cti::cmvdc(ps); - const auto ps2_h = cti::cmvdc(ps2); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - { - Real ps = h.ai[0]*h.ps0; - for (int k = 0; k < nlev; ++k) - ps += dp1.r(i,j,k); - if (std::abs(ps_h(i,j) - ps) > tol*ps) ++nerr; - } - for (int t = 0; t < 2; ++t) { - Real ps = h.ai[0]*h.ps0; - for (int k = 0; k < nlev; ++k) - ps += (1 - alpha[t])*dp1.r(i,j,k) + alpha[t]*dp2.r(i,j,k); - if (std::abs(ps2_h(t,i,j) - ps) > tol*ps) ++nerr; - } - } - } - - return nerr; -} - -int test_calc_etadotmid_from_etadotdpdnint (TestData& td) { - int nerr = 0; - const Real tol = 100*td.eps; - - for (const int nlev : {143, 128, 81}) { - HybridLevels h; - fill(h, nlev); - - // Test function: - // eta_dot_dpdn(eta) = c eta + d. - // Then - // eta_dot = eta_dot_dpdn(eta)/dpdn(eta) - // = (c eta + d)/(a_eta p0 + b_eta ps). - // Since a_eta, b_eta are constants independent of eta in this test, eta_dot - // is then also a linear function of eta. Thus, we can test for exact - // agreement with the true solution. - - ColData hydai("hydai",nlev), hydbi("hydbi",nlev), hydetai("hydetai",nlev); - ElData wrk("wrk",nlev+1), ed("ed",nlev+1); - ExecView ps("ps"); - const Real ps0 = h.ps0; - - const auto ps_m = Kokkos::create_mirror_view(ps); - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - ps_m(i,j) = td.urand(0.5, 1.2)*ps0; - for (int k = 0; k < nlev; ++k) { - hydai.r[k] = h.dai[k]; - hydbi.r[k] = h.dbi[k]; - hydetai.r[k] = h.detai[k]; - } - for (int k = 0; k <= nlev; ++k) - ed.r(i,j,k) = (i-j)*h.etai[k] + 0.3; - } - Kokkos::deep_copy(ps, ps_m); - hydai.h2d(); hydbi.h2d(); hydetai.h2d(); - ed.h2d(); - - const auto policy = get_test_team_policy(1, nlev); - const auto f = KOKKOS_LAMBDA(const cti::MT& team) { - KernelVariables kv(team); - calc_etadotmid_from_etadotdpdnint( - kv, nlev, ps0, hydai.d, hydbi.d, hydetai.d, ps, wrk.d, ed.d); - }; - Kokkos::parallel_for(policy, f); - Kokkos::fence(); - ed.d2h(); - - for (int i = 0; i < NP; ++i) - for (int j = 0; j < NP; ++j) { - const auto den = h.a_eta*h.ps0 + h.b_eta*ps_m(i,j); - for (int k = 0; k < nlev; ++k) { - const auto ed_true = ((i-j)*h.etam[k] + 0.3)/den; - if (std::abs(ed.r(i,j,k) - ed_true) > tol*(10/den)) ++nerr; - } - } - } - - return nerr; -} - -int test_calc_eta_dot_ref_mid (TestData& td) { - int nerr = 0; - - // calc_eta_dot_ref_mid calls several routines that are all tested - // mathematically. calc_eta_dot_ref_mid itself is too complicated to test - // mathematically. But we can still test it for s/w properties like - // determinism. - - //todo - - return nerr; -} - -int test_interp_departure_points_to_floating_level_midpoints (TestData& td) { - int nerr = 0; - //todo test case of ed = 0 - return nerr; -} - -static int test1_init_velocity_record ( - const int dtf, const int drf, const int nsub, const int nvel) -{ - const auto eps = std::numeric_limits::epsilon(); - int e = 0; - - if (dtf % drf != 0) { - printf("Testing erro: dtf %% drf == 0 is required: %d %d\n", dtf, drf); - ++e; - } - - const CTI::VelocityRecord v(dtf, drf, nsub, nvel); - if (v.dtf() != dtf) ++e; - if (v.nsub() != nsub) ++e; - - // Check that t_vel is monotonically increasing. - for (int n = 1; n < v.nvel(); ++n) - if (v.t_vel(n) <= v.t_vel(n-1)) - ++e; - - // Check that obs_slots does not reference end points. This should not happen - // b/c nvel <= navail and observations are uniformly spaced. - for (int n = 0; n < dtf; ++n) - for (int i = 0; i < 2; ++i) - if (v.obs_slots(n,i) == 0 or v.obs_slots(n,i) == dtf) - ++e; - - // Check that weights sum to 1. - std::vector ys(dtf); - for (int n = 0; n < dtf; ++n) - for (int i = 0; i < 2; ++i) - if (v.obs_slots(n,i) >= 0) - ys[v.obs_slots(n,i)] += v.obs_wts(n,i); - for (int i = 1; i < v.nvel()-1; ++i) - if (std::abs(ys[i] - 1) > 1e3*eps) - ++e; - - // Test for exact interp of an affine function. - const auto tfn = [] (const Real x) { return 7.1*x - 11.5; }; - // Observe data forward in time. - Real endslots[2]; - endslots[0] = tfn(0); - endslots[1] = tfn(dtf); - ys[0] = -1000; // unused - for (int i = 1; i < dtf; ++i) ys[i] = 0; - for (int n = 1; n < dtf; ++n) { - if (n % drf != 0) continue; - const Real y = tfn(n); - for (int i = 0; i < 2; ++i) { - if (v.obs_slots(n,i) < 0) continue; - ys[v.obs_slots(n,i)] += v.obs_wts(n,i)*y; - } - } - // Use the data backward in time. - for (int n = 0; n < nsub; ++n) { - // Each segment orders the data forward in time. Thus, data are always - // ordered forward in time but used backward. - Real xsup[2], ysup[2]; - for (int i = 0; i < 2; ++i) { - int k = nsub - (n+1) + i; - xsup[i] = (k*v.t_vel(v.nvel()-1))/nsub; - k = v.run_step(nsub-i); - const Real - y0 = k == 1 ? endslots[0] : ys[k-1], - y1 = k == v.nvel()-1 ? endslots[2] : ys[k]; - ysup[i] = (((v.t_vel(k) - xsup[i])*y0 + (xsup[i] - v.t_vel(k-1))*y1) / - (v.t_vel(k) - v.t_vel(k-1))); - } - for (int i = 0; i <= 10; ++i) { - const Real - a = Real(i)/10, - x = (1-a)*xsup[0] + a*xsup[1], - y = (1-a)*ysup[0] + a*ysup[1]; - if (std::abs(y - tfn(x)) > 1e3*eps) { - printf("n %d i %2d x %7.3f y %7.3f t %7.3f\n", n, i, x, y, tfn(x)); - ++e; - } - } - } - - if (e) { - printf("ERROR e %d\n", e); - printf("dtf %d drf %d nsub %d nvel %d v.nvel %d\n", - dtf, drf, nsub, nvel, v.nvel()); - printf(" t_vel:"); - for (int i = 0; i < v.nvel(); ++i) printf(" %1.3f", v.t_vel(i)); - printf("\n obs:\n"); - for (int n = 0; n <= dtf; ++n) - printf(" %2d %2d %2d %1.3f %1.3f\n", - n, v.obs_slots(n,0), v.obs_slots(n,1), v.obs_wts(n,0), - v.obs_wts(n,1)); - printf(" run_step:\n"); - for (int n = 0; n <= nsub; ++n) printf(" %2d %2d\n", n, v.run_step(n)); - } - - return e; -} - -int test_init_velocity_record (TestData& td) { - int dtf, drf, nsub, nvel, nerr; - - nerr = 0; - - const auto f = [&] () { - const int e = test1_init_velocity_record(dtf, drf, nsub, nvel); - if (e > 0) ++nerr; - }; - - nerr = 0; - dtf = 6; - drf = 2; - nsub = 3; - nvel = 4; - f(); - nvel = 3; - f(); - drf = 3; - nvel = 6; - f(); - drf = 1; - nsub = 5; - f(); - dtf = 12; - drf = 2; - nsub = 3; - nvel = -1; - f(); - nsub = 5; - nvel = 5; - f(); - dtf = 27; - drf = 3; - nsub = 51; - nvel = 99; - f(); - - return nerr; -} - -} // namespace anon - -#define comunittest(f) do { \ - ne = f(td); \ - if (ne) printf(#f " ne %d\n", ne); \ - nerr += ne; \ - } while (0) - -int ComposeTransportImpl::run_enhanced_trajectory_unit_tests () { - int nerr = 0, ne; - TestData td(*this); - comunittest(test_find_support); - comunittest(test_linterp); - comunittest(test_eta_interp); - comunittest(test_eta_to_dp); - comunittest(test_deta_caas); - comunittest(test_limit_etam); - comunittest(test_calc_ps); - comunittest(test_calc_etadotmid_from_etadotdpdnint); - comunittest(test_calc_eta_dot_ref_mid); - comunittest(test_interp_departure_points_to_floating_level_midpoints); - comunittest(test_init_velocity_record); - return nerr; -} - -#undef comunittest - } // namespace Homme #endif // HOMME_ENABLE_COMPOSE diff --git a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp new file mode 100644 index 00000000000..dba5a641e34 --- /dev/null +++ b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp @@ -0,0 +1,996 @@ +/******************************************************************************** + * HOMMEXX 1.0: Copyright of Sandia Corporation + * This software is released under the BSD license + * See the file 'COPYRIGHT' in the HOMMEXX/src/share/cxx directory + *******************************************************************************/ + +#include "Config.hpp" +#ifdef HOMME_ENABLE_COMPOSE + +#ifndef HOMMEXX_COMPOSE_TRANSPORT_IMPL_ENHANCED_TRAJECTORY_IMPL_HPP +#define HOMMEXX_COMPOSE_TRANSPORT_IMPL_ENHANCED_TRAJECTORY_IMPL_HPP + +#include "ComposeTransportImpl.hpp" + +#include "compose_hommexx.hpp" + +namespace Homme { +namespace { // anon + +using cti = ComposeTransportImpl; +using CTI = ComposeTransportImpl; +using CSelNlev = cti::CSNlev; +using CRelNlev = cti::CRNlev; +using CSelNlevp = cti::CSNlevp; +using CRelNlevp = cti::CRNlevp; +using CS2elNlev = cti::CS2Nlev; +using CR2elNlev = cti::CR2Nlev; +using SelNlev = cti::SNlev; +using RelNlev = cti::RNlev; +using SelNlevp = cti::SNlevp; +using RelNlevp = cti::RNlevp; +using S2elNlev = cti::S2Nlev; +using R2elNlev = cti::R2Nlev; +using S2elNlevp = cti::S2Nlevp; + +using RelV = ExecViewUnmanaged; +using CRelV = typename ViewConst::type; + +template using SelNV = ExecViewUnmanaged; +template using CSelNV = typename ViewConst>::type; + +template using RelNV = ExecViewUnmanaged; +template using CRelNV = typename ViewConst>::type; + +template using RNV = ExecViewUnmanaged; +template using CRNV = typename ViewConst>::type; +using RNlevp = RNV; +using CRNlevp = CRNV; + +using RnV = ExecViewUnmanaged; +using CRnV = ExecViewUnmanaged; +using SnV = ExecViewUnmanaged; +using CSnV = ExecViewUnmanaged; + +template using SNV = ExecViewUnmanaged; +template using CSNV = typename ViewConst>::type; + +using RelnV = ExecViewUnmanaged; +using CRelnV = ExecViewUnmanaged; +using SelnV = ExecViewUnmanaged; +using CSelnV = ExecViewUnmanaged; + +KOKKOS_INLINE_FUNCTION +static int calc_npack (const int nscal) { + return (nscal + cti::packn - 1) / VECTOR_SIZE; +} + +KOKKOS_INLINE_FUNCTION +static int calc_nscal (const int npack) { + return npack * VECTOR_SIZE; +} + +KOKKOS_INLINE_FUNCTION +RnV getcol (const RelnV& a, const int i, const int j) { + return Kokkos::subview(a,i,j,Kokkos::ALL); +} + +KOKKOS_INLINE_FUNCTION +CRnV getcolc (const CRelnV& a, const int i, const int j) { + return Kokkos::subview(a,i,j,Kokkos::ALL); +} + +KOKKOS_INLINE_FUNCTION +RelnV elp2r (const SelnV& p) { + return RelnV(cti::pack2real(p), NP, NP, calc_nscal(p.extent_int(2))); +} + +KOKKOS_INLINE_FUNCTION +CRelnV elp2r (const CSelnV& p) { + return CRelnV(cti::cpack2real(p), NP, NP, calc_nscal(p.extent_int(2))); +} + +KOKKOS_INLINE_FUNCTION +RelnV p2rel (Scalar* data, const int nlev) { + return RelnV(cti::pack2real(data), NP, NP, nlev); +} + +KOKKOS_INLINE_FUNCTION +void assert_eln (const CRelnV& a, const int nlev) { + assert(a.extent_int(0) >= NP); + assert(a.extent_int(1) >= NP); + assert(a.extent_int(2) >= nlev); +} + +KOKKOS_INLINE_FUNCTION +void assert_eln (const CSelnV& a, const int nlev) { + assert(a.extent_int(0) >= NP); + assert(a.extent_int(1) >= NP); + assert(calc_nscal(a.extent_int(2)) >= nlev); +} + +// For sorted ascending x[0:n] and x in [x[0], x[n-1]] with hint xi_idx, return +// i such that x[i] <= xi <= x[i+1]. +// This function is meant for the case that x_idx is very close to the +// support. If that isn't true, then this method is inefficient; binary search +// should be used instead. +template +KOKKOS_FUNCTION static +int find_support (const int n, const ConstRealArray& x, const int x_idx, + const Real xi) { + assert(xi >= x[0] and xi <= x[n-1]); + // Handle the most common case. + if (x_idx < n-1 and xi >= x[x_idx ] and xi <= x[x_idx+1]) return x_idx; + if (x_idx > 0 and xi >= x[x_idx-1] and xi <= x[x_idx ]) return x_idx-1; + // Move on to less common ones. + const int max_step = max(x_idx, n-1 - x_idx); + for (int step = 1; step <= max_step; ++step) { + if (x_idx < n-1-step and xi >= x[x_idx+step ] and xi <= x[x_idx+step+1]) + return x_idx+step; + if (x_idx > step and xi >= x[x_idx-step-1] and xi <= x[x_idx-step ]) + return x_idx-step-1; + } + assert(false); + return -1; +} + +// Linear interpolation core computation. +template +KOKKOS_FUNCTION Real +linterp (const int n, const XT& x, const YT& y, const int x_idx, const Real xi) { + const auto isup = find_support(n, x, x_idx, xi); + const Real a = (xi - x[isup])/(x[isup+1] - x[isup]); + return (1-a)*y[isup] + a*y[isup+1]; +} + +// Linear interpolation at the lowest level of team ||ism. +// Range provides this ||ism over index 0 <= k < ni. +// Interpolate y(x) to yi(xi). +// x_idx_offset is added to k in the call to find_support. +// Arrays should all have rank 1. +template +KOKKOS_FUNCTION void +linterp (const Range& range, + const int n , const XT& x , const YT& y, + const int ni, const XIT& xi, const YIT& yi, + const int x_idx_offset = 0, const char* const caller = nullptr) { +#ifndef NDEBUG + if (xi[0] < x[0] or xi[ni-1] > x[n-1]) { + if (caller) + printf("linterp: xi out of bounds: %s %1.15e %1.15e %1.15e %1.15e\n", + caller ? caller : "NONE", x[0], xi[0], xi[ni-1], x[n-1]); + assert(false); + } +#endif + assert(range.start == 0); + assert(range.end == ni); + const auto f = [&] (const int k) { + yi[k] = linterp(n, x, y, k + x_idx_offset, xi[k]); + }; + Kokkos::parallel_for(range, f); +} + +KOKKOS_FUNCTION void +eta_interp_eta (const KernelVariables& kv, const int nlev, + const CRnV& hy_etai, const CRelnV& x, const CRnV& y, + const RelnV& xwrk, const RnV& ywrk, + // Use xi(i_os:), yi(i,j,i_os:). + const int ni, const CRnV& xi, const RelnV& yi, const int i_os = 0) { + const auto& xbdy = xwrk; + const auto& ybdy = ywrk; + assert(hy_etai.extent_int(0) >= nlev+1); + assert_eln(x, nlev); + assert(y.extent_int(0) >= nlev); + assert_eln(xbdy, nlev+2); + assert(ybdy.extent_int(0) >= nlev+2); + assert(xi.extent_int(0) >= i_os + ni); + assert_eln(yi, i_os + ni); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_ni = Kokkos::ThreadVectorRange(kv.team, ni); + const auto tvr_nlevp2 = Kokkos::ThreadVectorRange(kv.team, nlev+2); + const auto f_y = [&] (const int k) { + ybdy(k) = (k == 0 ? hy_etai(0) : + k == nlev+1 ? hy_etai(nlev) : + /**/ y(k-1)); + }; + Kokkos::parallel_for(Kokkos::TeamVectorRange(kv.team, nlev+2), f_y); + kv.team_barrier(); + const auto f_x = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] (const int k) { + xbdy(i,j,k) = (k == 0 ? hy_etai(0) : + k == nlev+1 ? hy_etai(nlev) : + /**/ x(i,j,k-1)); + }; + Kokkos::parallel_for(tvr_nlevp2, g); + }; + Kokkos::parallel_for(ttr, f_x); + kv.team_barrier(); + const auto f_linterp = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + linterp(tvr_ni, + nlev+2, getcolc(xbdy,i,j), ybdy, + ni, xi.data() + i_os, getcol(yi,i,j).data() + i_os, + 1, "eta_interp_eta"); + }; + Kokkos::parallel_for(ttr, f_linterp); +} + +KOKKOS_FUNCTION void +eta_interp_horiz (const KernelVariables& kv, const int nlev, + const CRnV& hy_etai, const CRnV& x, const CRelnV& y, + const RnV& xwrk, const RelnV& ywrk, + const CRelnV& xi, const RelnV& yi) { + const auto& xbdy = xwrk; + const auto& ybdy = ywrk; + assert(hy_etai.extent_int(0) >= nlev+1); + assert(x.extent_int(0) >= nlev); + assert_eln(y, nlev); + assert(xbdy.extent_int(0) >= nlev+2); + assert_eln(ybdy, nlev+2); + assert_eln(xi, nlev); + assert_eln(yi, nlev); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_nlev = Kokkos::ThreadVectorRange(kv.team, nlev); + const auto tvr_nlevp2 = Kokkos::ThreadVectorRange(kv.team, nlev+2); + const auto f_x = [&] (const int k) { + xbdy(k) = (k == 0 ? hy_etai(0) : + k == nlev+1 ? hy_etai(nlev) : + /**/ x(k-1)); + }; + Kokkos::parallel_for(Kokkos::TeamVectorRange(kv.team, nlev+2), f_x); + kv.team_barrier(); + const auto f_y = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] (const int k) { + // Constant interp outside of the etam support. + ybdy(i,j,k) = (k == 0 ? y(i,j,0) : + k == nlev+1 ? y(i,j,nlev-1) : + /**/ y(i,j,k-1)); + }; + Kokkos::parallel_for(tvr_nlevp2, g); + }; + Kokkos::parallel_for(ttr, f_y); + kv.team_barrier(); + const auto f_linterp = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + linterp(tvr_nlev, + nlev+2, xbdy, getcolc(ybdy,i,j), + nlev, getcolc(xi,i,j), getcol(yi,i,j), + 1, "eta_interp_horiz"); + }; + Kokkos::parallel_for(ttr, f_linterp); +} + +/* Compute level pressure thickness given eta at interfaces using the following + approximation: + e = A(e) + B(e) + p(e) = A(e) p0 + B(e) ps + = e p0 + B(e) (ps - p0) + a= e p0 + I[Bi(eref)](e) (ps - p0). + Then dp = diff(p). +*/ +KOKKOS_FUNCTION void +eta_to_dp (const KernelVariables& kv, const int nlev, + const Real hy_ps0, const CRnV& hy_bi, const CRnV& hy_etai, + const CRelV& ps, const CRelnV& etai, const RelnV& wrk, + const RelnV& dp) { + const int nlevp = nlev + 1; + assert(hy_bi.extent_int(0) >= nlevp); + assert(hy_etai.extent_int(0) >= nlevp); + assert_eln(etai, nlevp); + assert_eln(wrk, nlevp); + assert_eln(dp, nlev); + const auto& bi = wrk; + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_linterp = Kokkos::ThreadVectorRange(kv.team, nlevp); + const auto f_linterp = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + linterp(tvr_linterp, + nlevp, hy_etai, hy_bi, + nlevp, getcolc(etai,i,j), getcol(bi,i,j), + 0, "eta_to_dp"); + }; + Kokkos::parallel_for(ttr, f_linterp); + kv.team_barrier(); + const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlev); + const auto f = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto dps = ps(i,j) - hy_ps0; + const auto g = [&] (const int k) { + dp(i,j,k) = ((etai(i,j,k+1) - etai(i,j,k))*hy_ps0 + + (bi(i,j,k+1) - bi(i,j,k))*dps); + }; + Kokkos::parallel_for(tvr, g); + }; + Kokkos::parallel_for(ttr, f); +} + +/* Limit eta levels so their thicknesses, deta, are bounded below by 'low'. + + This method pulls mass only from intervals k that are larger than their + reference value (deta(k) > deta_ref(k)), and only down to their reference + value. This concentrates changes to intervals that, by having a lot more mass + than usual, drive other levels negative, leaving all the other intervals + unchanged. + + This selective use of mass provides enough to fulfill the needed mass. + Inputs: + m (deta): input mass + r (deta_ref): level mass reference. + Preconditions: + (1) 0 <= low <= min r(i) + (2) 1 = sum r(i) = sum(m(i)). + Rewrite (2) as + 1 = sum_{m(i) >= r(i)} m(i) + sum_{m(i) < r(i)} m(i) + and, thus, + 0 = sum_{m(i) >= r(i)} (m(i) - r(i)) + sum_{m(i) < r(i)} (m(i) - r(i)). + Then + sum_{m(i) >= r(i)} (m(i) - r(i)) (available mass to redistribute) + = -sum_{m(i) < r(i)} (m(i) - r(i)) + >= -sum_{m(i) < lo } (m(i) - r(i)) + >= -sum_{m(i) < lo } (m(i) - lo ) (mass to fill in). + Thus, if the preconditions hold, then there's enough mass to redistribute. + */ +template +KOKKOS_FUNCTION void +deta_caas (const KernelVariables& kv, const Range& tvr_nlevp, + const CRnV& deta_ref, const Real low, const RnV& w, + const RnV& deta) { + const auto g1 = [&] (const int k, Kokkos::Real2& sums) { + Real wk; + if (deta(k) < low) { + sums.v[0] += deta(k) - low; + deta(k) = low; + wk = 0; + } else { + wk = (deta(k) > deta_ref(k) ? + deta(k) - deta_ref(k) : + 0); + } + sums.v[1] += wk; + w(k) = wk; + }; + Kokkos::Real2 sums; + Dispatch<>::parallel_reduce(kv.team, tvr_nlevp, g1, sums); + const Real wneeded = sums.v[0]; + if (wneeded == 0) return; + // Remove what is needed from the donors. + const Real wavail = sums.v[1]; + const auto g2 = [&] (const int k) { + deta(k) += wneeded*(w(k)/wavail); + }; + Kokkos::parallel_for(tvr_nlevp, g2); +} + +KOKKOS_FUNCTION void +deta_caas (const KernelVariables& kv, const int nlevp, const CRnV& deta_ref, + const Real low, const RelnV& wrk, const RelnV& deta) { + assert(deta_ref.extent_int(0) >= nlevp); + assert_eln(wrk, nlevp); + assert_eln(deta, nlevp); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlevp); + const auto f = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + deta_caas(kv, tvr, deta_ref, low, getcol(wrk,i,j), getcol(deta,i,j)); + }; + Kokkos::parallel_for(ttr, f); +} + +// Wrapper to deta_caas. On input and output, eta contains the midpoint eta +// values. On output, deta_caas has been applied, if necessary, to +// diff(eta(i,j,:)). +KOKKOS_FUNCTION void +limit_etam (const KernelVariables& kv, const int nlev, const CRnV& hy_etai, + const CRnV& deta_ref, const Real deta_tol, const RelnV& wrk1, + const RelnV& wrk2, const RelnV& eta) { + assert(hy_etai.extent_int(0) >= nlev+1); + assert(deta_ref.extent_int(0) >= nlev+1); + const auto deta = wrk2; + assert_eln(wrk1, nlev+1); + assert_eln(deta, nlev+1); + assert_eln(eta , nlev ); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr = Kokkos::ThreadVectorRange(kv.team, nlev+1); + // eta -> deta; limit deta if needed. + const auto f1 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto etaij = getcolc( eta,i,j); + const auto detaij = getcol(deta,i,j); + const auto g1 = [&] (const int k, int& nbad) { + const auto d = (k == 0 ? etaij(0) - hy_etai(0) : + k == nlev ? hy_etai(nlev) - etaij(nlev-1) : + /**/ etaij(k) - etaij(k-1)); + const bool ok = d >= deta_tol; + if (not ok) ++nbad; + detaij(k) = d; + }; + int nbad = 0; + Dispatch<>::parallel_reduce(kv.team, tvr, g1, nbad); + if (nbad == 0) { + // Signal this column is fine. + Kokkos::single(Kokkos::PerThread(kv.team), [&] () { detaij(0) = -1; }); + return; + }; + deta_caas(kv, tvr, deta_ref, deta_tol, getcol(wrk1,i,j), detaij); + }; + Kokkos::parallel_for(ttr, f1); + kv.team_barrier(); + // deta -> eta; ignore columns where limiting wasn't needed. + const auto f2 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto etaij = getcol( eta,i,j); + const auto detaij = getcol(deta,i,j); + if (detaij(0) == -1) return; + const auto g = [&] (const int k, Real& accum, const bool final) { + assert(k != 0 or accum == 0); + const Real d = k == 0 ? hy_etai(0) + detaij(0) : detaij(k); + accum += d; + if (final) etaij(k) = accum; + }; + Dispatch<>::parallel_scan(kv.team, nlev, g); + }; + Kokkos::parallel_for(ttr, f2); +} + +KOKKOS_FUNCTION void calc_ps ( + const KernelVariables& kv, const int nlev, + const Real& ps0, const Real& hyai0, + const CSelnV& dp, + const ExecViewUnmanaged& ps) +{ + assert_eln(dp, nlev); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_snlev = Kokkos::ThreadVectorRange(kv.team, nlev); + const CRelnV dps = elp2r(dp); + const auto f1 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] (int k, Real& sum) { sum += dps(i,j,k); }; + Real sum; + Dispatch<>::parallel_reduce(kv.team, tvr_snlev, g, sum); + Kokkos::single(Kokkos::PerThread(kv.team), + [&] { ps(i,j) = hyai0*ps0 + sum; }); + }; + Kokkos::parallel_for(ttr, f1); +} + +KOKKOS_FUNCTION void calc_ps ( + const KernelVariables& kv, const int nlev, + const Real& ps0, const Real& hyai0, + const Real alpha[2], const CSelnV& dp1, const CSelnV& dp2, + const ExecViewUnmanaged& ps) +{ + assert_eln(dp1, nlev); + assert_eln(dp2, nlev); + const auto ttr = Kokkos::TeamThreadRange(kv.team, NP*NP); + const auto tvr_snlev = Kokkos::ThreadVectorRange(kv.team, nlev); + const CRelnV dps[] = {elp2r(dp1), elp2r(dp2)}; + const auto f1 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + for (int t = 0; t < 2; ++t) { + const auto& dp = dps[t]; + const auto g = [&] (int k, Real& sum) { sum += dp(i,j,k); }; + Real sum; + Dispatch<>::parallel_reduce(kv.team, tvr_snlev, g, sum); + Kokkos::single(Kokkos::PerThread(kv.team), [&] { ps(t,i,j) = sum; }); + } + }; + Kokkos::parallel_for(ttr, f1); + kv.team_barrier(); + const auto f2 = [&] (const int idx) { + const int i = idx / NP, j = idx % NP; + const auto g = [&] () { + Real vals[2]; + for (int t = 0; t < 2; ++t) + vals[t] = (hyai0*ps0 + + (1 - alpha[t])*ps(0,i,j) + + /**/ alpha[t] *ps(1,i,j)); + for (int t = 0; t < 2; ++t) + ps(t,i,j) = vals[t]; + }; + Kokkos::single(Kokkos::PerThread(kv.team), g); + }; + Kokkos::parallel_for(ttr, f2); +} + +// Transform eta_dot_dpdn at interfaces to eta_dot at midpoints using the +// formula +// eta_dot = eta_dot_dpdn/(A_eta p0 + B_eta ps). +// a= eta_dot_dpdn diff(eta)/(diff(A) p0 + diff(B) ps). +KOKKOS_FUNCTION void calc_etadotmid_from_etadotdpdnint ( + const KernelVariables& kv, const int nlev, + const Real& ps0, const CSnV& hydai, const CSnV& hydbi, + const CSnV& hydetai, const CRelV& ps, const SelnV& wrk, + // in: eta_dot_dpdn at interfaces + // out: eta_dot at midpoints, final slot unused + const SelnV& ed) +{ + assert(calc_nscal(hydai.extent_int(0)) >= nlev); + assert(calc_nscal(hydbi.extent_int(0)) >= nlev); + assert(calc_nscal(hydetai.extent_int(0)) >= nlev); + assert_eln(wrk, nlev+1); + assert_eln(ed, nlev+1); + const auto& edd_mid = wrk; + { + const CRelnV edd(elp2r(ed)); + const RelnV tmp(elp2r(wrk)); + const auto f = [&] (const int i, const int j, const int k) { + tmp(i,j,k) = (edd(i,j,k) + edd(i,j,k+1))/2; + }; + cti::loop_ijk(nlev, kv, f); + } + kv.team_barrier(); + { + const auto f = [&] (const int i, const int j, const int kp) { + ed(i,j,kp) = (edd_mid(i,j,kp) + * hydetai(kp) + / (hydai(kp)*ps0 + hydbi(kp)*ps(i,j))); + }; + cti::loop_ijk(calc_npack(nlev), kv, f); + } +} + +KOKKOS_FUNCTION void calc_eta_dot_ref_mid ( + const KernelVariables& kv, const SphereOperators& sphere_ops, + const Real& ps0, const Real& hyai0, const CSNV& hybi, + const CSNV& hydai, const CSNV& hydbi, // delta ai, bi + const CSNV& hydetai, // delta etai + const Real alpha[2], + const CS2elNlev& v1, const CSelNlev& dp1, const CS2elNlev& v2, const CSelNlev& dp2, + const SelNlevp& wrk1, const SelNlevp& wrk2, const S2elNlevp& vwrk1, + // Holds interface levels as intermediate data but is midpoint data on output, + // with final slot unused. + const SelNlevp eta_dot[2]) +{ + using Kokkos::ALL; + const int nlev = NUM_PHYSICAL_LEV; + const SelNlev divdp(wrk1.data()); + const S2elNlev vdp(vwrk1.data()); + const ExecViewUnmanaged ps(cti::pack2real(wrk2)); + // Calc surface pressure for use at the end. + calc_ps(kv, nlev, + ps0, hyai0, + alpha, dp1, dp2, + ps); + kv.team_barrier(); + for (int t = 0; t < 2; ++t) { + // Compute divdp. + const auto f = [&] (const int i, const int j, const int kp) { + for (int d = 0; d < 2; ++d) + vdp(d,i,j,kp) = ((1 - alpha[t])*v1(d,i,j,kp)*dp1(i,j,kp) + + /**/ alpha[t] *v2(d,i,j,kp)*dp2(i,j,kp)); + }; + cti::loop_ijk(kv, f); + kv.team_barrier(); + sphere_ops.divergence_sphere(kv, vdp, divdp); + kv.team_barrier(); + // Compute eta_dot_dpdn at interface nodes. + const auto& edd = eta_dot[t]; + const RelNlevp edds(cti::pack2real(edd)); + const RelNlev divdps(cti::pack2real(wrk1)); + cti::calc_eta_dot_dpdn(kv, + hybi, + divdps, edd, + edds); + kv.team_barrier(); + calc_etadotmid_from_etadotdpdnint(kv, nlev, + ps0, hydai, hydbi, hydetai, + Kokkos::subview(ps,t,ALL,ALL), + wrk1, + edd); + // No team_barrier: wrk1 is protected in second iteration. + } +} + +KOKKOS_FUNCTION void calc_vel_horiz_formula_node_ref_mid ( + const KernelVariables& kv, const SphereOperators& sphere_ops, + const CSNV& hyetam, const ExecViewUnmanaged& vec_sph2cart, + // Velocities are at midpoints. Final eta_dot entry is ignored. + const Real dtsub, const CS2elNlev vsph[2], const CSelNlevp eta_dot[2], + const SelNlevp& wrk1, const S2elNlevp& vwrk1, const S2elNlevp& vwrk2, + const ExecViewUnmanaged& vnode) +{ + using Kokkos::ALL; + const S2elNlev vfsph(vwrk1.data()), vw2(vwrk2.data()); + const SelNlev w1(wrk1.data()); + const R2elNlev vfsphs(cti::pack2real(vfsph)); + const auto& vsph1 = vsph[0]; + const auto& vsph2 = vsph[1]; + { // Horizontal terms. + cti::ugradv_sphere(sphere_ops, kv, vec_sph2cart, vsph2, vsph1, w1, vw2, vfsph); + for (int d = 0; d < 2; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + vfsph(d,i,j,k) = vsph1(d,i,j,k) + vsph2(d,i,j,k) - dtsub*vfsph(d,i,j,k); + }; + cti::loop_ijk(kv, f); + } + } + kv.team_barrier(); + { // Vertical terms. + const CRNV etams(cti::cpack2real(hyetam)); + const CR2elNlev vsph1s(cti::cpack2real(vsph1)); + const CRelNlevp eds(cti::cpack2real(eta_dot[1])); + for (int d = 0; d < 2; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + Real deriv; + if (k == 0 or k+1 == NUM_PHYSICAL_LEV) { + const int k1 = k == 0 ? 0 : NUM_PHYSICAL_LEV-2; + const int k2 = k == 0 ? 1 : NUM_PHYSICAL_LEV-1; + deriv = ((vsph1s(d,i,j,k2) - vsph1s(d,i,j,k1)) / + (etams(k2) - etams(k1))); + } else { + deriv = cti::approx_derivative( + etams(k-1), etams(k), etams(k+1), + vsph1s(d,i,j,k-1), vsph1s(d,i,j,k), vsph1s(d,i,j,k+1)); + } + vfsphs(d,i,j,k) = (vfsphs(d,i,j,k) - dtsub*eds(i,j,k)*deriv)/2; + }; + cti::loop_ijk(kv, f); + } + } + { // Transform to Cartesian. + for (int d = 0; d < 3; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + vnode(k,i,j,d) = (vec_sph2cart(0,d,i,j)*vfsphs(0,i,j,k) + + vec_sph2cart(1,d,i,j)*vfsphs(1,i,j,k)); + }; + cti::loop_ijk(kv, f); + } + } +} + +KOKKOS_FUNCTION void calc_eta_dot_formula_node_ref_mid ( + const KernelVariables& kv, const SphereOperators& sphere_ops, + const CRNV& hyetai, const CSNV& hyetam, + // Velocities are at midpoints. Final eta_dot entry is ignored. + const Real dtsub, const CS2elNlev vsph[2], const CSelNlevp eta_dot[2], + const SelNlevp& wrk1, const S2elNlevp& vwrk1, + const ExecViewUnmanaged& vnode) +{ + const SelNlev ed1_vderiv(wrk1.data()); + { + const CRNV etams(cti::cpack2real(hyetam)); + const CRelNlevp ed1s(cti::cpack2real(eta_dot[0])); + const RelNlev ed1_vderiv_s(cti::pack2real(ed1_vderiv)); + const auto f = [&] (const int i, const int j, const int k) { + Real deriv; + if (k == 0 or k+1 == NUM_PHYSICAL_LEV) { + deriv = cti::approx_derivative( + k == 0 ? hyetai(0) : etams(k-1), + etams(k), + k+1 == NUM_PHYSICAL_LEV ? hyetai(NUM_PHYSICAL_LEV) : etams(k+1), + k == 0 ? 0 : ed1s(i,j,k-1), + ed1s(i,j,k), + k+1 == NUM_PHYSICAL_LEV ? 0 : ed1s(i,j,k+1)); + } else { + deriv = cti::approx_derivative( + etams(k-1), etams(k), etams(k+1), + ed1s(i,j,k-1), ed1s(i,j,k), ed1s(i,j,k+1)); + } + ed1_vderiv_s(i,j,k) = deriv; + }; + cti::loop_ijk(kv, f); + } + kv.team_barrier(); + const S2elNlev ed1_hderiv(vwrk1.data()); + sphere_ops.gradient_sphere(kv, eta_dot[0], ed1_hderiv, NUM_LEV); + { + const auto& vsph2 = vsph[1]; + const auto& ed1 = eta_dot[0]; + const auto& ed2 = eta_dot[1]; + const auto f = [&] (const int i, const int j, const int k) { + const auto v = (ed1(i,j,k) + ed2(i,j,k) + - dtsub*( vsph2(0,i,j,k)*ed1_hderiv(0,i,j,k) + + vsph2(1,i,j,k)*ed1_hderiv(1,i,j,k) + + ed2( i,j,k)*ed1_vderiv( i,j,k)))/2; + for (int s = 0; s < VECTOR_SIZE; ++s) + vnode(VECTOR_SIZE*k+s, i,j,3) = v[s]; + }; + cti::loop_ijk(kv, f); + } +} + +// Set dep_points_all to level-midpoint arrival points. +void init_dep_points (const CTI& c, const cti::DeparturePoints& dep_pts) { + const auto independent_time_steps = c.m_data.independent_time_steps; + const auto& sphere_cart = c.m_geometry.m_sphere_cart; + const CRNV hyetam(cti::cpack2real(c.m_hvcoord.etam)); + assert(not independent_time_steps or dep_pts.extent_int(4) == 4); + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < 3; ++d) + dep_pts(ie,lev,i,j,d) = sphere_cart(ie,i,j,d); + if (independent_time_steps) + dep_pts(ie,lev,i,j,3) = hyetam(lev); + }; + c.launch_ie_physlev_ij(f); +} + +void update_dep_points ( + const CTI& c, const Real dtsub, const cti::DeparturePoints& vdep, + const cti::DeparturePoints& dep_pts) +{ + const auto independent_time_steps = c.m_data.independent_time_steps; + const auto is_sphere = c.m_data.geometry_type == 0; + const auto scale_factor = c.m_geometry.m_scale_factor; + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + // Update horizontal position. + Real p[3]; + for (int d = 0; d < 3; ++d) + p[d] = dep_pts(ie,lev,i,j,d) - dtsub*vdep(ie,lev,i,j,d)/scale_factor; + if (is_sphere) { + const auto norm = std::sqrt(square(p[0]) + square(p[1]) + square(p[2])); + for (int d = 0; d < 3; ++d) + p[d] /= norm; + } + for (int d = 0; d < 3; ++d) + dep_pts(ie,lev,i,j,d) = p[d]; + if (independent_time_steps) { + // Update vertical position. + dep_pts(ie,lev,i,j,3) -= dtsub*vdep(ie,lev,i,j,3); + } + }; + c.launch_ie_physlev_ij(f); +} + +/* Evaluate a formula to provide an estimate of nodal velocities that are use to + create a 2nd-order update to the trajectory. The fundamental formula for the + update in position p from arrival point p1 to departure point p0 is + p0 = p1 - dt/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). + Here we compute the velocity estimate at the nodes: + 1/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). +*/ +void calc_nodal_velocities ( + const CTI& c, const Real dtsub, const Real halpha[2], + const cti::CVSlot& v1, const cti::CDpSlot& dp1, const int idx1, + const cti::CVSlot& v2, const cti::CDpSlot& dp2, const int idx2, + const cti::DeparturePoints& vnode) +{ + using Kokkos::ALL; + const auto& d = c.m_data; + const auto& h = c.m_hvcoord; + const auto& sphere_ops = c.m_sphere_ops; + const auto& vec_sph2cart = c.m_geometry.m_vec_sph2cart; + const bool independent_time_steps = d.independent_time_steps; + const auto ps0 = h.ps0; + const auto hyai0 = h.hybrid_ai0; + const auto& hybi = h.hybrid_bi_packed; + const auto& hydai = h.hybrid_ai_delta; + const auto& hydbi = h.hybrid_bi_delta; + const auto& hyetam = h.etam; + const auto& hyetai = h.etai; + const auto& hydetai = d.hydetai; + const auto& buf1a = d.buf1o[0]; const auto& buf1b = d.buf1o[1]; + const auto& buf1c = d.buf1o[2]; const auto& buf1d = d.buf1o[3]; + const auto& buf2a = d.buf2 [0]; const auto& buf2b = d.buf2 [1]; + const auto& buf2c = d.buf2 [2]; const auto& buf2d = d.buf2 [3]; + const auto alpha0 = halpha[0], alpha1 = halpha[1]; + const auto f = KOKKOS_LAMBDA (const cti::MT& team) { + KernelVariables kv(team); + const int ie = kv.ie; + const auto wrk1 = Homme::subview(buf1a, kv.team_idx); + const auto wrk2 = Homme::subview(buf1b, kv.team_idx); + const auto vwrk1 = Homme::subview(buf2a, kv.team_idx); + const auto vwrk2 = Homme::subview(buf2b, kv.team_idx); + const auto v1_ie = Homme::subview(v1, ie, idx1); + const auto v2_ie = Homme::subview(v2, ie, idx2); + const Real alpha[] = {alpha0, alpha1}; + CSelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), + Homme::subview(buf1d, kv.team_idx)}; + { + SelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), + Homme::subview(buf1d, kv.team_idx)}; + if (independent_time_steps) { + const auto dp1_ie = Homme::subview(dp1, ie, idx1); + const auto dp2_ie = Homme::subview(dp2, ie, idx2); + calc_eta_dot_ref_mid(kv, sphere_ops, + ps0, hyai0, hybi, hydai, hydbi, hydetai, + alpha, v1_ie, dp1_ie, v2_ie, dp2_ie, + wrk1, wrk2, vwrk1, + eta_dot); + } else { + for (int t = 0; t < 2; ++t) { + const auto& ed = eta_dot[t]; + const auto f = [&] (const int i, const int j, const int k) { + ed(i,j,k) = 0; + }; + cti::loop_ijk(kv, f); + } + } + } + // Collect the horizontal nodal velocities. v1,2 are on Eulerian levels. v1 + // is from time t1 < t2. + auto* vm1 = Homme::subview(buf2c, kv.team_idx).data(); + auto* vm2 = Homme::subview(buf2d, kv.team_idx).data(); + CS2elNlev vsph[] = {CS2elNlev(vm1), CS2elNlev(vm2)}; + { + S2elNlev vsph[] = {S2elNlev(vm1), S2elNlev(vm2)}; + for (int t = 0; t < 2; ++t) { + const auto& v = vsph[t]; + for (int d = 0; d < 2; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + v(d,i,j,k) = ((1 - alpha[t])*v1_ie(d,i,j,k) + + /**/ alpha[t] *v2_ie(d,i,j,k)); + }; + cti::loop_ijk(kv, f); + } + } + } + kv.team_barrier(); + // Given the vertical and horizontal nodal velocities at time endpoints, + // evaluate the velocity estimate formula, providing the final horizontal + // and vertical velocity estimates at midpoint nodes. + const auto vnode_ie = Kokkos::subview(vnode, ie, ALL,ALL,ALL,ALL); + const auto vec_sph2cart_ie = Homme::subview(vec_sph2cart, ie); + calc_vel_horiz_formula_node_ref_mid(kv, sphere_ops, + hyetam, vec_sph2cart_ie, + dtsub, vsph, eta_dot, + wrk1, vwrk1, vwrk2, + vnode_ie); + if (independent_time_steps) { + kv.team_barrier(); + calc_eta_dot_formula_node_ref_mid(kv, sphere_ops, + hyetai, hyetam, + dtsub, vsph, eta_dot, + wrk1, vwrk1, + vnode_ie); + } + }; + Kokkos::parallel_for(c.m_tp_ne, f); +} + +// Determine the departure points corresponding to the vertically Lagragnian +// grid's arrival midpoints, where the floating levels are those that evolve +// over the course of the full tracer time step. Also compute divdp, which holds +// the floating levels' dp values for later use in vertical remap. +void interp_departure_points_to_floating_level_midpoints (const CTI& c, const int np1) { + using Kokkos::ALL; + const int nlev = NUM_PHYSICAL_LEV, nlevp = nlev+1; + const auto is_sphere = c.m_data.geometry_type == 0; + const auto& d = c.m_data; + const auto& h = c.m_hvcoord; + const auto ps0 = h.ps0; + const auto hyai0 = h.hybrid_ai0; + const auto& hybi = h.hybrid_bi; + const auto& hyetai = h.etai; + const CRNV hyetam(cti::cpack2real(h.etam)); + const auto& detam_ref = d.hydetam_ref; + const auto deta_tol = d.deta_tol; + const auto& dep_pts = d.dep_pts; + const auto& dp3d = c.m_state.m_dp3d; + const auto& buf1a = d.buf1e[0]; const auto& buf1b = d.buf1e[1]; + const auto& buf1c = d.buf1e[2]; const auto& buf1d = d.buf1e[3]; + const auto& buf2a = d.buf2[0]; + const auto f = KOKKOS_LAMBDA (const cti::MT& team) { + KernelVariables kv(team); + const int ie = kv.ie; + const auto wrk1 = Homme::subview(buf1a, kv.team_idx); + const auto wrk2 = Homme::subview(buf1b, kv.team_idx); + const auto wrk3 = Homme::subview(buf1c, kv.team_idx); + const auto wrk4 = Homme::subview(buf1d, kv.team_idx); + const auto vwrk = Homme::subview(buf2a, kv.team_idx); + // Reconstruct Lagrangian levels at t1 on arrival column: + // eta_arr_int = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_int) + const auto etam = p2rel(wrk3.data(), nlev); + const auto f = [&] (const int i, const int j, const int k) { + etam(i,j,k) = dep_pts(ie,k,i,j,3); + }; + cti::loop_ijk(kv, f); + kv.team_barrier(); + limit_etam(kv, nlev, + hyetai, detam_ref, deta_tol, + p2rel(wrk1.data(), nlevp), p2rel(wrk2.data(), nlevp), + etam); + kv.team_barrier(); + { + // Compute eta_arr_int. + const auto etai_arr = p2rel(wrk4.data(), nlevp); + eta_interp_eta(kv, nlev, + hyetai, + etam, hyetam, + p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), + nlevp-2, hyetai, etai_arr, 1); + const auto f = [&] (const int i, const int j) { + etai_arr(i,j,0) = hyetai(0); + etai_arr(i,j,nlev) = hyetai(nlev); + }; + c.loop_ij(kv, f); + // Compute divdp. + const ExecViewUnmanaged ps(cti::pack2real(vwrk)); + calc_ps(kv, nlev, + ps0, hyai0, + Homme::subview(dp3d, ie, np1), + ps); + kv.team_barrier(); + eta_to_dp(kv, nlev, + ps0, hybi, hyetai, + ps, etai_arr, + p2rel(wrk2.data(), nlev+1), + RelnV(cti::pack2real(Homme::subview(c.m_derived.m_divdp, ie)), + NP, NP, NUM_LEV*VECTOR_SIZE)); + kv.team_barrier(); + } + // Compute Lagrangian level midpoints at t1 on arrival column: + // eta_arr_mid = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_mid) + const auto etam_arr = p2rel(wrk4.data(), nlev); + eta_interp_eta(kv, nlev, + hyetai, + etam, hyetam, + p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), + nlev, hyetam, etam_arr); + kv.team_barrier(); + // Compute departure horizontal points corresponding to arrival + // Lagrangian level midpoints: + // p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid) + { + const RelnV dpts_in(cti::pack2real(vwrk), NP, NP, nlev); + const RelnV dpts_out(dpts_in.data() + NP*NP*nlev, NP, NP, nlev); + for (int d = 0; d < 3; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + dpts_in(i,j,k) = dep_pts(ie,k,i,j,d); + }; + c.loop_ijk(kv, f); + kv.team_barrier(); + eta_interp_horiz(kv, nlev, + hyetai, + hyetam, dpts_in, + RnV(cti::pack2real(wrk2), nlev+2), p2rel(wrk1.data(), nlev+2), + etam_arr, dpts_out); + kv.team_barrier(); + const auto g = [&] (const int i, const int j, const int k) { + dep_pts(ie,k,i,j,d) = dpts_out(i,j,k); + }; + c.loop_ijk(kv, g); + kv.team_barrier(); + } + if (is_sphere) { + // Normalize. + const auto h = [&] (const int i, const int j, const int k) { + Real norm = 0; + for (int d = 0; d < 3; ++d) norm += square(dep_pts(ie,k,i,j,d)); + norm = std::sqrt(norm); + for (int d = 0; d < 3; ++d) dep_pts(ie,k,i,j,d) /= norm; + }; + c.loop_ijk(kv, h); + } + } + }; + Kokkos::parallel_for(c.m_tp_ne, f); +} + +void dss_vnode (const CTI& c, const cti::DeparturePoints& vnode) { + const int ndim = c.m_data.independent_time_steps ? 4 : 3; + const auto& spheremp = c.m_geometry.m_spheremp; + const auto& rspheremp = c.m_geometry.m_rspheremp; + const auto& vp = c.m_tracers.qtens_biharmonic; + const ExecViewUnmanaged + v(cti::pack2real(vp), vp.extent_int(0), vp.extent_int(1)); + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < ndim; ++d) + v(ie,d,i,j,lev) = vnode(ie,lev,i,j,d)*spheremp(ie,i,j)*rspheremp(ie,i,j); + }; + c.launch_ie_physlev_ij(f); + Kokkos::fence(); + const auto be = c.m_v_dss_be[c.m_data.independent_time_steps ? 1 : 0]; + be->exchange(); + Kokkos::fence(); + const auto g = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < ndim; ++d) + vnode(ie,lev,i,j,d) = v(ie,d,i,j,lev); + }; + c.launch_ie_physlev_ij(g); +} + +} // namespace anon +} // namespace Homme + +#endif +#endif diff --git a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryTests.cpp b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryTests.cpp new file mode 100644 index 00000000000..da8fbab4d91 --- /dev/null +++ b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryTests.cpp @@ -0,0 +1,839 @@ +/******************************************************************************** + * HOMMEXX 1.0: Copyright of Sandia Corporation + * This software is released under the BSD license + * See the file 'COPYRIGHT' in the HOMMEXX/src/share/cxx directory + *******************************************************************************/ + +#include "Config.hpp" +#ifdef HOMME_ENABLE_COMPOSE + +#include "ComposeTransportImplEnhancedTrajectoryImpl.hpp" + +#include + +namespace Homme { +namespace { // anon + +Kokkos::TeamPolicy +get_test_team_policy (const int nelem, const int nlev, const int ncol=NP*NP) { + ThreadPreferences tp; + tp.max_threads_usable = ncol; + tp.max_vectors_usable = nlev; + tp.prefer_threads = true; + tp.prefer_larger_team = true; + return Homme::get_default_team_policy(nelem, tp); +} + +struct TestData { + std::mt19937_64 engine; + static const Real eps; + const ComposeTransportImpl& cti; + + TestData (const CTI& cti_, const int seed = 0) + : cti(cti_), engine(seed == 0 ? std::random_device()() : seed) + {} + + Real urand (const Real lo = 0, const Real hi = 1) { + std::uniform_real_distribution urb(lo, hi); + return urb(engine); + } +}; + +// Data to deal with views of packs easily in tests. +struct ColData { + int npack; + ExecView d; + ExecView::HostMirror h; + ExecView::HostMirror r; + + ColData (const std::string& name, const int nlev) { + npack = calc_npack(nlev); + d = decltype(d)(name, npack); + h = Kokkos::create_mirror_view(d); + r = decltype(r)(cti::pack2real(h), calc_nscal(npack)); + } + + void h2d () { Kokkos::deep_copy(d, h); } +}; + +struct ElData { + int npack; + ExecView d; + ExecView::HostMirror h; + ExecView::HostMirror r; + + ElData (const std::string& name, const int nlev) { + npack = calc_npack(nlev); + d = decltype(d)(name, NP, NP, npack); + h = Kokkos::create_mirror_view(d); + r = decltype(r)(cti::pack2real(h), NP, NP, calc_nscal(npack)); + } + + void d2h () { Kokkos::deep_copy(h, d); } + void h2d () { Kokkos::deep_copy(d, h); } +}; + +const Real TestData::eps = std::numeric_limits::epsilon(); + +int test_find_support (TestData&) { + int ne = 0; + const int n = 97; + std::vector x(n); + for (int i = 0; i < n; ++i) x[i] = -11.7 + (i*i)/n; + const int ntest = 10000; + for (int i = 0; i < ntest; ++i) { + const Real xi = x[0] + (Real(i)/ntest)*(x[n-1] - x[0]); + for (int x_idx : {0, 1, n/3, n/2, n-2, n-1}) { + const int sup = find_support(n, x.data(), x_idx, xi); + if (sup > n-2) ++ne; + else if (xi < x[sup] or xi > x[sup+1]) ++ne; + } + } + return ne; +} + +void todev (const std::vector& h, const RnV& d) { + assert(h.size() <= d.size()); + const auto m = Kokkos::create_mirror_view(d); + for (size_t i = 0; i < h.size(); ++i) m(i) = h[i]; + Kokkos::deep_copy(d, m); +} + +void fillcols (const int n, const Real* const h, const RelnV::HostMirror& a) { + assert(n <= a.extent_int(2)); + for (int i = 0; i < a.extent_int(0); ++i) + for (int j = 0; j < a.extent_int(1); ++j) + for (size_t k = 0; k < n; ++k) + a(i,j,k) = h[k]; +} + +void todev (const int n, const Real* const h, const RelnV& d) { + const auto m = Kokkos::create_mirror_view(d); + fillcols(n, h, m) ; + Kokkos::deep_copy(d, m); +} + +void todev (const std::vector& h, const RelnV& d) { + todev(h.size(), h.data(), d); +} + +void tohost (const ExecView& d, std::vector& h) { + assert(h.size() <= d.size()); + const auto m = Kokkos::create_mirror_view(d); + Kokkos::deep_copy(m, d); + for (size_t i = 0; i < h.size(); ++i) h[i] = m(i); +} + +void run_linterp (const std::vector& x, const std::vector& y, + std::vector& xi, std::vector& yi) { + const auto n = x.size(), ni = xi.size(); + assert(y.size() == n); assert(yi.size() == ni); + // input -> device (test different sizes >= n) + ExecView xv("xv", n), yv("yv", n+1), xiv("xiv", ni+2), yiv("yiv", ni+3); + todev(x, xv); + todev(y, yv); + todev(xi, xiv); + // call linterp + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + const auto range = Kokkos::TeamVectorRange(team, ni); + linterp(range, n, xv, yv, ni, xiv, yiv, 0, "unittest"); + }; + Homme::ThreadPreferences tp; + tp.max_threads_usable = 1; + tp.max_vectors_usable = ni; + tp.prefer_threads = false; + tp.prefer_larger_team = true; + const auto policy = get_test_team_policy(1, n); + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + // output -> host + tohost(yiv, yi); +} + +void make_random_sorted (TestData& td, const int n, const Real xlo, const Real xhi, + std::vector& x) { + assert(n >= 2); + x.resize(n); + x[0] = xlo; + for (int i = 1; i < n-1; ++i) x[i] = td.urand(xlo, xhi); + x[n-1] = xhi; + std::sort(x.begin(), x.end()); +} + +int test_linterp (TestData& td) { + int nerr = 0; + { // xi == x => yi == y. + int ne = 0; + const int n = 30; + std::vector x(n), y(n), xi(n), yi(n); + make_random_sorted(td, n, -0.1, 1.2, x); + make_random_sorted(td, n, -3, -1, y); + for (int i = 0; i < n; ++i) xi[i] = x[i]; + run_linterp(x, y, xi, yi); + for (int i = 0; i < n; ++i) + if (yi[i] != y[i]) + ++ne; + nerr += ne; + } + { // Reconstruct a linear function exactly. + int ne = 0; + const int n = 56, ni = n-3; + const Real xlo = -1.2, xhi = 3.1; + const auto f = [&] (const Real x) { return -0.7 + 1.3*x; }; + std::vector x(n), y(n), xi(ni), yi(ni); + for (int trial = 0; trial < 4; ++trial) { + make_random_sorted(td, n, xlo, xhi, x); + make_random_sorted(td, ni, + xlo + (trial == 1 or trial == 3 ? 0.1 : 0), + xhi + (trial == 2 or trial == 3 ? -0.5 : 0), + xi); + for (int i = 0; i < n; ++i) y[i] = f(x[i]); + run_linterp(x, y, xi, yi); + for (int i = 0; i < ni; ++i) + if (std::abs(yi[i] - f(xi[i])) > 100*td.eps) + ++ne; + } + nerr += ne; + } + return nerr; +} + +int make_random_deta (TestData& td, const Real deta_tol, const int nlev, + Real* const deta) { + int nerr = 0; + Real sum = 0; + for (int k = 0; k < nlev; ++k) { + deta[k] = td.urand(0, 1) + 0.1; + sum += deta[k]; + } + for (int k = 0; k < nlev; ++k) { + deta[k] /= sum; + if (deta[k] < deta_tol) ++nerr; + } + return nerr; +} + +int make_random_deta (TestData& td, const Real deta_tol, const RnV& deta) { + int nerr = 0; + const int nlev = deta.extent_int(0); + const auto m = Kokkos::create_mirror_view(deta); + nerr = make_random_deta(td, deta_tol, nlev, &m(0)); + Kokkos::deep_copy(deta, m); + return nerr; +} + +int make_random_deta (TestData& td, const Real deta_tol, const RelnV& deta) { + int nerr = 0; + const int nlev = deta.extent_int(2); + const auto m = Kokkos::create_mirror_view(deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + nerr += make_random_deta(td, deta_tol, nlev, &m(i,j,0)); + Kokkos::deep_copy(deta, m); + return nerr; +} + +int test_deta_caas (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {15, 128, 161}) { + const Real deta_tol = 10*td.eps/nlev; + const auto err = [&] (const char* lbl) { + ++nerr; + printf("test_deta_caa nlev %d: %s\n", nlev, lbl); + }; + + // nlev+1 deltas: deta = diff([0, etam, 1]) + ExecView deta_ref("deta_ref", nlev+1); + ExecView deta("deta",NP,NP,nlev+1), wrk("wrk",NP,NP,nlev+1); + nerr += make_random_deta(td, deta_tol, deta_ref); + + const auto policy = get_test_team_policy(1, nlev); + const auto run = [&] (const RelnV& deta) { + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + deta_caas(kv, nlev+1, deta_ref, deta_tol, wrk, deta); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + }; + + { // Test that if all is OK, the input is not altered. + nerr += make_random_deta(td, deta_tol, deta); + ExecView::HostMirror copy("copy",NP,NP,nlev+1); + Kokkos::deep_copy(copy, deta); + run(deta); + const auto m = cti::cmvdc(deta); + bool diff = false; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k <= nlev; ++k) + if (m(i,j,k) != copy(i,j,k)) + diff = true; + if (diff) err("input not altered"); + } + + { // Modify one etam and test that only adjacent intervals change beyond eps. + // nlev midpoints + ExecView etam_ref("etam_ref",nlev); + const auto her = Kokkos::create_mirror_view(etam_ref); + const auto hder = cti::cmvdc(deta_ref); + { + her(0) = hder(0); + for (int k = 1; k < nlev; ++k) + her(k) = her(k-1) + hder(k); + Kokkos::deep_copy(etam_ref, her); + } + std::vector etam(nlev); + const auto hde = Kokkos::create_mirror_view(deta); + const auto get_idx = [&] (const int i, const int j) { + const int idx = static_cast(0.15*nlev); + return std::max(1, std::min(nlev-2, idx+NP*i+j)); + }; + for (int trial = 0; trial < 2; ++trial) { + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + for (int k = 0; k < nlev; ++k) etam[k] = her(k); + // Perturb one level. + const int idx = get_idx(i,j); + etam[idx] += trial == 0 ? 1.1 : -13.1; + hde(i,j,0) = etam[0]; + for (int k = 1; k < nlev; ++k) hde(i,j,k) = etam[k] - etam[k-1]; + hde(i,j,nlev) = 1 - etam[nlev-1]; + // Make sure we have a meaningful test. + Real minval = 1; + for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); + if (minval >= deta_tol) err("meaningful test"); + } + Kokkos::deep_copy(deta, hde); + run(deta); + Kokkos::deep_copy(hde, deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + const int idx = get_idx(i,j); + // Min val should be deta_tol. + Real minval = 1; + for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); + if (minval != deta_tol) err("min val"); + // Sum of levels should be 1. + Real sum = 0; + for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); + if (std::abs(sum - 1) > tol) err("sum 1"); + // Only two deltas should be affected. + Real maxdiff = 0; + for (int k = 0; k <= nlev; ++k) { + const auto diff = std::abs(hde(i,j,k) - hder(k)); + if (k == idx or k == idx+1) { + if (diff <= deta_tol) err("2 deltas a"); + } else { + maxdiff = std::max(maxdiff, diff); + } + } + if (maxdiff > tol) err("2 deltas b"); + } + } + } + + { // Test generally (and highly) perturbed levels. + const auto hde = Kokkos::create_mirror_view(deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + Real sum = 0; + for (int k = 0; k <= nlev; ++k) { + hde(i,j,k) = td.urand(-0.5, 0.5); + sum += hde(i,j,k); + } + // Make the column sum to 0.2 for safety in the next step. + const Real colsum = 0.2; + for (int k = 0; k <= nlev; ++k) hde(i,j,k) += (colsum - sum)/(nlev+1); + for (int k = 0; k <= nlev; ++k) hde(i,j,k) /= colsum; + sum = 0; + for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); + if (std::abs(sum - 1) > 10*tol) err("general sum 1"); + } + Kokkos::deep_copy(deta, hde); + run(deta); + Kokkos::deep_copy(hde, deta); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + Real sum = 0, minval = 1; + for (int k = 0; k <= nlev; ++k) sum += hde(i,j,k); + for (int k = 0; k <= nlev; ++k) minval = std::min(minval, hde(i,j,k)); + if (std::abs(sum - 1) > 1e3*td.eps) ++nerr; + if (minval != deta_tol) err("general minval"); + } + } + } + + return nerr; +} + +struct HybridLevels { + Real ps0, a_eta, b_eta; + std::vector ai, dai, bi, dbi, am, bm, etai, detai, etam, detam; +}; + +// Follow DCMIP2012 3D tracer transport specification for a, b, eta. +void fill (HybridLevels& h, const int n) { + h.ai.resize(n+1); h.bi.resize(n+1); + h.am.resize(n ); h.bm.resize(n ); + h.etai.resize(n+1); h.etam.resize(n); + + const auto Rd = PhysicalConstants::Rgas; + const auto T0 = 300; // K + const auto p0 = PhysicalConstants::p0; + const auto g = PhysicalConstants::g; + const Real ztop = 12e3; // m + + h.ps0 = p0; + + const auto calc_pressure = [&] (const Real z) { + return p0*std::exp(-g*z/(Rd*T0)); + }; + + const Real eta_top = calc_pressure(ztop)/p0; + assert(eta_top > 0); + for (int i = 0; i <= n; ++i) { + const auto z = (Real(n - i)/n)*ztop; + h.etai[i] = calc_pressure(z)/p0; + h.bi[i] = i == 0 ? 0 : (h.etai[i] - eta_top)/(1 - eta_top); + h.ai[i] = h.etai[i] - h.bi[i]; + assert(i == 0 or h.etai[i] > h.etai[i-1]); + } + assert(h.bi [0] == 0); // Real(n - i)/n is exactly 1, so exact = holds + assert(h.bi [n] == 1); // exp(0) is exactly 0, so exact = holds + assert(h.etai[n] == 1); // same + // b = (eta - eta_top)/(1 - eta_top) => b_eta = 1/(1 - eta_top) + // a = eta - b => a_eta = 1 - b_eta = -eta_top/(1 - eta_top) + // p_eta = a_eta p0 + b_eta ps + h.b_eta = 1/(1 - eta_top); + h.a_eta = 1 - h.b_eta; + + const auto tomid = [&] (const std::vector& in, std::vector& mi) { + for (int i = 0; i < n; ++i) mi[i] = (in[i] + in[i+1])/2; + }; + tomid(h.ai, h.am); + tomid(h.bi, h.bm); + tomid(h.etai, h.etam); + + const auto diff = [&] (const std::vector& ai, std::vector& dai) { + dai.resize(n); + for (int i = 0; i < n; ++i) dai[i] = ai[i+1] - ai[i]; + }; + diff(h.ai, h.dai); + diff(h.bi, h.dbi); + diff(h.etai, h.detai); + + h.detam.resize(n+1); + h.detam[0] = h.etam[0] - h.etai[0]; + for (int i = 1; i < n; ++i) h.detam[i] = h.etam[i] - h.etam[i-1]; + h.detam[n] = h.etai[n] - h.etam[n-1]; +} + +int test_limit_etam (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {143, 128, 81}) { + const Real deta_tol = 1e5*td.eps/nlev; + + ExecView hy_etai("hy_etai",nlev+1), detam("detam",nlev+1); + ExecView wrk1("wrk1",NP,NP,nlev+1), wrk2("wrk2",NP,NP,nlev+1); + ExecView etam("etam",NP,NP,nlev); + + HybridLevels h; + fill(h, nlev); + todev(h.etai, hy_etai); + todev(h.detam, detam); + + const auto he = Kokkos::create_mirror_view(etam); + + const auto policy = get_test_team_policy(1, nlev); + const auto run = [&] () { + Kokkos::deep_copy(etam, he); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + limit_etam(kv, nlev, hy_etai, detam, deta_tol, wrk1, wrk2, etam); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + Kokkos::deep_copy(he, etam); + }; + + fillcols(h.etam.size(), h.etam.data(), he); + // Col 0 should be untouched. Cols 1 and 2 should have very specific changes. + const int col1_idx = static_cast(0.25*nlev); + he(0,1,col1_idx) += 0.3; + const int col2_idx = static_cast(0.8*nlev); + he(0,2,col2_idx) -= 5.3; + // The rest of the columns get wild changes. + for (int idx = 3; idx < NP*NP; ++idx) { + const int i = idx / NP, j = idx % NP; + for (int k = 0; k < nlev; ++k) + he(i,j,k) += td.urand(-1, 1)*(h.etai[k+1] - h.etai[k]); + } + run(); + bool ok = true; + for (int k = 0; k < nlev; ++k) + if (he(0,0,k) != h.etam[k]) ok = false; + for (int k = 0; k < nlev; ++k) { + if (k == col1_idx) continue; + if (std::abs(he(0,1,k) - h.etam[k]) > tol) ok = false; + } + for (int k = 0; k < nlev; ++k) { + if (k == col2_idx) continue; + if (std::abs(he(0,2,k) - h.etam[k]) > tol) ok = false; + } + Real mingap = 1; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + mingap = std::min(mingap, he(i,j,0) - h.etai[0]); + for (int k = 1; k < nlev; ++k) + mingap = std::min(mingap, he(i,j,k) - he(i,j,k-1)); + mingap = std::min(mingap, h.etai[nlev] - he(i,j,nlev-1)); + } + // Test minimum level delta, with room for numerical error. + if (mingap < 0.8*deta_tol) ok = false; + if (not ok) ++nerr; + } + + return nerr; +} + +int test_eta_interp (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {15, 128, 161}) { + HybridLevels h; + fill(h, nlev); + + ExecView hy_etai("hy_etai",nlev+1); + ExecView x("x",NP,NP,nlev), y("y",NP,NP,nlev); + ExecView xi("xi",NP,NP,nlev+1), yi("yi",NP,NP,nlev+1); + ExecView xwrk("xwrk",NP,NP,nlev+2), ywrk("ywrk",NP,NP,nlev+2); + + todev(h.etai, hy_etai); + + const auto xh = Kokkos::create_mirror_view(x ); + const auto yh = Kokkos::create_mirror_view(y ); + const auto xih = Kokkos::create_mirror_view(xi); + const auto yih = Kokkos::create_mirror_view(yi); + + const auto policy = get_test_team_policy(1, nlev); + const auto run_eta = [&] (const int ni) { + Kokkos::deep_copy(x, xh); Kokkos::deep_copy(y, yh); + Kokkos::deep_copy(xi, xih); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + eta_interp_eta(kv, nlev, hy_etai, + x, getcolc(y,0,0), + xwrk, getcol(ywrk,0,0), + ni, getcolc(xi,0,0), yi); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + Kokkos::deep_copy(yih, yi); + }; + const auto run_horiz = [&] () { + Kokkos::deep_copy(x, xh); Kokkos::deep_copy(y, yh); + Kokkos::deep_copy(xi, xih); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + eta_interp_horiz(kv, nlev, hy_etai, + getcolc(x,0,0), y, + getcol(xwrk,0,0), ywrk, + xi, yi); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + Kokkos::deep_copy(yih, yi); + }; + + std::vector v; + const Real d = 1e-6, vlo = h.etai[0]+d, vhi = h.etai[nlev]-d; + + for (const int ni : {int(0.7*nlev), nlev-1, nlev, nlev+1}) { + make_random_sorted(td, nlev, vlo, vhi, v); + fillcols(nlev, v.data(), xh); + fillcols(nlev, v.data(), yh); + make_random_sorted(td, ni, vlo, vhi, v); + fillcols(ni, v.data(), xih); + run_eta(ni); + bool ok = true; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < ni; ++k) + if (std::abs(yih(i,j,k) - xih(i,j,k)) > tol) + ok = false; + if (not ok) ++nerr; + } + + { // Test exact interp of line in the interior, const interp near the bdys. + make_random_sorted(td, nlev, vlo+0.05, vhi-0.1, v); + fillcols(nlev, v.data(), xh); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + for (int k = 0; k < nlev; ++k) + yh(i,j,k) = i*xh(0,0,k) - j; + make_random_sorted(td, nlev, vlo, vhi, v); + for (int k = 0; k < nlev; ++k) + xih(i,j,k) = v[k]; + } + run_horiz(); + bool ok = true; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) { + if (xih(i,j,k) < xh(0,0,0)) { + if (std::abs(yih(i,j,k) - yih(i,j,0)) > tol) + ok = false; + } else if (xih(i,j,k) > xh(0,0,nlev-1)) { + if (std::abs(yih(i,j,k) - yih(i,j,nlev-1)) > tol) + ok = false; + } else { + if (std::abs(yih(i,j,k) - (i*xih(i,j,k) - j)) > tol) + ok = false; + } + } + if (not ok) ++nerr; + } + } + + return nerr; +} + +int test_eta_to_dp (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {143, 128, 81}) { + const auto err = [&] (const char* lbl) { + ++nerr; + printf("test_eta_to_dp nlev %d: %s\n", nlev, lbl); + }; + + HybridLevels h; + fill(h, nlev); + + ExecView hy_bi("hy_bi",nlev+1), hy_etai("hy_etai",nlev+1); + ExecView etai("etai",NP,NP,nlev+1), wrk("wrk",NP,NP,nlev+1); + ExecView dp("dp",NP,NP,nlev); + ExecView ps("ps"); + const Real hy_ps0 = h.ps0; + + todev(h.bi, hy_bi); + todev(h.etai, hy_etai); + + const auto psm = Kokkos::create_mirror_view(ps); + HostView dp1("dp1",NP,NP,nlev); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + psm(i,j) = (1 + 0.1*td.urand(-1, 1))*h.ps0; + Kokkos::deep_copy(ps, psm); + + const auto policy = get_test_team_policy(1, nlev); + const auto run = [&] () { + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + eta_to_dp(kv, nlev, hy_ps0, hy_bi, hy_etai, ps, etai, wrk, dp); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + }; + + { // Test that for etai_ref we get the same as the usual formula. + todev(h.etai, etai); + HostView dp1("dp1",NP,NP,nlev); + Real dp1_max = 0; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) { + dp1(i,j,k) = ((h.ai[k+1] - h.ai[k])*h.ps0 + + (h.bi[k+1] - h.bi[k])*psm(i,j)); + dp1_max = std::max(dp1_max, std::abs(dp1(i,j,k))); + } + run(); + const auto dph = cti::cmvdc(dp); + Real err_max = 0; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) + err_max = std::max(err_max, std::abs(dph(i,j,k) - dp1(i,j,k))); + if (err_max > tol*dp1_max) err("t1"); + } + + { // Test that sum(dp) = ps for random input etai. + std::vector etai_r; + make_random_sorted(td, nlev+1, h.etai[0], h.etai[nlev], etai_r); + todev(etai_r, etai); + run(); + const auto dph1 = cti::cmvdc(dp); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + Real ps = h.ai[0]*h.ps0; + for (int k = 0; k < nlev; ++k) + ps += dph1(i,j,k); + if (std::abs(ps - psm(i,j)) > tol*psm(i,j)) err("t2"); + } + // Test that values on input don't affect solution. + Kokkos::deep_copy(wrk, 0); + Kokkos::deep_copy(dp, 0); + run(); + const auto dph2 = cti::cmvdc(dp); + bool alleq = true; + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) + if (dph2(i,j,k) != dph1(i,j,k)) + alleq = false; + if (not alleq) err("t3"); + } + } + + return nerr; +} + +int test_calc_ps (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {15, 128, 161}) { + HybridLevels h; + fill(h, nlev); + const auto ps0 = h.ps0, hyai0 = h.ai[0]; + + ElData dp1("dp1", nlev), dp2("dp2", nlev); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) + for (int k = 0; k < nlev; ++k) { + dp1.r(i,j,k) = td.urand(0, 1000); + dp2.r(i,j,k) = td.urand(0, 1000); + } + dp1.h2d(); + dp2.h2d(); + + const Real alpha[] = {td.urand(0,1), td.urand(0,1)}; + + ExecView ps("ps"); + ExecView ps2("ps2"); + const auto policy = get_test_team_policy(1, nlev); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + calc_ps(kv, nlev, ps0, hyai0, alpha, dp1.d, dp2.d, ps2); + calc_ps(kv, nlev, ps0, hyai0, dp1.d, ps); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + + const auto ps_h = cti::cmvdc(ps); + const auto ps2_h = cti::cmvdc(ps2); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + { + Real ps = h.ai[0]*h.ps0; + for (int k = 0; k < nlev; ++k) + ps += dp1.r(i,j,k); + if (std::abs(ps_h(i,j) - ps) > tol*ps) ++nerr; + } + for (int t = 0; t < 2; ++t) { + Real ps = h.ai[0]*h.ps0; + for (int k = 0; k < nlev; ++k) + ps += (1 - alpha[t])*dp1.r(i,j,k) + alpha[t]*dp2.r(i,j,k); + if (std::abs(ps2_h(t,i,j) - ps) > tol*ps) ++nerr; + } + } + } + + return nerr; +} + +int test_calc_etadotmid_from_etadotdpdnint (TestData& td) { + int nerr = 0; + const Real tol = 100*td.eps; + + for (const int nlev : {143, 128, 81}) { + HybridLevels h; + fill(h, nlev); + + // Test function: + // eta_dot_dpdn(eta) = c eta + d. + // Then + // eta_dot = eta_dot_dpdn(eta)/dpdn(eta) + // = (c eta + d)/(a_eta p0 + b_eta ps). + // Since a_eta, b_eta are constants independent of eta in this test, eta_dot + // is then also a linear function of eta. Thus, we can test for exact + // agreement with the true solution. + + ColData hydai("hydai",nlev), hydbi("hydbi",nlev), hydetai("hydetai",nlev); + ElData wrk("wrk",nlev+1), ed("ed",nlev+1); + ExecView ps("ps"); + const Real ps0 = h.ps0; + + const auto ps_m = Kokkos::create_mirror_view(ps); + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + ps_m(i,j) = td.urand(0.5, 1.2)*ps0; + for (int k = 0; k < nlev; ++k) { + hydai.r[k] = h.dai[k]; + hydbi.r[k] = h.dbi[k]; + hydetai.r[k] = h.detai[k]; + } + for (int k = 0; k <= nlev; ++k) + ed.r(i,j,k) = (i-j)*h.etai[k] + 0.3; + } + Kokkos::deep_copy(ps, ps_m); + hydai.h2d(); hydbi.h2d(); hydetai.h2d(); + ed.h2d(); + + const auto policy = get_test_team_policy(1, nlev); + const auto f = KOKKOS_LAMBDA(const cti::MT& team) { + KernelVariables kv(team); + calc_etadotmid_from_etadotdpdnint( + kv, nlev, ps0, hydai.d, hydbi.d, hydetai.d, ps, wrk.d, ed.d); + }; + Kokkos::parallel_for(policy, f); + Kokkos::fence(); + ed.d2h(); + + for (int i = 0; i < NP; ++i) + for (int j = 0; j < NP; ++j) { + const auto den = h.a_eta*h.ps0 + h.b_eta*ps_m(i,j); + for (int k = 0; k < nlev; ++k) { + const auto ed_true = ((i-j)*h.etam[k] + 0.3)/den; + if (std::abs(ed.r(i,j,k) - ed_true) > tol*(10/den)) ++nerr; + } + } + } + + return nerr; +} + +} // namespace anon + +#define comunittest(f) do { \ + ne = f(td); \ + if (ne) printf(#f " ne %d\n", ne); \ + nerr += ne; \ + } while (0) + +int ComposeTransportImpl::run_enhanced_trajectory_unit_tests () { + int nerr = 0, ne; + TestData td(*this); + comunittest(test_find_support); + comunittest(test_linterp); + comunittest(test_eta_interp); + comunittest(test_eta_to_dp); + comunittest(test_deta_caas); + comunittest(test_limit_etam); + comunittest(test_calc_ps); + comunittest(test_calc_etadotmid_from_etadotdpdnint); + return nerr; +} + +#undef comunittest + +} // namespace Homme + +#endif diff --git a/components/homme/src/theta-l_kokkos/CMakeLists.txt b/components/homme/src/theta-l_kokkos/CMakeLists.txt index ab9e648d467..191e3821cdd 100644 --- a/components/homme/src/theta-l_kokkos/CMakeLists.txt +++ b/components/homme/src/theta-l_kokkos/CMakeLists.txt @@ -162,6 +162,7 @@ MACRO(THETAL_KOKKOS_SETUP) ${SRC_SHARE_DIR}/cxx/ComposeTransportImplGeneral.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplTrajectory.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplEnhancedTrajectory.cpp + ${SRC_SHARE_DIR}/cxx/ComposeTransportImplEnhancedTrajectoryTests.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplVerticalRemap.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplHypervis.cpp ${SRC_SHARE_DIR}/cxx/ComposeTransportImplTest2D.cpp From 2641e960084de64917c90c0bc2637f2af4a2d079 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 9 Jan 2025 21:15:48 +0000 Subject: [PATCH 502/529] make sunspot macros file ident to aurora --- .../oneapi-ifxgpu_sunspot-pvc.cmake | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake index 7f3d9ab5d21..c6afa7c2329 100644 --- a/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake +++ b/cime_config/machines/cmake_macros/oneapi-ifxgpu_sunspot-pvc.cmake @@ -1,21 +1,9 @@ -string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -fsycl-device-code-split=per_kernel -fsycl-max-parallel-link-jobs=16") +string(APPEND CMAKE_EXE_LINKER_FLAGS " -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -fsycl-device-code-split=per_kernel -fsycl-max-parallel-link-jobs=16 -Wl,--no-relax") if (compile_threaded) string(APPEND CMAKE_EXE_LINKER_FLAGS " -fiopenmp -fopenmp-targets=spir64") endif() - -if (DEBUG) -#undefined reference to `__msan.... -#https://community.intel.com/t5/Intel-Fortran-Compiler/Linking-errors-when-using-memory-sanitizer-in-fortran-project/m-p/1521476 -#When you compile with -check uninit (or -check all) you also need to link with that compiler option. -# string(APPEND CMAKE_EXE_LINKER_FLAGS " -check uninit") -endif() - -string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off -DCMAKE_CXX_FLAGS='-fsycl-device-code-split=per_kernel'") +string(APPEND KOKKOS_OPTIONS " -DCMAKE_CXX_STANDARD=17 -DKokkos_ENABLE_SERIAL=On -DKokkos_ARCH_INTEL_PVC=On -DKokkos_ENABLE_SYCL=On -DKokkos_ENABLE_EXPLICIT_INSTANTIATION=Off") string(APPEND SYCL_FLAGS " -\-intel -fsycl -fsycl-targets=spir64_gen -mlong-double-64 -Xsycl-target-backend \"-device 12.60.7\"") -set(SCREAM_MPI_ON_DEVICE ON CACHE STRING "") - - - - +set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "") From f4d1a7c268cdb47b0d258b5be497903e33201a2c Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 9 Jan 2025 21:38:37 +0000 Subject: [PATCH 503/529] make sunspot file ident to auroras --- .../cmake/machine-files/sunspot-pvc.cmake | 31 +++---------------- 1 file changed, 5 insertions(+), 26 deletions(-) diff --git a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake index f36dc8f473c..53740d87e0e 100644 --- a/components/eamxx/cmake/machine-files/sunspot-pvc.cmake +++ b/components/eamxx/cmake/machine-files/sunspot-pvc.cmake @@ -1,35 +1,20 @@ -cmake_minimum_required(VERSION 3.18) - -#cmake_policy(SET CMP0057 NEW) -#cmake_policy(SET CMP0074 NEW) -#cmake_policy(SET CMP0079 NEW) # Remove once scorpio in a better state - -#set(CMAKE_CXX_STANDARD 17) - -#project(aaa C CXX Fortran) - include(${CMAKE_CURRENT_LIST_DIR}/common.cmake) common_setup() include (${EKAT_MACH_FILES_PATH}/kokkos/intel-pvc.cmake) -# kokkos sycl is on in the above file -#include (${EKAT_MACH_FILES_PATH}/kokkos/sycl.cmake) -include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake) +include (${EKAT_MACH_FILES_PATH}/mpi/other.cmake) +set(EKAT_MPIRUN_EXE "mpiexec" CACHE STRING "" FORCE) +set(EKAT_MPI_NP_FLAG "-np" CACHE STRING "" FORCE) +set(EKAT_MPI_EXTRA_ARGS "--label --cpu-bind depth -envall" CACHE STRING "") +set(EKAT_MPI_THREAD_FLAG "-d" CACHE STRING "") -#AB flags from ekat -# -fsycl -fsycl-unnamed-lambda -sycl-std=2020 -qopenmp-simd -Wsycl-strict -fsycl-device-code-split=per_kernel SET(SYCL_COMPILE_FLAGS "-std=c++17 -fsycl -fsycl-device-code-split=per_kernel -fno-sycl-id-queries-fit-in-int -fsycl-unnamed-lambda") SET(SYCL_LINK_FLAGS "-fsycl -fsycl-link-huge-device-code -fsycl-device-code-split=per_kernel -fsycl-targets=spir64_gen -Xsycl-target-backend \"-device 12.60.7\"") -#SET(MPICH_DIR "/soft/restricted/CNDA/updates/mpich/52.2/mpich-ofi-all-icc-default-pmix-gpu-drop52/" CACHE STRING "") - set(CMAKE_CXX_FLAGS " -\-intel -Xclang -fsycl-allow-virtual-functions -mlong-double-64 -O3 -DNDEBUG ${SYCL_COMPILE_FLAGS}" CACHE STRING "" FORCE) set(CMAKE_Fortran_FLAGS "-fc=ifx -O3 -DNDEBUG -DCPRINTEL -g" CACHE STRING "" FORCE) set(CMAKE_C_FLAGS "-O3 -DNDEBUG" CACHE STRING "" FORCE) set(CMAKE_EXE_LINKER_FLAGS " -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib" CACHE STRING "" FORCE) -#set(CMAKE_EXE_LINKER_FLAGS " -Wl,-\-defsym,main=MAIN_\_ -lifcore -\-intel -Xclang -fsycl-allow-virtual-functions -lsycl -mlong-double-64 -DNDEBUG ${SYCL_LINK_FLAGS} -fortlib -L${MPICH_DIR}/lib" CACHE STRING "" FORCE) - - set(NETCDF_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") set(NETCDF_DIR "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/netcdf" CACHE STRING "") @@ -41,9 +26,3 @@ set(NETCDF_FORTRAN_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.20 set(PNETCDF_PATH "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf" CACHE STRING "") -set(PNETCDF_DIR "/lus/gila/projects/CSC249ADSE15_CNDA/software/oneAPI.2022.12.30.003/pnetcdf" CACHE STRING "") - - - - - From d8f088f4d3c5d0eef690320d6e8ef22ddd539cfe Mon Sep 17 00:00:00 2001 From: "Andrew M. Bradley" Date: Thu, 9 Jan 2025 16:07:52 -0600 Subject: [PATCH 504/529] Homme/SL: Rearrange some code; add more comments. --- ...ComposeTransportImplEnhancedTrajectory.cpp | 420 ++++++++++++++++++ ...oseTransportImplEnhancedTrajectoryImpl.hpp | 326 ++------------ components/homme/src/share/sl_advection.F90 | 2 +- 3 files changed, 446 insertions(+), 302 deletions(-) diff --git a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp index 6d2050751b6..62bd190bc30 100644 --- a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp +++ b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectory.cpp @@ -7,9 +7,429 @@ #include "Config.hpp" #ifdef HOMME_ENABLE_COMPOSE +/* This is the second trajectory method for semi-Lagrangian transport; the first + is in ComposeTransportImplTrajectory.cpp. + + Usage + + To use it, add the following setting to the Homme namelist: + semi_lagrange_trajectory_nsubstep = N ! where N > 0 + A value of 0 (default) means Homme will use the original method. + + Another option makes the method use more than two velocity snapshots per time + step: + semi_lagrange_trajectory_nvelocity = N ! where N > 2 + A value <= 2 other than -1 means Homme will use the standard two velocity + snapshots (time step end points). -1 (default) triggers an internal + calculation based on nsubstep. This option has no effect if nsubstep=0 + (default). + + Summary + + This method provides multiple benefits over the original method, depending on + configuration: + * Supports (much) longer time steps than the original method. + * Maximizes flexibility in specifying the various atmosphere time steps. + * Greater accuracy than the original method for time steps the original + method can handle. + * Extreme accuracy in hypothetical niche applications. + + Method overview + + Recall that semi-Lagrangian tracer transport has six phases: + 1. At time step n+1, for each GLL point on the Eulerian grid, compute a + trajectory backward in time to the departure point at time n. This step is + independent of number of tracers. + 2. Simultaneously reconstruct vertically Lagrangian levels at time + n+1. This step is independent of number of tracers. + 3. In each level, for each level-midpoint departure point, interpolate tracer + mixing ratios at time n to the point. These mixing ratios are then the new + ratios at time n+1 on the Eulerian grid. + 4. Optionally apply hyperviscosity. + 5. Apply the Communication-Efficient Density Reconstructor (CEDR). + 6. Vertically remap tracers at time n+1 from the reconstructed vertically + Lagrangian levels to the vertically Eulerian grid. + + Trajectory methods implement phases 1 and 2. + + The key capability of this enhanced trajectory method (ETM) is to be able to + take multiple substeps when computing the departure points. The original + method cannot substep. Each substep has second-order accuracy, so the overall + method is always second-order accurate. But as the number of substeps + increases, so does accuracy. + + A second capability of the ETM is to use more velocity snapshots than just + the tracer time step end-point snapshots. For example, if there are two + substeps, the method can use three velocity snapshots: beginning, middle, + end. The first substep uses (middle, end), and the second uses (beginning, + middle). (This might be the opposite of what you expected, but recall that + the trajectory is computed backward in time.) + + At a software level, a third capability is to use an arbitrarily large + element halo when computing departure points. The original method is limited + to two halo layers. Extra halo layers do not increase the cost of search for + a fixed time step because of the ordering of elements in the layer. + + Speedup comes from the fact that taking a longer time step means phases 3-6, + the most expensive phases, run less often. Phases 1 and 2 also run less often + but take more time per run, summing to about the same cost over a fixed time + duration T as the original method. + + Algorithm outline + + This method works principally in the eta coordinate. eta is constant in a + level on the Eulerian grid. + Let time t1 > t0 and consider a trajectory substep from t1 to t0. + Terminology: An arrival point is the time-t1 point of a trajectory. A + departure point is the time-t0 point. + For each interface node at times t0 and t1, compute eta_dot dp/deta + (calc_eta_dot_dpdn). + For each midpoint node at times t0 and t1, compute + eta_dot = eta_dot dp/deta/(A_eta p0 + B_eta ps) + (calc_etadotmid_from_etadotdpdnint). + Use eta_dot, the horizontal velocity data, and the update formula described + in the comment for calc_nodal_velocities to compute the velocity term in the + update formula at the Eulerian vertical-midpoint nodes. Call the result V + (calc_vel_horiz_formula_node_ref_mid, calc_eta_dot_formula_node_ref_mid). + In general, the trajectory arrival point at t1 is not on the grid, but it + is in the first substep. If it is not on the grid, interpolate V to the + arrival points to produce V_dep (calc_v_departure). A detail here is we + should actually think of the original velocity data as being interpolated, + and then V_dep is computed from the interpolated data. But the formula to + compute V is linear in these data, so we can defer interpolation to the end + and do it just once. + Integrate the trajectory backward from t1 at the arrival point to t0 at the + departure point using V_dep (update_dep_points). + The algorithm up to this point can be substepped, running multiple times to + go backward from t1 to t0 in multiple steps. + After substepping is finished, there is one final part. + So far we have computed departure points corresponding to Eulerian-grid + arrival points. But now we need to account for the fact that the levels are + vertically Lagrangian ("floating"). The arrival points we actually need are + those on the floating levels at time t1 corresponding to Eulerian levels at + time t0. This is implemented in + describe interp_departure_points_to_floating_level_midpoints. + We use the following notation: yi = I[y(x)](xi) is an interpolant + constructed from y(x) and evaluated at xi. + On input, we have departure-point level-midpoint eta, eta_dep_mid, and the + corresponding horizontal position, p_dep_mid. We also know eta level + interfaces and midpoints on the reference grid, eta_ref_int and eta_ref_mid, + and the top and bottom boundary values of eta, eta(0) and eta(1). + First, reconstruct Lagrangian levels at t1 on the arrival column: + eta_arr_int = I[eta_ref_mid([eta(0),eta_dep_mid,eta(1)])](eta_ref_int). + Second, compute the Lagrangian level midpoints at t1 on the arrival column: + eta_arr_mid = I[eta_ref_mid([eta(0),eta_dep_mid,eta(1)])](eta_ref_mid). + Third, compute the departure horizontal points corresponding to the arrival + Lagrangian level midpoints: + p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid). + These calcualtions provide us with the final results: p_dep_mid is used in + phase 3, and eta_arr_int is used in phase 6. + */ + #include "ComposeTransportImplEnhancedTrajectoryImpl.hpp" namespace Homme { +namespace { + +// Set dep_points_all to level-midpoint arrival points. +void init_dep_points (const CTI& c, const cti::DeparturePoints& dep_pts) { + const auto independent_time_steps = c.m_data.independent_time_steps; + const auto& sphere_cart = c.m_geometry.m_sphere_cart; + const CRNV hyetam(cti::cpack2real(c.m_hvcoord.etam)); + assert(not independent_time_steps or dep_pts.extent_int(4) == 4); + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < 3; ++d) + dep_pts(ie,lev,i,j,d) = sphere_cart(ie,i,j,d); + if (independent_time_steps) + dep_pts(ie,lev,i,j,3) = hyetam(lev); + }; + c.launch_ie_physlev_ij(f); +} + +void update_dep_points ( + const CTI& c, const Real dtsub, const cti::DeparturePoints& vdep, + const cti::DeparturePoints& dep_pts) +{ + const auto independent_time_steps = c.m_data.independent_time_steps; + const auto is_sphere = c.m_data.geometry_type == 0; + const auto scale_factor = c.m_geometry.m_scale_factor; + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + // Update horizontal position. + Real p[3]; + for (int d = 0; d < 3; ++d) + p[d] = dep_pts(ie,lev,i,j,d) - dtsub*vdep(ie,lev,i,j,d)/scale_factor; + if (is_sphere) { + const auto norm = std::sqrt(square(p[0]) + square(p[1]) + square(p[2])); + for (int d = 0; d < 3; ++d) + p[d] /= norm; + } + for (int d = 0; d < 3; ++d) + dep_pts(ie,lev,i,j,d) = p[d]; + if (independent_time_steps) { + // Update vertical position. + dep_pts(ie,lev,i,j,3) -= dtsub*vdep(ie,lev,i,j,3); + } + }; + c.launch_ie_physlev_ij(f); +} + +/* Evaluate a formula to provide an estimate of nodal velocities that are use to + create a 2nd-order update to the trajectory. The fundamental formula for the + update in position p from arrival point p1 to departure point p0 is + p0 = p1 - dt/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). + Here we compute the velocity estimate at the nodes: + 1/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). +*/ +void calc_nodal_velocities ( + const CTI& c, const Real dtsub, const Real halpha[2], + const cti::CVSlot& v1, const cti::CDpSlot& dp1, const int idx1, + const cti::CVSlot& v2, const cti::CDpSlot& dp2, const int idx2, + const cti::DeparturePoints& vnode) +{ + using Kokkos::ALL; + const auto& d = c.m_data; + const auto& h = c.m_hvcoord; + const auto& sphere_ops = c.m_sphere_ops; + const auto& vec_sph2cart = c.m_geometry.m_vec_sph2cart; + const bool independent_time_steps = d.independent_time_steps; + const auto ps0 = h.ps0; + const auto hyai0 = h.hybrid_ai0; + const auto& hybi = h.hybrid_bi_packed; + const auto& hydai = h.hybrid_ai_delta; + const auto& hydbi = h.hybrid_bi_delta; + const auto& hyetam = h.etam; + const auto& hyetai = h.etai; + const auto& hydetai = d.hydetai; + const auto& buf1a = d.buf1o[0]; const auto& buf1b = d.buf1o[1]; + const auto& buf1c = d.buf1o[2]; const auto& buf1d = d.buf1o[3]; + const auto& buf2a = d.buf2 [0]; const auto& buf2b = d.buf2 [1]; + const auto& buf2c = d.buf2 [2]; const auto& buf2d = d.buf2 [3]; + const auto alpha0 = halpha[0], alpha1 = halpha[1]; + const auto f = KOKKOS_LAMBDA (const cti::MT& team) { + KernelVariables kv(team); + const int ie = kv.ie; + const auto wrk1 = Homme::subview(buf1a, kv.team_idx); + const auto wrk2 = Homme::subview(buf1b, kv.team_idx); + const auto vwrk1 = Homme::subview(buf2a, kv.team_idx); + const auto vwrk2 = Homme::subview(buf2b, kv.team_idx); + const auto v1_ie = Homme::subview(v1, ie, idx1); + const auto v2_ie = Homme::subview(v2, ie, idx2); + const Real alpha[] = {alpha0, alpha1}; + CSelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), + Homme::subview(buf1d, kv.team_idx)}; + { + SelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), + Homme::subview(buf1d, kv.team_idx)}; + if (independent_time_steps) { + const auto dp1_ie = Homme::subview(dp1, ie, idx1); + const auto dp2_ie = Homme::subview(dp2, ie, idx2); + calc_eta_dot_ref_mid(kv, sphere_ops, + ps0, hyai0, hybi, hydai, hydbi, hydetai, + alpha, v1_ie, dp1_ie, v2_ie, dp2_ie, + wrk1, wrk2, vwrk1, + eta_dot); + } else { + for (int t = 0; t < 2; ++t) { + const auto& ed = eta_dot[t]; + const auto f = [&] (const int i, const int j, const int k) { + ed(i,j,k) = 0; + }; + cti::loop_ijk(kv, f); + } + } + } + // Collect the horizontal nodal velocities. v1,2 are on Eulerian levels. v1 + // is from time t1 < t2. + auto* vm1 = Homme::subview(buf2c, kv.team_idx).data(); + auto* vm2 = Homme::subview(buf2d, kv.team_idx).data(); + CS2elNlev vsph[] = {CS2elNlev(vm1), CS2elNlev(vm2)}; + { + S2elNlev vsph[] = {S2elNlev(vm1), S2elNlev(vm2)}; + for (int t = 0; t < 2; ++t) { + const auto& v = vsph[t]; + for (int d = 0; d < 2; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + v(d,i,j,k) = ((1 - alpha[t])*v1_ie(d,i,j,k) + + /**/ alpha[t] *v2_ie(d,i,j,k)); + }; + cti::loop_ijk(kv, f); + } + } + } + kv.team_barrier(); + // Given the vertical and horizontal nodal velocities at time endpoints, + // evaluate the velocity estimate formula, providing the final horizontal + // and vertical velocity estimates at midpoint nodes. + const auto vnode_ie = Kokkos::subview(vnode, ie, ALL,ALL,ALL,ALL); + const auto vec_sph2cart_ie = Homme::subview(vec_sph2cart, ie); + calc_vel_horiz_formula_node_ref_mid(kv, sphere_ops, + hyetam, vec_sph2cart_ie, + dtsub, vsph, eta_dot, + wrk1, vwrk1, vwrk2, + vnode_ie); + if (independent_time_steps) { + kv.team_barrier(); + calc_eta_dot_formula_node_ref_mid(kv, sphere_ops, + hyetai, hyetam, + dtsub, vsph, eta_dot, + wrk1, vwrk1, + vnode_ie); + } + }; + Kokkos::parallel_for(c.m_tp_ne, f); +} + +// Determine the departure points corresponding to the vertically Lagrangian +// grid's arrival midpoints, where the floating levels are those that evolve +// over the course of the full tracer time step. Also compute divdp, which holds +// the floating levels' dp values for later use in vertical remap. +void interp_departure_points_to_floating_level_midpoints (const CTI& c, const int np1) { + using Kokkos::ALL; + const int nlev = NUM_PHYSICAL_LEV, nlevp = nlev+1; + const auto is_sphere = c.m_data.geometry_type == 0; + const auto& d = c.m_data; + const auto& h = c.m_hvcoord; + const auto ps0 = h.ps0; + const auto hyai0 = h.hybrid_ai0; + const auto& hybi = h.hybrid_bi; + const auto& hyetai = h.etai; + const CRNV hyetam(cti::cpack2real(h.etam)); + const auto& detam_ref = d.hydetam_ref; + const auto deta_tol = d.deta_tol; + const auto& dep_pts = d.dep_pts; + const auto& dp3d = c.m_state.m_dp3d; + const auto& buf1a = d.buf1e[0]; const auto& buf1b = d.buf1e[1]; + const auto& buf1c = d.buf1e[2]; const auto& buf1d = d.buf1e[3]; + const auto& buf2a = d.buf2[0]; + const auto f = KOKKOS_LAMBDA (const cti::MT& team) { + KernelVariables kv(team); + const int ie = kv.ie; + const auto wrk1 = Homme::subview(buf1a, kv.team_idx); + const auto wrk2 = Homme::subview(buf1b, kv.team_idx); + const auto wrk3 = Homme::subview(buf1c, kv.team_idx); + const auto wrk4 = Homme::subview(buf1d, kv.team_idx); + const auto vwrk = Homme::subview(buf2a, kv.team_idx); + // Reconstruct Lagrangian levels at t1 on arrival column: + // eta_arr_int = I[eta_ref_mid([eta(0),eta_dep_mid,eta(1)])](eta_ref_int) + const auto etam = p2rel(wrk3.data(), nlev); + const auto f = [&] (const int i, const int j, const int k) { + etam(i,j,k) = dep_pts(ie,k,i,j,3); + }; + cti::loop_ijk(kv, f); + kv.team_barrier(); + limit_etam(kv, nlev, + hyetai, detam_ref, deta_tol, + p2rel(wrk1.data(), nlevp), p2rel(wrk2.data(), nlevp), + etam); + kv.team_barrier(); + { + // Compute eta_arr_int. + const auto etai_arr = p2rel(wrk4.data(), nlevp); + eta_interp_eta(kv, nlev, + hyetai, + etam, hyetam, + p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), + nlevp-2, hyetai, etai_arr, 1); + const auto f = [&] (const int i, const int j) { + etai_arr(i,j,0) = hyetai(0); + etai_arr(i,j,nlev) = hyetai(nlev); + }; + c.loop_ij(kv, f); + // Compute divdp. + const ExecViewUnmanaged ps(cti::pack2real(vwrk)); + calc_ps(kv, nlev, + ps0, hyai0, + Homme::subview(dp3d, ie, np1), + ps); + kv.team_barrier(); + eta_to_dp(kv, nlev, + ps0, hybi, hyetai, + ps, etai_arr, + p2rel(wrk2.data(), nlev+1), + RelnV(cti::pack2real(Homme::subview(c.m_derived.m_divdp, ie)), + NP, NP, NUM_LEV*VECTOR_SIZE)); + kv.team_barrier(); + } + // Compute Lagrangian level midpoints at t1 on arrival column: + // eta_arr_mid = I[eta_ref_mid([eta(0),eta_dep_mid,eta(1)])](eta_ref_mid) + const auto etam_arr = p2rel(wrk4.data(), nlev); + eta_interp_eta(kv, nlev, + hyetai, + etam, hyetam, + p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), + nlev, hyetam, etam_arr); + kv.team_barrier(); + // Compute departure horizontal points corresponding to arrival + // Lagrangian level midpoints: + // p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid) + { + const RelnV dpts_in(cti::pack2real(vwrk), NP, NP, nlev); + const RelnV dpts_out(dpts_in.data() + NP*NP*nlev, NP, NP, nlev); + for (int d = 0; d < 3; ++d) { + const auto f = [&] (const int i, const int j, const int k) { + dpts_in(i,j,k) = dep_pts(ie,k,i,j,d); + }; + c.loop_ijk(kv, f); + kv.team_barrier(); + eta_interp_horiz(kv, nlev, + hyetai, + hyetam, dpts_in, + RnV(cti::pack2real(wrk2), nlev+2), p2rel(wrk1.data(), nlev+2), + etam_arr, dpts_out); + kv.team_barrier(); + const auto g = [&] (const int i, const int j, const int k) { + dep_pts(ie,k,i,j,d) = dpts_out(i,j,k); + }; + c.loop_ijk(kv, g); + kv.team_barrier(); + } + if (is_sphere) { + // Normalize. + const auto h = [&] (const int i, const int j, const int k) { + Real norm = 0; + for (int d = 0; d < 3; ++d) norm += square(dep_pts(ie,k,i,j,d)); + norm = std::sqrt(norm); + for (int d = 0; d < 3; ++d) dep_pts(ie,k,i,j,d) /= norm; + }; + c.loop_ijk(kv, h); + } + } + }; + Kokkos::parallel_for(c.m_tp_ne, f); +} + +void dss_vnode (const CTI& c, const cti::DeparturePoints& vnode) { + const int ndim = c.m_data.independent_time_steps ? 4 : 3; + const auto& spheremp = c.m_geometry.m_spheremp; + const auto& rspheremp = c.m_geometry.m_rspheremp; + const auto& vp = c.m_tracers.qtens_biharmonic; + const ExecViewUnmanaged + v(cti::pack2real(vp), vp.extent_int(0), vp.extent_int(1)); + const auto f = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < ndim; ++d) + v(ie,d,i,j,lev) = vnode(ie,lev,i,j,d)*spheremp(ie,i,j)*rspheremp(ie,i,j); + }; + c.launch_ie_physlev_ij(f); + Kokkos::fence(); + const auto be = c.m_v_dss_be[c.m_data.independent_time_steps ? 1 : 0]; + be->exchange(); + Kokkos::fence(); + const auto g = KOKKOS_LAMBDA (const int idx) { + int ie, lev, i, j; + cti::idx_ie_physlev_ij(idx, ie, lev, i, j); + for (int d = 0; d < ndim; ++d) + vnode(ie,lev,i,j,d) = v(ie,d,i,j,lev); + }; + c.launch_ie_physlev_ij(g); +} + +} // namespace anon // For limit_etam. void ComposeTransportImpl::setup_enhanced_trajectory () { diff --git a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp index dba5a641e34..1d9ee6da4ad 100644 --- a/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp +++ b/components/homme/src/share/cxx/ComposeTransportImplEnhancedTrajectoryImpl.hpp @@ -60,6 +60,9 @@ using CRelnV = ExecViewUnmanaged; using SelnV = ExecViewUnmanaged; using CSelnV = ExecViewUnmanaged; +// Helper functions to move between various array data structures and assert +// things about them. + KOKKOS_INLINE_FUNCTION static int calc_npack (const int nscal) { return (nscal + cti::packn - 1) / VECTOR_SIZE; @@ -109,8 +112,9 @@ void assert_eln (const CSelnV& a, const int nlev) { assert(calc_nscal(a.extent_int(2)) >= nlev); } -// For sorted ascending x[0:n] and x in [x[0], x[n-1]] with hint xi_idx, return -// i such that x[i] <= xi <= x[i+1]. +// Find the support for the linear interpolant. +// For sorted ascending x[0:n] and x in [x[0], x[n-1]] with hint xi_idx, +// return i such that x[i] <= xi <= x[i+1]. // This function is meant for the case that x_idx is very close to the // support. If that isn't true, then this method is inefficient; binary search // should be used instead. @@ -134,7 +138,7 @@ int find_support (const int n, const ConstRealArray& x, const int x_idx, return -1; } -// Linear interpolation core computation. +// Linear interpolation core formula. template KOKKOS_FUNCTION Real linterp (const int n, const XT& x, const YT& y, const int x_idx, const Real xi) { @@ -148,6 +152,8 @@ linterp (const int n, const XT& x, const YT& y, const int x_idx, const Real xi) // Interpolate y(x) to yi(xi). // x_idx_offset is added to k in the call to find_support. // Arrays should all have rank 1. +// Notation: yi = I[y(x)](xi) is an interpolant constructed from y(x) and +// evaluated at xi. template KOKKOS_FUNCTION void linterp (const Range& range, @@ -170,6 +176,8 @@ linterp (const Range& range, Kokkos::parallel_for(range, f); } +// Compute Lagrangian level midpoints at t1 on arrival column: +// eta_arr_mid = I[eta_ref_mid([eta(0),eta_dep_mid,eta(1)])](eta_ref_mid). KOKKOS_FUNCTION void eta_interp_eta (const KernelVariables& kv, const int nlev, const CRnV& hy_etai, const CRelnV& x, const CRnV& y, @@ -216,6 +224,9 @@ eta_interp_eta (const KernelVariables& kv, const int nlev, Kokkos::parallel_for(ttr, f_linterp); } +// Compute departure horizontal points corresponding to arrival Lagrangian level +// midpoints: +// p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid) KOKKOS_FUNCTION void eta_interp_horiz (const KernelVariables& kv, const int nlev, const CRnV& hy_etai, const CRnV& x, const CRelnV& y, @@ -363,6 +374,7 @@ deta_caas (const KernelVariables& kv, const Range& tvr_nlevp, Kokkos::parallel_for(tvr_nlevp, g2); } +// Wrapper to above. KOKKOS_FUNCTION void deta_caas (const KernelVariables& kv, const int nlevp, const CRnV& deta_ref, const Real low, const RelnV& wrk, const RelnV& deta) { @@ -434,6 +446,7 @@ limit_etam (const KernelVariables& kv, const int nlev, const CRnV& hy_etai, Kokkos::parallel_for(ttr, f2); } +// Compute surface pressure ps = ai(0) ps0 + sum dp. KOKKOS_FUNCTION void calc_ps ( const KernelVariables& kv, const int nlev, const Real& ps0, const Real& hyai0, @@ -455,6 +468,8 @@ KOKKOS_FUNCTION void calc_ps ( Kokkos::parallel_for(ttr, f1); } +// Compute the surface pressure ps[i] at time point i corresponding to +// dp[i] = (1-alpha[i]) dp1 + alpha[i] dp2. KOKKOS_FUNCTION void calc_ps ( const KernelVariables& kv, const int nlev, const Real& ps0, const Real& hyai0, @@ -531,6 +546,7 @@ KOKKOS_FUNCTION void calc_etadotmid_from_etadotdpdnint ( } } +// Compute eta_dot at midpoint nodes at the start and end of the substep. KOKKOS_FUNCTION void calc_eta_dot_ref_mid ( const KernelVariables& kv, const SphereOperators& sphere_ops, const Real& ps0, const Real& hyai0, const CSNV& hybi, @@ -583,6 +599,9 @@ KOKKOS_FUNCTION void calc_eta_dot_ref_mid ( } } +// Given the vertical and horizontal nodal velocities at time endpoints, +// evaluate the velocity estimate formula, providing the final horizontal +// velocity estimates at midpoint nodes. KOKKOS_FUNCTION void calc_vel_horiz_formula_node_ref_mid ( const KernelVariables& kv, const SphereOperators& sphere_ops, const CSNV& hyetam, const ExecViewUnmanaged& vec_sph2cart, @@ -640,6 +659,9 @@ KOKKOS_FUNCTION void calc_vel_horiz_formula_node_ref_mid ( } } +// Given the vertical and horizontal nodal velocities at time endpoints, +// evaluate the velocity estimate formula, providing the final vertical velocity +// estimates at midpoint nodes. KOKKOS_FUNCTION void calc_eta_dot_formula_node_ref_mid ( const KernelVariables& kv, const SphereOperators& sphere_ops, const CRNV& hyetai, const CSNV& hyetam, @@ -691,304 +713,6 @@ KOKKOS_FUNCTION void calc_eta_dot_formula_node_ref_mid ( } } -// Set dep_points_all to level-midpoint arrival points. -void init_dep_points (const CTI& c, const cti::DeparturePoints& dep_pts) { - const auto independent_time_steps = c.m_data.independent_time_steps; - const auto& sphere_cart = c.m_geometry.m_sphere_cart; - const CRNV hyetam(cti::cpack2real(c.m_hvcoord.etam)); - assert(not independent_time_steps or dep_pts.extent_int(4) == 4); - const auto f = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - for (int d = 0; d < 3; ++d) - dep_pts(ie,lev,i,j,d) = sphere_cart(ie,i,j,d); - if (independent_time_steps) - dep_pts(ie,lev,i,j,3) = hyetam(lev); - }; - c.launch_ie_physlev_ij(f); -} - -void update_dep_points ( - const CTI& c, const Real dtsub, const cti::DeparturePoints& vdep, - const cti::DeparturePoints& dep_pts) -{ - const auto independent_time_steps = c.m_data.independent_time_steps; - const auto is_sphere = c.m_data.geometry_type == 0; - const auto scale_factor = c.m_geometry.m_scale_factor; - const auto f = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - // Update horizontal position. - Real p[3]; - for (int d = 0; d < 3; ++d) - p[d] = dep_pts(ie,lev,i,j,d) - dtsub*vdep(ie,lev,i,j,d)/scale_factor; - if (is_sphere) { - const auto norm = std::sqrt(square(p[0]) + square(p[1]) + square(p[2])); - for (int d = 0; d < 3; ++d) - p[d] /= norm; - } - for (int d = 0; d < 3; ++d) - dep_pts(ie,lev,i,j,d) = p[d]; - if (independent_time_steps) { - // Update vertical position. - dep_pts(ie,lev,i,j,3) -= dtsub*vdep(ie,lev,i,j,3); - } - }; - c.launch_ie_physlev_ij(f); -} - -/* Evaluate a formula to provide an estimate of nodal velocities that are use to - create a 2nd-order update to the trajectory. The fundamental formula for the - update in position p from arrival point p1 to departure point p0 is - p0 = p1 - dt/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). - Here we compute the velocity estimate at the nodes: - 1/2 (v(p1,t0) + v(p1,t1) - dt v(p1,t1) grad v(p1,t0)). -*/ -void calc_nodal_velocities ( - const CTI& c, const Real dtsub, const Real halpha[2], - const cti::CVSlot& v1, const cti::CDpSlot& dp1, const int idx1, - const cti::CVSlot& v2, const cti::CDpSlot& dp2, const int idx2, - const cti::DeparturePoints& vnode) -{ - using Kokkos::ALL; - const auto& d = c.m_data; - const auto& h = c.m_hvcoord; - const auto& sphere_ops = c.m_sphere_ops; - const auto& vec_sph2cart = c.m_geometry.m_vec_sph2cart; - const bool independent_time_steps = d.independent_time_steps; - const auto ps0 = h.ps0; - const auto hyai0 = h.hybrid_ai0; - const auto& hybi = h.hybrid_bi_packed; - const auto& hydai = h.hybrid_ai_delta; - const auto& hydbi = h.hybrid_bi_delta; - const auto& hyetam = h.etam; - const auto& hyetai = h.etai; - const auto& hydetai = d.hydetai; - const auto& buf1a = d.buf1o[0]; const auto& buf1b = d.buf1o[1]; - const auto& buf1c = d.buf1o[2]; const auto& buf1d = d.buf1o[3]; - const auto& buf2a = d.buf2 [0]; const auto& buf2b = d.buf2 [1]; - const auto& buf2c = d.buf2 [2]; const auto& buf2d = d.buf2 [3]; - const auto alpha0 = halpha[0], alpha1 = halpha[1]; - const auto f = KOKKOS_LAMBDA (const cti::MT& team) { - KernelVariables kv(team); - const int ie = kv.ie; - const auto wrk1 = Homme::subview(buf1a, kv.team_idx); - const auto wrk2 = Homme::subview(buf1b, kv.team_idx); - const auto vwrk1 = Homme::subview(buf2a, kv.team_idx); - const auto vwrk2 = Homme::subview(buf2b, kv.team_idx); - const auto v1_ie = Homme::subview(v1, ie, idx1); - const auto v2_ie = Homme::subview(v2, ie, idx2); - const Real alpha[] = {alpha0, alpha1}; - CSelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), - Homme::subview(buf1d, kv.team_idx)}; - { - SelNlevp eta_dot[] = {Homme::subview(buf1c, kv.team_idx), - Homme::subview(buf1d, kv.team_idx)}; - if (independent_time_steps) { - const auto dp1_ie = Homme::subview(dp1, ie, idx1); - const auto dp2_ie = Homme::subview(dp2, ie, idx2); - calc_eta_dot_ref_mid(kv, sphere_ops, - ps0, hyai0, hybi, hydai, hydbi, hydetai, - alpha, v1_ie, dp1_ie, v2_ie, dp2_ie, - wrk1, wrk2, vwrk1, - eta_dot); - } else { - for (int t = 0; t < 2; ++t) { - const auto& ed = eta_dot[t]; - const auto f = [&] (const int i, const int j, const int k) { - ed(i,j,k) = 0; - }; - cti::loop_ijk(kv, f); - } - } - } - // Collect the horizontal nodal velocities. v1,2 are on Eulerian levels. v1 - // is from time t1 < t2. - auto* vm1 = Homme::subview(buf2c, kv.team_idx).data(); - auto* vm2 = Homme::subview(buf2d, kv.team_idx).data(); - CS2elNlev vsph[] = {CS2elNlev(vm1), CS2elNlev(vm2)}; - { - S2elNlev vsph[] = {S2elNlev(vm1), S2elNlev(vm2)}; - for (int t = 0; t < 2; ++t) { - const auto& v = vsph[t]; - for (int d = 0; d < 2; ++d) { - const auto f = [&] (const int i, const int j, const int k) { - v(d,i,j,k) = ((1 - alpha[t])*v1_ie(d,i,j,k) + - /**/ alpha[t] *v2_ie(d,i,j,k)); - }; - cti::loop_ijk(kv, f); - } - } - } - kv.team_barrier(); - // Given the vertical and horizontal nodal velocities at time endpoints, - // evaluate the velocity estimate formula, providing the final horizontal - // and vertical velocity estimates at midpoint nodes. - const auto vnode_ie = Kokkos::subview(vnode, ie, ALL,ALL,ALL,ALL); - const auto vec_sph2cart_ie = Homme::subview(vec_sph2cart, ie); - calc_vel_horiz_formula_node_ref_mid(kv, sphere_ops, - hyetam, vec_sph2cart_ie, - dtsub, vsph, eta_dot, - wrk1, vwrk1, vwrk2, - vnode_ie); - if (independent_time_steps) { - kv.team_barrier(); - calc_eta_dot_formula_node_ref_mid(kv, sphere_ops, - hyetai, hyetam, - dtsub, vsph, eta_dot, - wrk1, vwrk1, - vnode_ie); - } - }; - Kokkos::parallel_for(c.m_tp_ne, f); -} - -// Determine the departure points corresponding to the vertically Lagragnian -// grid's arrival midpoints, where the floating levels are those that evolve -// over the course of the full tracer time step. Also compute divdp, which holds -// the floating levels' dp values for later use in vertical remap. -void interp_departure_points_to_floating_level_midpoints (const CTI& c, const int np1) { - using Kokkos::ALL; - const int nlev = NUM_PHYSICAL_LEV, nlevp = nlev+1; - const auto is_sphere = c.m_data.geometry_type == 0; - const auto& d = c.m_data; - const auto& h = c.m_hvcoord; - const auto ps0 = h.ps0; - const auto hyai0 = h.hybrid_ai0; - const auto& hybi = h.hybrid_bi; - const auto& hyetai = h.etai; - const CRNV hyetam(cti::cpack2real(h.etam)); - const auto& detam_ref = d.hydetam_ref; - const auto deta_tol = d.deta_tol; - const auto& dep_pts = d.dep_pts; - const auto& dp3d = c.m_state.m_dp3d; - const auto& buf1a = d.buf1e[0]; const auto& buf1b = d.buf1e[1]; - const auto& buf1c = d.buf1e[2]; const auto& buf1d = d.buf1e[3]; - const auto& buf2a = d.buf2[0]; - const auto f = KOKKOS_LAMBDA (const cti::MT& team) { - KernelVariables kv(team); - const int ie = kv.ie; - const auto wrk1 = Homme::subview(buf1a, kv.team_idx); - const auto wrk2 = Homme::subview(buf1b, kv.team_idx); - const auto wrk3 = Homme::subview(buf1c, kv.team_idx); - const auto wrk4 = Homme::subview(buf1d, kv.team_idx); - const auto vwrk = Homme::subview(buf2a, kv.team_idx); - // Reconstruct Lagrangian levels at t1 on arrival column: - // eta_arr_int = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_int) - const auto etam = p2rel(wrk3.data(), nlev); - const auto f = [&] (const int i, const int j, const int k) { - etam(i,j,k) = dep_pts(ie,k,i,j,3); - }; - cti::loop_ijk(kv, f); - kv.team_barrier(); - limit_etam(kv, nlev, - hyetai, detam_ref, deta_tol, - p2rel(wrk1.data(), nlevp), p2rel(wrk2.data(), nlevp), - etam); - kv.team_barrier(); - { - // Compute eta_arr_int. - const auto etai_arr = p2rel(wrk4.data(), nlevp); - eta_interp_eta(kv, nlev, - hyetai, - etam, hyetam, - p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), - nlevp-2, hyetai, etai_arr, 1); - const auto f = [&] (const int i, const int j) { - etai_arr(i,j,0) = hyetai(0); - etai_arr(i,j,nlev) = hyetai(nlev); - }; - c.loop_ij(kv, f); - // Compute divdp. - const ExecViewUnmanaged ps(cti::pack2real(vwrk)); - calc_ps(kv, nlev, - ps0, hyai0, - Homme::subview(dp3d, ie, np1), - ps); - kv.team_barrier(); - eta_to_dp(kv, nlev, - ps0, hybi, hyetai, - ps, etai_arr, - p2rel(wrk2.data(), nlev+1), - RelnV(cti::pack2real(Homme::subview(c.m_derived.m_divdp, ie)), - NP, NP, NUM_LEV*VECTOR_SIZE)); - kv.team_barrier(); - } - // Compute Lagrangian level midpoints at t1 on arrival column: - // eta_arr_mid = I[eta_ref_mid([0,eta_dep_mid,1])](eta_ref_mid) - const auto etam_arr = p2rel(wrk4.data(), nlev); - eta_interp_eta(kv, nlev, - hyetai, - etam, hyetam, - p2rel(wrk1.data(), nlev+2), RnV(cti::pack2real(wrk2), nlev+2), - nlev, hyetam, etam_arr); - kv.team_barrier(); - // Compute departure horizontal points corresponding to arrival - // Lagrangian level midpoints: - // p_dep_mid(eta_arr_mid) = I[p_dep_mid(eta_ref_mid)](eta_arr_mid) - { - const RelnV dpts_in(cti::pack2real(vwrk), NP, NP, nlev); - const RelnV dpts_out(dpts_in.data() + NP*NP*nlev, NP, NP, nlev); - for (int d = 0; d < 3; ++d) { - const auto f = [&] (const int i, const int j, const int k) { - dpts_in(i,j,k) = dep_pts(ie,k,i,j,d); - }; - c.loop_ijk(kv, f); - kv.team_barrier(); - eta_interp_horiz(kv, nlev, - hyetai, - hyetam, dpts_in, - RnV(cti::pack2real(wrk2), nlev+2), p2rel(wrk1.data(), nlev+2), - etam_arr, dpts_out); - kv.team_barrier(); - const auto g = [&] (const int i, const int j, const int k) { - dep_pts(ie,k,i,j,d) = dpts_out(i,j,k); - }; - c.loop_ijk(kv, g); - kv.team_barrier(); - } - if (is_sphere) { - // Normalize. - const auto h = [&] (const int i, const int j, const int k) { - Real norm = 0; - for (int d = 0; d < 3; ++d) norm += square(dep_pts(ie,k,i,j,d)); - norm = std::sqrt(norm); - for (int d = 0; d < 3; ++d) dep_pts(ie,k,i,j,d) /= norm; - }; - c.loop_ijk(kv, h); - } - } - }; - Kokkos::parallel_for(c.m_tp_ne, f); -} - -void dss_vnode (const CTI& c, const cti::DeparturePoints& vnode) { - const int ndim = c.m_data.independent_time_steps ? 4 : 3; - const auto& spheremp = c.m_geometry.m_spheremp; - const auto& rspheremp = c.m_geometry.m_rspheremp; - const auto& vp = c.m_tracers.qtens_biharmonic; - const ExecViewUnmanaged - v(cti::pack2real(vp), vp.extent_int(0), vp.extent_int(1)); - const auto f = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - for (int d = 0; d < ndim; ++d) - v(ie,d,i,j,lev) = vnode(ie,lev,i,j,d)*spheremp(ie,i,j)*rspheremp(ie,i,j); - }; - c.launch_ie_physlev_ij(f); - Kokkos::fence(); - const auto be = c.m_v_dss_be[c.m_data.independent_time_steps ? 1 : 0]; - be->exchange(); - Kokkos::fence(); - const auto g = KOKKOS_LAMBDA (const int idx) { - int ie, lev, i, j; - cti::idx_ie_physlev_ij(idx, ie, lev, i, j); - for (int d = 0; d < ndim; ++d) - vnode(ie,lev,i,j,d) = v(ie,d,i,j,lev); - }; - c.launch_ie_physlev_ij(g); -} - } // namespace anon } // namespace Homme diff --git a/components/homme/src/share/sl_advection.F90 b/components/homme/src/share/sl_advection.F90 index 2549da8f5ae..63a476d0325 100644 --- a/components/homme/src/share/sl_advection.F90 +++ b/components/homme/src/share/sl_advection.F90 @@ -1568,7 +1568,7 @@ subroutine calc_eta_dot_ref_mid(elem, deriv, tl, hvcoord, alpha, v1, dp1, v2, dp end do ! Transform eta_dot_dpdn at interfaces to eta_dot at midpoints using the ! formula - ! eta_dot = eta_dot_dpdn/(A_eta p0 + B_eta ps). + ! eta_dot = eta_dot_dpdn/(A_eta p0 + B_eta ps) ! a= eta_dot_dpdn diff(eta)/(diff(A) p0 + diff(B) ps). ! Compute ps. w1 = hvcoord%hyai(1)*hvcoord%ps0 + & From 1a27b739dca08b48424251965ae151d1107c9c69 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 9 Jan 2025 14:33:23 -0700 Subject: [PATCH 505/529] EAMxx: temporarily disable failing mam tests --- components/eamxx/tests/single-process/CMakeLists.txt | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/components/eamxx/tests/single-process/CMakeLists.txt b/components/eamxx/tests/single-process/CMakeLists.txt index 2d0ae749c49..ee790550bd4 100644 --- a/components/eamxx/tests/single-process/CMakeLists.txt +++ b/components/eamxx/tests/single-process/CMakeLists.txt @@ -22,10 +22,15 @@ if (SCREAM_ENABLE_MAM) add_subdirectory(mam/optics) add_subdirectory(mam/aci) add_subdirectory(mam/drydep) - add_subdirectory(mam/wet_scav) add_subdirectory(mam/emissions) add_subdirectory(mam/constituent_fluxes) - add_subdirectory(mam/aero_microphys) + + # Currently, this test has a runtime error. Disabling while MAM folks debug. + # add_subdirectory(mam/wet_scav) + + # Currently this test produces non-deterministic output. + # Commenting it so the other PRs can test normally + # add_subdirectory(mam/aero_microphys) endif() if (SCREAM_TEST_LEVEL GREATER_EQUAL SCREAM_TEST_LEVEL_EXPERIMENTAL) add_subdirectory(zm) From b6c3f3e02e406f0ba86da43557e989b93637b156 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Thu, 9 Jan 2025 17:21:37 -0700 Subject: [PATCH 506/529] Workflows: run eamxx workflows when mam4xx/haero are updated --- .github/workflows/eamxx-sa-testing.yml | 2 ++ .github/workflows/eamxx-v1-testing.yml | 2 ++ 2 files changed, 4 insertions(+) diff --git a/.github/workflows/eamxx-sa-testing.yml b/.github/workflows/eamxx-sa-testing.yml index e3657266cb6..7bc20aeaca5 100644 --- a/.github/workflows/eamxx-sa-testing.yml +++ b/.github/workflows/eamxx-sa-testing.yml @@ -12,6 +12,8 @@ on: - 'components/eamxx/**' - 'components/homme/**' - 'externals/ekat' + - 'externals/mam4xx' + - 'externals/haero' - 'externals/scorpio' # second, no to these - '!components/eamxx/docs/**' diff --git a/.github/workflows/eamxx-v1-testing.yml b/.github/workflows/eamxx-v1-testing.yml index 88930a2c024..a4a164907ac 100644 --- a/.github/workflows/eamxx-v1-testing.yml +++ b/.github/workflows/eamxx-v1-testing.yml @@ -12,6 +12,8 @@ on: - 'components/eamxx/**' - 'components/homme/**' - 'externals/ekat' + - 'externals/mam4xx' + - 'externals/haero' - 'externals/scorpio' # second, no to these - '!components/eamxx/docs/**' From 3adbd5df5db57f3ead65f350c25c99e826631ae4 Mon Sep 17 00:00:00 2001 From: Michael J Schmidt Date: Thu, 9 Jan 2025 16:09:44 -0800 Subject: [PATCH 507/529] update mam4xx for wetdep KOKKOS_INLINE_FUNCTION fix --- externals/mam4xx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/mam4xx b/externals/mam4xx index d71354ec9a6..5b1dacdb4aa 160000 --- a/externals/mam4xx +++ b/externals/mam4xx @@ -1 +1 @@ -Subproject commit d71354ec9a6c2cecc3ca13cb5c3db3125743024b +Subproject commit 5b1dacdb4aa6fb9819fde8a8d2b3c92bbebae7e9 From f8420b027aee5146adc943c51b6e4098968dba55 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 10 Jan 2025 16:04:21 -0700 Subject: [PATCH 508/529] EAMxx: disable mam4xx wetscav tests --- .../tests/multi-process/dynamics_physics/mam/CMakeLists.txt | 2 +- .../eamxx/tests/multi-process/physics_only/CMakeLists.txt | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt b/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt index c67d46d4ffe..3cf0ac1995a 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt @@ -1,3 +1,3 @@ add_subdirectory(homme_shoc_cld_p3_mam_optics_rrtmgp) add_subdirectory(homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep) -add_subdirectory(homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav) +# add_subdirectory(homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav) diff --git a/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt b/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt index bb23911ff1c..6dc787c4a35 100644 --- a/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt +++ b/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt @@ -9,8 +9,8 @@ if (SCREAM_DOUBLE_PRECISION) add_subdirectory(mam/shoc_cldfrac_mam4_aci_p3) add_subdirectory(mam/shoc_cldfrac_mam4_aci_p3_rrtmgp) add_subdirectory(mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp) - add_subdirectory(mam/p3_mam4_wetscav) - add_subdirectory(mam/shoc_cldfrac_p3_wetscav) + # add_subdirectory(mam/p3_mam4_wetscav) + # add_subdirectory(mam/shoc_cldfrac_p3_wetscav) add_subdirectory(mam/mam4_srf_online_emiss_mam4_constituent_fluxes) endif() endif() From 3cbf01f6c53ec4c315638f9864c3e0d1ae7e2c97 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 10 Jan 2025 16:47:28 -0700 Subject: [PATCH 509/529] EAMxx: fix compiler warning --- components/eamxx/src/share/io/scorpio_output.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/share/io/scorpio_output.cpp b/components/eamxx/src/share/io/scorpio_output.cpp index 624bd10f7b5..10b2ee23d86 100644 --- a/components/eamxx/src/share/io/scorpio_output.cpp +++ b/components/eamxx/src/share/io/scorpio_output.cpp @@ -1110,7 +1110,7 @@ AtmosphereOutput::get_var_dof_offsets(const FieldLayout& layout) // Precompute this *before* the early return, since it involves collectives. // If one rank owns zero cols, and returns prematurely, the others will be left waiting. - AbstractGrid::gid_type min_gid; + AbstractGrid::gid_type min_gid = -1; if (layout.has_tag(COL) or layout.has_tag(EL)) { min_gid = m_io_grid->get_global_min_dof_gid(); } From 9521d961a993340e9ecd0cd6b21b124c2a53128f Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Fri, 10 Jan 2025 16:49:39 -0700 Subject: [PATCH 510/529] EAMxx: fix memory error in the atm proc dag generation --- .../atm_process/atmosphere_process_dag.cpp | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp b/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp index 50d89d9916a..d7d09e3af91 100644 --- a/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp +++ b/components/eamxx/src/share/atm_process/atmosphere_process_dag.cpp @@ -594,13 +594,16 @@ void AtmProcDAG::add_edges () { void AtmProcDAG::process_initial_conditions(const grid_field_map &ic_inited) { // First, add the fields that were determined to come from the previous time // step => IC for t = 0 - // get the begin_node since the IC is identical at first - const Node &begin_node = m_nodes[m_nodes.size() - 2]; - int id = m_nodes.size(); - // Create a node for the ICs by copying the begin_node - m_nodes.push_back(Node(begin_node)); - Node& ic_node = m_nodes.back(); + + // Create a node for the ICs by copying the begin_node. Recall that so far + // m_nodes contains [, 'beg-of-step', 'end-of-step'] + // WARNING: do NOT get a ref to beg-of-step node, since calls to m_nodes.push_back + // may resize the vector, invalidating the reference. + auto begin_node = m_nodes[m_nodes.size()-2]; + auto& ic_node = m_nodes.emplace_back(begin_node); + // now set/clear the basic data for the ic_node + int id = m_nodes.size(); ic_node.id = id; ic_node.name = "Initial Conditions"; m_unmet_deps[id].clear(); @@ -651,8 +654,6 @@ void AtmProcDAG::process_initial_conditions(const grid_field_map &ic_inited) { m_IC_processed = true; } - - int AtmProcDAG::add_fid (const FieldIdentifier& fid) { auto it = ekat::find(m_fids,fid); if (it==m_fids.end()) { From b55abfb897619ac0b360afbfe001fe1368275c22 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Fri, 10 Jan 2025 07:36:56 -0800 Subject: [PATCH 511/529] EAMxx: add vert_contraction field utility --- .../eamxx/src/share/field/field_utils.hpp | 93 ++++++++++ .../src/share/field/field_utils_impl.hpp | 99 +++++++++++ .../eamxx/src/share/tests/field_utils.cpp | 162 ++++++++++++++++++ 3 files changed, 354 insertions(+) diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index 4661d80db5d..471fb0f60fc 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -179,6 +179,99 @@ void horiz_contraction(const Field &f_out, const Field &f_in, impl::horiz_contraction(f_out, f_in, weight, comm); } +// Utility to compute the contraction of a field along its level dimension. +// This is equivalent to f_out = einsum('...k->...', weight, f_in). +// The impl is such that: +// - f_out, f_in, and weight must be provided and allocated +// - The last dimension is for the levels (LEV) +// - There can be only up to 3 dimensions of f_in +// - Weight is assumed to be (in order of checking/impl): +// - rank-1, with only LEV dimension +// - rank-2, with only COL and LEV dimensions +template +void vert_contraction(const Field &f_out, const Field &f_in, + const Field &weight, const ekat::Comm *comm = nullptr) { + using namespace ShortFieldTagsNames; + + const auto &l_out = f_out.get_header().get_identifier().get_layout(); + + const auto &l_in = f_in.get_header().get_identifier().get_layout(); + + const auto &l_w = weight.get_header().get_identifier().get_layout(); + + // Sanity checks before handing off to the implementation + EKAT_REQUIRE_MSG( + l_w.rank() >= 1 && l_w.rank() <= 2, + "Error! The weight field must be at least rank-1 and at most rank-2.\n" + "The weight field has rank " + << l_w.rank() << ".\n"); + EKAT_REQUIRE_MSG( + l_w.tags().back() == LEV, + "Error! The weight field must have LEV as its last dimension.\n" + "The weight field layout is " + << l_w.to_string() << ".\n"); + EKAT_REQUIRE_MSG(l_in.rank() <= 3, + "Error! The input field must be at most rank-3.\n" + "The input field rank is " + << l_in.rank() << ".\n"); + EKAT_REQUIRE_MSG(l_in.rank() >= l_w.rank(), + "Error! The input field must have at least as many " + "dimensions as the weight field.\n" + "The input field rank is " + << l_in.rank() << " and the weight field rank is " + << l_w.rank() << ".\n"); + EKAT_REQUIRE_MSG(l_in.tags().back() == LEV, + "Error! The input field must have a level dimension.\n" + "The input field layout is " + << l_in.to_string() << ".\n"); + EKAT_REQUIRE_MSG( + l_in.dim(l_in.rank() - 1) == l_w.dim(l_w.rank() - 1), + "Error! input and weight fields must have the same dimension along " + "which we are taking the reducing the field (last dimensions).\n" + "The weight field has last dimension " + << l_w.dim(l_w.rank() - 1) + << " while " + "the input field has last dimension " + << l_in.dim(l_in.rank() - 1) << ".\n"); + EKAT_REQUIRE_MSG( + l_in.dim(l_in.rank() - 1) > 0, + "Error! The input field must have a non-zero level dimension.\n" + "The input field layout is " + << l_in.to_string() << ".\n"); + if(l_w.rank() == 2) { + EKAT_REQUIRE_MSG( + l_w.tags()[0] == COL && l_in.tags()[0] == COL, + "Error! Rank-2 weight field must have COL as first dimension"); + EKAT_REQUIRE_MSG( + l_w.dim(0) == l_in.dim(0), + "Error! input and weight fields must have the same dimension along " + "which we are taking the reducing the field (first dimensions).\n" + "The weight field has first dimension " + << l_w.dim(0) + << " while " + "the input field has first dimension " + << l_in.dim(0) << ".\n"); + } + EKAT_REQUIRE_MSG( + l_out == l_in.clone().strip_dim(l_in.rank() - 1), + "Error! The output field must have the same layout as the input field " + "without the level dimension.\n" + "The input field layout is " + << l_in.to_string() << " and the output field layout is " + << l_out.to_string() << ".\n"); + EKAT_REQUIRE_MSG( + f_out.is_allocated() && f_in.is_allocated() && weight.is_allocated(), + "Error! All fields must be allocated."); + EKAT_REQUIRE_MSG(f_out.data_type() == f_in.data_type(), + "Error! In/out Fields have matching data types."); + EKAT_REQUIRE_MSG( + f_out.data_type() == weight.data_type(), + "Error! Weight field must have the same data type as input field."); + + // All good, call the implementation + impl::vert_contraction(f_out, f_in, weight, comm); +} + template ST frobenius_norm(const Field& f, const ekat::Comm* comm = nullptr) { diff --git a/components/eamxx/src/share/field/field_utils_impl.hpp b/components/eamxx/src/share/field/field_utils_impl.hpp index e6a8c41bfa3..6ffcf48ea9a 100644 --- a/components/eamxx/src/share/field/field_utils_impl.hpp +++ b/components/eamxx/src/share/field/field_utils_impl.hpp @@ -366,6 +366,105 @@ void horiz_contraction(const Field &f_out, const Field &f_in, } } +template +void vert_contraction(const Field &f_out, const Field &f_in, + const Field &weight, const ekat::Comm *comm) { + using KT = ekat::KokkosTypes; + using RangePolicy = Kokkos::RangePolicy; + using TeamPolicy = Kokkos::TeamPolicy; + using TeamMember = typename TeamPolicy::member_type; + using ESU = ekat::ExeSpaceUtils; + + auto l_out = f_out.get_header().get_identifier().get_layout(); + auto l_in = f_in.get_header().get_identifier().get_layout(); + auto l_w = weight.get_header().get_identifier().get_layout(); + + const int nlevs = l_in.dim(l_in.rank() - 1); + + switch(l_in.rank()) { + case 1: { + auto v_w = weight.get_view(); + auto v_in = f_in.get_view(); + auto v_out = f_out.get_view(); + Kokkos::parallel_reduce( + f_out.name(), RangePolicy(0, nlevs), + KOKKOS_LAMBDA(const int i, ST &ls) { ls += v_w(i) * v_in(i); }, + v_out); + } break; + case 2: { + auto v_in = f_in.get_view(); + auto v_out = f_out.get_view(); + const int d0 = l_in.dim(0); + auto p = ESU::get_default_team_policy(d0, nlevs); + if(l_w.rank() == 1) { + auto v_w = weight.get_view(); + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int i = tm.league_rank(); + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, nlevs), + [&](int j, ST &ac) { ac += v_w(j) * v_in(i, j); }, v_out(i)); + }); + } else { + auto v_w = weight.get_view(); + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int i = tm.league_rank(); + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, nlevs), + [&](int j, ST &ac) { ac += v_w(i, j) * v_in(i, j); }, + v_out(i)); + }); + } + } break; + case 3: { + auto v_in = f_in.get_view(); + auto v_out = f_out.get_view(); + const int d0 = l_in.dim(0); + const int d1 = l_in.dim(1); + auto p = ESU::get_default_team_policy(d0 * d1, nlevs); + if(l_w.rank() == 1) { + auto v_w = weight.get_view(); + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int idx = tm.league_rank(); + const int i = idx / d1; + const int j = idx % d1; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, nlevs), + [&](int k, ST &ac) { ac += v_w(k) * v_in(i, j, k); }, + v_out(i, j)); + }); + } else { + auto v_w = weight.get_view(); + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int idx = tm.league_rank(); + const int i = idx / d1; + const int j = idx % d1; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, nlevs), + [&](int k, ST &ac) { ac += v_w(i, k) * v_in(i, j, k); }, + v_out(i, j)); + }); + } + } break; + default: + EKAT_ERROR_MSG("Error! Unsupported field rank in vert_contraction.\n"); + } + + if(comm) { + // TODO: use device-side MPI calls + // TODO: the dev ptr causes problems; revisit this later + // TODO: doing cuda-aware MPI allreduce would be ~10% faster + Kokkos::fence(); + f_out.sync_to_host(); + comm->all_reduce(f_out.template get_internal_view_data(), + l_out.size(), MPI_SUM); + f_out.sync_to_dev(); + } +} + template ST frobenius_norm(const Field& f, const ekat::Comm* comm) { diff --git a/components/eamxx/src/share/tests/field_utils.cpp b/components/eamxx/src/share/tests/field_utils.cpp index 16da775d0a1..1b012c39ac2 100644 --- a/components/eamxx/src/share/tests/field_utils.cpp +++ b/components/eamxx/src/share/tests/field_utils.cpp @@ -236,6 +236,168 @@ TEST_CASE("utils") { REQUIRE(views_are_equal(result, manual_result)); } + SECTION("vert_contraction") { + using RPDF = std::uniform_real_distribution; + auto engine = setup_random_test(); + RPDF pdf(0, 1); + + int dim0 = 4; + int dim1 = 9; + int dim2 = 3; + + // Set a weight field + FieldIdentifier f00("f", {{LEV}, {dim2}}, m / s, "g"); + Field field00(f00); + field00.allocate_view(); + field00.sync_to_host(); + auto v00 = field00.get_strided_view(); + for(int i = 0; i < dim2; ++i) { + v00(i) = sp(i + 1) / sp(6); + } + field00.sync_to_dev(); + + // Create (random) sample fields + FieldIdentifier fsc("f", {{}, {}}, m / s, "g"); // scalar + FieldIdentifier f10("f", {{COL, LEV}, {dim0, dim2}}, m / s, "g"); + FieldIdentifier f11("f", {{CMP, LEV}, {dim1, dim2}}, m / s, "g"); + FieldIdentifier f20("f", {{COL, CMP, LEV}, {dim0, dim1, dim2}}, m / s, "g"); + Field fieldsc(fsc); + Field field10(f10); + Field field11(f11); + Field field20(f20); + fieldsc.allocate_view(); + field10.allocate_view(); + field11.allocate_view(); + field20.allocate_view(); + randomize(fieldsc, engine, pdf); + randomize(field10, engine, pdf); + randomize(field11, engine, pdf); + randomize(field20, engine, pdf); + + FieldIdentifier F_x("fx", {{COL}, {dim0}}, m / s, "g"); + FieldIdentifier F_y("fy", {{CMP}, {dim1}}, m / s, "g"); + FieldIdentifier F_z("fz", {{COL, CMP}, {dim0, dim1}}, m / s, "g"); + + Field field_x(F_x); + Field field_y(F_y); + Field field_z(F_z); + + // Test invalid inputs + REQUIRE_THROWS(vert_contraction(fieldsc, field_x, + field00)); // x not allocated yet + + field_x.allocate_view(); + field_y.allocate_view(); + field_z.allocate_view(); + + REQUIRE_THROWS(vert_contraction(fieldsc, field_y, + field_x)); // unmatching layout + REQUIRE_THROWS(vert_contraction(field_z, field11, + field11)); // wrong weight layout + + Field result; + + // Add test for invalid rank-2 weight field layout + FieldIdentifier bad_w("bad_w", {{CMP, LEV}, {dim1, dim2}}, m / s, "g"); + Field bad_weight(bad_w); + bad_weight.allocate_view(); + REQUIRE_THROWS(vert_contraction(result, field20, bad_weight)); + + // Add test for mismatched weight field dimensions + FieldIdentifier wrong_size_w("wrong_w", {{COL, LEV}, {dim0 + 1, dim2}}, + m / s, "g"); + Field wrong_weight(wrong_size_w); + wrong_weight.allocate_view(); + REQUIRE_THROWS(vert_contraction(result, field20, wrong_weight)); + + // Ensure a scalar case works + result = fieldsc.clone(); + vert_contraction(result, field00, field00); + result.sync_to_host(); + auto v = result.get_view(); + REQUIRE(v() == sp(1 + 4 + 9) / sp(36)); + + // Test higher-order cases + result = field_x.clone(); + vert_contraction(result, field10, field00); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({COL})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); + + // Check a 2D case with 1D weight + field10.sync_to_host(); + auto manual_result = result.clone(); + manual_result.deep_copy(0); + manual_result.sync_to_host(); + auto v1 = field10.get_strided_view(); + auto mr = manual_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim2; ++j) { + mr(i) += v00(j) * v1(i, j); + } + } + field11.sync_to_dev(); + manual_result.sync_to_dev(); + REQUIRE(views_are_equal(result, manual_result)); + + result = field_y.clone(); + vert_contraction(result, field11, field00); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({CMP})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); + + result = field_z.clone(); + vert_contraction(result, field20, field00); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({COL, CMP})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); + REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim1); + + // Check a 3D case with 1D weight + field20.sync_to_host(); + result.sync_to_host(); + manual_result = result.clone(); + manual_result.deep_copy(0); + manual_result.sync_to_host(); + auto v2 = field20.get_strided_view(); + auto mr2 = manual_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim1; ++j) { + for(int k = 0; k < dim2; ++k) { + mr2(i, j) += v00(k) * v2(i, j, k); + } + } + } + field20.sync_to_dev(); + manual_result.sync_to_dev(); + REQUIRE(views_are_equal(result, manual_result)); + + // Check a 3D case with 2D weight + result = field_z.clone(); + vert_contraction(result, field20, field10); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({COL, CMP})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); + REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim1); + + field20.sync_to_host(); + result.sync_to_host(); + manual_result = result.clone(); + manual_result.deep_copy(0); + manual_result.sync_to_host(); + auto mr3 = manual_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim1; ++j) { + for(int k = 0; k < dim2; ++k) { + mr3(i, j) += v1(i, k) * v2(i, j, k); + } + } + } + field20.sync_to_dev(); + manual_result.sync_to_dev(); + REQUIRE(views_are_equal(result, manual_result)); + } + SECTION ("frobenius") { auto v1 = f1.get_strided_view(); From c0739ee0992e88bff78711f4facfa7fe0f7e6e34 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Sat, 11 Jan 2025 15:45:04 -0800 Subject: [PATCH 512/529] EAMxx: improve vert_contraction sanity checks --- .../eamxx/src/share/field/field_utils.hpp | 39 ++++++++----------- 1 file changed, 17 insertions(+), 22 deletions(-) diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index 471fb0f60fc..1eb2f076d64 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -183,11 +183,11 @@ void horiz_contraction(const Field &f_out, const Field &f_in, // This is equivalent to f_out = einsum('...k->...', weight, f_in). // The impl is such that: // - f_out, f_in, and weight must be provided and allocated -// - The last dimension is for the levels (LEV) +// - The last dimension is for the levels (LEV/ILEV) // - There can be only up to 3 dimensions of f_in // - Weight is assumed to be (in order of checking/impl): -// - rank-1, with only LEV dimension -// - rank-2, with only COL and LEV dimensions +// - rank-1, with only LEV/ILEV dimension +// - rank-2, with only COL and LEV/ILEV dimensions template void vert_contraction(const Field &f_out, const Field &f_in, const Field &weight, const ekat::Comm *comm = nullptr) { @@ -201,12 +201,12 @@ void vert_contraction(const Field &f_out, const Field &f_in, // Sanity checks before handing off to the implementation EKAT_REQUIRE_MSG( - l_w.rank() >= 1 && l_w.rank() <= 2, + l_w.rank() == 1 or l_w.rank() == 2, "Error! The weight field must be at least rank-1 and at most rank-2.\n" "The weight field has rank " << l_w.rank() << ".\n"); EKAT_REQUIRE_MSG( - l_w.tags().back() == LEV, + l_w.tags().back() == LEV or l_w.tags().back() == ILEV, "Error! The weight field must have LEV as its last dimension.\n" "The weight field layout is " << l_w.to_string() << ".\n"); @@ -220,37 +220,32 @@ void vert_contraction(const Field &f_out, const Field &f_in, "The input field rank is " << l_in.rank() << " and the weight field rank is " << l_w.rank() << ".\n"); - EKAT_REQUIRE_MSG(l_in.tags().back() == LEV, + EKAT_REQUIRE_MSG(l_in.tags().back() == LEV or l_in.tags().back() == ILEV, "Error! The input field must have a level dimension.\n" "The input field layout is " << l_in.to_string() << ".\n"); EKAT_REQUIRE_MSG( - l_in.dim(l_in.rank() - 1) == l_w.dim(l_w.rank() - 1), + l_in.dims().back() == l_w.dims().back(), "Error! input and weight fields must have the same dimension along " "which we are taking the reducing the field (last dimensions).\n" "The weight field has last dimension " - << l_w.dim(l_w.rank() - 1) + << l_w.dims().back() << " while " "the input field has last dimension " - << l_in.dim(l_in.rank() - 1) << ".\n"); + << l_in.dims().back() << ".\n"); EKAT_REQUIRE_MSG( - l_in.dim(l_in.rank() - 1) > 0, + l_in.dims().back() > 0, "Error! The input field must have a non-zero level dimension.\n" "The input field layout is " << l_in.to_string() << ".\n"); if(l_w.rank() == 2) { - EKAT_REQUIRE_MSG( - l_w.tags()[0] == COL && l_in.tags()[0] == COL, - "Error! Rank-2 weight field must have COL as first dimension"); - EKAT_REQUIRE_MSG( - l_w.dim(0) == l_in.dim(0), - "Error! input and weight fields must have the same dimension along " - "which we are taking the reducing the field (first dimensions).\n" - "The weight field has first dimension " - << l_w.dim(0) - << " while " - "the input field has first dimension " - << l_in.dim(0) << ".\n"); + EKAT_REQUIRE_MSG(l_w.congruent(l_in.clone().strip_dim(CMP, false)), + "Error! Incompatible layouts\n" + " field in: " + + l_in.to_string() + + "\n" + " weight: " + + l_w.to_string() + "\n"); } EKAT_REQUIRE_MSG( l_out == l_in.clone().strip_dim(l_in.rank() - 1), From 03000876f0b9fec9cf343dbc3443f17920c05576 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Sun, 12 Jan 2025 07:23:31 -0800 Subject: [PATCH 513/529] EAMxx: add ILEV testing for vert_contraction --- .../eamxx/src/share/tests/field_utils.cpp | 316 +++++++++--------- 1 file changed, 163 insertions(+), 153 deletions(-) diff --git a/components/eamxx/src/share/tests/field_utils.cpp b/components/eamxx/src/share/tests/field_utils.cpp index 1b012c39ac2..4ba0a8294e4 100644 --- a/components/eamxx/src/share/tests/field_utils.cpp +++ b/components/eamxx/src/share/tests/field_utils.cpp @@ -237,165 +237,175 @@ TEST_CASE("utils") { } SECTION("vert_contraction") { - using RPDF = std::uniform_real_distribution; - auto engine = setup_random_test(); - RPDF pdf(0, 1); - - int dim0 = 4; - int dim1 = 9; - int dim2 = 3; - - // Set a weight field - FieldIdentifier f00("f", {{LEV}, {dim2}}, m / s, "g"); - Field field00(f00); - field00.allocate_view(); - field00.sync_to_host(); - auto v00 = field00.get_strided_view(); - for(int i = 0; i < dim2; ++i) { - v00(i) = sp(i + 1) / sp(6); - } - field00.sync_to_dev(); - - // Create (random) sample fields - FieldIdentifier fsc("f", {{}, {}}, m / s, "g"); // scalar - FieldIdentifier f10("f", {{COL, LEV}, {dim0, dim2}}, m / s, "g"); - FieldIdentifier f11("f", {{CMP, LEV}, {dim1, dim2}}, m / s, "g"); - FieldIdentifier f20("f", {{COL, CMP, LEV}, {dim0, dim1, dim2}}, m / s, "g"); - Field fieldsc(fsc); - Field field10(f10); - Field field11(f11); - Field field20(f20); - fieldsc.allocate_view(); - field10.allocate_view(); - field11.allocate_view(); - field20.allocate_view(); - randomize(fieldsc, engine, pdf); - randomize(field10, engine, pdf); - randomize(field11, engine, pdf); - randomize(field20, engine, pdf); - - FieldIdentifier F_x("fx", {{COL}, {dim0}}, m / s, "g"); - FieldIdentifier F_y("fy", {{CMP}, {dim1}}, m / s, "g"); - FieldIdentifier F_z("fz", {{COL, CMP}, {dim0, dim1}}, m / s, "g"); - - Field field_x(F_x); - Field field_y(F_y); - Field field_z(F_z); - - // Test invalid inputs - REQUIRE_THROWS(vert_contraction(fieldsc, field_x, - field00)); // x not allocated yet - - field_x.allocate_view(); - field_y.allocate_view(); - field_z.allocate_view(); - - REQUIRE_THROWS(vert_contraction(fieldsc, field_y, - field_x)); // unmatching layout - REQUIRE_THROWS(vert_contraction(field_z, field11, - field11)); // wrong weight layout - - Field result; - - // Add test for invalid rank-2 weight field layout - FieldIdentifier bad_w("bad_w", {{CMP, LEV}, {dim1, dim2}}, m / s, "g"); - Field bad_weight(bad_w); - bad_weight.allocate_view(); - REQUIRE_THROWS(vert_contraction(result, field20, bad_weight)); - - // Add test for mismatched weight field dimensions - FieldIdentifier wrong_size_w("wrong_w", {{COL, LEV}, {dim0 + 1, dim2}}, - m / s, "g"); - Field wrong_weight(wrong_size_w); - wrong_weight.allocate_view(); - REQUIRE_THROWS(vert_contraction(result, field20, wrong_weight)); - - // Ensure a scalar case works - result = fieldsc.clone(); - vert_contraction(result, field00, field00); - result.sync_to_host(); - auto v = result.get_view(); - REQUIRE(v() == sp(1 + 4 + 9) / sp(36)); - - // Test higher-order cases - result = field_x.clone(); - vert_contraction(result, field10, field00); - REQUIRE(result.get_header().get_identifier().get_layout().tags() == - std::vector({COL})); - REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); - - // Check a 2D case with 1D weight - field10.sync_to_host(); - auto manual_result = result.clone(); - manual_result.deep_copy(0); - manual_result.sync_to_host(); - auto v1 = field10.get_strided_view(); - auto mr = manual_result.get_strided_view(); - for(int i = 0; i < dim0; ++i) { - for(int j = 0; j < dim2; ++j) { - mr(i) += v00(j) * v1(i, j); + std::vector lev_tags = {LEV, ILEV}; + // iterate over lev_tags + for(auto lev_tag : lev_tags) { + using RPDF = std::uniform_real_distribution; + auto engine = setup_random_test(); + RPDF pdf(0, 1); + + int dim0 = 4; + int dim1 = 9; + // Note that parallel reduction is happening over dim2 (LEV/ILEV) + // If it is more than 3, the order of ops will lead to non-bfb results + int dim2 = lev_tag == LEV ? 3 : 3; + + // Set a weight field + FieldIdentifier f00("f", {{lev_tag}, {dim2}}, m / s, "g"); + Field field00(f00); + field00.allocate_view(); + field00.sync_to_host(); + auto v00 = field00.get_strided_view(); + for(int i = 0; i < dim2; ++i) { + // denominator is the sum of the first dim2 integers (analytically known) + v00(i) = sp(i + 1) / sp(dim2*(dim2+1)/2); } - } - field11.sync_to_dev(); - manual_result.sync_to_dev(); - REQUIRE(views_are_equal(result, manual_result)); - - result = field_y.clone(); - vert_contraction(result, field11, field00); - REQUIRE(result.get_header().get_identifier().get_layout().tags() == - std::vector({CMP})); - REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); - - result = field_z.clone(); - vert_contraction(result, field20, field00); - REQUIRE(result.get_header().get_identifier().get_layout().tags() == - std::vector({COL, CMP})); - REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); - REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim1); - - // Check a 3D case with 1D weight - field20.sync_to_host(); - result.sync_to_host(); - manual_result = result.clone(); - manual_result.deep_copy(0); - manual_result.sync_to_host(); - auto v2 = field20.get_strided_view(); - auto mr2 = manual_result.get_strided_view(); - for(int i = 0; i < dim0; ++i) { - for(int j = 0; j < dim1; ++j) { - for(int k = 0; k < dim2; ++k) { - mr2(i, j) += v00(k) * v2(i, j, k); + field00.sync_to_dev(); + + // Create (random) sample fields + FieldIdentifier fsc("f", {{}, {}}, m / s, "g"); // scalar + FieldIdentifier f10("f", {{COL, lev_tag}, {dim0, dim2}}, m / s, "g"); + FieldIdentifier f11("f", {{CMP, lev_tag}, {dim1, dim2}}, m / s, "g"); + FieldIdentifier f20("f", {{COL, CMP, lev_tag}, {dim0, dim1, dim2}}, m / s, + "g"); + Field fieldsc(fsc); + Field field10(f10); + Field field11(f11); + Field field20(f20); + fieldsc.allocate_view(); + field10.allocate_view(); + field11.allocate_view(); + field20.allocate_view(); + randomize(fieldsc, engine, pdf); + randomize(field10, engine, pdf); + randomize(field11, engine, pdf); + randomize(field20, engine, pdf); + + FieldIdentifier F_x("fx", {{COL}, {dim0}}, m / s, "g"); + FieldIdentifier F_y("fy", {{CMP}, {dim1}}, m / s, "g"); + FieldIdentifier F_z("fz", {{COL, CMP}, {dim0, dim1}}, m / s, "g"); + + Field field_x(F_x); + Field field_y(F_y); + Field field_z(F_z); + + // Test invalid inputs + REQUIRE_THROWS(vert_contraction(fieldsc, field_x, + field00)); // x not allocated yet + + field_x.allocate_view(); + field_y.allocate_view(); + field_z.allocate_view(); + + REQUIRE_THROWS(vert_contraction(fieldsc, field_y, + field_x)); // unmatching layout + REQUIRE_THROWS(vert_contraction(field_z, field11, + field11)); // wrong weight layout + + Field result; + + // Add test for invalid rank-2 weight field layout + FieldIdentifier bad_w("bad_w", {{CMP, lev_tag}, {dim1, dim2}}, m / s, "g"); + Field bad_weight(bad_w); + bad_weight.allocate_view(); + REQUIRE_THROWS(vert_contraction(result, field20, bad_weight)); + + // Add test for mismatched weight field dimensions + FieldIdentifier wrong_size_w("wrong_w", {{COL, lev_tag}, {dim0 + 1, dim2}}, + m / s, "g"); + Field wrong_weight(wrong_size_w); + wrong_weight.allocate_view(); + REQUIRE_THROWS(vert_contraction(result, field20, wrong_weight)); + + // Ensure a scalar case works + result = fieldsc.clone(); + vert_contraction(result, field00, field00); + result.sync_to_host(); + auto v = result.get_view(); + // numerator is the sum of the suqares of the first dim2 integers (analytically known) + // denominator is the sum of the first dim2 integers squared (analytically known) + REQUIRE(v() == sp(dim2*(dim2+1)*(2*dim2+1)/6) / sp((dim2*(dim2+1)/2)*(dim2*(dim2+1)/2))); + + // Test higher-order cases + result = field_x.clone(); + vert_contraction(result, field10, field00); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({COL})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); + + // Check a 2D case with 1D weight + field10.sync_to_host(); + auto manual_result = result.clone(); + manual_result.deep_copy(0); + manual_result.sync_to_host(); + auto v1 = field10.get_strided_view(); + auto mr = manual_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim2; ++j) { + mr(i) += v00(j) * v1(i, j); } } - } - field20.sync_to_dev(); - manual_result.sync_to_dev(); - REQUIRE(views_are_equal(result, manual_result)); - - // Check a 3D case with 2D weight - result = field_z.clone(); - vert_contraction(result, field20, field10); - REQUIRE(result.get_header().get_identifier().get_layout().tags() == - std::vector({COL, CMP})); - REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); - REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim1); - - field20.sync_to_host(); - result.sync_to_host(); - manual_result = result.clone(); - manual_result.deep_copy(0); - manual_result.sync_to_host(); - auto mr3 = manual_result.get_strided_view(); - for(int i = 0; i < dim0; ++i) { - for(int j = 0; j < dim1; ++j) { - for(int k = 0; k < dim2; ++k) { - mr3(i, j) += v1(i, k) * v2(i, j, k); + field11.sync_to_dev(); + manual_result.sync_to_dev(); + REQUIRE(views_are_equal(result, manual_result)); + + result = field_y.clone(); + vert_contraction(result, field11, field00); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({CMP})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim1); + + result = field_z.clone(); + vert_contraction(result, field20, field00); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({COL, CMP})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); + REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim1); + + // Check a 3D case with 1D weight + field20.sync_to_host(); + result.sync_to_host(); + manual_result = result.clone(); + manual_result.deep_copy(0); + manual_result.sync_to_host(); + auto v2 = field20.get_strided_view(); + auto mr2 = manual_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim1; ++j) { + for(int k = 0; k < dim2; ++k) { + mr2(i, j) += v00(k) * v2(i, j, k); + } } } + field20.sync_to_dev(); + manual_result.sync_to_dev(); + REQUIRE(views_are_equal(result, manual_result)); + + // Check a 3D case with 2D weight + result = field_z.clone(); + vert_contraction(result, field20, field10); + REQUIRE(result.get_header().get_identifier().get_layout().tags() == + std::vector({COL, CMP})); + REQUIRE(result.get_header().get_identifier().get_layout().dim(0) == dim0); + REQUIRE(result.get_header().get_identifier().get_layout().dim(1) == dim1); + + field20.sync_to_host(); + result.sync_to_host(); + manual_result = result.clone(); + manual_result.deep_copy(0); + manual_result.sync_to_host(); + auto mr3 = manual_result.get_strided_view(); + for(int i = 0; i < dim0; ++i) { + for(int j = 0; j < dim1; ++j) { + for(int k = 0; k < dim2; ++k) { + mr3(i, j) += v1(i, k) * v2(i, j, k); + } + } + } + field20.sync_to_dev(); + manual_result.sync_to_dev(); + REQUIRE(views_are_equal(result, manual_result)); } - field20.sync_to_dev(); - manual_result.sync_to_dev(); - REQUIRE(views_are_equal(result, manual_result)); } SECTION ("frobenius") { From e1639edde8c71e2e737043bd83c565251b9cd374 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Jan 2025 08:42:14 -0800 Subject: [PATCH 514/529] bug fix for SCM tests --- share/util/shr_scam_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/share/util/shr_scam_mod.F90 b/share/util/shr_scam_mod.F90 index dd82ab5e171..2fb92f769cc 100644 --- a/share/util/shr_scam_mod.F90 +++ b/share/util/shr_scam_mod.F90 @@ -647,11 +647,13 @@ subroutine shr_scam_checkSurface(scmlon, scmlat, scm_multcols, scm_nx, scm_ny, & real(r8) :: sst_constant_value character(len=CL) :: restfilm = 'unset' character(len=CL) :: restfils = 'unset' + real(r8) :: RSO_fixed_MLD + real(r8) :: RSO_relax_tau integer(IN) :: nfrac logical :: force_prognostic_true = .false. namelist /dom_inparm/ sstcyc, nrevsn, rest_pfile, bndtvs, focndomain namelist / docn_nml / decomp, sst_constant_value, force_prognostic_true, & - restfilm, restfils + restfilm, restfils, RSO_fixed_MLD, RSO_relax_tau !------------------------------------------------------------------------------- ! Notes: From 83dd9f7de5c1f0fd6b4d388f86d1ae40e9ccae27 Mon Sep 17 00:00:00 2001 From: mahf708 Date: Mon, 13 Jan 2025 11:51:58 -0800 Subject: [PATCH 515/529] EAMxx: refactor vert_contraction to lessen code dupl --- .../src/share/field/field_utils_impl.hpp | 79 ++++++++----------- 1 file changed, 34 insertions(+), 45 deletions(-) diff --git a/components/eamxx/src/share/field/field_utils_impl.hpp b/components/eamxx/src/share/field/field_utils_impl.hpp index 6ffcf48ea9a..94584cbd043 100644 --- a/components/eamxx/src/share/field/field_utils_impl.hpp +++ b/components/eamxx/src/share/field/field_utils_impl.hpp @@ -381,6 +381,17 @@ void vert_contraction(const Field &f_out, const Field &f_in, const int nlevs = l_in.dim(l_in.rank() - 1); + // To avoid duplicating code for the 1d and 2d weight cases, + // we use a view to access the weight ahead of time + typename Field::get_view_type w1d; + typename Field::get_view_type w2d; + auto w_is_1d = l_w.rank() == 1; + if(w_is_1d) { + w1d = weight.get_view(); + } else { + w2d = weight.get_view(); + } + switch(l_in.rank()) { case 1: { auto v_w = weight.get_view(); @@ -396,26 +407,16 @@ void vert_contraction(const Field &f_out, const Field &f_in, auto v_out = f_out.get_view(); const int d0 = l_in.dim(0); auto p = ESU::get_default_team_policy(d0, nlevs); - if(l_w.rank() == 1) { - auto v_w = weight.get_view(); - Kokkos::parallel_for( - f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { - const int i = tm.league_rank(); - Kokkos::parallel_reduce( - Kokkos::TeamVectorRange(tm, nlevs), - [&](int j, ST &ac) { ac += v_w(j) * v_in(i, j); }, v_out(i)); - }); - } else { - auto v_w = weight.get_view(); - Kokkos::parallel_for( - f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { - const int i = tm.league_rank(); - Kokkos::parallel_reduce( - Kokkos::TeamVectorRange(tm, nlevs), - [&](int j, ST &ac) { ac += v_w(i, j) * v_in(i, j); }, - v_out(i)); - }); - } + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int i = tm.league_rank(); + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, nlevs), + [&](int j, ST &ac) { + ac += w_is_1d ? w1d(j) * v_in(i, j) : w2d(i, j) * v_in(i, j); + }, + v_out(i)); + }); } break; case 3: { auto v_in = f_in.get_view(); @@ -423,31 +424,19 @@ void vert_contraction(const Field &f_out, const Field &f_in, const int d0 = l_in.dim(0); const int d1 = l_in.dim(1); auto p = ESU::get_default_team_policy(d0 * d1, nlevs); - if(l_w.rank() == 1) { - auto v_w = weight.get_view(); - Kokkos::parallel_for( - f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { - const int idx = tm.league_rank(); - const int i = idx / d1; - const int j = idx % d1; - Kokkos::parallel_reduce( - Kokkos::TeamVectorRange(tm, nlevs), - [&](int k, ST &ac) { ac += v_w(k) * v_in(i, j, k); }, - v_out(i, j)); - }); - } else { - auto v_w = weight.get_view(); - Kokkos::parallel_for( - f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { - const int idx = tm.league_rank(); - const int i = idx / d1; - const int j = idx % d1; - Kokkos::parallel_reduce( - Kokkos::TeamVectorRange(tm, nlevs), - [&](int k, ST &ac) { ac += v_w(i, k) * v_in(i, j, k); }, - v_out(i, j)); - }); - } + Kokkos::parallel_for( + f_out.name(), p, KOKKOS_LAMBDA(const TeamMember &tm) { + const int idx = tm.league_rank(); + const int i = idx / d1; + const int j = idx % d1; + Kokkos::parallel_reduce( + Kokkos::TeamVectorRange(tm, nlevs), + [&](int k, ST &ac) { + ac += w_is_1d ? w1d(k) * v_in(i, j, k) + : w2d(i, k) * v_in(i, j, k); + }, + v_out(i, j)); + }); } break; default: EKAT_ERROR_MSG("Error! Unsupported field rank in vert_contraction.\n"); From 50c74d679a700083c48cc92523bab7b3e0ccecd6 Mon Sep 17 00:00:00 2001 From: Michael J Schmidt Date: Mon, 13 Jan 2025 12:23:15 -0800 Subject: [PATCH 516/529] update mam4xx to include fix for wet scavenging --- externals/mam4xx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/mam4xx b/externals/mam4xx index 5b1dacdb4aa..0c006b49bda 160000 --- a/externals/mam4xx +++ b/externals/mam4xx @@ -1 +1 @@ -Subproject commit 5b1dacdb4aa6fb9819fde8a8d2b3c92bbebae7e9 +Subproject commit 0c006b49bdaf696f43ec0d7849ec241a64f642e1 From f4c8489519d3efae3036f7047e7397fec624e28b Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Mon, 13 Jan 2025 17:08:53 -0700 Subject: [PATCH 517/529] EAMxx: set testing max ranks to 2 on ghci-snl-cuda --- components/eamxx/cmake/machine-files/ghci-snl-cuda.cmake | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/eamxx/cmake/machine-files/ghci-snl-cuda.cmake b/components/eamxx/cmake/machine-files/ghci-snl-cuda.cmake index 72a352f09d7..83d1d20c627 100644 --- a/components/eamxx/cmake/machine-files/ghci-snl-cuda.cmake +++ b/components/eamxx/cmake/machine-files/ghci-snl-cuda.cmake @@ -12,3 +12,6 @@ set(EKAT_MPI_NP_FLAG "-n" CACHE STRING "The mpirun flag for designating the tota # TODO: rebuild cuda image with cuda-aware MPI, so we can set this to ON option(SCREAM_MPI_ON_DEVICE "Whether to use device pointers for MPI calls" OFF) + +# Currently, we have 2 GPUs/node on Blake, and we run a SINGLE build per node, so we can fit 2 ranks there +set(SCREAM_TEST_MAX_RANKS 2 CACHE STRING "Upper limit on ranks for mpi tests") From 724b85148400347243110d6d1a51450ec44b903f Mon Sep 17 00:00:00 2001 From: Michael J Schmidt Date: Mon, 13 Jan 2025 17:54:37 -0700 Subject: [PATCH 518/529] re-enable wet scavenging test for mam --- .../tests/multi-process/dynamics_physics/mam/CMakeLists.txt | 2 +- .../eamxx/tests/multi-process/physics_only/CMakeLists.txt | 4 ++-- components/eamxx/tests/single-process/CMakeLists.txt | 4 +--- externals/mam4xx | 2 +- 4 files changed, 5 insertions(+), 7 deletions(-) diff --git a/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt b/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt index 3cf0ac1995a..c67d46d4ffe 100644 --- a/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt +++ b/components/eamxx/tests/multi-process/dynamics_physics/mam/CMakeLists.txt @@ -1,3 +1,3 @@ add_subdirectory(homme_shoc_cld_p3_mam_optics_rrtmgp) add_subdirectory(homme_shoc_cld_mam_aci_p3_mam_optics_rrtmgp_mam_drydep) -# add_subdirectory(homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav) +add_subdirectory(homme_shoc_cld_spa_p3_rrtmgp_mam4_wetscav) diff --git a/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt b/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt index 6dc787c4a35..bb23911ff1c 100644 --- a/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt +++ b/components/eamxx/tests/multi-process/physics_only/CMakeLists.txt @@ -9,8 +9,8 @@ if (SCREAM_DOUBLE_PRECISION) add_subdirectory(mam/shoc_cldfrac_mam4_aci_p3) add_subdirectory(mam/shoc_cldfrac_mam4_aci_p3_rrtmgp) add_subdirectory(mam/shoc_cldfrac_mam4_aci_p3_mam4_optics_rrtmgp) - # add_subdirectory(mam/p3_mam4_wetscav) - # add_subdirectory(mam/shoc_cldfrac_p3_wetscav) + add_subdirectory(mam/p3_mam4_wetscav) + add_subdirectory(mam/shoc_cldfrac_p3_wetscav) add_subdirectory(mam/mam4_srf_online_emiss_mam4_constituent_fluxes) endif() endif() diff --git a/components/eamxx/tests/single-process/CMakeLists.txt b/components/eamxx/tests/single-process/CMakeLists.txt index ee790550bd4..074a30c924f 100644 --- a/components/eamxx/tests/single-process/CMakeLists.txt +++ b/components/eamxx/tests/single-process/CMakeLists.txt @@ -24,9 +24,7 @@ if (SCREAM_ENABLE_MAM) add_subdirectory(mam/drydep) add_subdirectory(mam/emissions) add_subdirectory(mam/constituent_fluxes) - - # Currently, this test has a runtime error. Disabling while MAM folks debug. - # add_subdirectory(mam/wet_scav) + add_subdirectory(mam/wet_scav) # Currently this test produces non-deterministic output. # Commenting it so the other PRs can test normally diff --git a/externals/mam4xx b/externals/mam4xx index 0c006b49bda..277ead15bcb 160000 --- a/externals/mam4xx +++ b/externals/mam4xx @@ -1 +1 @@ -Subproject commit 0c006b49bdaf696f43ec0d7849ec241a64f642e1 +Subproject commit 277ead15bcb981a19b5fbed103bfad34124e1e19 From dbf4f3baf5fe9246f4d5d4741e5d00f02a92b89c Mon Sep 17 00:00:00 2001 From: Michael J Schmidt Date: Mon, 13 Jan 2025 18:32:01 -0700 Subject: [PATCH 519/529] ff mam4xx to main after merge --- externals/mam4xx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/mam4xx b/externals/mam4xx index 277ead15bcb..f3f215185ca 160000 --- a/externals/mam4xx +++ b/externals/mam4xx @@ -1 +1 @@ -Subproject commit 277ead15bcb981a19b5fbed103bfad34124e1e19 +Subproject commit f3f215185ca59cd765704e763c499b484791fc62 From a8996803e322236f5a6a9a3632b2a200a0373ec2 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 14 Jan 2025 13:43:04 -0600 Subject: [PATCH 520/529] EAMxx: fix compilation error on chrysalis --- components/eamxx/src/share/util/eamxx_data_interpolation.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp index 0b038c607bf..92fec65151b 100644 --- a/components/eamxx/src/share/util/eamxx_data_interpolation.cpp +++ b/components/eamxx/src/share/util/eamxx_data_interpolation.cpp @@ -154,7 +154,8 @@ setup_time_database (const strvec_t& input_files, } // Make sure there are no repetitions - EKAT_REQUIRE_MSG (std::unordered_set(input_files.begin(),input_files.end()).size()==input_files.size(), + auto num_unique_files = std::unordered_set(input_files.begin(),input_files.end()).size(); + EKAT_REQUIRE_MSG (num_unique_files==input_files.size(), "[DataInterpolation] Error! The input files list contains duplicates.\n" " - input_files:\n " + ekat::join(input_files,"\n ") + "\n"); From b0443a339d1cff2d9f96cc2f685caac3da138831 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Tue, 14 Jan 2025 14:43:18 -0600 Subject: [PATCH 521/529] Make bld files consistent with Registry --- .../mpas-albany-landice/bld/build-namelist | 4 +++ .../bld/build-namelist-section | 4 +++ .../namelist_files/namelist_defaults_mali.xml | 4 +++ .../namelist_definition_mali.xml | 32 +++++++++++++++++++ 4 files changed, 44 insertions(+) diff --git a/components/mpas-albany-landice/bld/build-namelist b/components/mpas-albany-landice/bld/build-namelist index 15272f7a2da..6634f7bd563 100755 --- a/components/mpas-albany-landice/bld/build-namelist +++ b/components/mpas-albany-landice/bld/build-namelist @@ -559,6 +559,10 @@ add_default($nl, 'config_alpha_subglacial_discharge'); add_default($nl, 'config_subglacial_discharge_coefficient'); add_default($nl, 'config_subglacial_discharge_intercept'); add_default($nl, 'config_uniform_face_melt_rate'); +add_default($nl, 'config_ocean_data_extrapolation'); +add_default($nl, 'config_ocean_data_extrap_ncells_extra'); +add_default($nl, 'config_invalid_value_TF'); +add_default($nl, 'config_weight_value_cell'); ####################################### # Namelist group: physical_parameters # diff --git a/components/mpas-albany-landice/bld/build-namelist-section b/components/mpas-albany-landice/bld/build-namelist-section index 4b5e05ec3cd..3001fa9754a 100644 --- a/components/mpas-albany-landice/bld/build-namelist-section +++ b/components/mpas-albany-landice/bld/build-namelist-section @@ -121,6 +121,10 @@ add_default($nl, 'config_alpha_subglacial_discharge'); add_default($nl, 'config_subglacial_discharge_coefficient'); add_default($nl, 'config_subglacial_discharge_intercept'); add_default($nl, 'config_uniform_face_melt_rate'); +add_default($nl, 'config_ocean_data_extrapolation'); +add_default($nl, 'config_ocean_data_extrap_ncells_extra'); +add_default($nl, 'config_invalid_value_TF'); +add_default($nl, 'config_weight_value_cell'); ####################################### # Namelist group: physical_parameters # diff --git a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml index 8dc305533ca..7bf8a86b958 100644 --- a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml +++ b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml @@ -106,6 +106,10 @@ 3.0e-4 0.15 0.0 +.false. +10 +1.0e36 +0.9 910.0 diff --git a/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml b/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml index e16e7042a2c..d765f8ee5a1 100644 --- a/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml +++ b/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml @@ -795,6 +795,38 @@ Valid values: any non-negative value Default: Defined in namelist_defaults.xml + +If true, extrapolate ocean data (temperature, salinity, thermal forcing) from external source into underneath the ice draft. + +Valid values: .true. or .false. +Default: Defined in namelist_defaults.xml + + + +number of extra cells for over-extrapolation into grounded ice + +Valid values: any non-negative value +Default: Defined in namelist_defaults.xml + + + +value assigned to indicate invalid thermal forcing value when config_ocean_data_extrapolation is set to true + +Valid values: Any real value +Default: Defined in namelist_defaults.xml + + + +weight used to smooth horizontal extrapolation of ocean data field. Value close to 1 implies more weight of the current cell value versus the averaged value of the neighbouring cells around the cell + +Valid values: any real value between 0 and 1 +Default: Defined in namelist_defaults.xml + + From 064ebad5617a84fa37a468225200df451dc2c650 Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Tue, 14 Jan 2025 15:22:33 -0700 Subject: [PATCH 522/529] EAMxx: fix bug in io_se_grid unit test --- components/eamxx/src/share/io/tests/io_se_grid.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/eamxx/src/share/io/tests/io_se_grid.cpp b/components/eamxx/src/share/io/tests/io_se_grid.cpp index 01afb5369f1..0e6d28b53d6 100644 --- a/components/eamxx/src/share/io/tests/io_se_grid.cpp +++ b/components/eamxx/src/share/io/tests/io_se_grid.cpp @@ -152,8 +152,9 @@ get_test_fm(const std::shared_ptr& grid, // field_2 is not partitioned, so let's sync it across ranks auto f2 = fm->get_field("field_2"); - auto v2 = f2.get_view(); + auto v2 = f2.get_view(); comm.all_reduce(v2.data(),nlevs,MPI_MAX); + f2.sync_to_dev(); return fm; } From e42a3d3ef80710a4b4eb89e5b303f52ad98e315e Mon Sep 17 00:00:00 2001 From: Luca Bertagna Date: Wed, 15 Jan 2025 15:00:52 -0700 Subject: [PATCH 523/529] EAMxx: change extrapolation of SPA fields at the top of the atm Do constant extrap rather than linear ramp down to 0 at p=0 --- .../eamxx/src/physics/spa/spa_functions_impl.hpp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/components/eamxx/src/physics/spa/spa_functions_impl.hpp b/components/eamxx/src/physics/spa/spa_functions_impl.hpp index 6c971183702..24195b9da1a 100644 --- a/components/eamxx/src/physics/spa/spa_functions_impl.hpp +++ b/components/eamxx/src/physics/spa/spa_functions_impl.hpp @@ -521,14 +521,14 @@ ::update_spa_data_from_file( // Set the first/last entries of the spa data, so that linear interp // can extrapolate if the p_tgt is outside the p_src bounds Kokkos::single(Kokkos::PerTeam(team),[&]{ - spa_data_ccn3(icol,0) = 0; + spa_data_ccn3(icol,0) = ccn3(icol,0); for (int isw=0; isw Date: Wed, 15 Jan 2025 15:19:31 -0700 Subject: [PATCH 524/529] EAMxx: fix misc compiler warnings --- .../eamxx/src/diagnostics/tests/horiz_avg_test.cpp | 4 ---- .../physics/spa/tests/spa_one_to_one_remap_test.cpp | 13 ++++++++----- components/eamxx/src/share/field/field_utils.hpp | 8 +++++--- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp b/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp index bca67f120ad..9b9ec2022fa 100644 --- a/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp +++ b/components/eamxx/src/diagnostics/tests/horiz_avg_test.cpp @@ -29,10 +29,6 @@ std::shared_ptr create_gm(const ekat::Comm &comm, const int ncols, TEST_CASE("horiz_avg") { using namespace ShortFieldTagsNames; using namespace ekat::units; - using TeamPolicy = Kokkos::TeamPolicy; - using TeamMember = typename TeamPolicy::member_type; - using KT = ekat::KokkosTypes; - using ESU = ekat::ExeSpaceUtils; // A numerical tolerance auto tol = std::numeric_limits::epsilon() * 100; diff --git a/components/eamxx/src/physics/spa/tests/spa_one_to_one_remap_test.cpp b/components/eamxx/src/physics/spa/tests/spa_one_to_one_remap_test.cpp index 71a7187ed38..8d38d19a4c9 100644 --- a/components/eamxx/src/physics/spa/tests/spa_one_to_one_remap_test.cpp +++ b/components/eamxx/src/physics/spa/tests/spa_one_to_one_remap_test.cpp @@ -123,16 +123,19 @@ Real ccn3_func(const int t, const gid_type i, const int klev) // Real aer_func(const int t, const gid_type i, const int bnd, const int klev, const int mode) { + Real ret = -1; if (mode==0) { // G - return t; + ret = t; } else if (mode==1) { // SSA - return i; + ret = i; } else if (mode==2) { // TAU - return bnd; + ret = bnd; } else if (mode==3) { // LW-TAU - return klev; + ret = klev; + } else { + EKAT_REQUIRE_MSG(false,"Error in aer_func, incorrect mode passed"); // Shouldn't get here, but just in case } - EKAT_REQUIRE_MSG(false,"Error in aer_func, incorrect mode passed"); // Shouldn't get here, but just in case + return ret; } // aer_func } // namespace diff --git a/components/eamxx/src/share/field/field_utils.hpp b/components/eamxx/src/share/field/field_utils.hpp index 1eb2f076d64..c6acbfc4079 100644 --- a/components/eamxx/src/share/field/field_utils.hpp +++ b/components/eamxx/src/share/field/field_utils.hpp @@ -11,16 +11,18 @@ inline bool views_are_equal(const Field& f1, const Field& f2, const ekat::Comm* EKAT_REQUIRE_MSG (f1.data_type()==f2.data_type(), "Error! Views have different data types.\n"); + bool ret = false; switch (f1.data_type()) { case DataType::IntType: - return impl::views_are_equal(f1,f2,comm); + ret = impl::views_are_equal(f1,f2,comm); break; case DataType::FloatType: - return impl::views_are_equal(f1,f2,comm); + ret = impl::views_are_equal(f1,f2,comm); break; case DataType::DoubleType: - return impl::views_are_equal(f1,f2,comm); + ret = impl::views_are_equal(f1,f2,comm); break; default: EKAT_ERROR_MSG ("Error! Unrecognized field data type.\n"); } + return ret; } template From da8115932f4c1e4e347a15f25738982e4a9d3332 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 15 Jan 2025 15:21:12 -0700 Subject: [PATCH 525/529] Begin to de-scream things (use eamxx instead) This PR changes the test suite names and unifies the testmods under eamxx. [BFB] --- .github/workflows/eamxx-v1-testing.yml | 16 ++-- cime_config/tests.py | 94 ++++++++++--------- .../{scream => eamxx}/L128/shell_commands | 0 .../{scream => eamxx}/L72/shell_commands | 0 .../{scream => eamxx}/bfbhash/shell_commands | 0 .../dpxx/arm97/shell_commands | 0 .../dpxx/comble/shell_commands | 0 .../dpxx/dycomsrf01/shell_commands | 0 .../internal_diagnostics_level/shell_commands | 0 .../mam4xx/aci/shell_commands | 2 +- .../mam4xx/aero_microphysics/shell_commands | 2 +- .../mam4xx/all_mam4xx_procs/shell_commands | 2 +- .../mam4xx/drydep/shell_commands | 2 +- .../mam4xx/optics/shell_commands | 2 +- .../remap_emiss_ne4_ne30/shell_commands | 2 +- .../shell_commands | 2 +- .../mam4xx/update_eamxx_num_tracers.sh | 0 .../mam4xx/wetscav/shell_commands | 2 +- .../{scream => eamxx}/output/README | 0 .../output/diags/shell_commands | 0 .../output/hremap_to_ne4/shell_commands | 0 .../output/phys/shell_commands | 0 .../output/phys_dyn/shell_commands | 0 .../output/preset/1/shell_commands | 2 +- .../output/preset/2/shell_commands | 2 +- .../output/preset/3/shell_commands | 2 +- .../output/preset/4/shell_commands | 2 +- .../output/preset/5/shell_commands | 2 +- .../output/preset/6/shell_commands | 2 +- .../output/set_avg/shell_commands | 0 .../output/vremap/shell_commands | 0 .../perf_test/shell_commands | 0 .../rad_frequency_2/shell_commands | 0 .../shell_commands | 0 .../shell_commands | 0 .../sl_nsubstep2/shell_commands | 0 .../small_kernels/shell_commands | 0 .../small_kernels_p3/shell_commands | 0 .../small_kernels_shoc/shell_commands | 0 .../spa_remap/shell_commands | 0 40 files changed, 70 insertions(+), 68 deletions(-) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/L128/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/L72/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/bfbhash/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/dpxx/arm97/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/dpxx/comble/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/dpxx/dycomsrf01/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/internal_diagnostics_level/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/aci/shell_commands (95%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/aero_microphysics/shell_commands (92%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/all_mam4xx_procs/shell_commands (96%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/drydep/shell_commands (92%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/optics/shell_commands (90%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/remap_emiss_ne4_ne30/shell_commands (98%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands (92%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/update_eamxx_num_tracers.sh (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/mam4xx/wetscav/shell_commands (92%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/README (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/diags/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/hremap_to_ne4/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/phys/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/phys_dyn/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/preset/1/shell_commands (92%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/preset/2/shell_commands (93%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/preset/3/shell_commands (93%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/preset/4/shell_commands (94%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/preset/5/shell_commands (94%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/preset/6/shell_commands (94%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/set_avg/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/output/vremap/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/perf_test/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/rad_frequency_2/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/scream_example_testmod_atmchange/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/scream_example_testmod_cmake/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/sl_nsubstep2/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/small_kernels/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/small_kernels_p3/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/small_kernels_shoc/shell_commands (100%) rename components/eamxx/cime_config/testdefs/testmods_dirs/{scream => eamxx}/spa_remap/shell_commands (100%) diff --git a/.github/workflows/eamxx-v1-testing.yml b/.github/workflows/eamxx-v1-testing.yml index a4a164907ac..e738a4adcb9 100644 --- a/.github/workflows/eamxx-v1-testing.yml +++ b/.github/workflows/eamxx-v1-testing.yml @@ -65,14 +65,14 @@ jobs: strategy: matrix: test: - - full_name: ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.ghci-snl-cpu_gnu.scream-output-preset-2 - short_name: ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.scream-output-preset-2 - - full_name: ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.ghci-snl-cpu_gnu.scream-dpxx-arm97 - short_name: ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.scream-dpxx-arm97 - - full_name: ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.ghci-snl-cpu_gnu.scream-small_kernels--scream-output-preset-5 - short_name: ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-small_kernels--scream-output-preset-5 - - full_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.ghci-snl-cpu_gnu.scream-mam4xx-all_mam4xx_procs - short_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-all_mam4xx_procs + - full_name: ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.ghci-snl-cpu_gnu.eamxx-output-preset-2 + short_name: ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.eamxx-output-preset-2 + - full_name: ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.ghci-snl-cpu_gnu.eamxx-dpxx-arm97 + short_name: ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.eamxx-dpxx-arm97 + - full_name: ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.ghci-snl-cpu_gnu.eamxx-small_kernels--eamxx-output-preset-5 + short_name: ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels--eamxx-output-preset-5 + - full_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.ghci-snl-cpu_gnu.eamxx-mam4xx-all_mam4xx_procs + short_name: SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-all_mam4xx_procs - full_name: SMS_Ln3_P4.ne4pg2_oQU480.F2010-MMF2.ghci-snl-cpu_gnu short_name: SMS_Ln3_P4.ne4pg2_oQU480.F2010-MMF2 fail-fast: false diff --git a/cime_config/tests.py b/cime_config/tests.py index 9f788ef84c2..5d6086f2113 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -323,6 +323,8 @@ "ERS_Ld5.TL319_oQU240wLI_ais8to30.MPAS_LISIO_JRA1p5.mpaso-ocn_glcshelf", "SMS_P12x2.ne4pg2_oQU480.WCYCL1850NS.allactive-mach_mods", "ERS_Ln9.ne4pg2_ne4pg2.F2010-MMF1.eam-mmf_crmout", + "SMS_Lh4.ne4_ne4.F2010-SCREAMv1.eamxx-output-preset-1", + "SMS_Lh4.ne4_ne4.F2010-SCREAMv1.eamxx-output-preset-1--eamxx-prod", ) }, @@ -653,17 +655,17 @@ "time" : "03:00:00", }, - "e3sm_scream" : { + "e3sm_eamxx" : { "time" : "03:00:00", - "inherit" : ("e3sm_scream_v0"), + "inherit" : ("e3sm_eamxx_v0"), }, - "e3sm_scream_v0" : { + "e3sm_eamxx_v0" : { "time" : "03:00:00", - "inherit" : ("e3sm_scream_v0_lowres"), + "inherit" : ("e3sm_eamxx_v0_lowres"), }, - "e3sm_scream_v0_lowres" : { + "e3sm_eamxx_v0_lowres" : { "time" : "03:00:00", "tests" : ( "SMS_D.ne4pg2_ne4pg2.F2010-SCREAM-HR", @@ -674,70 +676,70 @@ ) }, - "e3sm_scream_v1" : { + "e3sm_eamxx_v1" : { "time" : "03:00:00", - "inherit" : ("e3sm_scream_v1_lowres", "e3sm_scream_v1_medres", "e3sm_scream_v1_mpassi"), + "inherit" : ("e3sm_eamxx_v1_lowres", "e3sm_eamxx_v1_medres", "e3sm_eamxx_v1_mpassi"), }, - "e3sm_scream_v1_lowres" : { + "e3sm_eamxx_v1_lowres" : { "time" : "01:00:00", - "inherit" : ("e3sm_scream_mam4xx_v1_lowres"), + "inherit" : ("e3sm_eamxx_mam4xx_v1_lowres"), "tests" : ( - "ERP_D_Lh4.ne4_ne4.F2010-SCREAMv1.scream-output-preset-1", - "ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.scream-output-preset-2", - "SMS_D_Ln9.ne4_ne4.F2010-SCREAMv1-noAero.scream-output-preset-3", - "ERP_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-output-preset-4", - "ERS_D_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-rad_frequency_2--scream-output-preset-5", - "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-small_kernels--scream-output-preset-5", - "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-small_kernels_p3--scream-output-preset-5", - "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-small_kernels_shoc--scream-output-preset-5", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-all_mam4xx_procs", + "ERP_D_Lh4.ne4_ne4.F2010-SCREAMv1.eamxx-output-preset-1", + "ERS_Ln9.ne4_ne4.F2000-SCREAMv1-AQP1.eamxx-output-preset-2", + "SMS_D_Ln9.ne4_ne4.F2010-SCREAMv1-noAero.eamxx-output-preset-3", + "ERP_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-output-preset-4", + "ERS_D_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-rad_frequency_2--eamxx-output-preset-5", + "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels--eamxx-output-preset-5", + "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels_p3--eamxx-output-preset-5", + "ERS_Ln22.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-small_kernels_shoc--eamxx-output-preset-5", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-all_mam4xx_procs", ) }, - "e3sm_scream_v1_dp-eamxx" : { + "e3sm_eamxx_v1_dp-eamxx" : { "time" : "01:00:00", # each test runs with 225 dynamics and 100 physics columns, roughly size of ne2 "tests" : ( - "ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.scream-dpxx-dycomsrf01", - "ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.scream-dpxx-arm97", - "ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.scream-dpxx-comble", + "ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.eamxx-dpxx-dycomsrf01", + "ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.eamxx-dpxx-arm97", + "ERS_P16_Ln22.ne30pg2_ne30pg2.FIOP-SCREAMv1-DP.eamxx-dpxx-comble", "ERS_P16_Ln22.ne30pg2_ne30pg2.FRCE-SCREAMv1-DP", ) }, - # Tests run on exclusively on mappy for scream AT testing. These tests + # Tests run on exclusively on mappy for eamxx AT testing. These tests # should be fast, so we limit it to low res and add some thread tests # specifically for mappy. - "e3sm_scream_v1_at" : { - "inherit" : ("e3sm_scream_v1_lowres", "e3sm_scream_v1_dp-eamxx"), - "tests" : ("PET_Ln9_P32x2.ne4pg2_ne4pg2.F2010-SCREAMv1.scream-output-preset-1") + "e3sm_eamxx_v1_at" : { + "inherit" : ("e3sm_eamxx_v1_lowres", "e3sm_eamxx_v1_dp-eamxx"), + "tests" : ("PET_Ln9_P32x2.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-output-preset-1") }, - "e3sm_scream_v1_medres" : { + "e3sm_eamxx_v1_medres" : { "time" : "02:00:00", "tests" : ( # "SMS_D_Ln2.ne30_ne30.F2000-SCREAMv1-AQP1", # Uncomment once IC file for ne30 is ready - "ERS_Ln22.ne30_ne30.F2010-SCREAMv1.scream-internal_diagnostics_level--scream-output-preset-3", - "PEM_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-spa_remap--scream-output-preset-4", - "ERS_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-small_kernels--scream-output-preset-5", - "ERP_Ln22.conusx4v1pg2_r05_oECv3.F2010-SCREAMv1-noAero.scream-bfbhash--scream-output-preset-6", - "ERS_Ln22.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-L128--scream-output-preset-4", - "REP_Ld5.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-L128--scream-output-preset-6", - "ERS_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-L128--scream-sl_nsubstep2", + "ERS_Ln22.ne30_ne30.F2010-SCREAMv1.eamxx-internal_diagnostics_level--eamxx-output-preset-3", + "PEM_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-spa_remap--eamxx-output-preset-4", + "ERS_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-small_kernels--eamxx-output-preset-5", + "ERP_Ln22.conusx4v1pg2_r05_oECv3.F2010-SCREAMv1-noAero.eamxx-bfbhash--eamxx-output-preset-6", + "ERS_Ln22.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-L128--eamxx-output-preset-4", + "REP_Ld5.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-L128--eamxx-output-preset-6", + "ERS_Ln90.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-L128--eamxx-sl_nsubstep2", ) }, # Used to track performance - "e3sm_scream_v1_hires" : { + "e3sm_eamxx_v1_hires" : { "time" : "01:00:00", "tests" : ( - "SMS_Ln300.ne30pg2_ne30pg2.F2010-SCREAMv1.scream-perf_test--scream-output-preset-1" + "SMS_Ln300.ne30pg2_ne30pg2.F2010-SCREAMv1.eamxx-perf_test--eamxx-output-preset-1" ) }, - "e3sm_scream_v1_mpassi" : { + "e3sm_eamxx_v1_mpassi" : { "time" : "01:00:00", "tests" : ( # "ERP_D_Ln9.ne4_oQU240.F2010-SCREAMv1-MPASSI.atmlndactive-rtm_off", @@ -745,14 +747,14 @@ # Disable the two 111422-commented tests b/c they fail on pm-gpu and # we're not using MPASSI right now. #111422 "ERP_Ln22.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.atmlndactive-rtm_off", - "ERS_D_Ln22.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.atmlndactive-rtm_off--scream-output-preset-1", + "ERS_D_Ln22.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.atmlndactive-rtm_off--eamxx-output-preset-1", # "ERS_Ln22.ne30_oECv3.F2010-SCREAMv1-MPASSI.atmlndactive-rtm_off", #111422 "PEM_Ln90.ne30pg2_EC30to60E2r2.F2010-SCREAMv1-MPASSI", # "ERS_Ln22.ne30pg2_EC30to60E2r2.F2010-SCREAMv1-MPASSI.atmlndactive-rtm_off", ) }, - "e3sm_scream_v1_long" : { + "e3sm_eamxx_v1_long" : { "time" : "01:00:00", "tests" : ( "ERP_D_Lh182.ne4pg2_ne4pg2.F2010-SCREAMv1", @@ -760,7 +762,7 @@ ) }, - "e3sm_scream_v1_long_crusher" : { + "e3sm_eamxx_v1_long_crusher" : { # _D builds take a long longer on crusher than ascent or pm-gpu, so # don't run the long _D test. "time" : "01:00:00", @@ -769,14 +771,14 @@ ) }, - "e3sm_scream_mam4xx_v1_lowres" : { + "e3sm_eamxx_mam4xx_v1_lowres" : { "time" : "01:00:00", "tests" : ( - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-optics", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-aci", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-wetscav", - "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.scream-mam4xx-drydep", - "SMS_D_Ln5.ne30pg2_oECv3.F2010-SCREAMv1-MPASSI.scream-mam4xx-remap_emiss_ne4_ne30" + "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-optics", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-aci", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-wetscav", + "SMS_D_Ln5.ne4pg2_oQU480.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-drydep", + "SMS_D_Ln5.ne30pg2_oECv3.F2010-SCREAMv1-MPASSI.eamxx-mam4xx-remap_emiss_ne4_ne30" ) }, diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/L128/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/L128/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/L128/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/L128/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/L72/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/L72/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/L72/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/L72/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/bfbhash/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/bfbhash/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/bfbhash/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/bfbhash/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/dpxx/arm97/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/dpxx/arm97/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/dpxx/arm97/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/dpxx/arm97/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/dpxx/comble/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/dpxx/comble/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/dpxx/comble/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/dpxx/comble/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/dpxx/dycomsrf01/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/dpxx/dycomsrf01/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/dpxx/dycomsrf01/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/dpxx/dycomsrf01/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/internal_diagnostics_level/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/internal_diagnostics_level/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/internal_diagnostics_level/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/internal_diagnostics_level/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/aci/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aci/shell_commands similarity index 95% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/aci/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aci/shell_commands index 492bda019fc..4928859e4e8 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/aci/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aci/shell_commands @@ -3,7 +3,7 @@ # MAM4xx adds additionaltracers to the simulation # Increase number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh # Add spa as RRTMG needs spa $CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mac_aero_mic,spa,rrtmgp" -b diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/aero_microphysics/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aero_microphysics/shell_commands similarity index 92% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/aero_microphysics/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aero_microphysics/shell_commands index ac1709f7dca..81b3d44b221 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/aero_microphysics/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/aero_microphysics/shell_commands @@ -5,7 +5,7 @@ # Increase number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh -b +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b #------------------------------------------------------ # Add microphysics process diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/all_mam4xx_procs/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/all_mam4xx_procs/shell_commands similarity index 96% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/all_mam4xx_procs/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/all_mam4xx_procs/shell_commands index 8ef80aef633..366f9afdd28 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/all_mam4xx_procs/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/all_mam4xx_procs/shell_commands @@ -2,7 +2,7 @@ # MAM4xx adds additional tracers to the simulation # Increase the number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh #modify initial condition file to get aerosol species ICs $CIMEROOT/../components/eamxx/scripts/atmchange initial_conditions::Filename='$DIN_LOC_ROOT/atm/scream/init/screami_mam4xx_ne4np4L72_c20240208.nc' -b diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/drydep/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/drydep/shell_commands similarity index 92% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/drydep/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/drydep/shell_commands index ea2d56ab53f..02b4594dbc9 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/drydep/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/drydep/shell_commands @@ -5,7 +5,7 @@ # Increase number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh -b +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b #------------------------------------------------------ # Add drydep process diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/optics/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/optics/shell_commands similarity index 90% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/optics/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/optics/shell_commands index 9bbcfaea898..b62620e7fe0 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/optics/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/optics/shell_commands @@ -2,7 +2,7 @@ # MAM4xx adds additionaltracers to the simulation # Increase number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh $CIMEROOT/../components/eamxx/scripts/atmchange physics::atm_procs_list="mac_aero_mic,mam4_optics,rrtmgp" -b diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/remap_emiss_ne4_ne30/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/remap_emiss_ne4_ne30/shell_commands similarity index 98% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/remap_emiss_ne4_ne30/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/remap_emiss_ne4_ne30/shell_commands index b2d0286b870..9d0bbd39d97 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/remap_emiss_ne4_ne30/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/remap_emiss_ne4_ne30/shell_commands @@ -5,7 +5,7 @@ # Increase number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh -b +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b #------------------------------------------------------ # Add aerosol microphysics process, force ne4pg2 diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands similarity index 92% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands index 500d0bf660a..249d7c2371e 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/srf_online_emiss_constituent_fluxes/shell_commands @@ -5,7 +5,7 @@ # Increase number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh -b +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b #------------------------------------------------------ # Add the processes diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/wetscav/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/wetscav/shell_commands similarity index 92% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/wetscav/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/wetscav/shell_commands index 2cdf303a582..d8436d38450 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/wetscav/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/wetscav/shell_commands @@ -4,7 +4,7 @@ # Increase number of tracers for MAM4xx simulations #------------------------------------------------------ -$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/mam4xx/update_eamxx_num_tracers.sh -b +$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/mam4xx/update_eamxx_num_tracers.sh -b #------------------------------------------------------ # Add wetscav process diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/README b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/README similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/README rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/README diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/diags/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/diags/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/diags/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/diags/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/hremap_to_ne4/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/hremap_to_ne4/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/hremap_to_ne4/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/hremap_to_ne4/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/phys/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/phys/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/phys/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/phys/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/phys_dyn/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/phys_dyn/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/phys_dyn/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/phys_dyn/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/1/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/1/shell_commands similarity index 92% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/1/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/1/shell_commands index 74bd2a4d021..216f5c73628 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/1/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/1/shell_commands @@ -1,7 +1,7 @@ # This preset uses the three output streams (phys_dyn, phys, and diags) # It does not add remap, and uses INSTANT output -SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/output +SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output # Add the three streams . $SCRIPTS_DIR/phys/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/2/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/2/shell_commands similarity index 93% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/2/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/2/shell_commands index aea7feb5bbd..24b71ba0aa9 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/2/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/2/shell_commands @@ -1,7 +1,7 @@ # This preset uses the three output streams (phys_dyn, phys, and diags) # It does not add remap, and uses AVERAGE output -SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/output +SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output # Add the three streams . $SCRIPTS_DIR/phys/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/3/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/3/shell_commands similarity index 93% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/3/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/3/shell_commands index da1d02dc5de..5d27192d525 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/3/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/3/shell_commands @@ -1,7 +1,7 @@ # This preset uses the three output streams (phys, and diags) # It adds horiz remap, and uses INSTANT output -SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/output +SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output # Add the phys/diags streams (cannot add phys_dyn, b/c we use horiz remap) . $SCRIPTS_DIR/phys/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/4/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/4/shell_commands similarity index 94% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/4/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/4/shell_commands index 521ada7f508..6746cf1d46e 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/4/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/4/shell_commands @@ -1,7 +1,7 @@ # This preset uses the three output streams (phys, and diags) # It adds horizontal remap, and uses AVERAGE output -SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/output +SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output # Add the phys/diags streams (cannot add phys_dyn, b/c we use horiz remap) . $SCRIPTS_DIR/phys/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/5/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/5/shell_commands similarity index 94% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/5/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/5/shell_commands index bd60a0472a8..3c63c1abd8f 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/5/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/5/shell_commands @@ -1,7 +1,7 @@ # This preset uses the three output streams (phys_dyn, phys, and diags) # It adds vertical remap, and uses AVERAGE output -SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/output +SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output # Add the phys/dyn/diags streams . $SCRIPTS_DIR/phys/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/6/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/6/shell_commands similarity index 94% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/6/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/6/shell_commands index 937d1646851..442f8b9df8f 100644 --- a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/preset/6/shell_commands +++ b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/preset/6/shell_commands @@ -1,7 +1,7 @@ # This preset uses the three output streams (phys, and diags) # It adds horizontal and remap, and uses AVERAGE output -SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/scream/output +SCRIPTS_DIR=$CIMEROOT/../components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output # Add the phys/diags streams (cannot add phys_dyn, b/c we use horiz remap) . $SCRIPTS_DIR/phys/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/set_avg/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/set_avg/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/set_avg/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/set_avg/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/vremap/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/vremap/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/output/vremap/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/output/vremap/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/perf_test/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/perf_test/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/perf_test/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/perf_test/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/rad_frequency_2/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/rad_frequency_2/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/rad_frequency_2/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/rad_frequency_2/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/scream_example_testmod_atmchange/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/scream_example_testmod_atmchange/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/scream_example_testmod_atmchange/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/scream_example_testmod_atmchange/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/scream_example_testmod_cmake/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/scream_example_testmod_cmake/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/scream_example_testmod_cmake/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/scream_example_testmod_cmake/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/sl_nsubstep2/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/sl_nsubstep2/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/sl_nsubstep2/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/sl_nsubstep2/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/small_kernels/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/small_kernels/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/small_kernels/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/small_kernels/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/small_kernels_p3/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/small_kernels_p3/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/small_kernels_p3/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/small_kernels_p3/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/small_kernels_shoc/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/small_kernels_shoc/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/small_kernels_shoc/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/small_kernels_shoc/shell_commands diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/spa_remap/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/spa_remap/shell_commands similarity index 100% rename from components/eamxx/cime_config/testdefs/testmods_dirs/scream/spa_remap/shell_commands rename to components/eamxx/cime_config/testdefs/testmods_dirs/eamxx/spa_remap/shell_commands From ab8c22c0ceda6c23cd2638c20ee8586e4c6672fe Mon Sep 17 00:00:00 2001 From: James Foucar Date: Wed, 15 Jan 2025 16:07:33 -0700 Subject: [PATCH 526/529] eammx-prod only works with pg2 grids --- cime_config/tests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/tests.py b/cime_config/tests.py index 5d6086f2113..d67f15e7469 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -324,7 +324,7 @@ "SMS_P12x2.ne4pg2_oQU480.WCYCL1850NS.allactive-mach_mods", "ERS_Ln9.ne4pg2_ne4pg2.F2010-MMF1.eam-mmf_crmout", "SMS_Lh4.ne4_ne4.F2010-SCREAMv1.eamxx-output-preset-1", - "SMS_Lh4.ne4_ne4.F2010-SCREAMv1.eamxx-output-preset-1--eamxx-prod", + "SMS_Lh4.ne4pg2_ne4pg2.F2010-SCREAMv1.eamxx-output-preset-1--eamxx-prod", ) }, From bc0da70c896bae823b6f6640646bed4c4ce44d22 Mon Sep 17 00:00:00 2001 From: Oksana Guba Date: Thu, 16 Jan 2025 16:29:04 +0000 Subject: [PATCH 527/529] fix sunspot run error in internal_init mpi --- cime_config/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index ac8ac9c2423..07308c066b8 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -3105,7 +3105,7 @@ unset MPIR_CVAR_CH4_POSIX_COLL_SELECTION_TUNING_JSON_FILE 131072 20 - cxi + disabled 8388608 From 9ca118df2d8d9281c57313b90ed9ac8e57042b05 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Thu, 16 Jan 2025 15:34:19 -0600 Subject: [PATCH 528/529] Add missing file to landice.cmkae file list --- components/mpas-albany-landice/src/landice.cmake | 1 + 1 file changed, 1 insertion(+) diff --git a/components/mpas-albany-landice/src/landice.cmake b/components/mpas-albany-landice/src/landice.cmake index a0ce5fd0248..94a4e85e795 100644 --- a/components/mpas-albany-landice/src/landice.cmake +++ b/components/mpas-albany-landice/src/landice.cmake @@ -76,6 +76,7 @@ list(APPEND RAW_SOURCES core_landice/mode_forward/mpas_li_velocity_external.F core_landice/mode_forward/mpas_li_subglacial_hydro.F core_landice/mode_forward/mpas_li_bedtopo.F + core_landice/mode_forward/mpas_li_ocean_extrap.F ) if (CPPDEFS MATCHES ".*MPAS_LI_BUILD_INTERFACE.*") From 5875e79d10af8107187fb43c5b0d7601220c5df1 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Thu, 16 Jan 2025 14:36:29 -0700 Subject: [PATCH 529/529] Fix cime-nml test that was using old testmod dir --- components/eamxx/scripts/cime-nml-tests | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/scripts/cime-nml-tests b/components/eamxx/scripts/cime-nml-tests index e03151579ee..c76d0113207 100755 --- a/components/eamxx/scripts/cime-nml-tests +++ b/components/eamxx/scripts/cime-nml-tests @@ -256,7 +256,7 @@ class TestBuildnml(unittest.TestCase): def_mach_comp = \ run_cmd_assert_result(self, "../CIME/Tools/list_e3sm_tests cime_tiny", from_dir=CIME_SCRIPTS_DIR).splitlines()[-2].split(".")[-1] - case = self._create_test(f"SMS.ne30_ne30.F2010-SCREAMv1.{def_mach_comp}.scream-scream_example_testmod_atmchange --no-build") + case = self._create_test(f"SMS.ne30_ne30.F2010-SCREAMv1.{def_mach_comp}.eamxx-scream_example_testmod_atmchange --no-build") # Check that the value match what's in the testmod out = run_cmd_no_fail("./atmquery --value cubed_sphere_map", from_dir=case)
" << html_fix(n.name) << "
" << html_fix(n.name) + << "
" + << "Atm input fields from previous time step:
" + << "Initial Fields:
" + << "Computed Fields:
Atm input fields from previous time step:
Computed Fields:
" << fc << html_fix(print_fid(m_fids[fid],fid_verb)) << "
" << fc + << html_fix(print_fid(m_fids[fid],fid_verb)) + << "
Atm output fields for next time step:
Required Fields:
" << fc << html_fix(print_fid(m_fids[fid],fid_verb)); - if (ekat::contains(m_unmet_deps.at(n.id),fid)) { - ofile << " *** MISSING ***"; + if (sz_req > 0) { + // Required fields + if (n.id == id_end) { + ofile << "
" + << "Atm output fields for next time step:
" + << "Required Fields:
" << fc << html_fix(print_fid(m_fids[fid],fid_verb)); + if (ekat::contains(unmet, fid)) { + ofile << " *** MISSING ***"; + } else if (ekat::contains(unmet, -fid)) { + ofile << " (Init. Cond.)"; + has_IC_field = true; + } + ofile << "
Atm Input groups:
Computed Groups:
Atm Input groups:
Computed Groups:
" << fc << html_fix(print_fid(m_fids[gr_fid],fid_verb)); ofile << "
Atm Output Groups:
Atm Output Groups:
Required Groups:
Required Groups:
" << fc << html_fix(print_fid(m_fids[gr_fid],fid_verb)); - if (ekat::contains(m_unmet_deps.at(n.id),gr_fid)) { + if (ekat::contains(unmet, gr_fid)) { ofile << " *** MISSING ***"; } ofile << "
" << fc - << html_fix(print_fid(m_fids[fid],fid_verb)) + << html_fix(print_fid(m_fids[fid_out], fid_verb)) << "
" << fc << html_fix(print_fid(m_fids[gr_fid],fid_verb)); ofile << "