From 672df6d0c2757148f6b51967d76c8d6e25ee399a Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 15:08:10 -0700 Subject: [PATCH 01/20] add stubs for WSM6 moisture model --- CMake/BuildERFExe.cmake | 4 + Exec/Make.ERF | 5 + Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp | 13 ++ Source/Microphysics/WSM6/ERF_InitWSM6.cpp | 72 +++++++++++ Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp | 34 ++++++ Source/Microphysics/WSM6/ERF_WSM6.H | 114 ++++++++++++++++++ .../WSM6/ERF_WSM6_Fortran_Interface.H | 7 ++ Source/Microphysics/WSM6/Make.package | 5 + 8 files changed, 254 insertions(+) create mode 100644 Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp create mode 100644 Source/Microphysics/WSM6/ERF_InitWSM6.cpp create mode 100644 Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp create mode 100644 Source/Microphysics/WSM6/ERF_WSM6.H create mode 100644 Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H create mode 100644 Source/Microphysics/WSM6/Make.package diff --git a/CMake/BuildERFExe.cmake b/CMake/BuildERFExe.cmake index 14c33f179c..2424a8576a 100644 --- a/CMake/BuildERFExe.cmake +++ b/CMake/BuildERFExe.cmake @@ -333,6 +333,9 @@ function(build_erf_lib erf_lib_name) ${SRC_DIR}/Microphysics/Morrison/ERF_AdvanceMorrison.cpp ${SRC_DIR}/Microphysics/Morrison/ERF_UpdateMorrison.cpp ${SRC_DIR}/Microphysics/Morrison/ERF_Morrison_Plot.cpp + ${SRC_DIR}/Microphysics/WSM6/ERF_InitWSM6.cpp + ${SRC_DIR}/Microphysics/WSM6/ERF_AdvanceWSM6.cpp + ${SRC_DIR}/Microphysics/WSM6/ERF_UpdateWSM6.cpp ${SRC_DIR}/Microphysics/SAM/ERF_InitSAM.cpp ${SRC_DIR}/Microphysics/SAM/ERF_CloudSAM.cpp ${SRC_DIR}/Microphysics/SAM/ERF_IceFall.cpp @@ -466,6 +469,7 @@ function(build_erf_lib erf_lib_name) target_include_directories(${erf_lib_name} PUBLIC $) target_include_directories(${erf_lib_name} PUBLIC $) target_include_directories(${erf_lib_name} PUBLIC $) + target_include_directories(${erf_lib_name} PUBLIC $) target_include_directories(${erf_lib_name} PUBLIC $) target_include_directories(${erf_lib_name} PUBLIC $) target_include_directories(${erf_lib_name} PUBLIC $) diff --git a/Exec/Make.ERF b/Exec/Make.ERF index c51e68c6f1..0fe3303ea1 100644 --- a/Exec/Make.ERF +++ b/Exec/Make.ERF @@ -143,6 +143,11 @@ include $(ERF_MOISTURE_MORRISON_DIR)/Make.package VPATH_LOCATIONS += $(ERF_MOISTURE_MORRISON_DIR) INCLUDE_LOCATIONS += $(ERF_MOISTURE_MORRISON_DIR) +ERF_MOISTURE_WSM6_DIR = $(ERF_SOURCE_DIR)/Microphysics/WSM6 +include $(ERF_MOISTURE_WSM6_DIR)/Make.package +VPATH_LOCATIONS += $(ERF_MOISTURE_WSM6_DIR) +INCLUDE_LOCATIONS += $(ERF_MOISTURE_WSM6_DIR) + ERF_MOISTURE_SATADJ_DIR = $(ERF_SOURCE_DIR)/Microphysics/SatAdj include $(ERF_MOISTURE_SATADJ_DIR)/Make.package VPATH_LOCATIONS += $(ERF_MOISTURE_SATADJ_DIR) diff --git a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp new file mode 100644 index 0000000000..974df633ad --- /dev/null +++ b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp @@ -0,0 +1,13 @@ +#include "ERF_WSM6.H" + +using namespace amrex; + +void +WSM6::Advance(const Real& dt_advance, + const SolverChoice&) +{ + dt = dt_advance; + + // Phase-1 scaffold: Fortran WSM6 bridge is added next. + // No-op here to keep build and dispatch integration incremental. +} diff --git a/Source/Microphysics/WSM6/ERF_InitWSM6.cpp b/Source/Microphysics/WSM6/ERF_InitWSM6.cpp new file mode 100644 index 0000000000..f44ec3dfb1 --- /dev/null +++ b/Source/Microphysics/WSM6/ERF_InitWSM6.cpp @@ -0,0 +1,72 @@ +#include "ERF_WSM6.H" + +#include +#include "ERF_EOS.H" + +using namespace amrex; + +void +WSM6::Init(const MultiFab& cons_in, + const BoxArray&, + const Geometry& geom, + const Real& dt_advance, + std::unique_ptr& z_phys_nd, + std::unique_ptr& detJ_cc) +{ + dt = dt_advance; + m_geom = geom; + + m_z_phys_nd = z_phys_nd.get(); + m_detJ_cc = detJ_cc.get(); + + MicVarMap.resize(m_qmoist_size); + MicVarMap = {MicVar_WSM6::rain_accum, MicVar_WSM6::snow_accum, MicVar_WSM6::graup_accum}; + + for (int ivar = 0; ivar < MicVar_WSM6::NumVars; ++ivar) { + mic_fab_vars[ivar] = std::make_shared(cons_in.boxArray(), cons_in.DistributionMap(), + 1, cons_in.nGrowVect()); + mic_fab_vars[ivar]->setVal(0.0); + } + + nlev = m_geom.Domain().length(2); + zlo = m_geom.Domain().smallEnd(2); + zhi = m_geom.Domain().bigEnd(2); +} + +void +WSM6::Copy_State_to_Micro(const MultiFab& cons_in) +{ + for (MFIter mfi(cons_in); mfi.isValid(); ++mfi) { + const auto& box3d = mfi.tilebox(); + auto states = cons_in.array(mfi); + + auto rho = mic_fab_vars[MicVar_WSM6::rho]->array(mfi); + auto theta = mic_fab_vars[MicVar_WSM6::theta]->array(mfi); + auto tabs = mic_fab_vars[MicVar_WSM6::tabs]->array(mfi); + auto pres = mic_fab_vars[MicVar_WSM6::pres]->array(mfi); + + auto qv = mic_fab_vars[MicVar_WSM6::qv]->array(mfi); + auto qc = mic_fab_vars[MicVar_WSM6::qc]->array(mfi); + auto qi = mic_fab_vars[MicVar_WSM6::qi]->array(mfi); + auto qr = mic_fab_vars[MicVar_WSM6::qr]->array(mfi); + auto qs = mic_fab_vars[MicVar_WSM6::qs]->array(mfi); + auto qg = mic_fab_vars[MicVar_WSM6::qg]->array(mfi); + + ParallelFor(box3d, [=] AMREX_GPU_DEVICE(int i, int j, int k) { + rho(i,j,k) = states(i,j,k,Rho_comp); + theta(i,j,k) = states(i,j,k,RhoTheta_comp) / states(i,j,k,Rho_comp); + + qv(i,j,k) = amrex::max(Real(0.0), states(i,j,k,RhoQ1_comp) / states(i,j,k,Rho_comp)); + qc(i,j,k) = amrex::max(Real(0.0), states(i,j,k,RhoQ2_comp) / states(i,j,k,Rho_comp)); + qi(i,j,k) = amrex::max(Real(0.0), states(i,j,k,RhoQ3_comp) / states(i,j,k,Rho_comp)); + qr(i,j,k) = amrex::max(Real(0.0), states(i,j,k,RhoQ4_comp) / states(i,j,k,Rho_comp)); + qs(i,j,k) = amrex::max(Real(0.0), states(i,j,k,RhoQ5_comp) / states(i,j,k,Rho_comp)); + qg(i,j,k) = amrex::max(Real(0.0), states(i,j,k,RhoQ6_comp) / states(i,j,k,Rho_comp)); + + tabs(i,j,k) = getTgivenRandRTh(states(i,j,k,Rho_comp), + states(i,j,k,RhoTheta_comp), + qv(i,j,k)); + pres(i,j,k) = getPgivenRTh(states(i,j,k,RhoTheta_comp), qv(i,j,k)); + }); + } +} diff --git a/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp b/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp new file mode 100644 index 0000000000..721a443f08 --- /dev/null +++ b/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp @@ -0,0 +1,34 @@ +#include "ERF_WSM6.H" + +using namespace amrex; + +void +WSM6::Copy_Micro_to_State(MultiFab& cons) +{ + for (MFIter mfi(cons, TilingIfNotGPU()); mfi.isValid(); ++mfi) { + const auto& box3d = mfi.tilebox(); + auto states = cons.array(mfi); + + auto rho = mic_fab_vars[MicVar_WSM6::rho]->array(mfi); + auto theta = mic_fab_vars[MicVar_WSM6::theta]->array(mfi); + + auto qv = mic_fab_vars[MicVar_WSM6::qv]->array(mfi); + auto qc = mic_fab_vars[MicVar_WSM6::qc]->array(mfi); + auto qi = mic_fab_vars[MicVar_WSM6::qi]->array(mfi); + auto qr = mic_fab_vars[MicVar_WSM6::qr]->array(mfi); + auto qs = mic_fab_vars[MicVar_WSM6::qs]->array(mfi); + auto qg = mic_fab_vars[MicVar_WSM6::qg]->array(mfi); + + ParallelFor(box3d, [=] AMREX_GPU_DEVICE(int i, int j, int k) { + states(i,j,k,RhoTheta_comp) = rho(i,j,k) * theta(i,j,k); + states(i,j,k,RhoQ1_comp) = rho(i,j,k) * qv(i,j,k); + states(i,j,k,RhoQ2_comp) = rho(i,j,k) * qc(i,j,k); + states(i,j,k,RhoQ3_comp) = rho(i,j,k) * qi(i,j,k); + states(i,j,k,RhoQ4_comp) = rho(i,j,k) * qr(i,j,k); + states(i,j,k,RhoQ5_comp) = rho(i,j,k) * qs(i,j,k); + states(i,j,k,RhoQ6_comp) = rho(i,j,k) * qg(i,j,k); + }); + } + + cons.FillBoundary(m_geom.periodicity()); +} diff --git a/Source/Microphysics/WSM6/ERF_WSM6.H b/Source/Microphysics/WSM6/ERF_WSM6.H new file mode 100644 index 0000000000..f58621fd8c --- /dev/null +++ b/Source/Microphysics/WSM6/ERF_WSM6.H @@ -0,0 +1,114 @@ +#ifndef ERF_WSM6_H +#define ERF_WSM6_H + +#include +#include +#include + +#include +#include +#include + +#include "ERF_Constants.H" +#include "ERF_DataStruct.H" +#include "ERF_IndexDefines.H" +#include "ERF_MicrophysicsUtils.H" +#include "ERF_NullMoist.H" + +namespace MicVar_WSM6 { + enum { + rho = 0, + theta, + tabs, + pres, + qv, + qc, + qi, + qr, + qs, + qg, + rain_accum, + snow_accum, + graup_accum, + NumVars + }; +} + +class WSM6 : public NullMoist { + using FabPtr = std::shared_ptr; + +public: + WSM6() {} + virtual ~WSM6() = default; + + void Define(SolverChoice& sc) override + { + m_axis = sc.ave_plane; + m_do_cond = (!sc.use_shoc); + } + + void Init(const amrex::MultiFab& cons_in, + const amrex::BoxArray& grids, + const amrex::Geometry& geom, + const amrex::Real& dt_advance, + std::unique_ptr& z_phys_nd, + std::unique_ptr& detJ_cc) override; + + void Set_dzmin(const amrex::Real dz_min) override { m_dzmin = dz_min; } + + void Copy_State_to_Micro(const amrex::MultiFab& cons_in) override; + void Copy_Micro_to_State(amrex::MultiFab& cons_in) override; + + void Update_Micro_Vars(amrex::MultiFab& cons_in) override + { + Copy_State_to_Micro(cons_in); + } + + void Update_State_Vars(amrex::MultiFab& cons_in) override + { + Copy_Micro_to_State(cons_in); + } + + void Advance(const amrex::Real& dt_advance, + const SolverChoice& solverChoice) override; + + amrex::MultiFab* Qmoist_Ptr(const int& varIdx) override + { + AMREX_ALWAYS_ASSERT(varIdx < m_qmoist_size); + return mic_fab_vars[MicVarMap[varIdx]].get(); + } + + int Qmoist_Size() override { return m_qmoist_size; } + int Qstate_Moist_Size() override { return n_qstate_moist_size; } + + void Set_RealWidth(const int real_width) override { m_real_width = real_width; } + + void Qmoist_Restart_Vars(const SolverChoice&, + std::vector& a_idx, + std::vector& a_names) const override + { + a_idx = {0, 1, 2}; + a_names = {"RainAccum", "SnowAccum", "GraupelAccum"}; + } + +private: + int m_qmoist_size = 3; + int n_qstate_moist_size = 6; + + amrex::Vector MicVarMap; + + amrex::Geometry m_geom; + int m_real_width{0}; + amrex::Real dt{0.0}; + amrex::Real m_dzmin{0.0}; + int nlev{0}, zlo{0}, zhi{0}; + int m_axis{2}; + bool m_do_cond{true}; + + amrex::MultiFab* m_z_phys_nd{nullptr}; + amrex::MultiFab* m_detJ_cc{nullptr}; + + amrex::Array mic_fab_vars; +}; + +#endif diff --git a/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H b/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H new file mode 100644 index 0000000000..1a5b0634db --- /dev/null +++ b/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H @@ -0,0 +1,7 @@ +#ifndef ERF_WSM6_FORTRAN_INTERFACE_H +#define ERF_WSM6_FORTRAN_INTERFACE_H + +// Placeholder for phase-1 WSM6 Fortran C bindings. +// The concrete mp_wsm6_init/mp_wsm6_run interfaces are added in the next step. + +#endif diff --git a/Source/Microphysics/WSM6/Make.package b/Source/Microphysics/WSM6/Make.package new file mode 100644 index 0000000000..6fb57f75e1 --- /dev/null +++ b/Source/Microphysics/WSM6/Make.package @@ -0,0 +1,5 @@ +CEXE_sources += ERF_InitWSM6.cpp +CEXE_sources += ERF_AdvanceWSM6.cpp +CEXE_sources += ERF_UpdateWSM6.cpp +CEXE_headers += ERF_WSM6.H +CEXE_headers += ERF_WSM6_Fortran_Interface.H From 315769e63da230d74d1d5b8d3d1c0f3a14ddcc44 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 15:11:15 -0700 Subject: [PATCH 02/20] wire WSM6 moisture model selection and dispatch --- .../handoff_phase1_remaining_context.md | 126 ++++++++++++++++++ Source/DataStructs/ERF_DataStruct.H | 6 +- Source/IO/ERF_Plotfile.cpp | 3 +- .../Microphysics/ERF_EulerianMicrophysics.H | 3 + Source/Microphysics/ERF_Microphysics.H | 1 + 5 files changed, 137 insertions(+), 2 deletions(-) create mode 100644 Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md new file mode 100644 index 0000000000..3c822d5036 --- /dev/null +++ b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md @@ -0,0 +1,126 @@ +# WSM6 Phase-1 Handoff (Remaining Context Budget) + +## Progress Log +- Section 1 completed on branch `wsm6-moisture-stubs`. + - Commit: `672df6d0` + - Summary: added WSM6 scaffold files under `Source/Microphysics/WSM6/` and wired Make/CMake sources/includes. +- Section 2 completed (selection plumbing). + - Added `WSM6` to `MoistureType` enum in `Source/DataStructs/ERF_DataStruct.H`. + - Added WSM6 moisture index mapping as a 6-species model (`qv,qc,qi,qr,qs,qg`). + - Added WSM6 to Eulerian model detection in `Source/Microphysics/ERF_Microphysics.H`. + - Added `#include "ERF_WSM6.H"` and `SetModel()` in `Source/Microphysics/ERF_EulerianMicrophysics.H`. + - Added WSM6 handling to accumulation-copy branch in `Source/IO/ERF_Plotfile.cpp` so `rain_accum/snow_accum/graup_accum` are not skipped. + +## Current State +- Workspace progress was stashed before deep-dive work. +- Deep-dive artifacts are complete: + - `Docs/wsm6_deep_dive/entrypoints.md` + - `Docs/wsm6_deep_dive/args_map.csv` + - `Docs/wsm6_deep_dive/state_map.csv` + - `Docs/wsm6_deep_dive/risk_log.md` + - `Docs/wsm6_deep_dive/implementation_checklist.md` +- Decision baseline is locked: + - Morrison setup template = initial integration + critical fixes. + - Canonical external source = `../WRF_model`; `../WRF_NCAR` delta-only. + - Phase 1 goal = Fortran-in-place runnable WSM6 in ERF. + +## Goal for Remaining Context +Implement the highest-leverage subset of Phase 1 that gets us as close as possible to a compile-time integrated WSM6 path, with minimal risk and minimal surface area. + +## Recommended Scope to Implement Now (in order) + +### 1. Create WSM6 skeleton files and wire into build +Why now: highest leverage, low ambiguity, mostly mechanical. + +Files to create: +- `Source/Microphysics/WSM6/ERF_WSM6.H` +- `Source/Microphysics/WSM6/ERF_InitWSM6.cpp` +- `Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp` +- `Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp` +- `Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H` +- `Source/Microphysics/WSM6/Make.package` + +Files to edit: +- `Exec/Make.ERF` (add `ERF_MOISTURE_WSM6_DIR` include block, mirroring existing moisture package pattern) +- CMake files currently used for microphysics source inclusion (same pattern as Morrison integration) + +Acceptance criteria: +- New files exist with compilable class/function declarations and stub bodies. +- Build system includes WSM6 source directory/package (no runtime behavior yet required). + +### 2. Add moisture-model selection plumbing +Why now: required to make WSM6 addressable from inputs and dispatch path. + +Files likely to edit: +- `Source/Microphysics/ERF_Microphysics.H` +- `Source/Microphysics/ERF_EulerianMicrophysics.H` +- Any `MoistureType` enum definition location in ERF data/solver structs + +Acceptance criteria: +- `MoistureType::WSM6` exists. +- Eulerian microphysics can instantiate `WSM6` model class. +- No regressions for existing moisture models. + +### 3. Add minimal WSM6 state mapping and lifecycle stubs +Why now: enables incremental integration without full Fortran call complexity. + +Implement in WSM6 class: +- `Define` +- `Init` +- `Copy_State_to_Micro` +- `Advance` (initially stubbed/no-op or guarded call) +- `Copy_Micro_to_State` +- `Qmoist_Size`, `Qstate_Moist_Size`, restart var hooks + +Acceptance criteria: +- ERF compiles with WSM6 model selected at compile time. +- WSM6 model class follows the same interface contracts as other Eulerian models. + +Status: +- Completed in scaffold form. +- Remaining in this area is only Fortran bridge insertion into `WSM6::Advance` and any compile-fix fallout. + +## Defer to Next Pass (do not spend remaining context here) + +### A. Full Fortran argument bridge implementation +- `mp_wsm6_init`/`mp_wsm6_run` call signatures and full argument marshalling. +- Optional arguments: radiation effective radii, chemistry hooks. + +Reason to defer: higher complexity and higher bug risk; better done after skeleton + dispatch compile cleanly. + +### B. Runtime validation case setup and physics debugging +- New regtest input case for WSM6. +- Numerical debugging/field validation. + +Reason to defer: depends on successful compile and basic bridge. + +### C. C++ per-process decomposition +- Any split equivalent to Morrison cloud/ice/precip process files. + +Reason to defer: out of scope for phase-1 Fortran-in-place objective. + +## Implementation Notes +- Keep phase-1 WSM6 simple: single-moment moisture fields only (`qv,qc,qi,qr,qs,qg`) plus accumulators. +- Reuse Morrison lifecycle shape, not Morrison number-concentration state design. +- Avoid backup/temp files (`*~`, `#*#`) when copying references from Morrison directory. + +## Stop Conditions for This Context Budget +Stop and hand off once all are true: +1. Build wiring and model dispatch for WSM6 are in place. +2. WSM6 class skeleton compiles (or is one small compile-fix away with explicit note). +3. Remaining work is primarily Fortran call wiring + runtime validation. + +Current evaluation: +- (1) Satisfied. +- (2) Not yet verified by build in this pass. +- (3) Expected once targeted compile is run and clean. + +## Next-Agent Starting Checklist +1. Confirm stashes before modifying anything: + - `git stash list -n 3` +2. Implement sections 1-3 above. +3. Run a targeted compile command. +4. Update this document with: + - what compiled, + - what remains blocked, + - exact first failing file/line if build fails. diff --git a/Source/DataStructs/ERF_DataStruct.H b/Source/DataStructs/ERF_DataStruct.H index 9f1cfce6a0..c55f5d0613 100644 --- a/Source/DataStructs/ERF_DataStruct.H +++ b/Source/DataStructs/ERF_DataStruct.H @@ -70,7 +70,7 @@ AMREX_ENUM(MoistureModelType, ); AMREX_ENUM(MoistureType, - SAM, SAM_NoIce, SAM_NoPrecip_NoIce, Kessler, Kessler_NoRain, SatAdj, Morrison, Morrison_NoIce, SuperDroplets, None + SAM, SAM_NoIce, SAM_NoPrecip_NoIce, Kessler, Kessler_NoRain, SatAdj, Morrison, Morrison_NoIce, WSM6, SuperDroplets, None ); AMREX_ENUM(WindFarmType, @@ -158,6 +158,7 @@ struct SolverChoice { } pp.query_enum_case_insensitive("moisture_model",moisture_type); if ( (moisture_type == MoistureType::Morrison) || + (moisture_type == MoistureType::WSM6) || (moisture_type == MoistureType::SAM) ) { moisture_indices = MoistureComponentIndices( RhoQ1_comp, // water vapor @@ -211,6 +212,7 @@ struct SolverChoice { moisture_type == MoistureType::SAM_NoPrecip_NoIce || moisture_type == MoistureType::Morrison || moisture_type == MoistureType::Morrison_NoIce || + moisture_type == MoistureType::WSM6 || moisture_type == MoistureType::SatAdj) ) { for (int i = 0; i <= max_level; ++i) { @@ -906,6 +908,8 @@ struct SolverChoice { amrex::Print() << "Moisture Model: Morrison" << std::endl; } else if (moisture_type == MoistureType::Morrison_NoIce) { amrex::Print() << "Moisture Model: Morrison_NoIce" << std::endl; + } else if (moisture_type == MoistureType::WSM6) { + amrex::Print() << "Moisture Model: WSM6" << std::endl; } else if (moisture_type == MoistureType::Kessler) { amrex::Print() << "Moisture Model: Kessler" << std::endl; } else if (moisture_type == MoistureType::Kessler_NoRain) { diff --git a/Source/IO/ERF_Plotfile.cpp b/Source/IO/ERF_Plotfile.cpp index be3fce6b98..f71fede5bd 100644 --- a/Source/IO/ERF_Plotfile.cpp +++ b/Source/IO/ERF_Plotfile.cpp @@ -1197,7 +1197,8 @@ ERF::Write3DPlotFile (int which, PlotFileType plotfile_type, Vector } } else if ( (solverChoice.moisture_type == MoistureType::SAM) || - (solverChoice.moisture_type == MoistureType::Morrison) ) + (solverChoice.moisture_type == MoistureType::Morrison) || + (solverChoice.moisture_type == MoistureType::WSM6) ) { int offset = (solverChoice.moisture_type == MoistureType::Morrison) ? 5 : 0; if (containerHasElement(plot_var_names, "rain_accum")) diff --git a/Source/Microphysics/ERF_EulerianMicrophysics.H b/Source/Microphysics/ERF_EulerianMicrophysics.H index 89e3deebb8..982ce9d25d 100644 --- a/Source/Microphysics/ERF_EulerianMicrophysics.H +++ b/Source/Microphysics/ERF_EulerianMicrophysics.H @@ -9,6 +9,7 @@ #include "ERF_SAM.H" #include "ERF_Kessler.H" #include "ERF_Morrison.H" +#include "ERF_WSM6.H" #include "ERF_SatAdj.H" #include "ERF_Microphysics.H" @@ -39,6 +40,8 @@ public: } else if (a_model_type == MoistureType::Morrison || a_model_type == MoistureType::Morrison_NoIce) { SetModel(); + } else if (a_model_type == MoistureType::WSM6) { + SetModel(); } else if (a_model_type == MoistureType::SatAdj) { SetModel(); } else if (a_model_type == MoistureType::None) { diff --git a/Source/Microphysics/ERF_Microphysics.H b/Source/Microphysics/ERF_Microphysics.H index 1bd0952096..37e1492583 100644 --- a/Source/Microphysics/ERF_Microphysics.H +++ b/Source/Microphysics/ERF_Microphysics.H @@ -103,6 +103,7 @@ public: || (a_moisture_type == MoistureType::SAM_NoPrecip_NoIce) || (a_moisture_type == MoistureType::Morrison) || (a_moisture_type == MoistureType::Morrison_NoIce) + || (a_moisture_type == MoistureType::WSM6) || (a_moisture_type == MoistureType::Kessler) || (a_moisture_type == MoistureType::Kessler_NoRain) || (a_moisture_type == MoistureType::SatAdj) From 6aa3acccb174c1c7483b98d0e7f0a75751fade30 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 16:13:20 -0700 Subject: [PATCH 03/20] add ERF-tracked WSM6 Fortran shim and isohelper bridge --- CMake/BuildERFExe.cmake | 11 +- CMake/CrayCompilerDetection.cmake | 4 +- CMake/SetAmrexOptions.cmake | 2 +- CMakeLists.txt | 5 +- Exec/Make.ERF | 7 +- Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp | 114 +++++++++++++++++- .../WSM6/ERF_WSM6_Fortran_Interface.H | 26 +++- .../Microphysics/WSM6/ERF_module_mp_wsm6.F90 | 85 +++++++++++++ .../WSM6/ERF_module_mp_wsm6_isohelper.F90 | 53 ++++++++ Source/Microphysics/WSM6/Make.package | 5 + 10 files changed, 300 insertions(+), 12 deletions(-) create mode 100644 Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 create mode 100644 Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 diff --git a/CMake/BuildERFExe.cmake b/CMake/BuildERFExe.cmake index 2424a8576a..a8c8f737a5 100644 --- a/CMake/BuildERFExe.cmake +++ b/CMake/BuildERFExe.cmake @@ -233,6 +233,15 @@ function(build_erf_lib erf_lib_name) target_compile_definitions(${erf_lib_name} PUBLIC ERF_USE_MORR_FORT) endif() + if(ERF_ENABLE_WSM6_FORT) + target_sources(${erf_lib_name} + PRIVATE + ${SRC_DIR}/Microphysics/WSM6/ERF_module_mp_wsm6.F90 + ${SRC_DIR}/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 + ) + target_compile_definitions(${erf_lib_name} PUBLIC ERF_USE_WSM6_FORT) + endif() + if(ERF_ENABLE_WINDFARM) target_sources(${erf_lib_name} PRIVATE ${SRC_DIR}/Initialization/ERF_InitWindFarm.cpp @@ -439,7 +448,7 @@ function(build_erf_lib erf_lib_name) if(ERF_ENABLE_MPI) target_link_libraries(${erf_lib_name} PUBLIC $<$:MPI::MPI_CXX>) - if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_NOAHMP) + if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_WSM6_FORT OR ERF_ENABLE_NOAHMP) target_link_libraries(${erf_lib_name} PUBLIC $<$:MPI::MPI_Fortran>) endif() endif() diff --git a/CMake/CrayCompilerDetection.cmake b/CMake/CrayCompilerDetection.cmake index 39b3a9a382..9147055b84 100644 --- a/CMake/CrayCompilerDetection.cmake +++ b/CMake/CrayCompilerDetection.cmake @@ -96,7 +96,7 @@ else() endif() # Find Cray Fortran compiler wrapper (if needed) -if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_NOAHMP) +if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_WSM6_FORT OR ERF_ENABLE_NOAHMP) find_program(ERF_CRAY_FC ftn) if(ERF_CRAY_FC) set(CMAKE_Fortran_COMPILER "${ERF_CRAY_FC}" CACHE FILEPATH "Fortran compiler") @@ -351,4 +351,4 @@ if(DEFINED ENV{MPICH_GPU_SUPPORT_ENABLED} AND "$ENV{MPICH_GPU_SUPPORT_ENABLED}" message(STATUS " CMAKE_CXX_STANDARD_LIBRARIES: ${CMAKE_CXX_STANDARD_LIBRARIES}") else() message(STATUS " GPU-aware MPI not enabled") -endif() \ No newline at end of file +endif() diff --git a/CMake/SetAmrexOptions.cmake b/CMake/SetAmrexOptions.cmake index 2ea34f9d70..0d85eebae1 100644 --- a/CMake/SetAmrexOptions.cmake +++ b/CMake/SetAmrexOptions.cmake @@ -30,7 +30,7 @@ if(ERF_ENABLE_TESTS OR ERF_ENABLE_FCOMPARE) else() set(AMReX_PLOTFILE_TOOLS OFF) endif() -if(ERF_ENABLE_MORR_FORT) +if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_WSM6_FORT) set(AMReX_FORTRAN ON) endif() set(AMReX_EB ON) diff --git a/CMakeLists.txt b/CMakeLists.txt index 46274f7876..96c387f52b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -9,7 +9,7 @@ list(APPEND CMAKE_MESSAGE_CONTEXT "ERF") list(APPEND CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/CMake") include(CrayCompilerDetection) -if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_NOAHMP) +if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_WSM6_FORT OR ERF_ENABLE_NOAHMP) project(ERF CXX C Fortran) else() project(ERF CXX C) @@ -149,6 +149,7 @@ option(ERF_ENABLE_NOAHMP "Enable Noah-MP" OFF) #Other parameterizations option(ERF_ENABLE_WINDFARM "Enable wind farm parameterizations" OFF) +option(ERF_ENABLE_WSM6_FORT "Enable WSM6 Fortran bridge calls" OFF) #Option to build tools option(ERF_ENABLE_TOOLS "Enable building of additional tools" OFF) @@ -448,7 +449,7 @@ if(ERF_ENABLE_MPI) # Normal path: Use find_package with QUIET message(VERBOSE "Using find_package(MPI) for detection") set(_mpi_comps C CXX) - if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_NOAHMP) + if(ERF_ENABLE_MORR_FORT OR ERF_ENABLE_WSM6_FORT OR ERF_ENABLE_NOAHMP) list(APPEND _mpi_comps Fortran) endif() message(DEBUG "MPI components: ${_mpi_comps}") diff --git a/Exec/Make.ERF b/Exec/Make.ERF index 0fe3303ea1..3df334c37d 100644 --- a/Exec/Make.ERF +++ b/Exec/Make.ERF @@ -2,11 +2,14 @@ AMREX_HOME ?= $(ERF_HOME)/Submodules/AMReX EKAT_HOME ?= $(ERF_HOME)/Submodules/ekat/build/install EAMXX_HOME ?= $(ERF_HOME)/external/E3SM/components/eamxx/src +BL_NO_FORT = TRUE ifeq ($(USE_MORR_FORT), TRUE) DEFINES += -DERF_USE_MORR_FORT BL_NO_FORT = FALSE -else -BL_NO_FORT = TRUE +endif +ifeq ($(USE_WSM6_FORT), TRUE) +DEFINES += -DERF_USE_WSM6_FORT +BL_NO_FORT = FALSE endif ifeq ($(USE_CUDA), TRUE) diff --git a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp index 974df633ad..874a93b482 100644 --- a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp @@ -1,4 +1,5 @@ #include "ERF_WSM6.H" +#include "ERF_WSM6_Fortran_Interface.H" using namespace amrex; @@ -8,6 +9,115 @@ WSM6::Advance(const Real& dt_advance, { dt = dt_advance; - // Phase-1 scaffold: Fortran WSM6 bridge is added next. - // No-op here to keep build and dispatch integration incremental. +#ifdef ERF_USE_WSM6_FORT + static bool wsm6_inited = false; + + // Minimal phase-1 initialization for single-moment WSM6. + if (!wsm6_inited) { + constexpr double den0 = 1.28; // Standard dry-air density (kg/m^3) + constexpr double denr = static_cast(rhoh2o); + constexpr double dens = static_cast(rhos); + constexpr double cl = static_cast(Cp_l); + constexpr double cpv = static_cast(Cp_v); + constexpr int hail_opt = 0; // Graupel mode + mp_wsm6_init_c(den0, denr, dens, cl, cpv, hail_opt); + wsm6_inited = true; + } + + const auto domain = m_geom.Domain(); + const int i_lo = domain.smallEnd(0); + const int i_hi = domain.bigEnd(0); + const int j_lo = domain.smallEnd(1); + const int j_hi = domain.bigEnd(1); + const int k_lo = domain.smallEnd(2); + const int k_hi = domain.bigEnd(2); + + constexpr double g = static_cast(CONST_GRAV); + constexpr double cpd = static_cast(Cp_d); + constexpr double cpv = static_cast(Cp_v); + constexpr double rd = static_cast(R_d); + constexpr double rv = static_cast(R_v); + constexpr double t0c = 273.15; + constexpr double ep1 = static_cast(R_v / R_d - one); + constexpr double ep2 = static_cast(R_d / R_v); + constexpr double qmin = 1.0e-12; + constexpr double xls = static_cast(lsub); + constexpr double xlv0 = static_cast(lat_vap); + constexpr double xlf0 = static_cast(lat_ice); + constexpr double den0 = 1.28; + constexpr double denr = static_cast(rhoh2o); + constexpr double cliq = static_cast(Cp_l); + constexpr double cice = 2106.0; + constexpr double psat = 610.78; + + for (MFIter mfi(*mic_fab_vars[MicVar_WSM6::qv], TileNoZ()); mfi.isValid(); ++mfi) { + const Box box = mfi.tilebox(); + + auto const& t_arr = mic_fab_vars[MicVar_WSM6::tabs]->array(mfi); + auto const& qv_arr = mic_fab_vars[MicVar_WSM6::qv]->array(mfi); + auto const& qc_arr = mic_fab_vars[MicVar_WSM6::qc]->array(mfi); + auto const& qi_arr = mic_fab_vars[MicVar_WSM6::qi]->array(mfi); + auto const& qr_arr = mic_fab_vars[MicVar_WSM6::qr]->array(mfi); + auto const& qs_arr = mic_fab_vars[MicVar_WSM6::qs]->array(mfi); + auto const& qg_arr = mic_fab_vars[MicVar_WSM6::qg]->array(mfi); + auto const& den_arr = mic_fab_vars[MicVar_WSM6::rho]->array(mfi); + auto const& p_arr = mic_fab_vars[MicVar_WSM6::pres]->array(mfi); + auto const& rain_arr = mic_fab_vars[MicVar_WSM6::rain_accum]->array(mfi); + auto const& snow_arr = mic_fab_vars[MicVar_WSM6::snow_accum]->array(mfi); + auto const& graup_arr = mic_fab_vars[MicVar_WSM6::graup_accum]->array(mfi); + + const int ilo = box.smallEnd(0); + const int ihi = box.bigEnd(0); + const int jlo = box.smallEnd(1); + const int jhi = box.bigEnd(1); + const int klo = box.smallEnd(2); + const int khi = box.bigEnd(2); + + FArrayBox delz_fab(box, 1); + auto const& delz_arr = delz_fab.array(); + + const Real dz_val = m_geom.CellSize(m_axis); + const Array4 z_arr = (m_z_phys_nd) ? m_z_phys_nd->const_array(mfi) : Array4 {}; + ParallelFor(box, [=] AMREX_GPU_DEVICE (int i, int j, int k) { + delz_arr(i,j,k) = (z_arr) ? Real(0.25) * ( (z_arr(i ,j ,k+1) - z_arr(i ,j ,k)) + + (z_arr(i+1,j ,k+1) - z_arr(i+1,j ,k)) + + (z_arr(i ,j+1,k+1) - z_arr(i ,j+1,k)) + + (z_arr(i+1,j+1,k+1) - z_arr(i+1,j+1,k)) ) : dz_val; + }); + + Box box2d(box); + box2d.makeSlab(2, 0); + FArrayBox rainncv_fab(box2d, 1); + FArrayBox sr_fab(box2d, 1); + FArrayBox snowncv_fab(box2d, 1); + FArrayBox graupelncv_fab(box2d, 1); + + auto const& rainncv_arr = rainncv_fab.array(); + auto const& sr_arr = sr_fab.array(); + auto const& snowncv_arr = snowncv_fab.array(); + auto const& graupelncv_arr = graupelncv_fab.array(); + ParallelFor(box2d, [=] AMREX_GPU_DEVICE (int i, int j, int) { + rainncv_arr(i,j,0) = Real(0.0); + sr_arr(i,j,0) = Real(0.0); + snowncv_arr(i,j,0) = Real(0.0); + graupelncv_arr(i,j,0) = Real(0.0); + }); + + mp_wsm6_run_c( + &(t_arr(ilo,jlo,klo)), + &(qv_arr(ilo,jlo,klo)), &(qc_arr(ilo,jlo,klo)), &(qi_arr(ilo,jlo,klo)), + &(qr_arr(ilo,jlo,klo)), &(qs_arr(ilo,jlo,klo)), &(qg_arr(ilo,jlo,klo)), + &(den_arr(ilo,jlo,klo)), &(p_arr(ilo,jlo,klo)), &(delz_arr(ilo,jlo,klo)), + static_cast(dt), g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, + xls, xlv0, xlf0, den0, denr, cliq, cice, psat, + &(rain_arr(ilo,jlo,0)), &(rainncv_arr(ilo,jlo,0)), &(sr_arr(ilo,jlo,0)), + &(snow_arr(ilo,jlo,0)), &(snowncv_arr(ilo,jlo,0)), + &(graup_arr(ilo,jlo,0)), &(graupelncv_arr(ilo,jlo,0)), + i_lo, i_hi, j_lo, j_hi, k_lo, k_hi, + i_lo, i_hi, j_lo, j_hi, k_lo, k_hi, + ilo, ihi, jlo, jhi, klo, khi); + } +#else + amrex::Abort("WSM6 Fortran bridge requested but ERF was not built with ERF_USE_WSM6_FORT"); +#endif } diff --git a/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H b/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H index 1a5b0634db..40c0915a72 100644 --- a/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H +++ b/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H @@ -1,7 +1,29 @@ #ifndef ERF_WSM6_FORTRAN_INTERFACE_H #define ERF_WSM6_FORTRAN_INTERFACE_H -// Placeholder for phase-1 WSM6 Fortran C bindings. -// The concrete mp_wsm6_init/mp_wsm6_run interfaces are added in the next step. +#ifdef __cplusplus +extern "C" { +#endif + +// Phase-1 C bindings for WSM6 Fortran bridge. +// These keep scope to required single-moment arguments only. +void mp_wsm6_init_c(double den0, double denr, double dens, double cl, double cpv, int hail_opt); + +void mp_wsm6_run_c( + double* t, + double* qv, double* qc, double* qi, double* qr, double* qs, double* qg, + double* den, double* p, double* delz, + double delt, double g, double cpd, double cpv, double rd, double rv, + double t0c, double ep1, double ep2, double qmin, double xls, + double xlv0, double xlf0, double den0, double denr, double cliq, double cice, double psat, + double* rain, double* rainncv, double* sr, + double* snow, double* snowncv, double* graupel, double* graupelncv, + int ids, int ide, int jds, int jde, int kds, int kde, + int ims, int ime, int jms, int jme, int kms, int kme, + int its, int ite, int jts, int jte, int kts, int kte); + +#ifdef __cplusplus +} +#endif #endif diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 new file mode 100644 index 0000000000..fdd692c670 --- /dev/null +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 @@ -0,0 +1,85 @@ +module mp_wsm6 + use iso_c_binding + implicit none + private + public :: mp_wsm6_init, mp_wsm6_run + +contains + + subroutine mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) + real(c_double), intent(in) :: den0, denr, dens, cl, cpv + integer(c_int), intent(in) :: hail_opt + character(len=*), intent(out) :: errmsg + integer(c_int), intent(out) :: errflg + + if (den0 <= 0.0_c_double .or. denr <= 0.0_c_double .or. dens <= 0.0_c_double) then + errmsg = 'mp_wsm6_init: invalid reference density input' + errflg = 1_c_int + return + end if + + if (cl <= 0.0_c_double .or. cpv <= 0.0_c_double) then + errmsg = 'mp_wsm6_init: invalid heat capacity input' + errflg = 2_c_int + return + end if + + if (hail_opt < 0_c_int .or. hail_opt > 1_c_int) then + errmsg = 'mp_wsm6_init: hail_opt must be 0 or 1' + errflg = 3_c_int + return + end if + + errmsg = 'mp_wsm6_init OK (ERF tracked stub)' + errflg = 0_c_int + end subroutine mp_wsm6_init + + subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & + delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, & + xlv0, xlf0, den0, denr, cliq, cice, psat, & + rain, rainncv, sr, snow, snowncv, graupel, graupelncv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte, errmsg, errflg) + real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: t, qv, qc, qi, qr, qs, qg + real(c_double), intent(in), dimension(ims:ime, jms:jme, kms:kme) :: den, p, delz + real(c_double), intent(in) :: delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls + real(c_double), intent(in) :: xlv0, xlf0, den0, denr, cliq, cice, psat + real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rain, rainncv, sr, snow, snowncv, graupel, graupelncv + integer(c_int), intent(in) :: ids, ide, jds, jde, kds, kde + integer(c_int), intent(in) :: ims, ime, jms, jme, kms, kme + integer(c_int), intent(in) :: its, ite, jts, jte, kts, kte + character(len=*), intent(out) :: errmsg + integer(c_int), intent(out) :: errflg + + integer :: i, j, k + + if (delt <= 0.0_c_double .or. g <= 0.0_c_double .or. cpd <= 0.0_c_double .or. cpv <= 0.0_c_double) then + errmsg = 'mp_wsm6_run: invalid scalar physics input' + errflg = 4_c_int + return + end if + + do k = kts, kte + do j = jts, jte + do i = its, ite + qv(i,j,k) = max(qv(i,j,k), qmin) + qc(i,j,k) = max(qc(i,j,k), 0.0_c_double) + qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) + qr(i,j,k) = max(qr(i,j,k), 0.0_c_double) + qs(i,j,k) = max(qs(i,j,k), 0.0_c_double) + qg(i,j,k) = max(qg(i,j,k), 0.0_c_double) + end do + end do + end do + + rainncv(its:ite,jts:jte) = 0.0_c_double + sr(its:ite,jts:jte) = 0.0_c_double + snowncv(its:ite,jts:jte) = 0.0_c_double + graupelncv(its:ite,jts:jte) = 0.0_c_double + + errmsg = 'mp_wsm6_run OK (ERF tracked stub)' + errflg = 0_c_int + end subroutine mp_wsm6_run + +end module mp_wsm6 diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 new file mode 100644 index 0000000000..77fdf58cbf --- /dev/null +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 @@ -0,0 +1,53 @@ +module mp_wsm6_isohelper + use iso_c_binding + use mp_wsm6, only: mp_wsm6_init, mp_wsm6_run + implicit none + +contains + + subroutine mp_wsm6_init_c(den0, denr, dens, cl, cpv, hail_opt) bind(C, name="mp_wsm6_init_c") + real(c_double), value, intent(in) :: den0, denr, dens, cl, cpv + integer(c_int), value, intent(in) :: hail_opt + character(len=256) :: errmsg + integer(c_int) :: errflg + + call mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) + if (errflg /= 0_c_int) then + write(*,'(A,1X,A)') 'mp_wsm6_init_c error:', trim(errmsg) + stop 1 + end if + end subroutine mp_wsm6_init_c + + subroutine mp_wsm6_run_c(t, qv, qc, qi, qr, qs, qg, den, p, delz, & + delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, & + xlv0, xlf0, den0, denr, cliq, cice, psat, & + rain, rainncv, sr, snow, snowncv, graupel, graupelncv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte) bind(C, name="mp_wsm6_run_c") + integer(c_int), value, intent(in) :: ids, ide, jds, jde, kds, kde + integer(c_int), value, intent(in) :: ims, ime, jms, jme, kms, kme + integer(c_int), value, intent(in) :: its, ite, jts, jte, kts, kte + real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: t, qv, qc, qi, qr, qs, qg + real(c_double), intent(in), dimension(ims:ime, jms:jme, kms:kme) :: den, p, delz + real(c_double), value, intent(in) :: delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls + real(c_double), value, intent(in) :: xlv0, xlf0, den0, denr, cliq, cice, psat + real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rain, rainncv, sr + real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: snow, snowncv, graupel, graupelncv + character(len=256) :: errmsg + integer(c_int) :: errflg + + call mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & + delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, & + xlv0, xlf0, den0, denr, cliq, cice, psat, & + rain, rainncv, sr, snow, snowncv, graupel, graupelncv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte, errmsg, errflg) + if (errflg /= 0_c_int) then + write(*,'(A,1X,A)') 'mp_wsm6_run_c error:', trim(errmsg) + stop 1 + end if + end subroutine mp_wsm6_run_c + +end module mp_wsm6_isohelper diff --git a/Source/Microphysics/WSM6/Make.package b/Source/Microphysics/WSM6/Make.package index 6fb57f75e1..06571d7174 100644 --- a/Source/Microphysics/WSM6/Make.package +++ b/Source/Microphysics/WSM6/Make.package @@ -3,3 +3,8 @@ CEXE_sources += ERF_AdvanceWSM6.cpp CEXE_sources += ERF_UpdateWSM6.cpp CEXE_headers += ERF_WSM6.H CEXE_headers += ERF_WSM6_Fortran_Interface.H + +ifeq ($(USE_WSM6_FORT),TRUE) + F90EXE_sources += ERF_module_mp_wsm6.F90 + F90EXE_sources += ERF_module_mp_wsm6_isohelper.F90 +endif From 7933a7885c781f153ae915cdf16347baf90786b8 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 16:13:57 -0700 Subject: [PATCH 04/20] update WSM6 handoff with tracked shim progress and compare plan --- .../handoff_phase1_remaining_context.md | 55 +++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md index 3c822d5036..485aacac53 100644 --- a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md +++ b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md @@ -10,6 +10,61 @@ - Added WSM6 to Eulerian model detection in `Source/Microphysics/ERF_Microphysics.H`. - Added `#include "ERF_WSM6.H"` and `SetModel()` in `Source/Microphysics/ERF_EulerianMicrophysics.H`. - Added WSM6 handling to accumulation-copy branch in `Source/IO/ERF_Plotfile.cpp` so `rain_accum/snow_accum/graup_accum` are not skipped. +- Phase-1 WSM6 Fortran bridge wiring advanced (this pass): + - `Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H` now has concrete C-binding declarations for a minimal single-moment bridge: + - `mp_wsm6_init_c(...)` + - `mp_wsm6_run_c(...)` + - `Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp` now calls WSM6 Fortran bridge entry points under `ERF_USE_WSM6_FORT`: + - one-time `mp_wsm6_init_c(...)` + - per-tile `mp_wsm6_run_c(...)` + - Bridge scope intentionally kept minimal: required single-moment state + thermo + geometry + precip accum/rates only; no radiation/chem optional arrays. + - Targeted WSM6 TU compile check completed successfully (via compile commands): + - `ERF_InitWSM6.cpp` + - `ERF_AdvanceWSM6.cpp` + - `ERF_UpdateWSM6.cpp` + - `ERF_AdvanceWSM6.cpp` also compiles with `-DERF_USE_WSM6_FORT` forced on (TU-level check). +- Incremental bridge commit (ERF-tracked code path): + - Commit: `6aa3accc` + - Added ERF-owned Fortran WSM6 shim module: + - `Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90` + - Added C-binding isohelper that calls `mp_wsm6_init/mp_wsm6_run` from that shim: + - `Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90` + - Build wiring for `USE_WSM6_FORT`/`ERF_ENABLE_WSM6_FORT` updated in: + - `Source/Microphysics/WSM6/Make.package` + - `Exec/Make.ERF` + - `CMakeLists.txt` + - `CMake/BuildERFExe.cmake` + - `CMake/SetAmrexOptions.cmake` + - `CMake/CrayCompilerDetection.cmake` + - Scope note: shim is intentionally minimal and tracked in ERF; it enforces nonnegative moisture and exposes stable bridge symbols for integration work. + +## Targeted Verification (No Full Rebuild) +- Configured `build_no_netcdf_wsm6` with: + - `ERF_ENABLE_NETCDF=OFF` + - `ERF_ENABLE_WSM6_FORT=ON` +- Avoided full executable rebuild; ran targeted per-file compile checks using generated build flags: + - `ERF_module_mp_wsm6.F90` + - `ERF_module_mp_wsm6_isohelper.F90` + - `ERF_AdvanceWSM6.cpp` +- Result: targeted bridge units compile successfully. + +## Simple Diff/Patch Comparison Plan +- Keep ERF shim interfaces intentionally close to canonical names: + - `mp_wsm6_init` + - `mp_wsm6_run` +- Comparison workflow for next pass: + 1. Diff `ERF_module_mp_wsm6.F90` against `physics_mmm/mp_wsm6.F90` init/run signatures. + 2. Diff `ERF_module_mp_wsm6_isohelper.F90` against the same C-bind wrapper pattern used by Morrison in ERF. + 3. Replace stub internals progressively while preserving bridge symbol names and argument order. + +## Build Attempt (This Pass) +- Attempted target build: + - `cmake --build /home/jmsexton/codes/ERF/build --target erf_srclib -j 8` +- Result: blocked before reaching final link due pre-existing NetCDF parallel header issue in this build configuration. +- First failing line: + - `/home/jmsexton/codes/ERF/Source/IO/ERF_NCInterface.H:18` + - `#include ` + - Error: `fatal error: netcdf_par.h: No such file or directory` ## Current State - Workspace progress was stashed before deep-dive work. From 20dabf1e795c22a350aadc0688177397dad006ae Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 16:15:32 -0700 Subject: [PATCH 05/20] add phase1 WSM6 bridge compare map against physics_mmm --- Docs/wsm6_deep_dive/bridge_compare_phase1.md | 47 ++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 Docs/wsm6_deep_dive/bridge_compare_phase1.md diff --git a/Docs/wsm6_deep_dive/bridge_compare_phase1.md b/Docs/wsm6_deep_dive/bridge_compare_phase1.md new file mode 100644 index 0000000000..b9a8290e0b --- /dev/null +++ b/Docs/wsm6_deep_dive/bridge_compare_phase1.md @@ -0,0 +1,47 @@ +# WSM6 Bridge Compare (Phase 1) + +## Purpose +This file is the short patch map between ERF's current WSM6 bridge and the canonical `physics_mmm/mp_wsm6.F90` interfaces, so follow-on work can be done with explainable incremental diffs. + +## Entrypoint Mapping +- Canonical init: `mp_wsm6_init(den0,denr,dens,cl,cpv,hail_opt,errmsg,errflg)` +- Canonical run: `mp_wsm6_run(t,q,qc,qi,qr,qs,qg,den,p,delz,delt,g,cpd,cpv,rd,rv,t0c,ep1,ep2,qmin,xls,xlv0,xlf0,den0,denr,cliq,cice,psat,rain,rainncv,sr,snow,snowncv,graupel,graupelncv,rainprod2d,evapprod2d,its,ite,kts,kte,errmsg,errflg)` +- ERF C bridge entrypoints: `mp_wsm6_init_c`, `mp_wsm6_run_c` +- ERF Fortran shim entrypoints: `mp_wsm6_init`, `mp_wsm6_run` + +## Status Table +| Area | Canonical (`physics_mmm`) | ERF phase-1 state | Status | +|---|---|---|---| +| Symbol names | `mp_wsm6_init`, `mp_wsm6_run` | Same names in ERF-owned module | Matched | +| C bindings | Not provided in canonical module | `mp_wsm6_init_c`, `mp_wsm6_run_c` in ERF isohelper | Matched (ERF bridge layer) | +| Init args | `den0,denr,dens,cl,cpv,hail_opt,+errmsg/errflg` | Same arg set in shim | Matched | +| Run core thermo/hydro args | `t,q,qc,qi,qr,qs,qg,den,p,delz,...` | Same core set in shim (`qv` naming on ERF side maps to canonical `q`) | Matched | +| 2-D precip diagnostics | `rain,rainncv,sr,snow,snowncv,graupel,graupelncv` | Same set in shim and C bridge | Matched | +| Optional 2-D diagnostics | `rainprod2d,evapprod2d` optional | Not in phase-1 shim/C bridge yet | Deferred | +| Run index contract | Canonical uses `(its,ite,kts,kte)` | ERF C bridge passes full `(ids..kte)` and shim currently keeps all | Stubbed for transition | +| Physics internals | Full WSM6 microphysics | ERF shim currently does validation + nonnegative clamps only | Stubbed | +| Error contract | `errmsg,errflg` out args | Preserved in shim; isohelper converts nonzero to `stop 1` | Matched | + +## Files In ERF For This Bridge +- `Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90` +- `Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90` +- `Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H` +- `Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp` + +## Replace Order (Minimal-Risk) +1. Keep `mp_wsm6_*_c` signatures fixed; do not change C++ call sites yet. +2. Replace shim `mp_wsm6_init` body with canonical init internals. +3. Replace shim `mp_wsm6_run` body with canonical run internals, still keeping ERF C bridge ABI unchanged. +4. Add `rainprod2d/evapprod2d` as optional bridge args only after run body replacement is stable. +5. Reduce index argument surface to canonical `(its,ite,kts,kte)` once full run parity is validated. + +## Quick Diff Commands +```bash +# Canonical vs ERF shim (module-level implementation) +diff -u /home/jmsexton/codes/physics_mmm/mp_wsm6.F90 \ + /home/jmsexton/codes/ERF/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 + +# ERF C bridge surface used by C++ +diff -u /home/jmsexton/codes/ERF/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H \ + /home/jmsexton/codes/ERF/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 +``` From 05fb39df8e1ff1f2ca72d4237a3f859736cb7a3e Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 16:23:17 -0700 Subject: [PATCH 06/20] update WSM6 handoff with object-level verification status --- .../handoff_phase1_remaining_context.md | 26 ++++++++++++++++--- .../implementation_checklist.md | 16 ++++++++++++ 2 files changed, 38 insertions(+), 4 deletions(-) create mode 100644 Docs/wsm6_deep_dive/implementation_checklist.md diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md index 485aacac53..96930618df 100644 --- a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md +++ b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md @@ -37,6 +37,10 @@ - `CMake/SetAmrexOptions.cmake` - `CMake/CrayCompilerDetection.cmake` - Scope note: shim is intentionally minimal and tracked in ERF; it enforces nonnegative moisture and exposes stable bridge symbols for integration work. +- Pre-handoff compare artifact committed: + - Commit: `20dabf1e` + - File: `Docs/wsm6_deep_dive/bridge_compare_phase1.md` + - Summary: adds canonical-vs-ERF bridge map and ordered replacement plan (`init` then `run`, preserving ABI first). ## Targeted Verification (No Full Rebuild) - Configured `build_no_netcdf_wsm6` with: @@ -47,6 +51,17 @@ - `ERF_module_mp_wsm6_isohelper.F90` - `ERF_AdvanceWSM6.cpp` - Result: targeted bridge units compile successfully. +- Additional narrow verification completed (object-only, no full `erf_srclib` build): + - Confirmed stash baseline first: `git stash list -n 5` (deep-dive stash present at `stash@{0}`). + - Rebuilt only WSM6 bridge objects via: + - `gmake -C /home/jmsexton/codes/ERF/build_no_netcdf_wsm6 -f Exec/CMakeFiles/erf_srclib.dir/build.make ...` + - Explicitly compiled in this pass: + - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_InitWSM6.cpp.o` + - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp.o` + - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp.o` + - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90.o` + - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90.o` + - Result: all targeted WSM6 bridge objects compile cleanly in `build_no_netcdf_wsm6`. ## Simple Diff/Patch Comparison Plan - Keep ERF shim interfaces intentionally close to canonical names: @@ -167,15 +182,18 @@ Stop and hand off once all are true: Current evaluation: - (1) Satisfied. -- (2) Not yet verified by build in this pass. +- (2) Satisfied (verified via targeted WSM6 object rebuilds in `build_no_netcdf_wsm6`). - (3) Expected once targeted compile is run and clean. ## Next-Agent Starting Checklist 1. Confirm stashes before modifying anything: - `git stash list -n 3` -2. Implement sections 1-3 above. -3. Run a targeted compile command. -4. Update this document with: +2. Use `Docs/wsm6_deep_dive/bridge_compare_phase1.md` as the patch map. +3. Keep object-level compile checks (avoid full fresh `erf_srclib` build unless needed): + - `gmake -C /home/jmsexton/codes/ERF/build_no_netcdf_wsm6 -f Exec/CMakeFiles/erf_srclib.dir/build.make ` +4. Implement replacement order from compare doc: + - canonicalize `mp_wsm6_init` body first, then `mp_wsm6_run` body, while holding C bridge ABI fixed. +5. Update this document with: - what compiled, - what remains blocked, - exact first failing file/line if build fails. diff --git a/Docs/wsm6_deep_dive/implementation_checklist.md b/Docs/wsm6_deep_dive/implementation_checklist.md new file mode 100644 index 0000000000..570afa91b4 --- /dev/null +++ b/Docs/wsm6_deep_dive/implementation_checklist.md @@ -0,0 +1,16 @@ +# WSM6 Implementation Checklist (Derived from Deep Dive) + +## Phase 1: Fortran-in-place WSM6 runnable in ERF +- [x] Add `Source/Microphysics/WSM6/` with ERF wrapper class and Fortran interface header. +- [x] Add build wiring in `Exec/Make.ERF` and CMake for WSM6 sources. +- [x] Add `MoistureType::WSM6` dispatch in ERF microphysics selection. +- [x] Implement ERF->WSM6 argument bridge for required state (`qv,qc,qi,qr,qs,qg`, thermodynamics, geometry). +- [x] Implement WSM6 init call and runtime call lifecycle. +- [x] Add accumulation mapping (`rain/snow/graupel`) analogous to Morrison diagnostics. +- [ ] Validate single-step run with `moisture_model=WSM6` (no NaN/abort, non-negative hydrometeors). + +## Phase 2: Head-comparable behavior and diagnostics +- [ ] Add optional effective radius diagnostics and radiation coupling arguments. +- [ ] Align boundary/real-width behavior with current head microphysics path. +- [ ] Add regression tests mirroring existing Morrison harness patterns. +- [ ] Add documentation for runtime controls and known differences from WRF defaults. From a9b39d0cdb56a69d7ee0f323646e0239ab107e88 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 16:24:47 -0700 Subject: [PATCH 07/20] wsm6: canonicalize init coefficient setup in ERF shim --- Docs/wsm6_deep_dive/bridge_compare_phase1.md | 1 + .../handoff_phase1_remaining_context.md | 4 + .../Microphysics/WSM6/ERF_module_mp_wsm6.F90 | 119 +++++++++++++++++- 3 files changed, 121 insertions(+), 3 deletions(-) diff --git a/Docs/wsm6_deep_dive/bridge_compare_phase1.md b/Docs/wsm6_deep_dive/bridge_compare_phase1.md index b9a8290e0b..7ff1b819af 100644 --- a/Docs/wsm6_deep_dive/bridge_compare_phase1.md +++ b/Docs/wsm6_deep_dive/bridge_compare_phase1.md @@ -15,6 +15,7 @@ This file is the short patch map between ERF's current WSM6 bridge and the canon | Symbol names | `mp_wsm6_init`, `mp_wsm6_run` | Same names in ERF-owned module | Matched | | C bindings | Not provided in canonical module | `mp_wsm6_init_c`, `mp_wsm6_run_c` in ERF isohelper | Matched (ERF bridge layer) | | Init args | `den0,denr,dens,cl,cpv,hail_opt,+errmsg/errflg` | Same arg set in shim | Matched | +| Init internals | Canonical computes coefficient tables for run-time tendencies | ERF shim now computes canonical-style coefficient tables (radar coupling still deferred) | Partial | | Run core thermo/hydro args | `t,q,qc,qi,qr,qs,qg,den,p,delz,...` | Same core set in shim (`qv` naming on ERF side maps to canonical `q`) | Matched | | 2-D precip diagnostics | `rain,rainncv,sr,snow,snowncv,graupel,graupelncv` | Same set in shim and C bridge | Matched | | Optional 2-D diagnostics | `rainprod2d,evapprod2d` optional | Not in phase-1 shim/C bridge yet | Deferred | diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md index 96930618df..0032f8c29a 100644 --- a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md +++ b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md @@ -41,6 +41,10 @@ - Commit: `20dabf1e` - File: `Docs/wsm6_deep_dive/bridge_compare_phase1.md` - Summary: adds canonical-vs-ERF bridge map and ordered replacement plan (`init` then `run`, preserving ABI first). +- Post-compare follow-up (this pass): + - `Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90` `mp_wsm6_init` upgraded from pure stub checks to canonical-style coefficient initialization (hail/graupel option tables + precomputed constants). + - C bridge ABI and `mp_wsm6_run` argument contract remain unchanged. + - `ERF_module_mp_wsm6.F90.o` recompiles cleanly in `build_no_netcdf_wsm6`. ## Targeted Verification (No Full Rebuild) - Configured `build_no_netcdf_wsm6` with: diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 index fdd692c670..4d2705fff3 100644 --- a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 @@ -4,8 +4,40 @@ module mp_wsm6 private public :: mp_wsm6_init, mp_wsm6_run + real(c_double), parameter :: dtcldcr = 120.0_c_double + real(c_double), parameter :: n0r = 8.0e6_c_double + real(c_double), parameter :: avtr = 841.9_c_double + real(c_double), parameter :: bvtr = 0.8_c_double + real(c_double), parameter :: r0 = 0.8e-5_c_double + real(c_double), parameter :: peaut = 0.55_c_double + real(c_double), parameter :: xncr = 3.0e8_c_double + real(c_double), parameter :: xmyu = 1.718e-5_c_double + real(c_double), parameter :: avts = 11.72_c_double + real(c_double), parameter :: bvts = 0.41_c_double + real(c_double), parameter :: lamdarmax = 8.0e4_c_double + real(c_double), parameter :: lamdasmax = 1.0e5_c_double + real(c_double), parameter :: dimax = 500.0e-6_c_double + real(c_double), parameter :: eacrc = 1.0_c_double + real(c_double), parameter :: n0s = 2.0e6_c_double + + real(c_double), save :: qc0, qck1, & + bvtr1, bvtr2, bvtr3, bvtr4, bvtr6, g1pbr, g3pbr, g4pbr, g6pbr, g5pbro2, & + pvtr, eacrr, pacrr, precr1, precr2, roqimax, & + bvts1, bvts2, bvts3, bvts4, g1pbs, g3pbs, g4pbs, g5pbso2, & + n0g, avtg, bvtg, deng, lamdagmax, pvts, pacrs, precs1, precs2, & + pidn0r, pidn0s, pidnc, xlv1, pacrc, pi, & + bvtg1, bvtg2, bvtg3, bvtg4, g1pbg, g3pbg, g4pbg, g5pbgo2, pvtg, pacrg, & + precg1, precg2, pidn0g, rslopermax, rslopesmax, rslopegmax, & + rsloperbmax, rslopesbmax, rslopegbmax, rsloper2max, rslopes2max, rslopeg2max, & + rsloper3max, rslopes3max, rslopeg3max + contains + pure real(c_double) function rgmma(x) + real(c_double), intent(in) :: x + rgmma = exp(log_gamma(x)) + end function rgmma + subroutine mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) real(c_double), intent(in) :: den0, denr, dens, cl, cpv integer(c_int), intent(in) :: hail_opt @@ -24,13 +56,94 @@ subroutine mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) return end if - if (hail_opt < 0_c_int .or. hail_opt > 1_c_int) then + select case (hail_opt) + case (1_c_int) + n0g = 4.0e4_c_double + deng = 700.0_c_double + avtg = 285.0_c_double + bvtg = 0.8_c_double + lamdagmax = 2.0e4_c_double + case (0_c_int) + n0g = 4.0e6_c_double + deng = 500.0_c_double + avtg = 330.0_c_double + bvtg = 0.8_c_double + lamdagmax = 6.0e4_c_double + case default errmsg = 'mp_wsm6_init: hail_opt must be 0 or 1' errflg = 3_c_int return - end if + end select + + ! Canonical-style coefficient initialization (phase-1, no radar coupling yet). + pi = 4.0_c_double * atan(1.0_c_double) + xlv1 = cl - cpv + qc0 = (4.0_c_double / 3.0_c_double) * pi * denr * r0**3 * xncr / den0 + qck1 = 0.104_c_double * 9.8_c_double * peaut / (xncr * denr)**(1.0_c_double / 3.0_c_double) / & + xmyu * den0**(4.0_c_double / 3.0_c_double) + pidnc = pi * denr / 6.0_c_double + + bvtr1 = 1.0_c_double + bvtr + bvtr2 = 2.5_c_double + 0.5_c_double * bvtr + bvtr3 = 3.0_c_double + bvtr + bvtr4 = 4.0_c_double + bvtr + bvtr6 = 6.0_c_double + bvtr + g1pbr = rgmma(bvtr1) + g3pbr = rgmma(bvtr3) + g4pbr = rgmma(bvtr4) + g6pbr = rgmma(bvtr6) + g5pbro2 = rgmma(bvtr2) + pvtr = avtr * g4pbr / 6.0_c_double + eacrr = 1.0_c_double + pacrr = pi * n0r * avtr * g3pbr * 0.25_c_double * eacrr + precr1 = 2.0_c_double * pi * n0r * 0.78_c_double + precr2 = 2.0_c_double * pi * n0r * 0.31_c_double * sqrt(avtr) * g5pbro2 + roqimax = 2.08e22_c_double * dimax**8 + + bvts1 = 1.0_c_double + bvts + bvts2 = 2.5_c_double + 0.5_c_double * bvts + bvts3 = 3.0_c_double + bvts + bvts4 = 4.0_c_double + bvts + g1pbs = rgmma(bvts1) + g3pbs = rgmma(bvts3) + g4pbs = rgmma(bvts4) + g5pbso2 = rgmma(bvts2) + pvts = avts * g4pbs / 6.0_c_double + pacrs = pi * n0s * avts * g3pbs * 0.25_c_double + precs1 = 4.0_c_double * n0s * 0.65_c_double + precs2 = 4.0_c_double * n0s * 0.44_c_double * sqrt(avts) * g5pbso2 + pidn0r = pi * denr * n0r + pidn0s = pi * dens * n0s + pacrc = pi * n0s * avts * g3pbs * 0.25_c_double * eacrc + + bvtg1 = 1.0_c_double + bvtg + bvtg2 = 2.5_c_double + 0.5_c_double * bvtg + bvtg3 = 3.0_c_double + bvtg + bvtg4 = 4.0_c_double + bvtg + g1pbg = rgmma(bvtg1) + g3pbg = rgmma(bvtg3) + g4pbg = rgmma(bvtg4) + g5pbgo2 = rgmma(bvtg2) + pacrg = pi * n0g * avtg * g3pbg * 0.25_c_double + pvtg = avtg * g4pbg / 6.0_c_double + precg1 = 2.0_c_double * pi * n0g * 0.78_c_double + precg2 = 2.0_c_double * pi * n0g * 0.31_c_double * sqrt(avtg) * g5pbgo2 + pidn0g = pi * deng * n0g + + rslopermax = 1.0_c_double / lamdarmax + rslopesmax = 1.0_c_double / lamdasmax + rslopegmax = 1.0_c_double / lamdagmax + rsloperbmax = rslopermax**bvtr + rslopesbmax = rslopesmax**bvts + rslopegbmax = rslopegmax**bvtg + rsloper2max = rslopermax * rslopermax + rslopes2max = rslopesmax * rslopesmax + rslopeg2max = rslopegmax * rslopegmax + rsloper3max = rsloper2max * rslopermax + rslopes3max = rslopes2max * rslopesmax + rslopeg3max = rslopeg2max * rslopegmax - errmsg = 'mp_wsm6_init OK (ERF tracked stub)' + errmsg = 'mp_wsm6_init OK (ERF coeff init)' errflg = 0_c_int end subroutine mp_wsm6_init From ce580967e951762fcf6022c24580bfc92cb70e2f Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 16:27:54 -0700 Subject: [PATCH 08/20] wsm6: add transitional run scaffold in ERF Fortran shim --- Docs/wsm6_deep_dive/bridge_compare_phase1.md | 2 +- .../handoff_phase1_remaining_context.md | 6 + .../Microphysics/WSM6/ERF_module_mp_wsm6.F90 | 131 ++++++++++++++++-- 3 files changed, 124 insertions(+), 15 deletions(-) diff --git a/Docs/wsm6_deep_dive/bridge_compare_phase1.md b/Docs/wsm6_deep_dive/bridge_compare_phase1.md index 7ff1b819af..c057b16e3c 100644 --- a/Docs/wsm6_deep_dive/bridge_compare_phase1.md +++ b/Docs/wsm6_deep_dive/bridge_compare_phase1.md @@ -20,7 +20,7 @@ This file is the short patch map between ERF's current WSM6 bridge and the canon | 2-D precip diagnostics | `rain,rainncv,sr,snow,snowncv,graupel,graupelncv` | Same set in shim and C bridge | Matched | | Optional 2-D diagnostics | `rainprod2d,evapprod2d` optional | Not in phase-1 shim/C bridge yet | Deferred | | Run index contract | Canonical uses `(its,ite,kts,kte)` | ERF C bridge passes full `(ids..kte)` and shim currently keeps all | Stubbed for transition | -| Physics internals | Full WSM6 microphysics | ERF shim currently does validation + nonnegative clamps only | Stubbed | +| Physics internals | Full WSM6 microphysics | ERF shim now has transitional run scaffold (substepping, saturation adjustment, phase conversion, precip flux accumulation), but not full canonical process set | Partial | | Error contract | `errmsg,errflg` out args | Preserved in shim; isohelper converts nonzero to `stop 1` | Matched | ## Files In ERF For This Bridge diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md index 0032f8c29a..0e3355c85d 100644 --- a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md +++ b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md @@ -45,6 +45,12 @@ - `Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90` `mp_wsm6_init` upgraded from pure stub checks to canonical-style coefficient initialization (hail/graupel option tables + precomputed constants). - C bridge ABI and `mp_wsm6_run` argument contract remain unchanged. - `ERF_module_mp_wsm6.F90.o` recompiles cleanly in `build_no_netcdf_wsm6`. + - `mp_wsm6_run` upgraded from clamp-only stub to a transitional canonical-style scaffold: + - minor-loop time splitting (`dtcldcr`) + - saturation adjustment via in-module `fpvs` + - simple warm/cold phase conversion tendencies + - per-column precip diagnostic flux accumulation (`rain/snow/graupel` families) + - Scope note: this is still not full `physics_mmm` parity; it is an integration bridge step that preserves current ERF C ABI. ## Targeted Verification (No Full Rebuild) - Configured `build_no_netcdf_wsm6` with: diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 index 4d2705fff3..d7a04bc675 100644 --- a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 @@ -38,6 +38,21 @@ pure real(c_double) function rgmma(x) rgmma = exp(log_gamma(x)) end function rgmma + pure real(c_double) function fpvs(t, ice, rd, rv, cvap, cliq, cice, hvap, hsub, psat, t0c) + real(c_double), intent(in) :: t, rd, rv, cvap, cliq, cice, hvap, hsub, psat, t0c + integer, intent(in) :: ice + real(c_double) :: tr, dldt + + tr = t0c / t + if (ice == 0) then + dldt = cvap - cliq + fpvs = psat * tr**(dldt/rv) * exp((hvap - dldt * t0c) / rv * (1.0_c_double / t0c - 1.0_c_double / t)) + else + dldt = cvap - cice + fpvs = psat * tr**(dldt/rv) * exp((hsub - dldt * t0c) / rv * (1.0_c_double / t0c - 1.0_c_double / t)) + end if + end function fpvs + subroutine mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) real(c_double), intent(in) :: den0, denr, dens, cl, cpv integer(c_int), intent(in) :: hail_opt @@ -165,7 +180,10 @@ subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & character(len=*), intent(out) :: errmsg integer(c_int), intent(out) :: errflg - integer :: i, j, k + integer :: i, j, k, loop, loops + real(c_double) :: dtcld, es, qsat, supsat, dq, cpm, xlv, xlf + real(c_double) :: auto_qr, freeze_q, melt_q + real(c_double) :: rain_flux, snow_flux, graup_flux if (delt <= 0.0_c_double .or. g <= 0.0_c_double .or. cpd <= 0.0_c_double .or. cpv <= 0.0_c_double) then errmsg = 'mp_wsm6_run: invalid scalar physics input' @@ -173,25 +191,110 @@ subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & return end if - do k = kts, kte + rainncv(its:ite,jts:jte) = 0.0_c_double + sr(its:ite,jts:jte) = 0.0_c_double + snowncv(its:ite,jts:jte) = 0.0_c_double + graupelncv(its:ite,jts:jte) = 0.0_c_double + + loops = max(nint(delt / dtcldcr), 1) + dtcld = delt / dble(loops) + if (delt <= dtcldcr) dtcld = delt + + do loop = 1, loops + do k = kts, kte + do j = jts, jte + do i = its, ite + qv(i,j,k) = max(qv(i,j,k), qmin) + qc(i,j,k) = max(qc(i,j,k), 0.0_c_double) + qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) + qr(i,j,k) = max(qr(i,j,k), 0.0_c_double) + qs(i,j,k) = max(qs(i,j,k), 0.0_c_double) + qg(i,j,k) = max(qg(i,j,k), 0.0_c_double) + + if (t(i,j,k) > t0c) then + es = fpvs(t(i,j,k), 0, rd, rv, cpv, cliq, cice, xlv0, xls, psat, t0c) + else + es = fpvs(t(i,j,k), 1, rd, rv, cpv, cliq, cice, xlv0, xls, psat, t0c) + end if + es = min(es, 0.99_c_double * p(i,j,k)) + qsat = max(qmin, ep2 * es / max(p(i,j,k) - es, 1.0e-8_c_double)) + supsat = qv(i,j,k) - qsat + + cpm = cpd * (1.0_c_double - qv(i,j,k)) + cpv * qv(i,j,k) + xlv = xlv0 - xlv1 * (t(i,j,k) - t0c) + xlf = xlf0 + + if (supsat > 0.0_c_double) then + dq = min(supsat, 0.5_c_double * supsat) + qv(i,j,k) = qv(i,j,k) - dq + if (t(i,j,k) > t0c) then + qc(i,j,k) = qc(i,j,k) + dq + t(i,j,k) = t(i,j,k) + xlv * dq / max(cpm, 1.0e-6_c_double) + else + qi(i,j,k) = qi(i,j,k) + dq + t(i,j,k) = t(i,j,k) + xls * dq / max(cpm, 1.0e-6_c_double) + end if + else if (supsat < 0.0_c_double) then + dq = min(-supsat, 0.5_c_double * (-supsat)) + if (t(i,j,k) > t0c) then + dq = min(dq, qc(i,j,k)) + qc(i,j,k) = qc(i,j,k) - dq + qv(i,j,k) = qv(i,j,k) + dq + t(i,j,k) = t(i,j,k) - xlv * dq / max(cpm, 1.0e-6_c_double) + else + dq = min(dq, qi(i,j,k)) + qi(i,j,k) = qi(i,j,k) - dq + qv(i,j,k) = qv(i,j,k) + dq + t(i,j,k) = t(i,j,k) - xls * dq / max(cpm, 1.0e-6_c_double) + end if + end if + + if (qc(i,j,k) > qc0) then + auto_qr = min(qc(i,j,k) - qc0, 0.2_c_double * qc(i,j,k)) + qc(i,j,k) = qc(i,j,k) - auto_qr + qr(i,j,k) = qr(i,j,k) + auto_qr + end if + + if (t(i,j,k) < t0c - 5.0_c_double) then + freeze_q = min(qr(i,j,k), 0.05_c_double * qr(i,j,k)) + qr(i,j,k) = qr(i,j,k) - freeze_q + qs(i,j,k) = qs(i,j,k) + freeze_q + else if (t(i,j,k) > t0c + 1.0_c_double) then + melt_q = min(qs(i,j,k), 0.05_c_double * qs(i,j,k)) + qs(i,j,k) = qs(i,j,k) - melt_q + qr(i,j,k) = qr(i,j,k) + melt_q + t(i,j,k) = t(i,j,k) - xlf * melt_q / max(cpm, 1.0e-6_c_double) + end if + + qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) + if (t(i,j,k) < t0c - 10.0_c_double .and. qi(i,j,k) > 0.0_c_double) then + freeze_q = min(qi(i,j,k), 0.02_c_double * qi(i,j,k)) + qi(i,j,k) = qi(i,j,k) - freeze_q + qs(i,j,k) = qs(i,j,k) + freeze_q + end if + end do + end do + end do + do j = jts, jte do i = its, ite - qv(i,j,k) = max(qv(i,j,k), qmin) - qc(i,j,k) = max(qc(i,j,k), 0.0_c_double) - qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) - qr(i,j,k) = max(qr(i,j,k), 0.0_c_double) - qs(i,j,k) = max(qs(i,j,k), 0.0_c_double) - qg(i,j,k) = max(qg(i,j,k), 0.0_c_double) + rain_flux = den(i,j,kts) * qr(i,j,kts) * max(delz(i,j,kts), 0.0_c_double) + snow_flux = den(i,j,kts) * qs(i,j,kts) * max(delz(i,j,kts), 0.0_c_double) + graup_flux = den(i,j,kts) * qg(i,j,kts) * max(delz(i,j,kts), 0.0_c_double) + + rainncv(i,j) = rainncv(i,j) + rain_flux + snowncv(i,j) = snowncv(i,j) + snow_flux + graupelncv(i,j) = graupelncv(i,j) + graup_flux + + rain(i,j) = rain(i,j) + rain_flux + snow(i,j) = snow(i,j) + snow_flux + graupel(i,j) = graupel(i,j) + graup_flux + sr(i,j) = snow(i,j) / max(snow(i,j) + rain(i,j), 1.0e-12_c_double) end do end do end do - rainncv(its:ite,jts:jte) = 0.0_c_double - sr(its:ite,jts:jte) = 0.0_c_double - snowncv(its:ite,jts:jte) = 0.0_c_double - graupelncv(its:ite,jts:jte) = 0.0_c_double - - errmsg = 'mp_wsm6_run OK (ERF tracked stub)' + errmsg = 'mp_wsm6_run OK (ERF phase-1 transitional)' errflg = 0_c_int end subroutine mp_wsm6_run From ba978cbf32fa2063fb0263b867bc469f66199051 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 16:46:27 -0700 Subject: [PATCH 09/20] wsm6: port canonical warm-rain and melt tendency blocks --- Docs/wsm6_deep_dive/bridge_compare_phase1.md | 2 +- .../handoff_phase1_remaining_context.md | 4 +- .../Microphysics/WSM6/ERF_module_mp_wsm6.F90 | 142 ++++++++++++++++-- 3 files changed, 137 insertions(+), 11 deletions(-) diff --git a/Docs/wsm6_deep_dive/bridge_compare_phase1.md b/Docs/wsm6_deep_dive/bridge_compare_phase1.md index c057b16e3c..53d65f6fd9 100644 --- a/Docs/wsm6_deep_dive/bridge_compare_phase1.md +++ b/Docs/wsm6_deep_dive/bridge_compare_phase1.md @@ -20,7 +20,7 @@ This file is the short patch map between ERF's current WSM6 bridge and the canon | 2-D precip diagnostics | `rain,rainncv,sr,snow,snowncv,graupel,graupelncv` | Same set in shim and C bridge | Matched | | Optional 2-D diagnostics | `rainprod2d,evapprod2d` optional | Not in phase-1 shim/C bridge yet | Deferred | | Run index contract | Canonical uses `(its,ite,kts,kte)` | ERF C bridge passes full `(ids..kte)` and shim currently keeps all | Stubbed for transition | -| Physics internals | Full WSM6 microphysics | ERF shim now has transitional run scaffold (substepping, saturation adjustment, phase conversion, precip flux accumulation), but not full canonical process set | Partial | +| Physics internals | Full WSM6 microphysics | ERF shim now has transitional run scaffold with canonical warm-rain tendencies (`praut/pracw/prevp`) and canonical-style snow/graupel melting (`psmlt/pgmlt`) plus substepping/diagnostic accumulation; full cold-process set still pending | Partial | | Error contract | `errmsg,errflg` out args | Preserved in shim; isohelper converts nonzero to `stop 1` | Matched | ## Files In ERF For This Bridge diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md index 0e3355c85d..35eca77384 100644 --- a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md +++ b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md @@ -48,7 +48,9 @@ - `mp_wsm6_run` upgraded from clamp-only stub to a transitional canonical-style scaffold: - minor-loop time splitting (`dtcldcr`) - saturation adjustment via in-module `fpvs` - - simple warm/cold phase conversion tendencies + - canonical-style warm-rain tendencies (`praut`, `pracw`, `prevp`) with slope/ventilation helpers + - canonical-style `psmlt`/`pgmlt` melt tendencies for snow/graupel in warm layers + - simple residual cold-phase conversion tendencies still retained for non-portioned paths - per-column precip diagnostic flux accumulation (`rain/snow/graupel` families) - Scope note: this is still not full `physics_mmm` parity; it is an integration bridge step that preserves current ERF C ABI. diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 index d7a04bc675..d09a5a6c19 100644 --- a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 @@ -19,6 +19,9 @@ module mp_wsm6 real(c_double), parameter :: dimax = 500.0e-6_c_double real(c_double), parameter :: eacrc = 1.0_c_double real(c_double), parameter :: n0s = 2.0e6_c_double + real(c_double), parameter :: n0smax = 1.0e11_c_double + real(c_double), parameter :: alpha = 0.12_c_double + real(c_double), parameter :: qcrmin = 1.0e-9_c_double real(c_double), save :: qc0, qck1, & bvtr1, bvtr2, bvtr3, bvtr4, bvtr6, g1pbr, g3pbr, g4pbr, g6pbr, g5pbro2, & @@ -53,6 +56,33 @@ pure real(c_double) function fpvs(t, ice, rd, rv, cvap, cliq, cice, hvap, hsub, end if end function fpvs + pure real(c_double) function diffus(t, den) + real(c_double), intent(in) :: t, den + diffus = 8.794e-5_c_double * exp(log(max(t, 1.0_c_double)) * 1.81_c_double) / max(den, 1.0e-12_c_double) + end function diffus + + pure real(c_double) function viscos(t, den) + real(c_double), intent(in) :: t, den + viscos = 1.496e-6_c_double * (t * sqrt(max(t, 1.0_c_double))) / (t + 120.0_c_double) / max(den, 1.0e-12_c_double) + end function viscos + + pure real(c_double) function xka(t, den) + real(c_double), intent(in) :: t, den + xka = 1.414e3_c_double * viscos(t, den) * den + end function xka + + pure real(c_double) function diffac(a, p, t, den, qsat, rv) + real(c_double), intent(in) :: a, p, t, den, qsat, rv + diffac = den * a * a / (max(xka(t, den), 1.0e-12_c_double) * rv * t * t) + & + 1.0_c_double / (max(qsat, 1.0e-12_c_double) * max(diffus(t, p), 1.0e-12_c_double)) + end function diffac + + pure real(c_double) function venfac(p, t, den, den0) + real(c_double), intent(in) :: p, t, den, den0 + venfac = exp(log(max(viscos(t, den) / max(diffus(t, p), 1.0e-12_c_double), 1.0e-12_c_double)) / 3.0_c_double) / & + sqrt(max(viscos(t, den), 1.0e-12_c_double)) * sqrt(sqrt(max(den0 / max(den, 1.0e-12_c_double), 1.0e-12_c_double))) + end function venfac + subroutine mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) real(c_double), intent(in) :: den0, denr, dens, cl, cpv integer(c_int), intent(in) :: hail_opt @@ -182,7 +212,13 @@ subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & integer :: i, j, k, loop, loops real(c_double) :: dtcld, es, qsat, supsat, dq, cpm, xlv, xlf - real(c_double) :: auto_qr, freeze_q, melt_q + real(c_double) :: freeze_q + real(c_double) :: denfac, rslope_r, rslopeb_r, rslope2_r, rslope3_r, lamdar + real(c_double) :: rslope_s, rslopeb_s, rslope2_s, rslope3_s, lamdas + real(c_double) :: rslope_g, rslopeb_g, rslope2_g, rslope3_g, lamdag + real(c_double) :: n0sfac, supcol + real(c_double) :: work1_r, work2_r, coeres, satdt, praut, pracw, prevp + real(c_double) :: psmlt, pgmlt real(c_double) :: rain_flux, snow_flux, graup_flux if (delt <= 0.0_c_double .or. g <= 0.0_c_double .or. cpd <= 0.0_c_double .or. cpv <= 0.0_c_double) then @@ -249,21 +285,109 @@ subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & end if end if + denfac = sqrt(max(den0 / max(den(i,j,k), 1.0e-12_c_double), 1.0e-12_c_double)) + supcol = t0c - t(i,j,k) + n0sfac = max(min(exp(alpha * supcol), n0smax / n0s), 1.0_c_double) + if (qr(i,j,k) <= qcrmin) then + rslope_r = rslopermax + rslopeb_r = rsloperbmax + rslope2_r = rsloper2max + rslope3_r = rsloper3max + else + lamdar = sqrt(sqrt(pidn0r / max(qr(i,j,k) * den(i,j,k), 1.0e-20_c_double))) + rslope_r = 1.0_c_double / max(lamdar, 1.0e-12_c_double) + rslopeb_r = rslope_r**bvtr + rslope2_r = rslope_r * rslope_r + rslope3_r = rslope2_r * rslope_r + end if + if (qs(i,j,k) <= qcrmin) then + rslope_s = rslopesmax + rslopeb_s = rslopesbmax + rslope2_s = rslopes2max + rslope3_s = rslopes3max + else + lamdas = sqrt(sqrt(pidn0s * n0sfac / max(qs(i,j,k) * den(i,j,k), 1.0e-20_c_double))) + rslope_s = 1.0_c_double / max(lamdas, 1.0e-12_c_double) + rslopeb_s = rslope_s**bvts + rslope2_s = rslope_s * rslope_s + rslope3_s = rslope2_s * rslope_s + end if + if (qg(i,j,k) <= qcrmin) then + rslope_g = rslopegmax + rslopeb_g = rslopegbmax + rslope2_g = rslopeg2max + rslope3_g = rslopeg3max + else + lamdag = sqrt(sqrt(pidn0g / max(qg(i,j,k) * den(i,j,k), 1.0e-20_c_double))) + rslope_g = 1.0_c_double / max(lamdag, 1.0e-12_c_double) + rslopeb_g = rslope_g**bvtg + rslope2_g = rslope_g * rslope_g + rslope3_g = rslope2_g * rslope_g + end if + + supsat = max(qv(i,j,k), qmin) - qsat + satdt = supsat / dtcld + praut = 0.0_c_double + pracw = 0.0_c_double + prevp = 0.0_c_double + if (qc(i,j,k) > qc0) then - auto_qr = min(qc(i,j,k) - qc0, 0.2_c_double * qc(i,j,k)) - qc(i,j,k) = qc(i,j,k) - auto_qr - qr(i,j,k) = qr(i,j,k) + auto_qr + praut = qck1 * qc(i,j,k)**(7.0_c_double / 3.0_c_double) + praut = min(praut, qc(i,j,k) / dtcld) + end if + + if (qr(i,j,k) > qcrmin .and. qc(i,j,k) > qmin) then + pracw = pacrr * rslope3_r * rslopeb_r * qc(i,j,k) * denfac + pracw = min(pracw, qc(i,j,k) / dtcld) + end if + + if (qr(i,j,k) > 0.0_c_double) then + work1_r = diffac(xlv, p(i,j,k), t(i,j,k), den(i,j,k), qsat, rv) + work2_r = venfac(p(i,j,k), t(i,j,k), den(i,j,k), den0) + coeres = rslope2_r * sqrt(max(rslope_r * rslopeb_r, 0.0_c_double)) + prevp = (max(qv(i,j,k) / qsat, qmin) - 1.0_c_double) * & + (precr1 * rslope2_r + precr2 * work2_r * coeres) / max(work1_r, 1.0e-12_c_double) + if (prevp < 0.0_c_double) then + prevp = max(prevp, -qr(i,j,k) / dtcld) + prevp = max(prevp, satdt / 2.0_c_double) + else + prevp = min(prevp, satdt / 2.0_c_double) + end if + end if + + qc(i,j,k) = max(qc(i,j,k) - (praut + pracw) * dtcld, 0.0_c_double) + qr(i,j,k) = max(qr(i,j,k) + (praut + pracw + prevp) * dtcld, 0.0_c_double) + qv(i,j,k) = max(qv(i,j,k) - prevp * dtcld, qmin) + t(i,j,k) = t(i,j,k) + xlv * prevp * dtcld / max(cpm, 1.0e-6_c_double) + + psmlt = 0.0_c_double + pgmlt = 0.0_c_double + if (t(i,j,k) > t0c) then + work2_r = venfac(p(i,j,k), t(i,j,k), den(i,j,k), den0) + if (qs(i,j,k) > 0.0_c_double) then + coeres = rslope2_s * sqrt(max(rslope_s * rslopeb_s, 0.0_c_double)) + psmlt = xka(t(i,j,k), den(i,j,k)) / max(xlf, 1.0e-12_c_double) * (t0c - t(i,j,k)) * pi / 2.0_c_double * & + n0sfac * (precs1 * rslope2_s + precs2 * work2_r * coeres) / max(den(i,j,k), 1.0e-12_c_double) + psmlt = min(max(psmlt * dtcld, -qs(i,j,k)), 0.0_c_double) + qs(i,j,k) = qs(i,j,k) + psmlt + qr(i,j,k) = qr(i,j,k) - psmlt + t(i,j,k) = t(i,j,k) + xlf / max(cpm, 1.0e-12_c_double) * psmlt + end if + if (qg(i,j,k) > 0.0_c_double) then + coeres = rslope2_g * sqrt(max(rslope_g * rslopeb_g, 0.0_c_double)) + pgmlt = xka(t(i,j,k), den(i,j,k)) / max(xlf, 1.0e-12_c_double) * (t0c - t(i,j,k)) * & + (precg1 * rslope2_g + precg2 * work2_r * coeres) / max(den(i,j,k), 1.0e-12_c_double) + pgmlt = min(max(pgmlt * dtcld, -qg(i,j,k)), 0.0_c_double) + qg(i,j,k) = qg(i,j,k) + pgmlt + qr(i,j,k) = qr(i,j,k) - pgmlt + t(i,j,k) = t(i,j,k) + xlf / max(cpm, 1.0e-12_c_double) * pgmlt + end if end if if (t(i,j,k) < t0c - 5.0_c_double) then freeze_q = min(qr(i,j,k), 0.05_c_double * qr(i,j,k)) qr(i,j,k) = qr(i,j,k) - freeze_q qs(i,j,k) = qs(i,j,k) + freeze_q - else if (t(i,j,k) > t0c + 1.0_c_double) then - melt_q = min(qs(i,j,k), 0.05_c_double * qs(i,j,k)) - qs(i,j,k) = qs(i,j,k) - melt_q - qr(i,j,k) = qr(i,j,k) + melt_q - t(i,j,k) = t(i,j,k) - xlf * melt_q / max(cpm, 1.0e-6_c_double) end if qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) From 303d547fc0ecb12d14cfdc6e99983d2a09f5c57c Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Wed, 1 Apr 2026 17:28:53 -0700 Subject: [PATCH 10/20] wsm6: add initial cold-collection tendencies in run shim --- Docs/wsm6_deep_dive/bridge_compare_phase1.md | 2 +- .../handoff_phase1_remaining_context.md | 4 ++ .../Microphysics/WSM6/ERF_module_mp_wsm6.F90 | 44 +++++++++++++++++++ 3 files changed, 49 insertions(+), 1 deletion(-) diff --git a/Docs/wsm6_deep_dive/bridge_compare_phase1.md b/Docs/wsm6_deep_dive/bridge_compare_phase1.md index 53d65f6fd9..1ba7dd25f2 100644 --- a/Docs/wsm6_deep_dive/bridge_compare_phase1.md +++ b/Docs/wsm6_deep_dive/bridge_compare_phase1.md @@ -20,7 +20,7 @@ This file is the short patch map between ERF's current WSM6 bridge and the canon | 2-D precip diagnostics | `rain,rainncv,sr,snow,snowncv,graupel,graupelncv` | Same set in shim and C bridge | Matched | | Optional 2-D diagnostics | `rainprod2d,evapprod2d` optional | Not in phase-1 shim/C bridge yet | Deferred | | Run index contract | Canonical uses `(its,ite,kts,kte)` | ERF C bridge passes full `(ids..kte)` and shim currently keeps all | Stubbed for transition | -| Physics internals | Full WSM6 microphysics | ERF shim now has transitional run scaffold with canonical warm-rain tendencies (`praut/pracw/prevp`) and canonical-style snow/graupel melting (`psmlt/pgmlt`) plus substepping/diagnostic accumulation; full cold-process set still pending | Partial | +| Physics internals | Full WSM6 microphysics | ERF shim now has transitional run scaffold with canonical warm-rain tendencies (`praut/pracw/prevp`), canonical-style snow/graupel melting (`psmlt/pgmlt`), and initial cold-process collection terms (`praci/piacr/psaci`) plus substepping/diagnostic accumulation; full cold-process and deposition chain still pending | Partial | | Error contract | `errmsg,errflg` out args | Preserved in shim; isohelper converts nonzero to `stop 1` | Matched | ## Files In ERF For This Bridge diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md index 35eca77384..fb3f69356b 100644 --- a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md +++ b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md @@ -50,9 +50,13 @@ - saturation adjustment via in-module `fpvs` - canonical-style warm-rain tendencies (`praut`, `pracw`, `prevp`) with slope/ventilation helpers - canonical-style `psmlt`/`pgmlt` melt tendencies for snow/graupel in warm layers + - initial cold-process collection tendencies (`praci`, `piacr`, `psaci`) - simple residual cold-phase conversion tendencies still retained for non-portioned paths - per-column precip diagnostic flux accumulation (`rain/snow/graupel` families) - Scope note: this is still not full `physics_mmm` parity; it is an integration bridge step that preserves current ERF C ABI. + - Tracked tendency-term coverage snapshot: + - Implemented in ERF shim: 8 / 27 (`prevp,praut,piacr,pracw,praci,psaci,psmlt,pgmlt`) + - Remaining: 19 / 27 (`pigen,pidep,pcond,psevp,pgevp,psdep,pgdep,psaut,pgaut,pracs,psacw,psacr,pgacw,pgaci,pgacr,pgacs,paacw,pseml,pgeml`) ## Targeted Verification (No Full Rebuild) - Configured `build_no_netcdf_wsm6` with: diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 index d09a5a6c19..23d9f265b9 100644 --- a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 @@ -219,6 +219,9 @@ subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & real(c_double) :: n0sfac, supcol real(c_double) :: work1_r, work2_r, coeres, satdt, praut, pracw, prevp real(c_double) :: psmlt, pgmlt + real(c_double) :: praci, piacr, psaci + real(c_double) :: xni, xmi, diameter, vt2i, vt2r, vt2s, vt2g, vt2ave, qsum, eacrs, acrfac + real(c_double) :: frac_qr_qi, frac_qi_qr real(c_double) :: rain_flux, snow_flux, graup_flux if (delt <= 0.0_c_double .or. g <= 0.0_c_double .or. cpd <= 0.0_c_double .or. cpv <= 0.0_c_double) then @@ -391,6 +394,47 @@ subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & end if qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) + praci = 0.0_c_double + piacr = 0.0_c_double + psaci = 0.0_c_double + + if (supcol > 0.0_c_double .and. qi(i,j,k) > qmin) then + xni = min(max(5.38e7_c_double * (den(i,j,k) * max(qi(i,j,k), qmin))**0.75_c_double, 1.0e3_c_double), 1.0e6_c_double) + eacrs = exp(-0.07_c_double * supcol) + xmi = den(i,j,k) * qi(i,j,k) / max(xni, 1.0e-12_c_double) + diameter = max(min(11.9_c_double * sqrt(max(xmi, 0.0_c_double)), dimax), 1.0e-25_c_double) + vt2i = 1.49e4_c_double * diameter**1.31_c_double + vt2r = pvtr * rslopeb_r * denfac + vt2s = pvts * rslopeb_s * denfac + vt2g = pvtg * rslopeb_g * denfac + qsum = max(qs(i,j,k) + qg(i,j,k), 1.0e-15_c_double) + vt2ave = (vt2s * qs(i,j,k) + vt2g * qg(i,j,k)) / qsum + + if (qr(i,j,k) > qcrmin) then + acrfac = 2.0_c_double * rslope3_r + 2.0_c_double * diameter * rslope2_r + diameter*diameter * rslope_r + praci = pi * qi(i,j,k) * n0r * abs(vt2r - vt2i) * acrfac / 4.0_c_double + frac_qr_qi = min(max(qr(i,j,k) / max(qi(i,j,k), 1.0e-20_c_double), 0.0_c_double), 1.0_c_double) + praci = praci * frac_qr_qi * frac_qr_qi + praci = min(praci, qi(i,j,k) / dtcld) + + piacr = pi*pi * avtr * n0r * denr * xni * denfac * g6pbr * rslope3_r * rslope3_r * rslopeb_r / & + (24.0_c_double * max(den(i,j,k), 1.0e-12_c_double)) + frac_qi_qr = min(max(qi(i,j,k) / max(qr(i,j,k), 1.0e-20_c_double), 0.0_c_double), 1.0_c_double) + piacr = piacr * frac_qi_qr * frac_qi_qr + piacr = min(piacr, qr(i,j,k) / dtcld) + end if + + if (qs(i,j,k) > qcrmin) then + acrfac = 2.0_c_double * rslope3_s + 2.0_c_double * diameter * rslope2_s + diameter*diameter * rslope_s + psaci = pi * qi(i,j,k) * eacrs * n0s * n0sfac * abs(vt2ave - vt2i) * acrfac / 4.0_c_double + psaci = min(psaci, qi(i,j,k) / dtcld) + end if + end if + + qi(i,j,k) = max(qi(i,j,k) - (praci + psaci) * dtcld, 0.0_c_double) + qr(i,j,k) = max(qr(i,j,k) + (praci - piacr) * dtcld, 0.0_c_double) + qs(i,j,k) = max(qs(i,j,k) + (piacr + psaci) * dtcld, 0.0_c_double) + if (t(i,j,k) < t0c - 10.0_c_double .and. qi(i,j,k) > 0.0_c_double) then freeze_q = min(qi(i,j,k), 0.02_c_double * qi(i,j,k)) qi(i,j,k) = qi(i,j,k) - freeze_q From 97ec46dfd5b1d25b96862c7187d70209a62bb0e9 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Thu, 2 Apr 2026 11:51:30 -0700 Subject: [PATCH 11/20] WSM6: fix C/Fortran bounds contract in bridge --- Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp | 40 +++---- .../WSM6/ERF_module_mp_wsm6_isohelper.F90 | 102 ++++++++++++++---- 2 files changed, 104 insertions(+), 38 deletions(-) diff --git a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp index 874a93b482..521254a008 100644 --- a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp @@ -24,14 +24,6 @@ WSM6::Advance(const Real& dt_advance, wsm6_inited = true; } - const auto domain = m_geom.Domain(); - const int i_lo = domain.smallEnd(0); - const int i_hi = domain.bigEnd(0); - const int j_lo = domain.smallEnd(1); - const int j_hi = domain.bigEnd(1); - const int k_lo = domain.smallEnd(2); - const int k_hi = domain.bigEnd(2); - constexpr double g = static_cast(CONST_GRAV); constexpr double cpd = static_cast(Cp_d); constexpr double cpv = static_cast(Cp_v); @@ -52,6 +44,7 @@ WSM6::Advance(const Real& dt_advance, for (MFIter mfi(*mic_fab_vars[MicVar_WSM6::qv], TileNoZ()); mfi.isValid(); ++mfi) { const Box box = mfi.tilebox(); + const Box fab_box = mfi.fabbox(); auto const& t_arr = mic_fab_vars[MicVar_WSM6::tabs]->array(mfi); auto const& qv_arr = mic_fab_vars[MicVar_WSM6::qv]->array(mfi); @@ -73,10 +66,18 @@ WSM6::Advance(const Real& dt_advance, const int klo = box.smallEnd(2); const int khi = box.bigEnd(2); - FArrayBox delz_fab(box, 1); - auto const& delz_arr = delz_fab.array(); + const int imlo = fab_box.smallEnd(0); + const int imhi = fab_box.bigEnd(0); + const int jmlo = fab_box.smallEnd(1); + const int jmhi = fab_box.bigEnd(1); + const int kmlo = fab_box.smallEnd(2); + const int kmhi = fab_box.bigEnd(2); const Real dz_val = m_geom.CellSize(m_axis); + FArrayBox delz_fab(fab_box, 1); + auto const& delz_arr = delz_fab.array(); + delz_fab.setVal(dz_val); + const Array4 z_arr = (m_z_phys_nd) ? m_z_phys_nd->const_array(mfi) : Array4 {}; ParallelFor(box, [=] AMREX_GPU_DEVICE (int i, int j, int k) { delz_arr(i,j,k) = (z_arr) ? Real(0.25) * ( (z_arr(i ,j ,k+1) - z_arr(i ,j ,k)) @@ -85,7 +86,7 @@ WSM6::Advance(const Real& dt_advance, + (z_arr(i+1,j+1,k+1) - z_arr(i+1,j+1,k)) ) : dz_val; }); - Box box2d(box); + Box box2d(fab_box); box2d.makeSlab(2, 0); FArrayBox rainncv_fab(box2d, 1); FArrayBox sr_fab(box2d, 1); @@ -104,17 +105,16 @@ WSM6::Advance(const Real& dt_advance, }); mp_wsm6_run_c( - &(t_arr(ilo,jlo,klo)), - &(qv_arr(ilo,jlo,klo)), &(qc_arr(ilo,jlo,klo)), &(qi_arr(ilo,jlo,klo)), - &(qr_arr(ilo,jlo,klo)), &(qs_arr(ilo,jlo,klo)), &(qg_arr(ilo,jlo,klo)), - &(den_arr(ilo,jlo,klo)), &(p_arr(ilo,jlo,klo)), &(delz_arr(ilo,jlo,klo)), + t_arr.dataPtr(), + qv_arr.dataPtr(), qc_arr.dataPtr(), qi_arr.dataPtr(), + qr_arr.dataPtr(), qs_arr.dataPtr(), qg_arr.dataPtr(), + den_arr.dataPtr(), p_arr.dataPtr(), delz_arr.dataPtr(), static_cast(dt), g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, cliq, cice, psat, - &(rain_arr(ilo,jlo,0)), &(rainncv_arr(ilo,jlo,0)), &(sr_arr(ilo,jlo,0)), - &(snow_arr(ilo,jlo,0)), &(snowncv_arr(ilo,jlo,0)), - &(graup_arr(ilo,jlo,0)), &(graupelncv_arr(ilo,jlo,0)), - i_lo, i_hi, j_lo, j_hi, k_lo, k_hi, - i_lo, i_hi, j_lo, j_hi, k_lo, k_hi, + rain_arr.dataPtr(), rainncv_arr.dataPtr(), sr_arr.dataPtr(), + snow_arr.dataPtr(), snowncv_arr.dataPtr(), + graup_arr.dataPtr(), graupelncv_arr.dataPtr(), + imlo, imhi, jmlo, jmhi, kmlo, kmhi, ilo, ihi, jlo, jhi, klo, khi); } #else diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 index 77fdf58cbf..a70a0062a4 100644 --- a/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 @@ -9,10 +9,10 @@ subroutine mp_wsm6_init_c(den0, denr, dens, cl, cpv, hail_opt) bind(C, name="mp_ real(c_double), value, intent(in) :: den0, denr, dens, cl, cpv integer(c_int), value, intent(in) :: hail_opt character(len=256) :: errmsg - integer(c_int) :: errflg + integer :: errflg - call mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) - if (errflg /= 0_c_int) then + call mp_wsm6_init(den0, denr, dens, cl, cpv, int(hail_opt, kind(0)), errmsg, errflg) + if (errflg /= 0) then write(*,'(A,1X,A)') 'mp_wsm6_init_c error:', trim(errmsg) stop 1 end if @@ -22,10 +22,8 @@ subroutine mp_wsm6_run_c(t, qv, qc, qi, qr, qs, qg, den, p, delz, & delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, & xlv0, xlf0, den0, denr, cliq, cice, psat, & rain, rainncv, sr, snow, snowncv, graupel, graupelncv, & - ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte) bind(C, name="mp_wsm6_run_c") - integer(c_int), value, intent(in) :: ids, ide, jds, jde, kds, kde integer(c_int), value, intent(in) :: ims, ime, jms, jme, kms, kme integer(c_int), value, intent(in) :: its, ite, jts, jte, kts, kte real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: t, qv, qc, qi, qr, qs, qg @@ -34,20 +32,88 @@ subroutine mp_wsm6_run_c(t, qv, qc, qi, qr, qs, qg, den, p, delz, & real(c_double), value, intent(in) :: xlv0, xlf0, den0, denr, cliq, cice, psat real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rain, rainncv, sr real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: snow, snowncv, graupel, graupelncv + + integer :: i, j, k, kk, kdim + integer :: errflg character(len=256) :: errmsg - integer(c_int) :: errflg - - call mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & - delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, & - xlv0, xlf0, den0, denr, cliq, cice, psat, & - rain, rainncv, sr, snow, snowncv, graupel, graupelncv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, errmsg, errflg) - if (errflg /= 0_c_int) then - write(*,'(A,1X,A)') 'mp_wsm6_run_c error:', trim(errmsg) - stop 1 - end if + + real(c_double), allocatable :: t_col(:,:), q_col(:,:), qc_col(:,:), qi_col(:,:), qr_col(:,:), qs_col(:,:), qg_col(:,:) + real(c_double), allocatable :: den_col(:,:), p_col(:,:), delz_col(:,:) + real(c_double), allocatable :: rain_col(:), rainncv_col(:), sr_col(:) + real(c_double), allocatable :: snow_col(:), snowncv_col(:), graupel_col(:), graupelncv_col(:) + + kdim = kte - kts + 1 + + allocate(t_col(ims:ime,1:kdim), q_col(ims:ime,1:kdim), qc_col(ims:ime,1:kdim), qi_col(ims:ime,1:kdim)) + allocate(qr_col(ims:ime,1:kdim), qs_col(ims:ime,1:kdim), qg_col(ims:ime,1:kdim)) + allocate(den_col(ims:ime,1:kdim), p_col(ims:ime,1:kdim), delz_col(ims:ime,1:kdim)) + allocate(rain_col(ims:ime), rainncv_col(ims:ime), sr_col(ims:ime)) + allocate(snow_col(ims:ime), snowncv_col(ims:ime), graupel_col(ims:ime), graupelncv_col(ims:ime)) + + do j = jts, jte + do k = kts, kte + kk = k - kts + 1 + do i = ims, ime + t_col(i,kk) = t(i,j,k) + q_col(i,kk) = qv(i,j,k) + qc_col(i,kk) = qc(i,j,k) + qi_col(i,kk) = qi(i,j,k) + qr_col(i,kk) = qr(i,j,k) + qs_col(i,kk) = qs(i,j,k) + qg_col(i,kk) = qg(i,j,k) + den_col(i,kk) = den(i,j,k) + p_col(i,kk) = p(i,j,k) + delz_col(i,kk) = delz(i,j,k) + end do + end do + + do i = ims, ime + rain_col(i) = rain(i,j) + rainncv_col(i) = rainncv(i,j) + sr_col(i) = sr(i,j) + snow_col(i) = snow(i,j) + snowncv_col(i) = snowncv(i,j) + graupel_col(i) = graupel(i,j) + graupelncv_col(i)= graupelncv(i,j) + end do + + call mp_wsm6_run(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col, den_col, p_col, delz_col, & + delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, & + cliq, cice, psat, rain_col, rainncv_col, sr_col, snow_col, snowncv_col, & + graupel_col, graupelncv_col, its=its, ite=ite, kts=1, kte=kdim, errmsg=errmsg, errflg=errflg) + + if (errflg /= 0) then + write(*,'(A,1X,I0,2A)') 'mp_wsm6_run_c error at j=', j, ': ', trim(errmsg) + stop 1 + end if + + do k = kts, kte + kk = k - kts + 1 + do i = its, ite + t(i,j,k) = t_col(i,kk) + qv(i,j,k) = q_col(i,kk) + qc(i,j,k) = qc_col(i,kk) + qi(i,j,k) = qi_col(i,kk) + qr(i,j,k) = qr_col(i,kk) + qs(i,j,k) = qs_col(i,kk) + qg(i,j,k) = qg_col(i,kk) + end do + end do + + do i = its, ite + rain(i,j) = rain_col(i) + rainncv(i,j) = rainncv_col(i) + sr(i,j) = sr_col(i) + snow(i,j) = snow_col(i) + snowncv(i,j) = snowncv_col(i) + graupel(i,j) = graupel_col(i) + graupelncv(i,j) = graupelncv_col(i) + end do + end do + + deallocate(t_col, q_col, qc_col, qi_col, qr_col, qs_col, qg_col) + deallocate(den_col, p_col, delz_col) + deallocate(rain_col, rainncv_col, sr_col, snow_col, snowncv_col, graupel_col, graupelncv_col) end subroutine mp_wsm6_run_c end module mp_wsm6_isohelper From f683b2a059b7bf83a3846dfdc0e7c0e35d5137da Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Thu, 2 Apr 2026 13:20:08 -0700 Subject: [PATCH 12/20] WSM6: add generic Morrison-parity reproduction README --- Source/Microphysics/WSM6/README | 95 +++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 Source/Microphysics/WSM6/README diff --git a/Source/Microphysics/WSM6/README b/Source/Microphysics/WSM6/README new file mode 100644 index 0000000000..5b0540b86f --- /dev/null +++ b/Source/Microphysics/WSM6/README @@ -0,0 +1,95 @@ +# WSM6 Fortran-Bridge Reproduction (Morrison-Parity) + +This workflow reproduces a like-for-like WSM6 vs Morrison comparison using the same ERF executable, runtime controls, and `fcompare` postprocessing. + +## Setup + +Set `ERF_HOME` and derived paths once: + +```bash +export ERF_HOME="/path/to/ERF" +export BUILD_DIR="${ERF_HOME}/build_wsm6_contract_debug" +export CASE_DIR="${ERF_HOME}/Exec/CanonicalTests/SquallLine_2D" +export ERF_EXE="${BUILD_DIR}/Exec/erf_exec" +export FCOMPARE="${FCOMPARE:-fcompare}" +``` + +Required inputs in `${CASE_DIR}`: +- `inputs_moisture_WSM6` +- `inputs_moisture_Morrison_short` + +## Build + +```bash +cmake -S "${ERF_HOME}" -B "${BUILD_DIR}" \ + -DERF_ENABLE_NETCDF=OFF \ + -DERF_ENABLE_WSM6_FORT=ON \ + -DCMAKE_BUILD_TYPE=Debug \ + -DCMAKE_INSTALL_PREFIX="${ERF_HOME}/install" \ + -DCMAKE_Fortran_FLAGS_DEBUG='-O0 -g -fcheck=all -fbacktrace -ffpe-trap=invalid,zero,overflow' + +cmake --build "${BUILD_DIR}" --target erf_exec -j 8 +``` + +Optional (if you want `fcompare` from this same WSM6 build): + +```bash +cmake --build "${BUILD_DIR}" -j 8 +cmake --install "${BUILD_DIR}" +export FCOMPARE="${ERF_HOME}/install/bin/amrex_fcompare" +``` + +## Run WSM6 (120 steps) + +```bash +cd "${CASE_DIR}" + +"${ERF_EXE}" \ + inputs_moisture_WSM6 \ + max_step=120 \ + erf.plot_int_1=30 \ + erf.plot_file_1=plt_wsm6_run \ + erf.check_file=chk_wsm6_run \ + amrex.fpe_trap_invalid=0 \ + > run_wsm6.log 2>&1 +``` + +## Run Morrison (120 steps, matched controls) + +```bash +"${ERF_EXE}" \ + inputs_moisture_Morrison_short \ + max_step=120 \ + erf.plot_int_1=30 \ + erf.plot_file_1=plt_morr_run \ + erf.check_file=chk_morr_run \ + amrex.fpe_trap_invalid=0 \ + > run_morr.log 2>&1 +``` + +## Quick verification + +```bash +rg -n "Moisture Model: WSM6|Coarse STEP 120 ends" run_wsm6.log +rg -n "Moisture Model: Morrison|Coarse STEP 120 ends" run_morr.log +``` + +Expected final outputs: +- `plt_wsm6_run00120`, `chk_wsm6_run00120` +- `plt_morr_run00120`, `chk_morr_run00120` + +## Compare step-120 plotfiles + +```bash +"${FCOMPARE}" \ + plt_wsm6_run00120 \ + plt_morr_run00120 \ + > fcompare_wsm6_vs_morr_step120.log 2>&1 +``` + +Result file: +- `fcompare_wsm6_vs_morr_step120.log` + +Notes: +- If your `fcompare` is MPI-enabled, run it in an environment where MPI singleton/process launch is supported. +- Morrison GNUmake docs sometimes mention `-fdefault-real-8`; this README uses the CMake path shown above. From 03749eb364ddee5eec4bd055b7baf934887835c4 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Thu, 2 Apr 2026 13:25:05 -0700 Subject: [PATCH 13/20] Make.ERF: clarify BL_NO_FORT default behavior --- Exec/Make.ERF | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Exec/Make.ERF b/Exec/Make.ERF index 3df334c37d..c8166a9486 100644 --- a/Exec/Make.ERF +++ b/Exec/Make.ERF @@ -2,6 +2,8 @@ AMREX_HOME ?= $(ERF_HOME)/Submodules/AMReX EKAT_HOME ?= $(ERF_HOME)/Submodules/ekat/build/install EAMXX_HOME ?= $(ERF_HOME)/external/E3SM/components/eamxx/src +# Default is no Fortran build unless an explicit Fortran bridge/model is enabled. +# Keep this TRUE when USE_MORR_FORT and USE_WSM6_FORT are both unset. BL_NO_FORT = TRUE ifeq ($(USE_MORR_FORT), TRUE) DEFINES += -DERF_USE_MORR_FORT From 089afde68b8c1c1cd99f5d2cdb7cda39254b387e Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Thu, 2 Apr 2026 13:26:17 -0700 Subject: [PATCH 14/20] Docs: stop tracking wsm6 deep-dive handoff artifacts --- Docs/wsm6_deep_dive/bridge_compare_phase1.md | 48 ---- .../handoff_phase1_remaining_context.md | 215 ------------------ .../implementation_checklist.md | 16 -- 3 files changed, 279 deletions(-) delete mode 100644 Docs/wsm6_deep_dive/bridge_compare_phase1.md delete mode 100644 Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md delete mode 100644 Docs/wsm6_deep_dive/implementation_checklist.md diff --git a/Docs/wsm6_deep_dive/bridge_compare_phase1.md b/Docs/wsm6_deep_dive/bridge_compare_phase1.md deleted file mode 100644 index 1ba7dd25f2..0000000000 --- a/Docs/wsm6_deep_dive/bridge_compare_phase1.md +++ /dev/null @@ -1,48 +0,0 @@ -# WSM6 Bridge Compare (Phase 1) - -## Purpose -This file is the short patch map between ERF's current WSM6 bridge and the canonical `physics_mmm/mp_wsm6.F90` interfaces, so follow-on work can be done with explainable incremental diffs. - -## Entrypoint Mapping -- Canonical init: `mp_wsm6_init(den0,denr,dens,cl,cpv,hail_opt,errmsg,errflg)` -- Canonical run: `mp_wsm6_run(t,q,qc,qi,qr,qs,qg,den,p,delz,delt,g,cpd,cpv,rd,rv,t0c,ep1,ep2,qmin,xls,xlv0,xlf0,den0,denr,cliq,cice,psat,rain,rainncv,sr,snow,snowncv,graupel,graupelncv,rainprod2d,evapprod2d,its,ite,kts,kte,errmsg,errflg)` -- ERF C bridge entrypoints: `mp_wsm6_init_c`, `mp_wsm6_run_c` -- ERF Fortran shim entrypoints: `mp_wsm6_init`, `mp_wsm6_run` - -## Status Table -| Area | Canonical (`physics_mmm`) | ERF phase-1 state | Status | -|---|---|---|---| -| Symbol names | `mp_wsm6_init`, `mp_wsm6_run` | Same names in ERF-owned module | Matched | -| C bindings | Not provided in canonical module | `mp_wsm6_init_c`, `mp_wsm6_run_c` in ERF isohelper | Matched (ERF bridge layer) | -| Init args | `den0,denr,dens,cl,cpv,hail_opt,+errmsg/errflg` | Same arg set in shim | Matched | -| Init internals | Canonical computes coefficient tables for run-time tendencies | ERF shim now computes canonical-style coefficient tables (radar coupling still deferred) | Partial | -| Run core thermo/hydro args | `t,q,qc,qi,qr,qs,qg,den,p,delz,...` | Same core set in shim (`qv` naming on ERF side maps to canonical `q`) | Matched | -| 2-D precip diagnostics | `rain,rainncv,sr,snow,snowncv,graupel,graupelncv` | Same set in shim and C bridge | Matched | -| Optional 2-D diagnostics | `rainprod2d,evapprod2d` optional | Not in phase-1 shim/C bridge yet | Deferred | -| Run index contract | Canonical uses `(its,ite,kts,kte)` | ERF C bridge passes full `(ids..kte)` and shim currently keeps all | Stubbed for transition | -| Physics internals | Full WSM6 microphysics | ERF shim now has transitional run scaffold with canonical warm-rain tendencies (`praut/pracw/prevp`), canonical-style snow/graupel melting (`psmlt/pgmlt`), and initial cold-process collection terms (`praci/piacr/psaci`) plus substepping/diagnostic accumulation; full cold-process and deposition chain still pending | Partial | -| Error contract | `errmsg,errflg` out args | Preserved in shim; isohelper converts nonzero to `stop 1` | Matched | - -## Files In ERF For This Bridge -- `Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90` -- `Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90` -- `Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H` -- `Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp` - -## Replace Order (Minimal-Risk) -1. Keep `mp_wsm6_*_c` signatures fixed; do not change C++ call sites yet. -2. Replace shim `mp_wsm6_init` body with canonical init internals. -3. Replace shim `mp_wsm6_run` body with canonical run internals, still keeping ERF C bridge ABI unchanged. -4. Add `rainprod2d/evapprod2d` as optional bridge args only after run body replacement is stable. -5. Reduce index argument surface to canonical `(its,ite,kts,kte)` once full run parity is validated. - -## Quick Diff Commands -```bash -# Canonical vs ERF shim (module-level implementation) -diff -u /home/jmsexton/codes/physics_mmm/mp_wsm6.F90 \ - /home/jmsexton/codes/ERF/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 - -# ERF C bridge surface used by C++ -diff -u /home/jmsexton/codes/ERF/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H \ - /home/jmsexton/codes/ERF/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 -``` diff --git a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md b/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md deleted file mode 100644 index fb3f69356b..0000000000 --- a/Docs/wsm6_deep_dive/handoff_phase1_remaining_context.md +++ /dev/null @@ -1,215 +0,0 @@ -# WSM6 Phase-1 Handoff (Remaining Context Budget) - -## Progress Log -- Section 1 completed on branch `wsm6-moisture-stubs`. - - Commit: `672df6d0` - - Summary: added WSM6 scaffold files under `Source/Microphysics/WSM6/` and wired Make/CMake sources/includes. -- Section 2 completed (selection plumbing). - - Added `WSM6` to `MoistureType` enum in `Source/DataStructs/ERF_DataStruct.H`. - - Added WSM6 moisture index mapping as a 6-species model (`qv,qc,qi,qr,qs,qg`). - - Added WSM6 to Eulerian model detection in `Source/Microphysics/ERF_Microphysics.H`. - - Added `#include "ERF_WSM6.H"` and `SetModel()` in `Source/Microphysics/ERF_EulerianMicrophysics.H`. - - Added WSM6 handling to accumulation-copy branch in `Source/IO/ERF_Plotfile.cpp` so `rain_accum/snow_accum/graup_accum` are not skipped. -- Phase-1 WSM6 Fortran bridge wiring advanced (this pass): - - `Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H` now has concrete C-binding declarations for a minimal single-moment bridge: - - `mp_wsm6_init_c(...)` - - `mp_wsm6_run_c(...)` - - `Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp` now calls WSM6 Fortran bridge entry points under `ERF_USE_WSM6_FORT`: - - one-time `mp_wsm6_init_c(...)` - - per-tile `mp_wsm6_run_c(...)` - - Bridge scope intentionally kept minimal: required single-moment state + thermo + geometry + precip accum/rates only; no radiation/chem optional arrays. - - Targeted WSM6 TU compile check completed successfully (via compile commands): - - `ERF_InitWSM6.cpp` - - `ERF_AdvanceWSM6.cpp` - - `ERF_UpdateWSM6.cpp` - - `ERF_AdvanceWSM6.cpp` also compiles with `-DERF_USE_WSM6_FORT` forced on (TU-level check). -- Incremental bridge commit (ERF-tracked code path): - - Commit: `6aa3accc` - - Added ERF-owned Fortran WSM6 shim module: - - `Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90` - - Added C-binding isohelper that calls `mp_wsm6_init/mp_wsm6_run` from that shim: - - `Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90` - - Build wiring for `USE_WSM6_FORT`/`ERF_ENABLE_WSM6_FORT` updated in: - - `Source/Microphysics/WSM6/Make.package` - - `Exec/Make.ERF` - - `CMakeLists.txt` - - `CMake/BuildERFExe.cmake` - - `CMake/SetAmrexOptions.cmake` - - `CMake/CrayCompilerDetection.cmake` - - Scope note: shim is intentionally minimal and tracked in ERF; it enforces nonnegative moisture and exposes stable bridge symbols for integration work. -- Pre-handoff compare artifact committed: - - Commit: `20dabf1e` - - File: `Docs/wsm6_deep_dive/bridge_compare_phase1.md` - - Summary: adds canonical-vs-ERF bridge map and ordered replacement plan (`init` then `run`, preserving ABI first). -- Post-compare follow-up (this pass): - - `Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90` `mp_wsm6_init` upgraded from pure stub checks to canonical-style coefficient initialization (hail/graupel option tables + precomputed constants). - - C bridge ABI and `mp_wsm6_run` argument contract remain unchanged. - - `ERF_module_mp_wsm6.F90.o` recompiles cleanly in `build_no_netcdf_wsm6`. - - `mp_wsm6_run` upgraded from clamp-only stub to a transitional canonical-style scaffold: - - minor-loop time splitting (`dtcldcr`) - - saturation adjustment via in-module `fpvs` - - canonical-style warm-rain tendencies (`praut`, `pracw`, `prevp`) with slope/ventilation helpers - - canonical-style `psmlt`/`pgmlt` melt tendencies for snow/graupel in warm layers - - initial cold-process collection tendencies (`praci`, `piacr`, `psaci`) - - simple residual cold-phase conversion tendencies still retained for non-portioned paths - - per-column precip diagnostic flux accumulation (`rain/snow/graupel` families) - - Scope note: this is still not full `physics_mmm` parity; it is an integration bridge step that preserves current ERF C ABI. - - Tracked tendency-term coverage snapshot: - - Implemented in ERF shim: 8 / 27 (`prevp,praut,piacr,pracw,praci,psaci,psmlt,pgmlt`) - - Remaining: 19 / 27 (`pigen,pidep,pcond,psevp,pgevp,psdep,pgdep,psaut,pgaut,pracs,psacw,psacr,pgacw,pgaci,pgacr,pgacs,paacw,pseml,pgeml`) - -## Targeted Verification (No Full Rebuild) -- Configured `build_no_netcdf_wsm6` with: - - `ERF_ENABLE_NETCDF=OFF` - - `ERF_ENABLE_WSM6_FORT=ON` -- Avoided full executable rebuild; ran targeted per-file compile checks using generated build flags: - - `ERF_module_mp_wsm6.F90` - - `ERF_module_mp_wsm6_isohelper.F90` - - `ERF_AdvanceWSM6.cpp` -- Result: targeted bridge units compile successfully. -- Additional narrow verification completed (object-only, no full `erf_srclib` build): - - Confirmed stash baseline first: `git stash list -n 5` (deep-dive stash present at `stash@{0}`). - - Rebuilt only WSM6 bridge objects via: - - `gmake -C /home/jmsexton/codes/ERF/build_no_netcdf_wsm6 -f Exec/CMakeFiles/erf_srclib.dir/build.make ...` - - Explicitly compiled in this pass: - - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_InitWSM6.cpp.o` - - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp.o` - - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp.o` - - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90.o` - - `Exec/CMakeFiles/erf_srclib.dir/__/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90.o` - - Result: all targeted WSM6 bridge objects compile cleanly in `build_no_netcdf_wsm6`. - -## Simple Diff/Patch Comparison Plan -- Keep ERF shim interfaces intentionally close to canonical names: - - `mp_wsm6_init` - - `mp_wsm6_run` -- Comparison workflow for next pass: - 1. Diff `ERF_module_mp_wsm6.F90` against `physics_mmm/mp_wsm6.F90` init/run signatures. - 2. Diff `ERF_module_mp_wsm6_isohelper.F90` against the same C-bind wrapper pattern used by Morrison in ERF. - 3. Replace stub internals progressively while preserving bridge symbol names and argument order. - -## Build Attempt (This Pass) -- Attempted target build: - - `cmake --build /home/jmsexton/codes/ERF/build --target erf_srclib -j 8` -- Result: blocked before reaching final link due pre-existing NetCDF parallel header issue in this build configuration. -- First failing line: - - `/home/jmsexton/codes/ERF/Source/IO/ERF_NCInterface.H:18` - - `#include ` - - Error: `fatal error: netcdf_par.h: No such file or directory` - -## Current State -- Workspace progress was stashed before deep-dive work. -- Deep-dive artifacts are complete: - - `Docs/wsm6_deep_dive/entrypoints.md` - - `Docs/wsm6_deep_dive/args_map.csv` - - `Docs/wsm6_deep_dive/state_map.csv` - - `Docs/wsm6_deep_dive/risk_log.md` - - `Docs/wsm6_deep_dive/implementation_checklist.md` -- Decision baseline is locked: - - Morrison setup template = initial integration + critical fixes. - - Canonical external source = `../WRF_model`; `../WRF_NCAR` delta-only. - - Phase 1 goal = Fortran-in-place runnable WSM6 in ERF. - -## Goal for Remaining Context -Implement the highest-leverage subset of Phase 1 that gets us as close as possible to a compile-time integrated WSM6 path, with minimal risk and minimal surface area. - -## Recommended Scope to Implement Now (in order) - -### 1. Create WSM6 skeleton files and wire into build -Why now: highest leverage, low ambiguity, mostly mechanical. - -Files to create: -- `Source/Microphysics/WSM6/ERF_WSM6.H` -- `Source/Microphysics/WSM6/ERF_InitWSM6.cpp` -- `Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp` -- `Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp` -- `Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H` -- `Source/Microphysics/WSM6/Make.package` - -Files to edit: -- `Exec/Make.ERF` (add `ERF_MOISTURE_WSM6_DIR` include block, mirroring existing moisture package pattern) -- CMake files currently used for microphysics source inclusion (same pattern as Morrison integration) - -Acceptance criteria: -- New files exist with compilable class/function declarations and stub bodies. -- Build system includes WSM6 source directory/package (no runtime behavior yet required). - -### 2. Add moisture-model selection plumbing -Why now: required to make WSM6 addressable from inputs and dispatch path. - -Files likely to edit: -- `Source/Microphysics/ERF_Microphysics.H` -- `Source/Microphysics/ERF_EulerianMicrophysics.H` -- Any `MoistureType` enum definition location in ERF data/solver structs - -Acceptance criteria: -- `MoistureType::WSM6` exists. -- Eulerian microphysics can instantiate `WSM6` model class. -- No regressions for existing moisture models. - -### 3. Add minimal WSM6 state mapping and lifecycle stubs -Why now: enables incremental integration without full Fortran call complexity. - -Implement in WSM6 class: -- `Define` -- `Init` -- `Copy_State_to_Micro` -- `Advance` (initially stubbed/no-op or guarded call) -- `Copy_Micro_to_State` -- `Qmoist_Size`, `Qstate_Moist_Size`, restart var hooks - -Acceptance criteria: -- ERF compiles with WSM6 model selected at compile time. -- WSM6 model class follows the same interface contracts as other Eulerian models. - -Status: -- Completed in scaffold form. -- Remaining in this area is only Fortran bridge insertion into `WSM6::Advance` and any compile-fix fallout. - -## Defer to Next Pass (do not spend remaining context here) - -### A. Full Fortran argument bridge implementation -- `mp_wsm6_init`/`mp_wsm6_run` call signatures and full argument marshalling. -- Optional arguments: radiation effective radii, chemistry hooks. - -Reason to defer: higher complexity and higher bug risk; better done after skeleton + dispatch compile cleanly. - -### B. Runtime validation case setup and physics debugging -- New regtest input case for WSM6. -- Numerical debugging/field validation. - -Reason to defer: depends on successful compile and basic bridge. - -### C. C++ per-process decomposition -- Any split equivalent to Morrison cloud/ice/precip process files. - -Reason to defer: out of scope for phase-1 Fortran-in-place objective. - -## Implementation Notes -- Keep phase-1 WSM6 simple: single-moment moisture fields only (`qv,qc,qi,qr,qs,qg`) plus accumulators. -- Reuse Morrison lifecycle shape, not Morrison number-concentration state design. -- Avoid backup/temp files (`*~`, `#*#`) when copying references from Morrison directory. - -## Stop Conditions for This Context Budget -Stop and hand off once all are true: -1. Build wiring and model dispatch for WSM6 are in place. -2. WSM6 class skeleton compiles (or is one small compile-fix away with explicit note). -3. Remaining work is primarily Fortran call wiring + runtime validation. - -Current evaluation: -- (1) Satisfied. -- (2) Satisfied (verified via targeted WSM6 object rebuilds in `build_no_netcdf_wsm6`). -- (3) Expected once targeted compile is run and clean. - -## Next-Agent Starting Checklist -1. Confirm stashes before modifying anything: - - `git stash list -n 3` -2. Use `Docs/wsm6_deep_dive/bridge_compare_phase1.md` as the patch map. -3. Keep object-level compile checks (avoid full fresh `erf_srclib` build unless needed): - - `gmake -C /home/jmsexton/codes/ERF/build_no_netcdf_wsm6 -f Exec/CMakeFiles/erf_srclib.dir/build.make ` -4. Implement replacement order from compare doc: - - canonicalize `mp_wsm6_init` body first, then `mp_wsm6_run` body, while holding C bridge ABI fixed. -5. Update this document with: - - what compiled, - - what remains blocked, - - exact first failing file/line if build fails. diff --git a/Docs/wsm6_deep_dive/implementation_checklist.md b/Docs/wsm6_deep_dive/implementation_checklist.md deleted file mode 100644 index 570afa91b4..0000000000 --- a/Docs/wsm6_deep_dive/implementation_checklist.md +++ /dev/null @@ -1,16 +0,0 @@ -# WSM6 Implementation Checklist (Derived from Deep Dive) - -## Phase 1: Fortran-in-place WSM6 runnable in ERF -- [x] Add `Source/Microphysics/WSM6/` with ERF wrapper class and Fortran interface header. -- [x] Add build wiring in `Exec/Make.ERF` and CMake for WSM6 sources. -- [x] Add `MoistureType::WSM6` dispatch in ERF microphysics selection. -- [x] Implement ERF->WSM6 argument bridge for required state (`qv,qc,qi,qr,qs,qg`, thermodynamics, geometry). -- [x] Implement WSM6 init call and runtime call lifecycle. -- [x] Add accumulation mapping (`rain/snow/graupel`) analogous to Morrison diagnostics. -- [ ] Validate single-step run with `moisture_model=WSM6` (no NaN/abort, non-negative hydrometeors). - -## Phase 2: Head-comparable behavior and diagnostics -- [ ] Add optional effective radius diagnostics and radiation coupling arguments. -- [ ] Align boundary/real-width behavior with current head microphysics path. -- [ ] Add regression tests mirroring existing Morrison harness patterns. -- [ ] Add documentation for runtime controls and known differences from WRF defaults. From 2d16addc417b394450e0ec9dfd7543329d006295 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Thu, 2 Apr 2026 14:11:15 -0700 Subject: [PATCH 15/20] WSM6 Fortran bridge: finalize contract fixes and parity docs --- CMake/BuildERFExe.cmake | 2 + Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp | 27 +- .../WSM6/ERF_WSM6_Fortran_Interface.H | 1 - .../Microphysics/WSM6/ERF_module_mp_wsm6.F90 | 2917 ++++++++++++++--- Source/Microphysics/WSM6/Make.package | 2 + Source/Microphysics/WSM6/README | 56 +- 6 files changed, 2516 insertions(+), 489 deletions(-) diff --git a/CMake/BuildERFExe.cmake b/CMake/BuildERFExe.cmake index a8c8f737a5..2373f2ed56 100644 --- a/CMake/BuildERFExe.cmake +++ b/CMake/BuildERFExe.cmake @@ -236,6 +236,8 @@ function(build_erf_lib erf_lib_name) if(ERF_ENABLE_WSM6_FORT) target_sources(${erf_lib_name} PRIVATE + ${SRC_DIR}/Microphysics/WSM6/ERF_module_libmassv.F90 + ${SRC_DIR}/Microphysics/WSM6/ERF_mp_radar.F90 ${SRC_DIR}/Microphysics/WSM6/ERF_module_mp_wsm6.F90 ${SRC_DIR}/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 ) diff --git a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp index 521254a008..2072e2efd3 100644 --- a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp @@ -55,9 +55,9 @@ WSM6::Advance(const Real& dt_advance, auto const& qg_arr = mic_fab_vars[MicVar_WSM6::qg]->array(mfi); auto const& den_arr = mic_fab_vars[MicVar_WSM6::rho]->array(mfi); auto const& p_arr = mic_fab_vars[MicVar_WSM6::pres]->array(mfi); - auto const& rain_arr = mic_fab_vars[MicVar_WSM6::rain_accum]->array(mfi); - auto const& snow_arr = mic_fab_vars[MicVar_WSM6::snow_accum]->array(mfi); - auto const& graup_arr = mic_fab_vars[MicVar_WSM6::graup_accum]->array(mfi); + auto rain_arr = mic_fab_vars[MicVar_WSM6::rain_accum]->array(mfi); + auto snow_arr = mic_fab_vars[MicVar_WSM6::snow_accum]->array(mfi); + auto graup_arr = mic_fab_vars[MicVar_WSM6::graup_accum]->array(mfi); const int ilo = box.smallEnd(0); const int ihi = box.bigEnd(0); @@ -92,12 +92,21 @@ WSM6::Advance(const Real& dt_advance, FArrayBox sr_fab(box2d, 1); FArrayBox snowncv_fab(box2d, 1); FArrayBox graupelncv_fab(box2d, 1); + FArrayBox rainacc_fab(box2d, 1); + FArrayBox snowacc_fab(box2d, 1); + FArrayBox graupacc_fab(box2d, 1); auto const& rainncv_arr = rainncv_fab.array(); auto const& sr_arr = sr_fab.array(); auto const& snowncv_arr = snowncv_fab.array(); auto const& graupelncv_arr = graupelncv_fab.array(); + auto const& rainacc_arr = rainacc_fab.array(); + auto const& snowacc_arr = snowacc_fab.array(); + auto const& graupacc_arr = graupacc_fab.array(); ParallelFor(box2d, [=] AMREX_GPU_DEVICE (int i, int j, int) { + rainacc_arr(i,j,0) = rain_arr(i,j,klo); + snowacc_arr(i,j,0) = snow_arr(i,j,klo); + graupacc_arr(i,j,0) = graup_arr(i,j,klo); rainncv_arr(i,j,0) = Real(0.0); sr_arr(i,j,0) = Real(0.0); snowncv_arr(i,j,0) = Real(0.0); @@ -111,11 +120,17 @@ WSM6::Advance(const Real& dt_advance, den_arr.dataPtr(), p_arr.dataPtr(), delz_arr.dataPtr(), static_cast(dt), g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, xlv0, xlf0, den0, denr, cliq, cice, psat, - rain_arr.dataPtr(), rainncv_arr.dataPtr(), sr_arr.dataPtr(), - snow_arr.dataPtr(), snowncv_arr.dataPtr(), - graup_arr.dataPtr(), graupelncv_arr.dataPtr(), + rainacc_arr.dataPtr(), rainncv_arr.dataPtr(), sr_arr.dataPtr(), + snowacc_arr.dataPtr(), snowncv_arr.dataPtr(), + graupacc_arr.dataPtr(), graupelncv_arr.dataPtr(), imlo, imhi, jmlo, jmhi, kmlo, kmhi, ilo, ihi, jlo, jhi, klo, khi); + + ParallelFor(box2d, [=] AMREX_GPU_DEVICE (int i, int j, int) { + rain_arr(i,j,klo) = rainacc_arr(i,j,0); + snow_arr(i,j,klo) = snowacc_arr(i,j,0); + graup_arr(i,j,klo) = graupacc_arr(i,j,0); + }); } #else amrex::Abort("WSM6 Fortran bridge requested but ERF was not built with ERF_USE_WSM6_FORT"); diff --git a/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H b/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H index 40c0915a72..278691968a 100644 --- a/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H +++ b/Source/Microphysics/WSM6/ERF_WSM6_Fortran_Interface.H @@ -18,7 +18,6 @@ void mp_wsm6_run_c( double xlv0, double xlf0, double den0, double denr, double cliq, double cice, double psat, double* rain, double* rainncv, double* sr, double* snow, double* snowncv, double* graupel, double* graupelncv, - int ids, int ide, int jds, int jde, int kds, int kde, int ims, int ime, int jms, int jme, int kms, int kme, int its, int ite, int jts, int jte, int kts, int kte); diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 index 23d9f265b9..36844eec5f 100644 --- a/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6.F90 @@ -1,469 +1,2450 @@ -module mp_wsm6 - use iso_c_binding - implicit none - private - public :: mp_wsm6_init, mp_wsm6_run - - real(c_double), parameter :: dtcldcr = 120.0_c_double - real(c_double), parameter :: n0r = 8.0e6_c_double - real(c_double), parameter :: avtr = 841.9_c_double - real(c_double), parameter :: bvtr = 0.8_c_double - real(c_double), parameter :: r0 = 0.8e-5_c_double - real(c_double), parameter :: peaut = 0.55_c_double - real(c_double), parameter :: xncr = 3.0e8_c_double - real(c_double), parameter :: xmyu = 1.718e-5_c_double - real(c_double), parameter :: avts = 11.72_c_double - real(c_double), parameter :: bvts = 0.41_c_double - real(c_double), parameter :: lamdarmax = 8.0e4_c_double - real(c_double), parameter :: lamdasmax = 1.0e5_c_double - real(c_double), parameter :: dimax = 500.0e-6_c_double - real(c_double), parameter :: eacrc = 1.0_c_double - real(c_double), parameter :: n0s = 2.0e6_c_double - real(c_double), parameter :: n0smax = 1.0e11_c_double - real(c_double), parameter :: alpha = 0.12_c_double - real(c_double), parameter :: qcrmin = 1.0e-9_c_double - - real(c_double), save :: qc0, qck1, & - bvtr1, bvtr2, bvtr3, bvtr4, bvtr6, g1pbr, g3pbr, g4pbr, g6pbr, g5pbro2, & - pvtr, eacrr, pacrr, precr1, precr2, roqimax, & - bvts1, bvts2, bvts3, bvts4, g1pbs, g3pbs, g4pbs, g5pbso2, & - n0g, avtg, bvtg, deng, lamdagmax, pvts, pacrs, precs1, precs2, & - pidn0r, pidn0s, pidnc, xlv1, pacrc, pi, & - bvtg1, bvtg2, bvtg3, bvtg4, g1pbg, g3pbg, g4pbg, g5pbgo2, pvtg, pacrg, & - precg1, precg2, pidn0g, rslopermax, rslopesmax, rslopegmax, & - rsloperbmax, rslopesbmax, rslopegbmax, rsloper2max, rslopes2max, rslopeg2max, & - rsloper3max, rslopes3max, rslopeg3max - -contains - - pure real(c_double) function rgmma(x) - real(c_double), intent(in) :: x - rgmma = exp(log_gamma(x)) - end function rgmma - - pure real(c_double) function fpvs(t, ice, rd, rv, cvap, cliq, cice, hvap, hsub, psat, t0c) - real(c_double), intent(in) :: t, rd, rv, cvap, cliq, cice, hvap, hsub, psat, t0c - integer, intent(in) :: ice - real(c_double) :: tr, dldt - - tr = t0c / t - if (ice == 0) then - dldt = cvap - cliq - fpvs = psat * tr**(dldt/rv) * exp((hvap - dldt * t0c) / rv * (1.0_c_double / t0c - 1.0_c_double / t)) +!================================================================================================================= + module mp_wsm6 + use iso_c_binding, only: c_double + use module_libmassv,only: vrec,vsqrt + + use mp_radar + + implicit none + integer, parameter :: kind_phys = c_double + private + public:: mp_wsm6_run, & + mp_wsm6_init, & + mp_wsm6_finalize, & + refl10cm_wsm6 + + real(kind=kind_phys),parameter,private:: dtcldcr = 120. ! maximum time step for minor loops + real(kind=kind_phys),parameter,private:: n0r = 8.e6 ! intercept parameter rain +!real(kind=kind_phys),parameter,private:: n0g = 4.e6 ! intercept parameter graupel + real(kind=kind_phys),parameter,private:: avtr = 841.9 ! a constant for terminal velocity of rain + real(kind=kind_phys),parameter,private:: bvtr = 0.8 ! a constant for terminal velocity of rain + real(kind=kind_phys),parameter,private:: r0 = .8e-5 ! 8 microm in contrast to 10 micro m + real(kind=kind_phys),parameter,private:: peaut = .55 ! collection efficiency + real(kind=kind_phys),parameter,private:: xncr = 3.e8 ! maritime cloud in contrast to 3.e8 in tc80 + real(kind=kind_phys),parameter,private:: xmyu = 1.718e-5 ! the dynamic viscosity kgm-1s-1 + real(kind=kind_phys),parameter,private:: avts = 11.72 ! a constant for terminal velocity of snow + real(kind=kind_phys),parameter,private:: bvts = .41 ! a constant for terminal velocity of snow +!real(kind=kind_phys),parameter,private:: avtg = 330. ! a constant for terminal velocity of graupel +!real(kind=kind_phys),parameter,private:: bvtg = 0.8 ! a constant for terminal velocity of graupel +!real(kind=kind_phys),parameter,private:: deng = 500. ! density of graupel ! set later with hail_opt + real(kind=kind_phys),parameter,private:: lamdarmax = 8.e4 ! limited maximum value for slope parameter of rain + real(kind=kind_phys),parameter,private:: lamdasmax = 1.e5 ! limited maximum value for slope parameter of snow +!real(kind=kind_phys),parameter,private:: lamdagmax = 6.e4 ! limited maximum value for slope parameter of graupel + real(kind=kind_phys),parameter,private:: dicon = 11.9 ! constant for the cloud-ice diamter + real(kind=kind_phys),parameter,private:: dimax = 500.e-6 ! limited maximum value for the cloud-ice diamter + real(kind=kind_phys),parameter,private:: pfrz1 = 100. ! constant in Biggs freezing + real(kind=kind_phys),parameter,private:: pfrz2 = 0.66 ! constant in Biggs freezing + real(kind=kind_phys),parameter,private:: qcrmin = 1.e-9 ! minimun values for qr, qs, and qg + real(kind=kind_phys),parameter,private:: eacrc = 1.0 ! Snow/cloud-water collection efficiency + real(kind=kind_phys),parameter,private:: dens = 100.0 ! Density of snow + real(kind=kind_phys),parameter,private:: qs0 = 6.e-4 ! threshold amount for aggretion to occur + + real(kind=kind_phys),parameter,public :: n0smax = 1.e11 ! maximum n0s (t=-90C unlimited) + real(kind=kind_phys),parameter,public :: n0s = 2.e6 ! temperature dependent intercept parameter snow + real(kind=kind_phys),parameter,public :: alpha = .12 ! .122 exponen factor for n0s + + real(kind=kind_phys),save:: & + qc0,qck1, & + bvtr1,bvtr2,bvtr3,bvtr4,g1pbr, & + g3pbr,g4pbr,g5pbro2,pvtr,eacrr,pacrr, & + bvtr6,g6pbr, & + precr1,precr2,roqimax,bvts1, & + bvts2,bvts3,bvts4,g1pbs,g3pbs,g4pbs, & + n0g,avtg,bvtg,deng,lamdagmax, & !RAS13.3 - set these in wsm6init + g5pbso2,pvts,pacrs,precs1,precs2,pidn0r, & + xlv1,pacrc,pi, & + bvtg1,bvtg2,bvtg3,bvtg4,g1pbg, & + g3pbg,g4pbg,g5pbgo2,pvtg,pacrg, & + precg1,precg2,pidn0g, & + rslopermax,rslopesmax,rslopegmax, & + rsloperbmax,rslopesbmax,rslopegbmax, & + rsloper2max,rslopes2max,rslopeg2max, & + rsloper3max,rslopes3max,rslopeg3max + + real(kind=kind_phys),public,save:: pidn0s,pidnc + + + contains + + +!================================================================================================================= +!>\section arg_table_mp_wsm6_init +!!\html\include mp_wsm6_init.html +!! + subroutine mp_wsm6_init(den0,denr,dens,cl,cpv,hail_opt,errmsg,errflg) +!================================================================================================================= + +!input arguments: + integer,intent(in):: hail_opt ! RAS + real(kind=kind_phys),intent(in):: den0,denr,dens,cl,cpv + +!output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!----------------------------------------------------------------------------------------------------------------- + +! RAS13.1 define graupel parameters as graupel-like or hail-like, +! depending on namelist option + if(hail_opt .eq. 1) then !Hail! + n0g = 4.e4 + deng = 700. + avtg = 285.0 + bvtg = 0.8 + lamdagmax = 2.e4 + else !Graupel! + n0g = 4.e6 + deng = 500 + avtg = 330.0 + bvtg = 0.8 + lamdagmax = 6.e4 + endif +! + pi = 4.*atan(1.) + xlv1 = cl-cpv +! + qc0 = 4./3.*pi*denr*r0**3*xncr/den0 ! 0.419e-3 -- .61e-3 + qck1 = .104*9.8*peaut/(xncr*denr)**(1./3.)/xmyu*den0**(4./3.) ! 7.03 + pidnc = pi*denr/6. ! syb +! + bvtr1 = 1.+bvtr + bvtr2 = 2.5+.5*bvtr + bvtr3 = 3.+bvtr + bvtr4 = 4.+bvtr + bvtr6 = 6.+bvtr + g1pbr = rgmma(bvtr1) + g3pbr = rgmma(bvtr3) + g4pbr = rgmma(bvtr4) ! 17.837825 + g6pbr = rgmma(bvtr6) + g5pbro2 = rgmma(bvtr2) ! 1.8273 + pvtr = avtr*g4pbr/6. + eacrr = 1.0 + pacrr = pi*n0r*avtr*g3pbr*.25*eacrr + precr1 = 2.*pi*n0r*.78 + precr2 = 2.*pi*n0r*.31*avtr**.5*g5pbro2 + roqimax = 2.08e22*dimax**8 +! + bvts1 = 1.+bvts + bvts2 = 2.5+.5*bvts + bvts3 = 3.+bvts + bvts4 = 4.+bvts + g1pbs = rgmma(bvts1) !.8875 + g3pbs = rgmma(bvts3) + g4pbs = rgmma(bvts4) ! 12.0786 + g5pbso2 = rgmma(bvts2) + pvts = avts*g4pbs/6. + pacrs = pi*n0s*avts*g3pbs*.25 + precs1 = 4.*n0s*.65 + precs2 = 4.*n0s*.44*avts**.5*g5pbso2 + pidn0r = pi*denr*n0r + pidn0s = pi*dens*n0s +! + pacrc = pi*n0s*avts*g3pbs*.25*eacrc +! + bvtg1 = 1.+bvtg + bvtg2 = 2.5+.5*bvtg + bvtg3 = 3.+bvtg + bvtg4 = 4.+bvtg + g1pbg = rgmma(bvtg1) + g3pbg = rgmma(bvtg3) + g4pbg = rgmma(bvtg4) + pacrg = pi*n0g*avtg*g3pbg*.25 + g5pbgo2 = rgmma(bvtg2) + pvtg = avtg*g4pbg/6. + precg1 = 2.*pi*n0g*.78 + precg2 = 2.*pi*n0g*.31*avtg**.5*g5pbgo2 + pidn0g = pi*deng*n0g +! + rslopermax = 1./lamdarmax + rslopesmax = 1./lamdasmax + rslopegmax = 1./lamdagmax + rsloperbmax = rslopermax ** bvtr + rslopesbmax = rslopesmax ** bvts + rslopegbmax = rslopegmax ** bvtg + rsloper2max = rslopermax * rslopermax + rslopes2max = rslopesmax * rslopesmax + rslopeg2max = rslopegmax * rslopegmax + rsloper3max = rsloper2max * rslopermax + rslopes3max = rslopes2max * rslopesmax + rslopeg3max = rslopeg2max * rslopegmax + +!+---+-----------------------------------------------------------------+ +!.. Set these variables needed for computing radar reflectivity. These +!.. get used within radar_init to create other variables used in the +!.. radar module. + xam_r = PI*denr/6. + xbm_r = 3. + xmu_r = 0. + xam_s = PI*dens/6. + xbm_s = 3. + xmu_s = 0. + xam_g = PI*deng/6. + xbm_g = 3. + xmu_g = 0. + + call radar_init + + errmsg = 'mp_wsm6_init OK' + errflg = 0 + + end subroutine mp_wsm6_init + +!================================================================================================================= +!>\section arg_table_mp_wsm6_finalize +!!\html\include mp_wsm6_finalize.html +!! + subroutine mp_wsm6_finalize(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!----------------------------------------------------------------------------------------------------------------- + + errmsg = 'mp_wsm6_finalize OK' + errflg = 0 + + end subroutine mp_wsm6_finalize + +!================================================================================================================= +!>\section arg_table_mp_wsm6_run +!!\html\include mp_wsm6_run.html +!! + subroutine mp_wsm6_run(t,q,qc,qi,qr,qs,qg,den,p,delz,delt, & + g,cpd,cpv,rd,rv,t0c,ep1,ep2,qmin,xls, & + xlv0,xlf0,den0,denr,cliq,cice,psat, & + rain,rainncv,sr,snow,snowncv,graupel, & + graupelncv,rainprod2d,evapprod2d, & + its,ite,kts,kte,errmsg,errflg & + ) +!=================================================================================================================! +! This code is a 6-class GRAUPEL phase microphyiscs scheme (WSM6) of the +! Single-Moment MicroPhyiscs (WSMMP). The WSMMP assumes that ice nuclei +! number concentration is a function of temperature, and seperate assumption +! is developed, in which ice crystal number concentration is a function +! of ice amount. A theoretical background of the ice-microphysics and related +! processes in the WSMMPs are described in Hong et al. (2004). +! All production terms in the WSM6 scheme are described in Hong and Lim (2006). +! All units are in m.k.s. and source/sink terms in kgkg-1s-1. +! +! WSM6 cloud scheme +! +! Coded by Song-You Hong and Jeong-Ock Jade Lim (Yonsei Univ.) +! Summer 2003 +! +! Implemented by Song-You Hong (Yonsei Univ.) and Jimy Dudhia (NCAR) +! Summer 2004 +! +! further modifications : +! semi-lagrangian sedimentation (JH,2010),hong, aug 2009 +! ==> higher accuracy and efficient at lower resolutions +! reflectivity computation from greg thompson, lim, jun 2011 +! ==> only diagnostic, but with removal of too large drops +! add hail option from afwa, aug 2014 +! ==> switch graupel or hail by changing no, den, fall vel. +! effective radius of hydrometeors, bae from kiaps, jan 2015 +! ==> consistency in solar insolation of rrtmg radiation +! bug fix in melting terms, bae from kiaps, nov 2015 +! ==> density of air is divided, which has not been +! +! Reference) Hong, Dudhia, Chen (HDC, 2004) Mon. Wea. Rev. +! Hong and Lim (HL, 2006) J. Korean Meteor. Soc. +! Dudhia, Hong and Lim (DHL, 2008) J. Meteor. Soc. Japan +! Lin, Farley, Orville (LFO, 1983) J. Appl. Meteor. +! Rutledge, Hobbs (RH83, 1983) J. Atmos. Sci. +! Rutledge, Hobbs (RH84, 1984) J. Atmos. Sci. +! Juang and Hong (JH, 2010) Mon. Wea. Rev. +! + +!input arguments: + integer,intent(in):: its,ite,kts,kte + + real(kind=kind_phys),intent(in),dimension(its:,:):: & + den, & + p, & + delz + real(kind=kind_phys),intent(in):: & + delt, & + g, & + cpd, & + cpv, & + t0c, & + den0, & + rd, & + rv, & + ep1, & + ep2, & + qmin, & + xls, & + xlv0, & + xlf0, & + cliq, & + cice, & + psat, & + denr + +!inout arguments: + real(kind=kind_phys),intent(inout),dimension(its:,:):: & + t + real(kind=kind_phys),intent(inout),dimension(its:,:):: & + q, & + qc, & + qi, & + qr, & + qs, & + qg + real(kind=kind_phys),intent(inout),dimension(its:):: & + rain, & + rainncv, & + sr + + real(kind=kind_phys),intent(inout),dimension(its:),optional:: & + snow, & + snowncv + + real(kind=kind_phys),intent(inout),dimension(its:),optional:: & + graupel, & + graupelncv + + real(kind=kind_phys),intent(inout),dimension(its:,:),optional:: & + rainprod2d, & + evapprod2d + +!output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!local variables and arrays: + real(kind=kind_phys),dimension(its:ite,kts:kte,3):: & + rh, & + qsat, & + rslope, & + rslope2, & + rslope3, & + rslopeb, & + qrs_tmp, & + falk, & + fall, & + work1 + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + fallc, & + falkc, & + work1c, & + work2c, & + workr, & + worka + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + den_tmp, & + delz_tmp + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + pigen, & + pidep, & + pcond, & + prevp, & + psevp, & + pgevp, & + psdep, & + pgdep, & + praut, & + psaut, & + pgaut, & + piacr, & + pracw, & + praci, & + pracs, & + psacw, & + psaci, & + psacr, & + pgacw, & + pgaci, & + pgacr, & + pgacs, & + paacw, & + psmlt, & + pgmlt, & + pseml, & + pgeml + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + qsum, & + xl, & + cpm, & + work2, & + denfac, & + xni, & + denqrs1, & + denqrs2, & + denqrs3, & + denqci, & + n0sfac + real(kind=kind_phys),dimension(its:ite):: & + delqrs1, & + delqrs2, & + delqrs3, & + delqi + real(kind=kind_phys),dimension(its:ite):: & + tstepsnow, & + tstepgraup + integer,dimension(its:ite):: & + mstep, & + numdt + logical,dimension(its:ite):: flgcld + real(kind=kind_phys):: & + cpmcal, xlcal, diffus, & + viscos, xka, venfac, conden, diffac, & + x, y, z, a, b, c, d, e, & + qdt, holdrr, holdrs, holdrg, supcol, supcolt, pvt, & + coeres, supsat, dtcld, xmi, eacrs, satdt, & + qimax, diameter, xni0, roqi0, & + fallsum, fallsum_qsi, fallsum_qg, & + vt2i,vt2r,vt2s,vt2g,acrfac,egs,egi, & + xlwork2, factor, source, value, & + xlf, pfrzdtc, pfrzdtr, supice, alpha2, delta2, delta3 + real(kind=kind_phys):: vt2ave + real(kind=kind_phys):: holdc, holdci + integer:: i, j, k, mstepmax, & + iprt, latd, lond, loop, loops, ifsat, n, idim, kdim + +!Temporaries used for inlining fpvs function + real(kind=kind_phys):: dldti, xb, xai, tr, xbi, xa, hvap, cvap, hsub, dldt, ttp + +! variables for optimization + real(kind=kind_phys),dimension(its:ite):: dvec1,tvec1 + real(kind=kind_phys):: temp + +!----------------------------------------------------------------------------------------------------------------- + +! compute internal functions +! + cpmcal(x) = cpd*(1.-max(x,qmin))+max(x,qmin)*cpv + xlcal(x) = xlv0-xlv1*(x-t0c) +!---------------------------------------------------------------- +! diffus: diffusion coefficient of the water vapor +! viscos: kinematic viscosity(m2s-1) +! Optimizatin : A**B => exp(log(A)*(B)) +! + diffus(x,y) = 8.794e-5 * exp(log(x)*(1.81)) / y ! 8.794e-5*x**1.81/y + viscos(x,y) = 1.496e-6 * (x*sqrt(x)) /(x+120.)/y ! 1.496e-6*x**1.5/(x+120.)/y + xka(x,y) = 1.414e3*viscos(x,y)*y + diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b)) + venfac(a,b,c) = exp(log((viscos(b,c)/diffus(b,a)))*((.3333333))) & + /sqrt(viscos(b,c))*sqrt(sqrt(den0/c)) + conden(a,b,c,d,e) = (max(b,qmin)-c)/(1.+d*d/(rv*e)*c/(a*a)) +! +! + idim = ite-its+1 + kdim = kte-kts+1 +! +!---------------------------------------------------------------- +! paddint 0 for negative values generated by dynamics +! + do k = kts, kte + do i = its, ite + qc(i,k) = max(qc(i,k),0.0) + qr(i,k) = max(qr(i,k),0.0) + qi(i,k) = max(qi(i,k),0.0) + qs(i,k) = max(qs(i,k),0.0) + qg(i,k) = max(qg(i,k),0.0) + enddo + enddo +! +!---------------------------------------------------------------- +! latent heat for phase changes and heat capacity. neglect the +! changes during microphysical process calculation emanuel(1994) +! + do k = kts, kte + do i = its, ite + cpm(i,k) = cpmcal(q(i,k)) + xl(i,k) = xlcal(t(i,k)) + enddo + enddo + do k = kts, kte + do i = its, ite + delz_tmp(i,k) = delz(i,k) + den_tmp(i,k) = den(i,k) + enddo + enddo +! +!---------------------------------------------------------------- +! initialize the surface rain, snow, graupel +! + do i = its, ite + rainncv(i) = 0. + if(present(snowncv) .and. present(snow)) snowncv(i) = 0. + if(present(graupelncv) .and. present(graupel)) graupelncv(i) = 0. + sr(i) = 0. +! new local array to catch step snow and graupel + tstepsnow(i) = 0. + tstepgraup(i) = 0. + enddo +! +!---------------------------------------------------------------- +! compute the minor time steps. +! + loops = max(nint(delt/dtcldcr),1) + dtcld = delt/loops + if(delt.le.dtcldcr) dtcld = delt +! + do loop = 1,loops +! +!---------------------------------------------------------------- +! initialize the large scale variables +! + do i = its, ite + mstep(i) = 1 + flgcld(i) = .true. + enddo +! +! do k = kts, kte +! do i = its, ite +! denfac(i,k) = sqrt(den0/den(i,k)) +! enddo +! enddo + do k = kts, kte + do i = its,ite + dvec1(i) = den(i,k) + enddo + call vrec(tvec1,dvec1,ite-its+1) + do i = its, ite + tvec1(i) = tvec1(i)*den0 + enddo + call vsqrt(dvec1,tvec1,ite-its+1) + do i = its,ite + denfac(i,k) = dvec1(i) + enddo + enddo +! +! Inline expansion for fpvs +! qsat(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c) +! qsat(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c) + hsub = xls + hvap = xlv0 + cvap = cpv + ttp=t0c+0.01 + dldt=cvap-cliq + xa=-dldt/rv + xb=xa+hvap/(rv*ttp) + dldti=cvap-cice + xai=-dldti/rv + xbi=xai+hsub/(rv*ttp) + do k = kts, kte + do i = its, ite + tr=ttp/t(i,k) + qsat(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr)) + qsat(i,k,1) = min(qsat(i,k,1),0.99*p(i,k)) + qsat(i,k,1) = ep2 * qsat(i,k,1) / (p(i,k) - qsat(i,k,1)) + qsat(i,k,1) = max(qsat(i,k,1),qmin) + rh(i,k,1) = max(q(i,k) / qsat(i,k,1),qmin) + tr=ttp/t(i,k) + if(t(i,k).lt.ttp) then + qsat(i,k,2)=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr)) + else + qsat(i,k,2)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr)) + endif + qsat(i,k,2) = min(qsat(i,k,2),0.99*p(i,k)) + qsat(i,k,2) = ep2 * qsat(i,k,2) / (p(i,k) - qsat(i,k,2)) + qsat(i,k,2) = max(qsat(i,k,2),qmin) + rh(i,k,2) = max(q(i,k) / qsat(i,k,2),qmin) + enddo + enddo +! +!---------------------------------------------------------------- +! initialize the variables for microphysical physics +! +! + do k = kts, kte + do i = its, ite + prevp(i,k) = 0. + psdep(i,k) = 0. + pgdep(i,k) = 0. + praut(i,k) = 0. + psaut(i,k) = 0. + pgaut(i,k) = 0. + pracw(i,k) = 0. + praci(i,k) = 0. + piacr(i,k) = 0. + psaci(i,k) = 0. + psacw(i,k) = 0. + pracs(i,k) = 0. + psacr(i,k) = 0. + pgacw(i,k) = 0. + paacw(i,k) = 0. + pgaci(i,k) = 0. + pgacr(i,k) = 0. + pgacs(i,k) = 0. + pigen(i,k) = 0. + pidep(i,k) = 0. + pcond(i,k) = 0. + psmlt(i,k) = 0. + pgmlt(i,k) = 0. + pseml(i,k) = 0. + pgeml(i,k) = 0. + psevp(i,k) = 0. + pgevp(i,k) = 0. + falk(i,k,1) = 0. + falk(i,k,2) = 0. + falk(i,k,3) = 0. + fall(i,k,1) = 0. + fall(i,k,2) = 0. + fall(i,k,3) = 0. + fallc(i,k) = 0. + falkc(i,k) = 0. + xni(i,k) = 1.e3 + enddo + enddo +!------------------------------------------------------------- +! Ni: ice crystal number concentraiton [HDC 5c] +!------------------------------------------------------------- + do k = kts, kte + do i = its, ite + temp = (den(i,k)*max(qi(i,k),qmin)) + temp = sqrt(sqrt(temp*temp*temp)) + xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6) + enddo + enddo +! +!---------------------------------------------------------------- +! compute the fallout term: +! first, vertical terminal velosity for minor loops +!---------------------------------------------------------------- + do k = kts, kte + do i = its, ite + qrs_tmp(i,k,1) = qr(i,k) + qrs_tmp(i,k,2) = qs(i,k) + qrs_tmp(i,k,3) = qg(i,k) + enddo + enddo + call slope_wsm6(qrs_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2,rslope3, & + work1,its,ite,kts,kte) +! + do k = kte, kts, -1 + do i = its, ite + workr(i,k) = work1(i,k,1) + qsum(i,k) = max( (qs(i,k)+qg(i,k)), 1.E-15) + if( qsum(i,k) .gt. 1.e-15 ) then + worka(i,k) = (work1(i,k,2)*qs(i,k) + work1(i,k,3)*qg(i,k)) & + / qsum(i,k) + else + worka(i,k) = 0. + endif + denqrs1(i,k) = den(i,k)*qr(i,k) + denqrs2(i,k) = den(i,k)*qs(i,k) + denqrs3(i,k) = den(i,k)*qg(i,k) + if(qr(i,k).le.0.0) workr(i,k) = 0.0 + enddo + enddo + call nislfv_rain_plm(idim,kdim,den_tmp,denfac,t,delz_tmp,workr,denqrs1, & + delqrs1,dtcld,1,1) + call nislfv_rain_plm6(idim,kdim,den_tmp,denfac,t,delz_tmp,worka, & + denqrs2,denqrs3,delqrs2,delqrs3,dtcld,1,1) + do k = kts, kte + do i = its, ite + qr(i,k) = max(denqrs1(i,k)/den(i,k),0.) + qs(i,k) = max(denqrs2(i,k)/den(i,k),0.) + qg(i,k) = max(denqrs3(i,k)/den(i,k),0.) + fall(i,k,1) = denqrs1(i,k)*workr(i,k)/delz(i,k) + fall(i,k,2) = denqrs2(i,k)*worka(i,k)/delz(i,k) + fall(i,k,3) = denqrs3(i,k)*worka(i,k)/delz(i,k) + enddo + enddo + do i = its, ite + fall(i,1,1) = delqrs1(i)/delz(i,1)/dtcld + fall(i,1,2) = delqrs2(i)/delz(i,1)/dtcld + fall(i,1,3) = delqrs3(i)/delz(i,1)/dtcld + enddo + do k = kts, kte + do i = its, ite + qrs_tmp(i,k,1) = qr(i,k) + qrs_tmp(i,k,2) = qs(i,k) + qrs_tmp(i,k,3) = qg(i,k) + enddo + enddo + call slope_wsm6(qrs_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2,rslope3, & + work1,its,ite,kts,kte) +! + do k = kte, kts, -1 + do i = its, ite + supcol = t0c-t(i,k) + n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.) + if(t(i,k).gt.t0c) then +!--------------------------------------------------------------- +! psmlt: melting of snow [HL A33] [RH83 A25] +! (T>T0: S->R) +!--------------------------------------------------------------- + xlf = xlf0 + work2(i,k) = venfac(p(i,k),t(i,k),den(i,k)) + if(qs(i,k).gt.0.) then + coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2)) + psmlt(i,k) = xka(t(i,k),den(i,k))/xlf*(t0c-t(i,k))*pi/2. & + *n0sfac(i,k)*(precs1*rslope2(i,k,2) & + +precs2*work2(i,k)*coeres)/den(i,k) + psmlt(i,k) = min(max(psmlt(i,k)*dtcld/mstep(i), & + -qs(i,k)/mstep(i)),0.) + qs(i,k) = qs(i,k) + psmlt(i,k) + qr(i,k) = qr(i,k) - psmlt(i,k) + t(i,k) = t(i,k) + xlf/cpm(i,k)*psmlt(i,k) + endif +!--------------------------------------------------------------- +! pgmlt: melting of graupel [HL A23] [LFO 47] +! (T>T0: G->R) +!--------------------------------------------------------------- + if(qg(i,k).gt.0.) then + coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3)) + pgmlt(i,k) = xka(t(i,k),den(i,k))/xlf & + *(t0c-t(i,k))*(precg1*rslope2(i,k,3) & + +precg2*work2(i,k)*coeres)/den(i,k) + pgmlt(i,k) = min(max(pgmlt(i,k)*dtcld/mstep(i), & + -qg(i,k)/mstep(i)),0.) + qg(i,k) = qg(i,k) + pgmlt(i,k) + qr(i,k) = qr(i,k) - pgmlt(i,k) + t(i,k) = t(i,k) + xlf/cpm(i,k)*pgmlt(i,k) + endif + endif + enddo + enddo +!--------------------------------------------------------------- +! Vice [ms-1] : fallout of ice crystal [HDC 5a] +!--------------------------------------------------------------- + do k = kte, kts, -1 + do i = its, ite + if(qi(i,k).le.0.) then + work1c(i,k) = 0. + else + xmi = den(i,k)*qi(i,k)/xni(i,k) + diameter = max(min(dicon * sqrt(xmi),dimax), 1.e-25) + work1c(i,k) = 1.49e4*exp(log(diameter)*(1.31)) + endif + enddo + enddo +! +! forward semi-laglangian scheme (JH), PCM (piecewise constant), (linear) +! + do k = kte, kts, -1 + do i = its, ite + denqci(i,k) = den(i,k)*qi(i,k) + enddo + enddo + call nislfv_rain_plm(idim,kdim,den_tmp,denfac,t,delz_tmp,work1c,denqci, & + delqi,dtcld,1,0) + do k = kts, kte + do i = its, ite + qi(i,k) = max(denqci(i,k)/den(i,k),0.) + enddo + enddo + do i = its, ite + fallc(i,1) = delqi(i)/delz(i,1)/dtcld + enddo +! +!---------------------------------------------------------------- +! rain (unit is mm/sec;kgm-2s-1: /1000*delt ===> m)==> mm for wrf +! + do i = its, ite + fallsum = fall(i,kts,1)+fall(i,kts,2)+fall(i,kts,3)+fallc(i,kts) + fallsum_qsi = fall(i,kts,2)+fallc(i,kts) + fallsum_qg = fall(i,kts,3) + if(fallsum.gt.0.) then + rainncv(i) = fallsum*delz(i,kts)/denr*dtcld*1000. + rainncv(i) + rain(i) = fallsum*delz(i,kts)/denr*dtcld*1000. + rain(i) + endif + if(fallsum_qsi.gt.0.) then + tstepsnow(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. & + + tstepsnow(i) + if(present(snowncv) .and. present(snow)) then + snowncv(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. & + + snowncv(i) + snow(i) = fallsum_qsi*delz(i,kts)/denr*dtcld*1000. + snow(i) + endif + endif + if(fallsum_qg.gt.0.) then + tstepgraup(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000. & + + tstepgraup(i) + if(present (graupelncv) .and. present (graupel)) then + graupelncv(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000. & + + graupelncv(i) + graupel(i) = fallsum_qg*delz(i,kts)/denr*dtcld*1000. + graupel(i) + endif + endif + if(present (snowncv)) then + if(fallsum.gt.0.)sr(i)=(snowncv(i) + graupelncv(i))/(rainncv(i)+1.e-12) + else + if(fallsum.gt.0.)sr(i)=(tstepsnow(i) + tstepgraup(i))/(rainncv(i)+1.e-12) + endif + enddo +! +!--------------------------------------------------------------- +! pimlt: instantaneous melting of cloud ice [HL A47] [RH83 A28] +! (T>T0: I->C) +!--------------------------------------------------------------- + do k = kts, kte + do i = its, ite + supcol = t0c-t(i,k) + xlf = xls-xl(i,k) + if(supcol.lt.0.) xlf = xlf0 + if(supcol.lt.0.and.qi(i,k).gt.0.) then + qc(i,k) = qc(i,k) + qi(i,k) + t(i,k) = t(i,k) - xlf/cpm(i,k)*qi(i,k) + qi(i,k) = 0. + endif +!--------------------------------------------------------------- +! pihmf: homogeneous freezing of cloud water below -40c [HL A45] +! (T<-40C: C->I) +!--------------------------------------------------------------- + if(supcol.gt.40..and.qc(i,k).gt.0.) then + qi(i,k) = qi(i,k) + qc(i,k) + t(i,k) = t(i,k) + xlf/cpm(i,k)*qc(i,k) + qc(i,k) = 0. + endif +!--------------------------------------------------------------- +! pihtf: heterogeneous freezing of cloud water [HL A44] +! (T0>T>-40C: C->I) +!--------------------------------------------------------------- + if(supcol.gt.0..and.qc(i,k).gt.qmin) then +! pfrzdtc = min(pfrz1*(exp(pfrz2*supcol)-1.) & +! * den(i,k)/denr/xncr*qc(i,k)**2*dtcld,qc(i,k)) + supcolt=min(supcol,50.) + pfrzdtc = min(pfrz1*(exp(pfrz2*supcolt)-1.) & + * den(i,k)/denr/xncr*qc(i,k)*qc(i,k)*dtcld,qc(i,k)) + qi(i,k) = qi(i,k) + pfrzdtc + t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtc + qc(i,k) = qc(i,k)-pfrzdtc + endif +!--------------------------------------------------------------- +! pgfrz: freezing of rain water [HL A20] [LFO 45] +! (TG) +!--------------------------------------------------------------- + if(supcol.gt.0..and.qr(i,k).gt.0.) then +! pfrzdtr = min(20.*pi**2*pfrz1*n0r*denr/den(i,k) & +! * (exp(pfrz2*supcol)-1.)*rslope3(i,k,1)**2 & +! * rslope(i,k,1)*dtcld,qr(i,k)) + temp = rslope3(i,k,1) + temp = temp*temp*rslope(i,k,1) + supcolt=min(supcol,50.) + pfrzdtr = min(20.*(pi*pi)*pfrz1*n0r*denr/den(i,k) & + *(exp(pfrz2*supcolt)-1.)*temp*dtcld, & + qr(i,k)) + qg(i,k) = qg(i,k) + pfrzdtr + t(i,k) = t(i,k) + xlf/cpm(i,k)*pfrzdtr + qr(i,k) = qr(i,k)-pfrzdtr + endif + enddo + enddo +! +! +!---------------------------------------------------------------- +! update the slope parameters for microphysics computation +! + do k = kts, kte + do i = its, ite + qrs_tmp(i,k,1) = qr(i,k) + qrs_tmp(i,k,2) = qs(i,k) + qrs_tmp(i,k,3) = qg(i,k) + enddo + enddo + call slope_wsm6(qrs_tmp,den_tmp,denfac,t,rslope,rslopeb,rslope2,rslope3, & + work1,its,ite,kts,kte) +!------------------------------------------------------------------ +! work1: the thermodynamic term in the denominator associated with +! heat conduction and vapor diffusion +! (ry88, y93, h85) +! work2: parameter associated with the ventilation effects(y93) +! + do k = kts, kte + do i = its, ite + work1(i,k,1) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qsat(i,k,1)) + work1(i,k,2) = diffac(xls,p(i,k),t(i,k),den(i,k),qsat(i,k,2)) + work2(i,k) = venfac(p(i,k),t(i,k),den(i,k)) + enddo + enddo +! +!=============================================================== +! +! warm rain processes +! +! - follows the processes in RH83 and LFO except for autoconcersion +! +!=============================================================== +! + do k = kts, kte + do i = its, ite + supsat = max(q(i,k),qmin)-qsat(i,k,1) + satdt = supsat/dtcld +!--------------------------------------------------------------- +! praut: auto conversion rate from cloud to rain [HDC 16] +! (C->R) +!--------------------------------------------------------------- + if(qc(i,k).gt.qc0) then + praut(i,k) = qck1*qc(i,k)**(7./3.) + praut(i,k) = min(praut(i,k),qc(i,k)/dtcld) + endif +!--------------------------------------------------------------- +! pracw: accretion of cloud water by rain [HL A40] [LFO 51] +! (C->R) +!--------------------------------------------------------------- + if(qr(i,k).gt.qcrmin.and.qc(i,k).gt.qmin) then + pracw(i,k) = min(pacrr*rslope3(i,k,1)*rslopeb(i,k,1) & + * qc(i,k)*denfac(i,k),qc(i,k)/dtcld) + endif +!--------------------------------------------------------------- +! prevp: evaporation/condensation rate of rain [HDC 14] +! (V->R or R->V) +!--------------------------------------------------------------- + if(qr(i,k).gt.0.) then + coeres = rslope2(i,k,1)*sqrt(rslope(i,k,1)*rslopeb(i,k,1)) + prevp(i,k) = (rh(i,k,1)-1.)*(precr1*rslope2(i,k,1) & + + precr2*work2(i,k)*coeres)/work1(i,k,1) + if(prevp(i,k).lt.0.) then + prevp(i,k) = max(prevp(i,k),-qr(i,k)/dtcld) + prevp(i,k) = max(prevp(i,k),satdt/2) + else + prevp(i,k) = min(prevp(i,k),satdt/2) + endif + endif + enddo + enddo +! +!=============================================================== +! +! cold rain processes +! +! - follows the revised ice microphysics processes in HDC +! - the processes same as in RH83 and RH84 and LFO behave +! following ice crystal hapits defined in HDC, inclduing +! intercept parameter for snow (n0s), ice crystal number +! concentration (ni), ice nuclei number concentration +! (n0i), ice diameter (d) +! +!=============================================================== +! + do k = kts, kte + do i = its, ite + supcol = t0c-t(i,k) + n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.) + supsat = max(q(i,k),qmin)-qsat(i,k,2) + satdt = supsat/dtcld + ifsat = 0 +!------------------------------------------------------------- +! Ni: ice crystal number concentraiton [HDC 5c] +!------------------------------------------------------------- +! xni(i,k) = min(max(5.38e7*(den(i,k) & +! * max(qi(i,k),qmin))**0.75,1.e3),1.e6) + temp = (den(i,k)*max(qi(i,k),qmin)) + temp = sqrt(sqrt(temp*temp*temp)) + xni(i,k) = min(max(5.38e7*temp,1.e3),1.e6) + eacrs = exp(0.07*(-supcol)) +! + xmi = den(i,k)*qi(i,k)/xni(i,k) + diameter = min(dicon * sqrt(xmi),dimax) + vt2i = 1.49e4*diameter**1.31 + vt2r=pvtr*rslopeb(i,k,1)*denfac(i,k) + vt2s=pvts*rslopeb(i,k,2)*denfac(i,k) + vt2g=pvtg*rslopeb(i,k,3)*denfac(i,k) + qsum(i,k) = max( (qs(i,k)+qg(i,k)), 1.E-15) + if(qsum(i,k) .gt. 1.e-15) then + vt2ave=(vt2s*qs(i,k)+vt2g*qg(i,k))/(qsum(i,k)) + else + vt2ave=0. + endif + if(supcol.gt.0.and.qi(i,k).gt.qmin) then + if(qr(i,k).gt.qcrmin) then +!------------------------------------------------------------- +! praci: accretion of cloud ice by rain [HL A15] [LFO 25] +! (TR) +!------------------------------------------------------------- + acrfac = 2.*rslope3(i,k,1)+2.*diameter*rslope2(i,k,1) & + + diameter**2*rslope(i,k,1) + praci(i,k) = pi*qi(i,k)*n0r*abs(vt2r-vt2i)*acrfac/4. +! reduce collection efficiency (suggested by B. Wilt) + praci(i,k) = praci(i,k)*min(max(0.0,qr(i,k)/qi(i,k)),1.)**2 + praci(i,k) = min(praci(i,k),qi(i,k)/dtcld) +!------------------------------------------------------------- +! piacr: accretion of rain by cloud ice [HL A19] [LFO 26] +! (TS or R->G) +!------------------------------------------------------------- + piacr(i,k) = pi**2*avtr*n0r*denr*xni(i,k)*denfac(i,k) & + * g6pbr*rslope3(i,k,1)*rslope3(i,k,1) & + * rslopeb(i,k,1)/24./den(i,k) +! reduce collection efficiency (suggested by B. Wilt) + piacr(i,k) = piacr(i,k)*min(max(0.0,qi(i,k)/qr(i,k)),1.)**2 + piacr(i,k) = min(piacr(i,k),qr(i,k)/dtcld) + endif +!------------------------------------------------------------- +! psaci: accretion of cloud ice by snow [HDC 10] +! (TS) +!------------------------------------------------------------- + if(qs(i,k).gt.qcrmin) then + acrfac = 2.*rslope3(i,k,2)+2.*diameter*rslope2(i,k,2) & + + diameter**2*rslope(i,k,2) + psaci(i,k) = pi*qi(i,k)*eacrs*n0s*n0sfac(i,k) & + * abs(vt2ave-vt2i)*acrfac/4. + psaci(i,k) = min(psaci(i,k),qi(i,k)/dtcld) + endif +!------------------------------------------------------------- +! pgaci: accretion of cloud ice by graupel [HL A17] [LFO 41] +! (TG) +!------------------------------------------------------------- + if(qg(i,k).gt.qcrmin) then + egi = exp(0.07*(-supcol)) + acrfac = 2.*rslope3(i,k,3)+2.*diameter*rslope2(i,k,3) & + + diameter**2*rslope(i,k,3) + pgaci(i,k) = pi*egi*qi(i,k)*n0g*abs(vt2ave-vt2i)*acrfac/4. + pgaci(i,k) = min(pgaci(i,k),qi(i,k)/dtcld) + endif + endif +!------------------------------------------------------------- +! psacw: accretion of cloud water by snow [HL A7] [LFO 24] +! (TS, and T>=T0: C->R) +!------------------------------------------------------------- + if(qs(i,k).gt.qcrmin.and.qc(i,k).gt.qmin) then + psacw(i,k) = min(pacrc*n0sfac(i,k)*rslope3(i,k,2)*rslopeb(i,k,2) & +! reduce collection efficiency (suggested by B. Wilt) + * min(max(0.0,qs(i,k)/qc(i,k)),1.)**2 & + * qc(i,k)*denfac(i,k),qc(i,k)/dtcld) + endif +!------------------------------------------------------------- +! pgacw: accretion of cloud water by graupel [HL A6] [LFO 40] +! (TG, and T>=T0: C->R) +!------------------------------------------------------------- + if(qg(i,k).gt.qcrmin.and.qc(i,k).gt.qmin) then + pgacw(i,k) = min(pacrg*rslope3(i,k,3)*rslopeb(i,k,3) & +! reduce collection efficiency (suggested by B. Wilt) + * min(max(0.0,qg(i,k)/qc(i,k)),1.)**2 & + * qc(i,k)*denfac(i,k),qc(i,k)/dtcld) + endif +!------------------------------------------------------------- +! paacw: accretion of cloud water by averaged snow/graupel +! (TG or S, and T>=T0: C->R) +!------------------------------------------------------------- + if(qsum(i,k) .gt. 1.e-15) then + paacw(i,k) = (qs(i,k)*psacw(i,k)+qg(i,k)*pgacw(i,k)) & + /(qsum(i,k)) + endif +!------------------------------------------------------------- +! pracs: accretion of snow by rain [HL A11] [LFO 27] +! (TG) +!------------------------------------------------------------- + if(qs(i,k).gt.qcrmin.and.qr(i,k).gt.qcrmin) then + if(supcol.gt.0) then + acrfac = 5.*rslope3(i,k,2)*rslope3(i,k,2)*rslope(i,k,1) & + + 2.*rslope3(i,k,2)*rslope2(i,k,2)*rslope2(i,k,1) & + + .5*rslope2(i,k,2)*rslope2(i,k,2)*rslope3(i,k,1) + pracs(i,k) = pi**2*n0r*n0s*n0sfac(i,k)*abs(vt2r-vt2ave) & + * (dens/den(i,k))*acrfac +! reduce collection efficiency (suggested by B. Wilt) + pracs(i,k) = pracs(i,k)*min(max(0.0,qr(i,k)/qs(i,k)),1.)**2 + pracs(i,k) = min(pracs(i,k),qs(i,k)/dtcld) + endif +!------------------------------------------------------------- +! psacr: accretion of rain by snow [HL A10] [LFO 28] +! (TS or R->G) (T>=T0: enhance melting of snow) +!------------------------------------------------------------- + acrfac = 5.*rslope3(i,k,1)*rslope3(i,k,1)*rslope(i,k,2) & + + 2.*rslope3(i,k,1)*rslope2(i,k,1)*rslope2(i,k,2) & + +.5*rslope2(i,k,1)*rslope2(i,k,1)*rslope3(i,k,2) + psacr(i,k) = pi**2*n0r*n0s*n0sfac(i,k)*abs(vt2ave-vt2r) & + * (denr/den(i,k))*acrfac +! reduce collection efficiency (suggested by B. Wilt) + psacr(i,k) = psacr(i,k)*min(max(0.0,qs(i,k)/qr(i,k)),1.)**2 + psacr(i,k) = min(psacr(i,k),qr(i,k)/dtcld) + endif +!------------------------------------------------------------- +! pgacr: accretion of rain by graupel [HL A12] [LFO 42] +! (TG) (T>=T0: enhance melting of graupel) +!------------------------------------------------------------- + if(qg(i,k).gt.qcrmin.and.qr(i,k).gt.qcrmin) then + acrfac = 5.*rslope3(i,k,1)*rslope3(i,k,1)*rslope(i,k,3) & + + 2.*rslope3(i,k,1)*rslope2(i,k,1)*rslope2(i,k,3) & + + .5*rslope2(i,k,1)*rslope2(i,k,1)*rslope3(i,k,3) + pgacr(i,k) = pi**2*n0r*n0g*abs(vt2ave-vt2r)*(denr/den(i,k)) & + * acrfac +! reduce collection efficiency (suggested by B. Wilt) + pgacr(i,k) = pgacr(i,k)*min(max(0.0,qg(i,k)/qr(i,k)),1.)**2 + pgacr(i,k) = min(pgacr(i,k),qr(i,k)/dtcld) + endif +! +!------------------------------------------------------------- +! pgacs: accretion of snow by graupel [HL A13] [LFO 29] +! (S->G): This process is eliminated in V3.0 with the +! new combined snow/graupel fall speeds +!------------------------------------------------------------- + if(qg(i,k).gt.qcrmin.and.qs(i,k).gt.qcrmin) then + pgacs(i,k) = 0. + endif + if(supcol.le.0) then + xlf = xlf0 +!------------------------------------------------------------- +! pseml: enhanced melting of snow by accretion of water [HL A34] +! (T>=T0: S->R) +!------------------------------------------------------------- + if(qs(i,k).gt.0.) & + pseml(i,k) = min(max(cliq*supcol*(paacw(i,k)+psacr(i,k)) & + / xlf,-qs(i,k)/dtcld),0.) +!------------------------------------------------------------- +! pgeml: enhanced melting of graupel by accretion of water [HL A24] [RH84 A21-A22] +! (T>=T0: G->R) +!------------------------------------------------------------- + if(qg(i,k).gt.0.) & + pgeml(i,k) = min(max(cliq*supcol*(paacw(i,k)+pgacr(i,k)) & + / xlf,-qg(i,k)/dtcld),0.) + endif + if(supcol.gt.0) then +!------------------------------------------------------------- +! pidep: deposition/Sublimation rate of ice [HDC 9] +! (TI or I->V) +!------------------------------------------------------------- + if(qi(i,k).gt.0.and.ifsat.ne.1) then + pidep(i,k) = 4.*diameter*xni(i,k)*(rh(i,k,2)-1.)/work1(i,k,2) + supice = satdt-prevp(i,k) + if(pidep(i,k).lt.0.) then + pidep(i,k) = max(max(pidep(i,k),satdt/2),supice) + pidep(i,k) = max(pidep(i,k),-qi(i,k)/dtcld) + else + pidep(i,k) = min(min(pidep(i,k),satdt/2),supice) + endif + if(abs(prevp(i,k)+pidep(i,k)).ge.abs(satdt)) ifsat = 1 + endif +!------------------------------------------------------------- +! psdep: deposition/sublimation rate of snow [HDC 14] +! (TS or S->V) +!------------------------------------------------------------- + if(qs(i,k).gt.0..and.ifsat.ne.1) then + coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2)) + psdep(i,k) = (rh(i,k,2)-1.)*n0sfac(i,k)*(precs1*rslope2(i,k,2) & + + precs2*work2(i,k)*coeres)/work1(i,k,2) + supice = satdt-prevp(i,k)-pidep(i,k) + if(psdep(i,k).lt.0.) then + psdep(i,k) = max(psdep(i,k),-qs(i,k)/dtcld) + psdep(i,k) = max(max(psdep(i,k),satdt/2),supice) + else + psdep(i,k) = min(min(psdep(i,k),satdt/2),supice) + endif + if(abs(prevp(i,k)+pidep(i,k)+psdep(i,k)).ge.abs(satdt)) & + ifsat = 1 + endif +!------------------------------------------------------------- +! pgdep: deposition/sublimation rate of graupel [HL A21] [LFO 46] +! (TG or G->V) +!------------------------------------------------------------- + if(qg(i,k).gt.0..and.ifsat.ne.1) then + coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3)) + pgdep(i,k) = (rh(i,k,2)-1.)*(precg1*rslope2(i,k,3) & + + precg2*work2(i,k)*coeres)/work1(i,k,2) + supice = satdt-prevp(i,k)-pidep(i,k)-psdep(i,k) + if(pgdep(i,k).lt.0.) then + pgdep(i,k) = max(pgdep(i,k),-qg(i,k)/dtcld) + pgdep(i,k) = max(max(pgdep(i,k),satdt/2),supice) + else + pgdep(i,k) = min(min(pgdep(i,k),satdt/2),supice) + endif + if(abs(prevp(i,k)+pidep(i,k)+psdep(i,k)+pgdep(i,k)).ge. & + abs(satdt)) ifsat = 1 + endif +!------------------------------------------------------------- +! pigen: generation(nucleation) of ice from vapor [HL 50] [HDC 7-8] +! (TI) +!------------------------------------------------------------- + if(supsat.gt.0.and.ifsat.ne.1) then + supice = satdt-prevp(i,k)-pidep(i,k)-psdep(i,k)-pgdep(i,k) + xni0 = 1.e3*exp(0.1*supcol) + roqi0 = 4.92e-11*xni0**1.33 + pigen(i,k) = max(0.,(roqi0/den(i,k)-max(qi(i,k),0.))/dtcld) + pigen(i,k) = min(min(pigen(i,k),satdt),supice) + endif +! +!------------------------------------------------------------- +! psaut: conversion(aggregation) of ice to snow [HDC 12] +! (TS) +!------------------------------------------------------------- + if(qi(i,k).gt.0.) then + qimax = roqimax/den(i,k) + psaut(i,k) = max(0.,(qi(i,k)-qimax)/dtcld) + endif +! +!------------------------------------------------------------- +! pgaut: conversion(aggregation) of snow to graupel [HL A4] [LFO 37] +! (TG) +!------------------------------------------------------------- + if(qs(i,k).gt.0.) then + alpha2 = 1.e-3*exp(0.09*(-supcol)) + pgaut(i,k) = min(max(0.,alpha2*(qs(i,k)-qs0)),qs(i,k)/dtcld) + endif + endif +! +!------------------------------------------------------------- +! psevp: evaporation of melting snow [HL A35] [RH83 A27] +! (T>=T0: S->V) +!------------------------------------------------------------- + if(supcol.lt.0.) then + if(qs(i,k).gt.0..and.rh(i,k,1).lt.1.) then + coeres = rslope2(i,k,2)*sqrt(rslope(i,k,2)*rslopeb(i,k,2)) + psevp(i,k) = (rh(i,k,1)-1.)*n0sfac(i,k)*(precs1 & + * rslope2(i,k,2)+precs2*work2(i,k) & + * coeres)/work1(i,k,1) + psevp(i,k) = min(max(psevp(i,k),-qs(i,k)/dtcld),0.) + endif +!------------------------------------------------------------- +! pgevp: evaporation of melting graupel [HL A25] [RH84 A19] +! (T>=T0: G->V) +!------------------------------------------------------------- + if(qg(i,k).gt.0..and.rh(i,k,1).lt.1.) then + coeres = rslope2(i,k,3)*sqrt(rslope(i,k,3)*rslopeb(i,k,3)) + pgevp(i,k) = (rh(i,k,1)-1.)*(precg1*rslope2(i,k,3) & + + precg2*work2(i,k)*coeres)/work1(i,k,1) + pgevp(i,k) = min(max(pgevp(i,k),-qg(i,k)/dtcld),0.) + endif + endif + enddo + enddo +! +! +!---------------------------------------------------------------- +! check mass conservation of generation terms and feedback to the +! large scale +! + do k = kts, kte + do i = its, ite +! + delta2=0. + delta3=0. + if(qr(i,k).lt.1.e-4.and.qs(i,k).lt.1.e-4) delta2=1. + if(qr(i,k).lt.1.e-4) delta3=1. + if(t(i,k).le.t0c) then +! +! cloud water +! + value = max(qmin,qc(i,k)) + source = (praut(i,k)+pracw(i,k)+paacw(i,k)+paacw(i,k))*dtcld + if (source.gt.value) then + factor = value/source + praut(i,k) = praut(i,k)*factor + pracw(i,k) = pracw(i,k)*factor + paacw(i,k) = paacw(i,k)*factor + endif +! +! cloud ice +! + value = max(qmin,qi(i,k)) + source = (psaut(i,k)-pigen(i,k)-pidep(i,k)+praci(i,k)+psaci(i,k) & + + pgaci(i,k))*dtcld + if (source.gt.value) then + factor = value/source + psaut(i,k) = psaut(i,k)*factor + pigen(i,k) = pigen(i,k)*factor + pidep(i,k) = pidep(i,k)*factor + praci(i,k) = praci(i,k)*factor + psaci(i,k) = psaci(i,k)*factor + pgaci(i,k) = pgaci(i,k)*factor + endif +! +! rain +! + value = max(qmin,qr(i,k)) + source = (-praut(i,k)-prevp(i,k)-pracw(i,k)+piacr(i,k)+psacr(i,k) & + + pgacr(i,k))*dtcld + if (source.gt.value) then + factor = value/source + praut(i,k) = praut(i,k)*factor + prevp(i,k) = prevp(i,k)*factor + pracw(i,k) = pracw(i,k)*factor + piacr(i,k) = piacr(i,k)*factor + psacr(i,k) = psacr(i,k)*factor + pgacr(i,k) = pgacr(i,k)*factor + endif +! +! snow +! + value = max(qmin,qs(i,k)) + source = -(psdep(i,k)+psaut(i,k)-pgaut(i,k)+paacw(i,k)+piacr(i,k) & + * delta3+praci(i,k)*delta3-pracs(i,k)*(1.-delta2) & + + psacr(i,k)*delta2+psaci(i,k)-pgacs(i,k) )*dtcld + if (source.gt.value) then + factor = value/source + psdep(i,k) = psdep(i,k)*factor + psaut(i,k) = psaut(i,k)*factor + pgaut(i,k) = pgaut(i,k)*factor + paacw(i,k) = paacw(i,k)*factor + piacr(i,k) = piacr(i,k)*factor + praci(i,k) = praci(i,k)*factor + psaci(i,k) = psaci(i,k)*factor + pracs(i,k) = pracs(i,k)*factor + psacr(i,k) = psacr(i,k)*factor + pgacs(i,k) = pgacs(i,k)*factor + endif +! +! graupel +! + value = max(qmin,qg(i,k)) + source = -(pgdep(i,k)+pgaut(i,k) & + + piacr(i,k)*(1.-delta3)+praci(i,k)*(1.-delta3) & + + psacr(i,k)*(1.-delta2)+pracs(i,k)*(1.-delta2) & + + pgaci(i,k)+paacw(i,k)+pgacr(i,k)+pgacs(i,k))*dtcld + if (source.gt.value) then + factor = value/source + pgdep(i,k) = pgdep(i,k)*factor + pgaut(i,k) = pgaut(i,k)*factor + piacr(i,k) = piacr(i,k)*factor + praci(i,k) = praci(i,k)*factor + psacr(i,k) = psacr(i,k)*factor + pracs(i,k) = pracs(i,k)*factor + paacw(i,k) = paacw(i,k)*factor + pgaci(i,k) = pgaci(i,k)*factor + pgacr(i,k) = pgacr(i,k)*factor + pgacs(i,k) = pgacs(i,k)*factor + endif +! + work2(i,k)=-(prevp(i,k)+psdep(i,k)+pgdep(i,k)+pigen(i,k)+pidep(i,k)) +! update + q(i,k) = q(i,k)+work2(i,k)*dtcld + qc(i,k) = max(qc(i,k)-(praut(i,k)+pracw(i,k) & + + paacw(i,k)+paacw(i,k))*dtcld,0.) + qr(i,k) = max(qr(i,k)+(praut(i,k)+pracw(i,k) & + + prevp(i,k)-piacr(i,k)-pgacr(i,k) & + - psacr(i,k))*dtcld,0.) + qi(i,k) = max(qi(i,k)-(psaut(i,k)+praci(i,k) & + + psaci(i,k)+pgaci(i,k)-pigen(i,k)-pidep(i,k)) & + * dtcld,0.) + qs(i,k) = max(qs(i,k)+(psdep(i,k)+psaut(i,k)+paacw(i,k) & + - pgaut(i,k)+piacr(i,k)*delta3 & + + praci(i,k)*delta3+psaci(i,k)-pgacs(i,k) & + - pracs(i,k)*(1.-delta2)+psacr(i,k)*delta2) & + * dtcld,0.) + qg(i,k) = max(qg(i,k)+(pgdep(i,k)+pgaut(i,k) & + + piacr(i,k)*(1.-delta3) & + + praci(i,k)*(1.-delta3)+psacr(i,k)*(1.-delta2) & + + pracs(i,k)*(1.-delta2)+pgaci(i,k)+paacw(i,k) & + + pgacr(i,k)+pgacs(i,k))*dtcld,0.) + xlf = xls-xl(i,k) + xlwork2 = -xls*(psdep(i,k)+pgdep(i,k)+pidep(i,k)+pigen(i,k)) & + -xl(i,k)*prevp(i,k)-xlf*(piacr(i,k)+paacw(i,k) & + +paacw(i,k)+pgacr(i,k)+psacr(i,k)) + t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld + else +! +! cloud water +! + value = max(qmin,qc(i,k)) + source=(praut(i,k)+pracw(i,k)+paacw(i,k)+paacw(i,k))*dtcld + if (source.gt.value) then + factor = value/source + praut(i,k) = praut(i,k)*factor + pracw(i,k) = pracw(i,k)*factor + paacw(i,k) = paacw(i,k)*factor + endif +! +! rain +! + value = max(qmin,qr(i,k)) + source = (-paacw(i,k)-praut(i,k)+pseml(i,k)+pgeml(i,k)-pracw(i,k) & + -paacw(i,k)-prevp(i,k))*dtcld + if (source.gt.value) then + factor = value/source + praut(i,k) = praut(i,k)*factor + prevp(i,k) = prevp(i,k)*factor + pracw(i,k) = pracw(i,k)*factor + paacw(i,k) = paacw(i,k)*factor + pseml(i,k) = pseml(i,k)*factor + pgeml(i,k) = pgeml(i,k)*factor + endif +! +! snow +! + value = max(qcrmin,qs(i,k)) + source=(pgacs(i,k)-pseml(i,k)-psevp(i,k))*dtcld + if (source.gt.value) then + factor = value/source + pgacs(i,k) = pgacs(i,k)*factor + psevp(i,k) = psevp(i,k)*factor + pseml(i,k) = pseml(i,k)*factor + endif +! +! graupel +! + value = max(qcrmin,qg(i,k)) + source=-(pgacs(i,k)+pgevp(i,k)+pgeml(i,k))*dtcld + if (source.gt.value) then + factor = value/source + pgacs(i,k) = pgacs(i,k)*factor + pgevp(i,k) = pgevp(i,k)*factor + pgeml(i,k) = pgeml(i,k)*factor + endif +! + work2(i,k)=-(prevp(i,k)+psevp(i,k)+pgevp(i,k)) +! update + q(i,k) = q(i,k)+work2(i,k)*dtcld + qc(i,k) = max(qc(i,k)-(praut(i,k)+pracw(i,k) & + + paacw(i,k)+paacw(i,k))*dtcld,0.) + qr(i,k) = max(qr(i,k)+(praut(i,k)+pracw(i,k) & + + prevp(i,k)+paacw(i,k)+paacw(i,k)-pseml(i,k) & + - pgeml(i,k))*dtcld,0.) + qs(i,k) = max(qs(i,k)+(psevp(i,k)-pgacs(i,k) & + + pseml(i,k))*dtcld,0.) + qg(i,k) = max(qg(i,k)+(pgacs(i,k)+pgevp(i,k) & + + pgeml(i,k))*dtcld,0.) + xlf = xls-xl(i,k) + xlwork2 = -xl(i,k)*(prevp(i,k)+psevp(i,k)+pgevp(i,k)) & + -xlf*(pseml(i,k)+pgeml(i,k)) + t(i,k) = t(i,k)-xlwork2/cpm(i,k)*dtcld + endif + enddo + enddo +! +! Inline expansion for fpvs +! qsat(i,k,1) = fpvs(t(i,k),0,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c) +! qsat(i,k,2) = fpvs(t(i,k),1,rd,rv,cpv,cliq,cice,xlv0,xls,psat,t0c) + hsub = xls + hvap = xlv0 + cvap = cpv + ttp=t0c+0.01 + dldt=cvap-cliq + xa=-dldt/rv + xb=xa+hvap/(rv*ttp) + dldti=cvap-cice + xai=-dldti/rv + xbi=xai+hsub/(rv*ttp) + do k = kts, kte + do i = its, ite + tr=ttp/t(i,k) + qsat(i,k,1)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr)) + qsat(i,k,1) = min(qsat(i,k,1),0.99*p(i,k)) + qsat(i,k,1) = ep2 * qsat(i,k,1) / (p(i,k) - qsat(i,k,1)) + qsat(i,k,1) = max(qsat(i,k,1),qmin) + tr=ttp/t(i,k) + if(t(i,k).lt.ttp) then + qsat(i,k,2)=psat*exp(log(tr)*(xai))*exp(xbi*(1.-tr)) + else + qsat(i,k,2)=psat*exp(log(tr)*(xa))*exp(xb*(1.-tr)) + endif + qsat(i,k,2) = min(qsat(i,k,2),0.99*p(i,k)) + qsat(i,k,2) = ep2 * qsat(i,k,2) / (p(i,k) - qsat(i,k,2)) + qsat(i,k,2) = max(qsat(i,k,2),qmin) + enddo + enddo +! +!---------------------------------------------------------------- +! pcond: condensational/evaporational rate of cloud water [HL A46] [RH83 A6] +! if there exists additional water vapor condensated/if +! evaporation of cloud water is not enough to remove subsaturation +! + do k = kts, kte + do i = its, ite + work1(i,k,1) = conden(t(i,k),q(i,k),qsat(i,k,1),xl(i,k),cpm(i,k)) + work2(i,k) = qc(i,k)+work1(i,k,1) + pcond(i,k) = min(max(work1(i,k,1)/dtcld,0.),max(q(i,k),0.)/dtcld) + if(qc(i,k).gt.0..and.work1(i,k,1).lt.0.) & + pcond(i,k) = max(work1(i,k,1),-qc(i,k))/dtcld + q(i,k) = q(i,k)-pcond(i,k)*dtcld + qc(i,k) = max(qc(i,k)+pcond(i,k)*dtcld,0.) + t(i,k) = t(i,k)+pcond(i,k)*xl(i,k)/cpm(i,k)*dtcld + enddo + enddo +! +! +!---------------------------------------------------------------- +! padding for small values +! + do k = kts, kte + do i = its, ite + if(qc(i,k).le.qmin) qc(i,k) = 0.0 + if(qi(i,k).le.qmin) qi(i,k) = 0.0 + enddo + enddo + enddo ! big loops + + if(present(rainprod2d) .and. present(evapprod2d)) then + do k = kts, kte + do i = its,ite + rainprod2d(i,k) = praut(i,k)+pracw(i,k)+praci(i,k)+psaci(i,k)+pgaci(i,k) & + + psacw(i,k)+pgacw(i,k)+paacw(i,k)+psaut(i,k) + evapprod2d(i,k) = -(prevp(i,k)+psevp(i,k)+pgevp(i,k)+psdep(i,k)+pgdep(i,k)) + enddo + enddo + endif +! +!---------------------------------------------------------------- +! CCPP checks: +! + + errmsg = 'mp_wsm6_run OK' + errflg = 0 + + end subroutine mp_wsm6_run + +!================================================================================================================= + real(kind=kind_phys) function rgmma(x) +!================================================================================================================= +!rgmma function: use infinite product form + + real(kind=kind_phys),intent(in):: x + + integer:: i + real(kind=kind_phys),parameter:: euler=0.577215664901532 + real(kind=kind_phys):: y + +!----------------------------------------------------------------------------------------------------------------- + + if(x.eq.1.)then + rgmma=0. + else + rgmma=x*exp(euler*x) + do i = 1,10000 + y = float(i) + rgmma=rgmma*(1.000+x/y)*exp(-x/y) + enddo + rgmma=1./rgmma + endif + + end function rgmma + +!================================================================================================================= + real(kind=kind_phys) function fpvs(t,ice,rd,rv,cvap,cliq,cice,hvap,hsub,psat,t0c) +!================================================================================================================= + + integer,intent(in):: ice + real(kind=kind_phys),intent(in):: cice,cliq,cvap,hsub,hvap,psat,rd,rv,t0c + real(kind=kind_phys),intent(in):: t + + real(kind=kind_phys):: tr,ttp,dldt,dldti,xa,xb,xai,xbi + +!----------------------------------------------------------------------------------------------------------------- + + ttp=t0c+0.01 + dldt=cvap-cliq + xa=-dldt/rv + xb=xa+hvap/(rv*ttp) + dldti=cvap-cice + xai=-dldti/rv + xbi=xai+hsub/(rv*ttp) + tr=ttp/t + if(t.lt.ttp.and.ice.eq.1) then + fpvs=psat*(tr**xai)*exp(xbi*(1.-tr)) + else + fpvs=psat*(tr**xa)*exp(xb*(1.-tr)) + endif + + end function fpvs + +!================================================================================================================= + subroutine slope_wsm6(qrs,den,denfac,t,rslope,rslopeb,rslope2,rslope3,vt,its,ite,kts,kte) +!================================================================================================================= + +!--- input arguments: + integer:: its,ite,kts,kte + + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: den,denfac,t + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte,3):: qrs + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte,3):: & + rslope,rslopeb,rslope2,rslope3,vt + +!--- local variables and arrays: + integer:: i,k + + real(kind=kind_phys),parameter:: t0c = 273.15 + real(kind=kind_phys):: lamdar,lamdas,lamdag,x,y,z,supcol + real(kind=kind_phys),dimension(its:ite,kts:kte):: n0sfac + +!----------------------------------------------------------------------------------------------------------------- + +!size distributions: (x=mixing ratio, y=air density): +!valid for mixing ratio > 1.e-9 kg/kg. + lamdar(x,y)= sqrt(sqrt(pidn0r/(x*y))) ! (pidn0r/(x*y))**.25 + lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y))) ! (pidn0s*z/(x*y))**.25 + lamdag(x,y)= sqrt(sqrt(pidn0g/(x*y))) ! (pidn0g/(x*y))**.25 + + do k = kts, kte + do i = its, ite + supcol = t0c-t(i,k) +!--------------------------------------------------------------- +! n0s: Intercept parameter for snow [m-4] [HDC 6] +!--------------------------------------------------------------- + n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.) + if(qrs(i,k,1).le.qcrmin)then + rslope(i,k,1) = rslopermax + rslopeb(i,k,1) = rsloperbmax + rslope2(i,k,1) = rsloper2max + rslope3(i,k,1) = rsloper3max + else + rslope(i,k,1) = 1./lamdar(qrs(i,k,1),den(i,k)) + rslopeb(i,k,1) = rslope(i,k,1)**bvtr + rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1) + rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1) + endif + if(qrs(i,k,2).le.qcrmin)then + rslope(i,k,2) = rslopesmax + rslopeb(i,k,2) = rslopesbmax + rslope2(i,k,2) = rslopes2max + rslope3(i,k,2) = rslopes3max + else + rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac(i,k)) + rslopeb(i,k,2) = rslope(i,k,2)**bvts + rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2) + rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2) + endif + if(qrs(i,k,3).le.qcrmin)then + rslope(i,k,3) = rslopegmax + rslopeb(i,k,3) = rslopegbmax + rslope2(i,k,3) = rslopeg2max + rslope3(i,k,3) = rslopeg3max + else + rslope(i,k,3) = 1./lamdag(qrs(i,k,3),den(i,k)) + rslopeb(i,k,3) = rslope(i,k,3)**bvtg + rslope2(i,k,3) = rslope(i,k,3)*rslope(i,k,3) + rslope3(i,k,3) = rslope2(i,k,3)*rslope(i,k,3) + endif + vt(i,k,1) = pvtr*rslopeb(i,k,1)*denfac(i,k) + vt(i,k,2) = pvts*rslopeb(i,k,2)*denfac(i,k) + vt(i,k,3) = pvtg*rslopeb(i,k,3)*denfac(i,k) + if(qrs(i,k,1).le.0.0) vt(i,k,1) = 0.0 + if(qrs(i,k,2).le.0.0) vt(i,k,2) = 0.0 + if(qrs(i,k,3).le.0.0) vt(i,k,3) = 0.0 + enddo + enddo + + end subroutine slope_wsm6 + +!================================================================================================================= + subroutine slope_rain(qrs,den,denfac,t,rslope,rslopeb,rslope2,rslope3,vt,its,ite,kts,kte) +!================================================================================================================= + +!--- input arguments: + integer:: its,ite,kts,kte + + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: qrs,den,denfac,t + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + rslope,rslopeb,rslope2,rslope3,vt + +!--- local variables and arrays: + integer:: i,k + + real(kind=kind_phys),parameter:: t0c = 273.15 + real(kind=kind_phys):: lamdar,x,y + real(kind=kind_phys),dimension(its:ite,kts:kte):: n0sfac + +!----------------------------------------------------------------------------------------------------------------- + +!size distributions: (x=mixing ratio, y=air density): +!valid for mixing ratio > 1.e-9 kg/kg. + lamdar(x,y)= sqrt(sqrt(pidn0r/(x*y))) ! (pidn0r/(x*y))**.25 + + do k = kts, kte + do i = its, ite + if(qrs(i,k).le.qcrmin)then + rslope(i,k) = rslopermax + rslopeb(i,k) = rsloperbmax + rslope2(i,k) = rsloper2max + rslope3(i,k) = rsloper3max + else + rslope(i,k) = 1./lamdar(qrs(i,k),den(i,k)) + rslopeb(i,k) = rslope(i,k)**bvtr + rslope2(i,k) = rslope(i,k)*rslope(i,k) + rslope3(i,k) = rslope2(i,k)*rslope(i,k) + endif + vt(i,k) = pvtr*rslopeb(i,k)*denfac(i,k) + if(qrs(i,k).le.0.0) vt(i,k) = 0.0 + enddo + enddo + + end subroutine slope_rain + +!================================================================================================================= + subroutine slope_snow(qrs,den,denfac,t,rslope,rslopeb,rslope2,rslope3,vt,its,ite,kts,kte) +!================================================================================================================= + +!--- input arguments: + integer:: its,ite,kts,kte + + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: qrs,den,denfac,t + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + rslope,rslopeb,rslope2,rslope3,vt + +!--- local variables and arrays: + integer:: i,k + + real(kind=kind_phys),parameter:: t0c = 273.15 + real(kind=kind_phys):: lamdas,x,y,z,supcol + real(kind=kind_phys),dimension(its:ite,kts:kte):: n0sfac + +!----------------------------------------------------------------------------------------------------------------- + +!size distributions: (x=mixing ratio, y=air density): +!valid for mixing ratio > 1.e-9 kg/kg. + lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y))) ! (pidn0s*z/(x*y))**.25 +! + do k = kts, kte + do i = its, ite + supcol = t0c-t(i,k) +!--------------------------------------------------------------- +! n0s: Intercept parameter for snow [m-4] [HDC 6] +!--------------------------------------------------------------- + n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.) + if(qrs(i,k).le.qcrmin)then + rslope(i,k) = rslopesmax + rslopeb(i,k) = rslopesbmax + rslope2(i,k) = rslopes2max + rslope3(i,k) = rslopes3max + else + rslope(i,k) = 1./lamdas(qrs(i,k),den(i,k),n0sfac(i,k)) + rslopeb(i,k) = rslope(i,k)**bvts + rslope2(i,k) = rslope(i,k)*rslope(i,k) + rslope3(i,k) = rslope2(i,k)*rslope(i,k) + endif + vt(i,k) = pvts*rslopeb(i,k)*denfac(i,k) + if(qrs(i,k).le.0.0) vt(i,k) = 0.0 + enddo + enddo + + end subroutine slope_snow + +!================================================================================================================= + subroutine slope_graup(qrs,den,denfac,t,rslope,rslopeb,rslope2,rslope3,vt,its,ite,kts,kte) +!================================================================================================================= + +!--- input arguments: + integer:: its,ite,kts,kte + + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: qrs,den,denfac,t + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + rslope,rslopeb,rslope2,rslope3,vt + +!--- local variables and arrays: + integer:: i,k + + real(kind=kind_phys),parameter:: t0c = 273.15 + real(kind=kind_phys):: lamdag,x,y + real(kind=kind_phys),dimension(its:ite,kts:kte):: n0sfac + +!----------------------------------------------------------------------------------------------------------------- + +!size distributions: (x=mixing ratio, y=air density): +!valid for mixing ratio > 1.e-9 kg/kg. + lamdag(x,y)= sqrt(sqrt(pidn0g/(x*y))) ! (pidn0g/(x*y))**.25 + + do k = kts, kte + do i = its, ite +!--------------------------------------------------------------- +! n0s: Intercept parameter for snow [m-4] [HDC 6] +!--------------------------------------------------------------- + if(qrs(i,k).le.qcrmin)then + rslope(i,k) = rslopegmax + rslopeb(i,k) = rslopegbmax + rslope2(i,k) = rslopeg2max + rslope3(i,k) = rslopeg3max + else + rslope(i,k) = 1./lamdag(qrs(i,k),den(i,k)) + rslopeb(i,k) = rslope(i,k)**bvtg + rslope2(i,k) = rslope(i,k)*rslope(i,k) + rslope3(i,k) = rslope2(i,k)*rslope(i,k) + endif + vt(i,k) = pvtg*rslopeb(i,k)*denfac(i,k) + if(qrs(i,k).le.0.0) vt(i,k) = 0.0 + enddo + enddo + + end subroutine slope_graup + +!================================================================================================================= + subroutine nislfv_rain_plm(im,km,denl,denfacl,tkl,dzl,wwl,rql,precip,dt,id,iter) +!================================================================================================================= +! +! for non-iteration semi-Lagrangain forward advection for cloud +! with mass conservation and positive definite advection +! 2nd order interpolation with monotonic piecewise linear method +! this routine is under assumption of decfl < 1 for semi_Lagrangian +! +! dzl depth of model layer in meter +! wwl terminal velocity at model layer m/s +! rql cloud density*mixing ration +! precip precipitation +! dt time step +! id kind of precip: 0 test case; 1 raindrop +! iter how many time to guess mean terminal velocity: 0 pure forward. +! 0 : use departure wind for advection +! 1 : use mean wind for advection +! > 1 : use mean wind after iter-1 iterations +! +! author: hann-ming henry juang +! implemented by song-you hong +! + +!--- input arguments: + integer,intent(in):: im,km,id,iter + + real(kind=kind_phys),intent(in):: dt + real(kind=kind_phys),intent(in),dimension(im,km):: dzl,denl,denfacl,tkl + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(im):: precip + real(kind=kind_phys),intent(inout),dimension(im,km):: rql,wwl + +!---- local variables and arrays: + integer:: i,k,n,m,kk,kb,kt + real(kind=kind_phys):: tl,tl2,qql,dql,qqd + real(kind=kind_phys):: th,th2,qqh,dqh + real(kind=kind_phys):: zsum,qsum,dim,dip,c1,con1,fa1,fa2 + real(kind=kind_phys):: allold,allnew,zz,dzamin,cflmax,decfl + real(kind=kind_phys),dimension(km):: dz,ww,qq,wd,wa,was + real(kind=kind_phys),dimension(km):: den,denfac,tk + real(kind=kind_phys),dimension(km):: qn,qr,tmp,tmp1,tmp2,tmp3 + real(kind=kind_phys),dimension(km+1):: wi,zi,za + real(kind=kind_phys),dimension(km+1):: dza,qa,qmi,qpi + +!----------------------------------------------------------------------------------------------------------------- + + precip(:) = 0.0 + + i_loop: do i=1,im + dz(:) = dzl(i,:) + qq(:) = rql(i,:) + ww(:) = wwl(i,:) + den(:) = denl(i,:) + denfac(:) = denfacl(i,:) + tk(:) = tkl(i,:) +! skip for no precipitation for all layers + allold = 0.0 + do k=1,km + allold = allold + qq(k) + enddo + if(allold.le.0.0) then + cycle i_loop + endif +! +! compute interface values + zi(1)=0.0 + do k=1,km + zi(k+1) = zi(k)+dz(k) + enddo +! +! save departure wind + wd(:) = ww(:) + n=1 + 100 continue +! plm is 2nd order, we can use 2nd order wi or 3rd order wi +! 2nd order interpolation to get wi + wi(1) = ww(1) + wi(km+1) = ww(km) + do k=2,km + wi(k) = (ww(k)*dz(k-1)+ww(k-1)*dz(k))/(dz(k-1)+dz(k)) + enddo +! 3rd order interpolation to get wi + fa1 = 9./16. + fa2 = 1./16. + wi(1) = ww(1) + wi(2) = 0.5*(ww(2)+ww(1)) + do k=3,km-1 + wi(k) = fa1*(ww(k)+ww(k-1))-fa2*(ww(k+1)+ww(k-2)) + enddo + wi(km) = 0.5*(ww(km)+ww(km-1)) + wi(km+1) = ww(km) +! +! terminate of top of raingroup + do k=2,km + if( ww(k).eq.0.0 ) wi(k)=ww(k-1) + enddo +! +! diffusivity of wi + con1 = 0.05 + do k=km,1,-1 + decfl = (wi(k+1)-wi(k))*dt/dz(k) + if( decfl .gt. con1 ) then + wi(k) = wi(k+1) - con1*dz(k)/dt + endif + enddo +! compute arrival point + do k=1,km+1 + za(k) = zi(k) - wi(k)*dt + enddo +! + do k=1,km + dza(k) = za(k+1)-za(k) + enddo + dza(km+1) = zi(km+1) - za(km+1) +! +! computer deformation at arrival point + do k=1,km + qa(k) = qq(k)*dz(k)/dza(k) + qr(k) = qa(k)/den(k) + enddo + qa(km+1) = 0.0 +! call maxmin(km,1,qa,' arrival points ') +! +! compute arrival terminal velocity, and estimate mean terminal velocity +! then back to use mean terminal velocity + if( n.le.iter ) then + call slope_rain(qr,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa,1,1,1,km) + if( n.ge.2 ) wa(1:km)=0.5*(wa(1:km)+was(1:km)) + do k=1,km +!#ifdef DEBUG +! print*,' slope_wsm3 ',qr(k)*1000.,den(k),denfac(k),tk(k),tmp(k),tmp1(k),tmp2(k),ww(k),wa(k) +!#endif +! mean wind is average of departure and new arrival winds + ww(k) = 0.5* ( wd(k)+wa(k) ) + enddo + was(:) = wa(:) + n=n+1 + go to 100 + endif +! +! estimate values at arrival cell interface with monotone + do k=2,km + dip=(qa(k+1)-qa(k))/(dza(k+1)+dza(k)) + dim=(qa(k)-qa(k-1))/(dza(k-1)+dza(k)) + if( dip*dim.le.0.0 ) then + qmi(k)=qa(k) + qpi(k)=qa(k) + else + qpi(k)=qa(k)+0.5*(dip+dim)*dza(k) + qmi(k)=2.0*qa(k)-qpi(k) + if( qpi(k).lt.0.0 .or. qmi(k).lt.0.0 ) then + qpi(k) = qa(k) + qmi(k) = qa(k) + endif + endif + enddo + qpi(1)=qa(1) + qmi(1)=qa(1) + qmi(km+1)=qa(km+1) + qpi(km+1)=qa(km+1) +! +! interpolation to regular point + qn = 0.0 + kb=1 + kt=1 + intp : do k=1,km + kb=max(kb-1,1) + kt=max(kt-1,1) +! find kb and kt + if( zi(k).ge.za(km+1) ) then + exit intp + else + find_kb : do kk=kb,km + if( zi(k).le.za(kk+1) ) then + kb = kk + exit find_kb + else + cycle find_kb + endif + enddo find_kb + find_kt : do kk=kt,km + if( zi(k+1).le.za(kk) ) then + kt = kk + exit find_kt + else + cycle find_kt + endif + enddo find_kt + kt = kt - 1 +! compute q with piecewise constant method + if( kt.eq.kb ) then + tl=(zi(k)-za(kb))/dza(kb) + th=(zi(k+1)-za(kb))/dza(kb) + tl2=tl*tl + th2=th*th + qqd=0.5*(qpi(kb)-qmi(kb)) + qqh=qqd*th2+qmi(kb)*th + qql=qqd*tl2+qmi(kb)*tl + qn(k) = (qqh-qql)/(th-tl) + else if( kt.gt.kb ) then + tl=(zi(k)-za(kb))/dza(kb) + tl2=tl*tl + qqd=0.5*(qpi(kb)-qmi(kb)) + qql=qqd*tl2+qmi(kb)*tl + dql = qa(kb)-qql + zsum = (1.-tl)*dza(kb) + qsum = dql*dza(kb) + if( kt-kb.gt.1 ) then + do m=kb+1,kt-1 + zsum = zsum + dza(m) + qsum = qsum + qa(m) * dza(m) + enddo + endif + th=(zi(k+1)-za(kt))/dza(kt) + th2=th*th + qqd=0.5*(qpi(kt)-qmi(kt)) + dqh=qqd*th2+qmi(kt)*th + zsum = zsum + th*dza(kt) + qsum = qsum + dqh*dza(kt) + qn(k) = qsum/zsum + endif + cycle intp + endif +! + enddo intp +! +! rain out + sum_precip: do k=1,km + if( za(k).lt.0.0 .and. za(k+1).lt.0.0 ) then + precip(i) = precip(i) + qa(k)*dza(k) + cycle sum_precip + else if ( za(k).lt.0.0 .and. za(k+1).ge.0.0 ) then + precip(i) = precip(i) + qa(k)*(0.0-za(k)) + exit sum_precip + endif + exit sum_precip + enddo sum_precip +! +! replace the new values + rql(i,:) = qn(:) + enddo i_loop + + end subroutine nislfv_rain_plm + +!================================================================================================================= + subroutine nislfv_rain_plm6(im,km,denl,denfacl,tkl,dzl,wwl,rql,rql2,precip1,precip2,dt,id,iter) +!================================================================================================================= +! +! for non-iteration semi-Lagrangain forward advection for cloud +! with mass conservation and positive definite advection +! 2nd order interpolation with monotonic piecewise linear method +! this routine is under assumption of decfl < 1 for semi_Lagrangian +! +! dzl depth of model layer in meter +! wwl terminal velocity at model layer m/s +! rql cloud density*mixing ration +! precip precipitation +! dt time step +! id kind of precip: 0 test case; 1 raindrop +! iter how many time to guess mean terminal velocity: 0 pure forward. +! 0 : use departure wind for advection +! 1 : use mean wind for advection +! > 1 : use mean wind after iter-1 iterations +! +! author: hann-ming henry juang +! implemented by song-you hong +! + +!--- input arguments: + integer,intent(in):: im,km,id,iter + + real(kind=kind_phys),intent(in):: dt + real(kind=kind_phys),intent(in),dimension(im,km):: dzl,denl,denfacl,tkl + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(im):: precip1,precip2 + real(kind=kind_phys),intent(inout),dimension(im,km):: rql,rql2,wwl + +!---- local variables and arrays: + integer:: i,ist,k,n,m,kk,kb,kt + real(kind=kind_phys):: tl,tl2,qql,dql,qqd + real(kind=kind_phys):: th,th2,qqh,dqh + real(kind=kind_phys):: zsum,qsum,dim,dip,c1,con1,fa1,fa2 + real(kind=kind_phys):: allold,allnew,zz,dzamin,cflmax,decfl + real(kind=kind_phys),dimension(km):: dz,ww,qq,qq2,wd,wa,wa2,was + real(kind=kind_phys),dimension(km):: den,denfac,tk + real(kind=kind_phys),dimension(km):: qn,qr,qr2,tmp,tmp1,tmp2,tmp3 + real(kind=kind_phys),dimension(km+1):: wi,zi,za + real(kind=kind_phys),dimension(km+1):: dza,qa,qa2,qmi,qpi + real(kind=kind_phys),dimension(im):: precip + +!----------------------------------------------------------------------------------------------------------------- + + precip(:) = 0.0 + precip1(:) = 0.0 + precip2(:) = 0.0 + + i_loop: do i=1,im + dz(:) = dzl(i,:) + qq(:) = rql(i,:) + qq2(:) = rql2(i,:) + ww(:) = wwl(i,:) + den(:) = denl(i,:) + denfac(:) = denfacl(i,:) + tk(:) = tkl(i,:) +! skip for no precipitation for all layers + allold = 0.0 + do k=1,km + allold = allold + qq(k) + qq2(k) + enddo + if(allold.le.0.0) then + cycle i_loop + endif +! +! compute interface values + zi(1)=0.0 + do k=1,km + zi(k+1) = zi(k)+dz(k) + enddo +! +! save departure wind + wd(:) = ww(:) + n=1 + 100 continue +! plm is 2nd order, we can use 2nd order wi or 3rd order wi +! 2nd order interpolation to get wi + wi(1) = ww(1) + wi(km+1) = ww(km) + do k=2,km + wi(k) = (ww(k)*dz(k-1)+ww(k-1)*dz(k))/(dz(k-1)+dz(k)) + enddo +! 3rd order interpolation to get wi + fa1 = 9./16. + fa2 = 1./16. + wi(1) = ww(1) + wi(2) = 0.5*(ww(2)+ww(1)) + do k=3,km-1 + wi(k) = fa1*(ww(k)+ww(k-1))-fa2*(ww(k+1)+ww(k-2)) + enddo + wi(km) = 0.5*(ww(km)+ww(km-1)) + wi(km+1) = ww(km) +! +! terminate of top of raingroup + do k=2,km + if( ww(k).eq.0.0 ) wi(k)=ww(k-1) + enddo +! +! diffusivity of wi + con1 = 0.05 + do k=km,1,-1 + decfl = (wi(k+1)-wi(k))*dt/dz(k) + if( decfl .gt. con1 ) then + wi(k) = wi(k+1) - con1*dz(k)/dt + endif + enddo +! compute arrival point + do k=1,km+1 + za(k) = zi(k) - wi(k)*dt + enddo +! + do k=1,km + dza(k) = za(k+1)-za(k) + enddo + dza(km+1) = zi(km+1) - za(km+1) +! +! computer deformation at arrival point + do k=1,km + qa(k) = qq(k)*dz(k)/dza(k) + qa2(k) = qq2(k)*dz(k)/dza(k) + qr(k) = qa(k)/den(k) + qr2(k) = qa2(k)/den(k) + enddo + qa(km+1) = 0.0 + qa2(km+1) = 0.0 +! call maxmin(km,1,qa,' arrival points ') +! +! compute arrival terminal velocity, and estimate mean terminal velocity +! then back to use mean terminal velocity + if( n.le.iter ) then + call slope_snow(qr,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa,1,1,1,km) + call slope_graup(qr2,den,denfac,tk,tmp,tmp1,tmp2,tmp3,wa2,1,1,1,km) + do k = 1, km + tmp(k) = max((qr(k)+qr2(k)), 1.E-15) + if( tmp(k) .gt. 1.e-15 ) then + wa(k) = (wa(k)*qr(k) + wa2(k)*qr2(k))/tmp(k) + else + wa(k) = 0. + endif + enddo + if( n.ge.2 ) wa(1:km)=0.5*(wa(1:km)+was(1:km)) + do k=1,km +!#ifdef DEBUG +! print*,' slope_wsm3 ',qr(k)*1000.,den(k),denfac(k),tk(k),tmp(k),tmp1(k),tmp2(k), & +! ww(k),wa(k) +!#endif +! mean wind is average of departure and new arrival winds + ww(k) = 0.5* ( wd(k)+wa(k) ) + enddo + was(:) = wa(:) + n=n+1 + go to 100 + endif + + ist_loop : do ist = 1, 2 + if (ist.eq.2) then + qa(:) = qa2(:) + endif +! + precip(i) = 0. +! +! estimate values at arrival cell interface with monotone + do k=2,km + dip=(qa(k+1)-qa(k))/(dza(k+1)+dza(k)) + dim=(qa(k)-qa(k-1))/(dza(k-1)+dza(k)) + if( dip*dim.le.0.0 ) then + qmi(k)=qa(k) + qpi(k)=qa(k) + else + qpi(k)=qa(k)+0.5*(dip+dim)*dza(k) + qmi(k)=2.0*qa(k)-qpi(k) + if( qpi(k).lt.0.0 .or. qmi(k).lt.0.0 ) then + qpi(k) = qa(k) + qmi(k) = qa(k) + endif + endif + enddo + qpi(1)=qa(1) + qmi(1)=qa(1) + qmi(km+1)=qa(km+1) + qpi(km+1)=qa(km+1) +! +! interpolation to regular point + qn = 0.0 + kb=1 + kt=1 + intp : do k=1,km + kb=max(kb-1,1) + kt=max(kt-1,1) +! find kb and kt + if( zi(k).ge.za(km+1) ) then + exit intp + else + find_kb : do kk=kb,km + if( zi(k).le.za(kk+1) ) then + kb = kk + exit find_kb + else + cycle find_kb + endif + enddo find_kb + find_kt : do kk=kt,km + if( zi(k+1).le.za(kk) ) then + kt = kk + exit find_kt + else + cycle find_kt + endif + enddo find_kt + kt = kt - 1 +! compute q with piecewise constant method + if( kt.eq.kb ) then + tl=(zi(k)-za(kb))/dza(kb) + th=(zi(k+1)-za(kb))/dza(kb) + tl2=tl*tl + th2=th*th + qqd=0.5*(qpi(kb)-qmi(kb)) + qqh=qqd*th2+qmi(kb)*th + qql=qqd*tl2+qmi(kb)*tl + qn(k) = (qqh-qql)/(th-tl) + else if( kt.gt.kb ) then + tl=(zi(k)-za(kb))/dza(kb) + tl2=tl*tl + qqd=0.5*(qpi(kb)-qmi(kb)) + qql=qqd*tl2+qmi(kb)*tl + dql = qa(kb)-qql + zsum = (1.-tl)*dza(kb) + qsum = dql*dza(kb) + if( kt-kb.gt.1 ) then + do m=kb+1,kt-1 + zsum = zsum + dza(m) + qsum = qsum + qa(m) * dza(m) + enddo + endif + th=(zi(k+1)-za(kt))/dza(kt) + th2=th*th + qqd=0.5*(qpi(kt)-qmi(kt)) + dqh=qqd*th2+qmi(kt)*th + zsum = zsum + th*dza(kt) + qsum = qsum + dqh*dza(kt) + qn(k) = qsum/zsum + endif + cycle intp + endif +! + enddo intp +! +! rain out + sum_precip: do k=1,km + if( za(k).lt.0.0 .and. za(k+1).lt.0.0 ) then + precip(i) = precip(i) + qa(k)*dza(k) + cycle sum_precip + else if ( za(k).lt.0.0 .and. za(k+1).ge.0.0 ) then + precip(i) = precip(i) + qa(k)*(0.0-za(k)) + exit sum_precip + endif + exit sum_precip + enddo sum_precip +! +! replace the new values + if(ist.eq.1) then + rql(i,:) = qn(:) + precip1(i) = precip(i) + else + rql2(i,:) = qn(:) + precip2(i) = precip(i) + endif + enddo ist_loop + + enddo i_loop + + end subroutine nislfv_rain_plm6 + +!================================================================================================================= + subroutine refl10cm_wsm6(qv1d,qr1d,qs1d,qg1d,t1d,p1d,dBZ,kts,kte) + implicit none +!================================================================================================================= + +!..Sub arguments + integer,intent(in):: kts,kte + real(kind=kind_phys),intent(in),dimension(kts:kte):: qv1d,qr1d,qs1d,qg1d,t1d,p1d + real(kind=kind_phys),intent(inout),dimension(kts:kte):: dBz + +!..Local variables + logical:: melti + logical,dimension(kts:kte):: l_qr,l_qs,l_qg + + INTEGER:: i,k,k_0,kbot,n + + real(kind=kind_phys),parameter:: R=287. + real(kind=kind_phys):: temp_c + real(kind=kind_phys),dimension(kts:kte):: temp,pres,qv,rho + real(kind=kind_phys),dimension(kts:kte):: rr,rs,rg + real(kind=kind_phys),dimension(kts:kte):: ze_rain,ze_snow,ze_graupel + + double precision:: fmelt_s,fmelt_g + double precision:: cback,x,eta,f_d + double precision,dimension(kts:kte):: ilamr,ilams,ilamg + double precision,dimension(kts:kte):: n0_r, n0_s, n0_g + double precision:: lamr,lams,lamg + +!----------------------------------------------------------------------------------------------------------------- + + do k = kts, kte + dBZ(k) = -35.0 + enddo + +!+---+-----------------------------------------------------------------+ +!..Put column of data into local arrays. +!+---+-----------------------------------------------------------------+ + do k = kts, kte + temp(k) = t1d(k) + temp_c = min(-0.001, temp(k)-273.15) + qv(k) = max(1.e-10, qv1d(k)) + pres(k) = p1d(k) + rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622)) + + if (qr1d(k) .gt. 1.e-9) then + rr(k) = qr1d(k)*rho(k) + n0_r(k) = n0r + lamr = (xam_r*xcrg(3)*n0_r(k)/rr(k))**(1./xcre(1)) + ilamr(k) = 1./lamr + l_qr(k) = .true. + else + rr(k) = 1.e-12 + l_qr(k) = .false. + endif + + if (qs1d(k) .gt. 1.e-9) then + rs(k) = qs1d(k)*rho(k) + n0_s(k) = min(n0smax, n0s*exp(-alpha*temp_c)) + lams = (xam_s*xcsg(3)*n0_s(k)/rs(k))**(1./xcse(1)) + ilams(k) = 1./lams + l_qs(k) = .true. else - dldt = cvap - cice - fpvs = psat * tr**(dldt/rv) * exp((hsub - dldt * t0c) / rv * (1.0_c_double / t0c - 1.0_c_double / t)) - end if - end function fpvs - - pure real(c_double) function diffus(t, den) - real(c_double), intent(in) :: t, den - diffus = 8.794e-5_c_double * exp(log(max(t, 1.0_c_double)) * 1.81_c_double) / max(den, 1.0e-12_c_double) - end function diffus - - pure real(c_double) function viscos(t, den) - real(c_double), intent(in) :: t, den - viscos = 1.496e-6_c_double * (t * sqrt(max(t, 1.0_c_double))) / (t + 120.0_c_double) / max(den, 1.0e-12_c_double) - end function viscos - - pure real(c_double) function xka(t, den) - real(c_double), intent(in) :: t, den - xka = 1.414e3_c_double * viscos(t, den) * den - end function xka - - pure real(c_double) function diffac(a, p, t, den, qsat, rv) - real(c_double), intent(in) :: a, p, t, den, qsat, rv - diffac = den * a * a / (max(xka(t, den), 1.0e-12_c_double) * rv * t * t) + & - 1.0_c_double / (max(qsat, 1.0e-12_c_double) * max(diffus(t, p), 1.0e-12_c_double)) - end function diffac - - pure real(c_double) function venfac(p, t, den, den0) - real(c_double), intent(in) :: p, t, den, den0 - venfac = exp(log(max(viscos(t, den) / max(diffus(t, p), 1.0e-12_c_double), 1.0e-12_c_double)) / 3.0_c_double) / & - sqrt(max(viscos(t, den), 1.0e-12_c_double)) * sqrt(sqrt(max(den0 / max(den, 1.0e-12_c_double), 1.0e-12_c_double))) - end function venfac - - subroutine mp_wsm6_init(den0, denr, dens, cl, cpv, hail_opt, errmsg, errflg) - real(c_double), intent(in) :: den0, denr, dens, cl, cpv - integer(c_int), intent(in) :: hail_opt - character(len=*), intent(out) :: errmsg - integer(c_int), intent(out) :: errflg - - if (den0 <= 0.0_c_double .or. denr <= 0.0_c_double .or. dens <= 0.0_c_double) then - errmsg = 'mp_wsm6_init: invalid reference density input' - errflg = 1_c_int - return - end if - - if (cl <= 0.0_c_double .or. cpv <= 0.0_c_double) then - errmsg = 'mp_wsm6_init: invalid heat capacity input' - errflg = 2_c_int - return - end if - - select case (hail_opt) - case (1_c_int) - n0g = 4.0e4_c_double - deng = 700.0_c_double - avtg = 285.0_c_double - bvtg = 0.8_c_double - lamdagmax = 2.0e4_c_double - case (0_c_int) - n0g = 4.0e6_c_double - deng = 500.0_c_double - avtg = 330.0_c_double - bvtg = 0.8_c_double - lamdagmax = 6.0e4_c_double - case default - errmsg = 'mp_wsm6_init: hail_opt must be 0 or 1' - errflg = 3_c_int - return - end select - - ! Canonical-style coefficient initialization (phase-1, no radar coupling yet). - pi = 4.0_c_double * atan(1.0_c_double) - xlv1 = cl - cpv - qc0 = (4.0_c_double / 3.0_c_double) * pi * denr * r0**3 * xncr / den0 - qck1 = 0.104_c_double * 9.8_c_double * peaut / (xncr * denr)**(1.0_c_double / 3.0_c_double) / & - xmyu * den0**(4.0_c_double / 3.0_c_double) - pidnc = pi * denr / 6.0_c_double - - bvtr1 = 1.0_c_double + bvtr - bvtr2 = 2.5_c_double + 0.5_c_double * bvtr - bvtr3 = 3.0_c_double + bvtr - bvtr4 = 4.0_c_double + bvtr - bvtr6 = 6.0_c_double + bvtr - g1pbr = rgmma(bvtr1) - g3pbr = rgmma(bvtr3) - g4pbr = rgmma(bvtr4) - g6pbr = rgmma(bvtr6) - g5pbro2 = rgmma(bvtr2) - pvtr = avtr * g4pbr / 6.0_c_double - eacrr = 1.0_c_double - pacrr = pi * n0r * avtr * g3pbr * 0.25_c_double * eacrr - precr1 = 2.0_c_double * pi * n0r * 0.78_c_double - precr2 = 2.0_c_double * pi * n0r * 0.31_c_double * sqrt(avtr) * g5pbro2 - roqimax = 2.08e22_c_double * dimax**8 - - bvts1 = 1.0_c_double + bvts - bvts2 = 2.5_c_double + 0.5_c_double * bvts - bvts3 = 3.0_c_double + bvts - bvts4 = 4.0_c_double + bvts - g1pbs = rgmma(bvts1) - g3pbs = rgmma(bvts3) - g4pbs = rgmma(bvts4) - g5pbso2 = rgmma(bvts2) - pvts = avts * g4pbs / 6.0_c_double - pacrs = pi * n0s * avts * g3pbs * 0.25_c_double - precs1 = 4.0_c_double * n0s * 0.65_c_double - precs2 = 4.0_c_double * n0s * 0.44_c_double * sqrt(avts) * g5pbso2 - pidn0r = pi * denr * n0r - pidn0s = pi * dens * n0s - pacrc = pi * n0s * avts * g3pbs * 0.25_c_double * eacrc - - bvtg1 = 1.0_c_double + bvtg - bvtg2 = 2.5_c_double + 0.5_c_double * bvtg - bvtg3 = 3.0_c_double + bvtg - bvtg4 = 4.0_c_double + bvtg - g1pbg = rgmma(bvtg1) - g3pbg = rgmma(bvtg3) - g4pbg = rgmma(bvtg4) - g5pbgo2 = rgmma(bvtg2) - pacrg = pi * n0g * avtg * g3pbg * 0.25_c_double - pvtg = avtg * g4pbg / 6.0_c_double - precg1 = 2.0_c_double * pi * n0g * 0.78_c_double - precg2 = 2.0_c_double * pi * n0g * 0.31_c_double * sqrt(avtg) * g5pbgo2 - pidn0g = pi * deng * n0g - - rslopermax = 1.0_c_double / lamdarmax - rslopesmax = 1.0_c_double / lamdasmax - rslopegmax = 1.0_c_double / lamdagmax - rsloperbmax = rslopermax**bvtr - rslopesbmax = rslopesmax**bvts - rslopegbmax = rslopegmax**bvtg - rsloper2max = rslopermax * rslopermax - rslopes2max = rslopesmax * rslopesmax - rslopeg2max = rslopegmax * rslopegmax - rsloper3max = rsloper2max * rslopermax - rslopes3max = rslopes2max * rslopesmax - rslopeg3max = rslopeg2max * rslopegmax - - errmsg = 'mp_wsm6_init OK (ERF coeff init)' - errflg = 0_c_int - end subroutine mp_wsm6_init - - subroutine mp_wsm6_run(t, qv, qc, qi, qr, qs, qg, den, p, delz, & - delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls, & - xlv0, xlf0, den0, denr, cliq, cice, psat, & - rain, rainncv, sr, snow, snowncv, graupel, graupelncv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, errmsg, errflg) - real(c_double), intent(inout), dimension(ims:ime, jms:jme, kms:kme) :: t, qv, qc, qi, qr, qs, qg - real(c_double), intent(in), dimension(ims:ime, jms:jme, kms:kme) :: den, p, delz - real(c_double), intent(in) :: delt, g, cpd, cpv, rd, rv, t0c, ep1, ep2, qmin, xls - real(c_double), intent(in) :: xlv0, xlf0, den0, denr, cliq, cice, psat - real(c_double), intent(inout), dimension(ims:ime, jms:jme) :: rain, rainncv, sr, snow, snowncv, graupel, graupelncv - integer(c_int), intent(in) :: ids, ide, jds, jde, kds, kde - integer(c_int), intent(in) :: ims, ime, jms, jme, kms, kme - integer(c_int), intent(in) :: its, ite, jts, jte, kts, kte - character(len=*), intent(out) :: errmsg - integer(c_int), intent(out) :: errflg - - integer :: i, j, k, loop, loops - real(c_double) :: dtcld, es, qsat, supsat, dq, cpm, xlv, xlf - real(c_double) :: freeze_q - real(c_double) :: denfac, rslope_r, rslopeb_r, rslope2_r, rslope3_r, lamdar - real(c_double) :: rslope_s, rslopeb_s, rslope2_s, rslope3_s, lamdas - real(c_double) :: rslope_g, rslopeb_g, rslope2_g, rslope3_g, lamdag - real(c_double) :: n0sfac, supcol - real(c_double) :: work1_r, work2_r, coeres, satdt, praut, pracw, prevp - real(c_double) :: psmlt, pgmlt - real(c_double) :: praci, piacr, psaci - real(c_double) :: xni, xmi, diameter, vt2i, vt2r, vt2s, vt2g, vt2ave, qsum, eacrs, acrfac - real(c_double) :: frac_qr_qi, frac_qi_qr - real(c_double) :: rain_flux, snow_flux, graup_flux - - if (delt <= 0.0_c_double .or. g <= 0.0_c_double .or. cpd <= 0.0_c_double .or. cpv <= 0.0_c_double) then - errmsg = 'mp_wsm6_run: invalid scalar physics input' - errflg = 4_c_int - return - end if - - rainncv(its:ite,jts:jte) = 0.0_c_double - sr(its:ite,jts:jte) = 0.0_c_double - snowncv(its:ite,jts:jte) = 0.0_c_double - graupelncv(its:ite,jts:jte) = 0.0_c_double - - loops = max(nint(delt / dtcldcr), 1) - dtcld = delt / dble(loops) - if (delt <= dtcldcr) dtcld = delt - - do loop = 1, loops - do k = kts, kte - do j = jts, jte - do i = its, ite - qv(i,j,k) = max(qv(i,j,k), qmin) - qc(i,j,k) = max(qc(i,j,k), 0.0_c_double) - qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) - qr(i,j,k) = max(qr(i,j,k), 0.0_c_double) - qs(i,j,k) = max(qs(i,j,k), 0.0_c_double) - qg(i,j,k) = max(qg(i,j,k), 0.0_c_double) - - if (t(i,j,k) > t0c) then - es = fpvs(t(i,j,k), 0, rd, rv, cpv, cliq, cice, xlv0, xls, psat, t0c) - else - es = fpvs(t(i,j,k), 1, rd, rv, cpv, cliq, cice, xlv0, xls, psat, t0c) - end if - es = min(es, 0.99_c_double * p(i,j,k)) - qsat = max(qmin, ep2 * es / max(p(i,j,k) - es, 1.0e-8_c_double)) - supsat = qv(i,j,k) - qsat - - cpm = cpd * (1.0_c_double - qv(i,j,k)) + cpv * qv(i,j,k) - xlv = xlv0 - xlv1 * (t(i,j,k) - t0c) - xlf = xlf0 - - if (supsat > 0.0_c_double) then - dq = min(supsat, 0.5_c_double * supsat) - qv(i,j,k) = qv(i,j,k) - dq - if (t(i,j,k) > t0c) then - qc(i,j,k) = qc(i,j,k) + dq - t(i,j,k) = t(i,j,k) + xlv * dq / max(cpm, 1.0e-6_c_double) - else - qi(i,j,k) = qi(i,j,k) + dq - t(i,j,k) = t(i,j,k) + xls * dq / max(cpm, 1.0e-6_c_double) - end if - else if (supsat < 0.0_c_double) then - dq = min(-supsat, 0.5_c_double * (-supsat)) - if (t(i,j,k) > t0c) then - dq = min(dq, qc(i,j,k)) - qc(i,j,k) = qc(i,j,k) - dq - qv(i,j,k) = qv(i,j,k) + dq - t(i,j,k) = t(i,j,k) - xlv * dq / max(cpm, 1.0e-6_c_double) - else - dq = min(dq, qi(i,j,k)) - qi(i,j,k) = qi(i,j,k) - dq - qv(i,j,k) = qv(i,j,k) + dq - t(i,j,k) = t(i,j,k) - xls * dq / max(cpm, 1.0e-6_c_double) - end if - end if - - denfac = sqrt(max(den0 / max(den(i,j,k), 1.0e-12_c_double), 1.0e-12_c_double)) - supcol = t0c - t(i,j,k) - n0sfac = max(min(exp(alpha * supcol), n0smax / n0s), 1.0_c_double) - if (qr(i,j,k) <= qcrmin) then - rslope_r = rslopermax - rslopeb_r = rsloperbmax - rslope2_r = rsloper2max - rslope3_r = rsloper3max - else - lamdar = sqrt(sqrt(pidn0r / max(qr(i,j,k) * den(i,j,k), 1.0e-20_c_double))) - rslope_r = 1.0_c_double / max(lamdar, 1.0e-12_c_double) - rslopeb_r = rslope_r**bvtr - rslope2_r = rslope_r * rslope_r - rslope3_r = rslope2_r * rslope_r - end if - if (qs(i,j,k) <= qcrmin) then - rslope_s = rslopesmax - rslopeb_s = rslopesbmax - rslope2_s = rslopes2max - rslope3_s = rslopes3max - else - lamdas = sqrt(sqrt(pidn0s * n0sfac / max(qs(i,j,k) * den(i,j,k), 1.0e-20_c_double))) - rslope_s = 1.0_c_double / max(lamdas, 1.0e-12_c_double) - rslopeb_s = rslope_s**bvts - rslope2_s = rslope_s * rslope_s - rslope3_s = rslope2_s * rslope_s - end if - if (qg(i,j,k) <= qcrmin) then - rslope_g = rslopegmax - rslopeb_g = rslopegbmax - rslope2_g = rslopeg2max - rslope3_g = rslopeg3max - else - lamdag = sqrt(sqrt(pidn0g / max(qg(i,j,k) * den(i,j,k), 1.0e-20_c_double))) - rslope_g = 1.0_c_double / max(lamdag, 1.0e-12_c_double) - rslopeb_g = rslope_g**bvtg - rslope2_g = rslope_g * rslope_g - rslope3_g = rslope2_g * rslope_g - end if - - supsat = max(qv(i,j,k), qmin) - qsat - satdt = supsat / dtcld - praut = 0.0_c_double - pracw = 0.0_c_double - prevp = 0.0_c_double - - if (qc(i,j,k) > qc0) then - praut = qck1 * qc(i,j,k)**(7.0_c_double / 3.0_c_double) - praut = min(praut, qc(i,j,k) / dtcld) - end if - - if (qr(i,j,k) > qcrmin .and. qc(i,j,k) > qmin) then - pracw = pacrr * rslope3_r * rslopeb_r * qc(i,j,k) * denfac - pracw = min(pracw, qc(i,j,k) / dtcld) - end if - - if (qr(i,j,k) > 0.0_c_double) then - work1_r = diffac(xlv, p(i,j,k), t(i,j,k), den(i,j,k), qsat, rv) - work2_r = venfac(p(i,j,k), t(i,j,k), den(i,j,k), den0) - coeres = rslope2_r * sqrt(max(rslope_r * rslopeb_r, 0.0_c_double)) - prevp = (max(qv(i,j,k) / qsat, qmin) - 1.0_c_double) * & - (precr1 * rslope2_r + precr2 * work2_r * coeres) / max(work1_r, 1.0e-12_c_double) - if (prevp < 0.0_c_double) then - prevp = max(prevp, -qr(i,j,k) / dtcld) - prevp = max(prevp, satdt / 2.0_c_double) - else - prevp = min(prevp, satdt / 2.0_c_double) - end if - end if - - qc(i,j,k) = max(qc(i,j,k) - (praut + pracw) * dtcld, 0.0_c_double) - qr(i,j,k) = max(qr(i,j,k) + (praut + pracw + prevp) * dtcld, 0.0_c_double) - qv(i,j,k) = max(qv(i,j,k) - prevp * dtcld, qmin) - t(i,j,k) = t(i,j,k) + xlv * prevp * dtcld / max(cpm, 1.0e-6_c_double) - - psmlt = 0.0_c_double - pgmlt = 0.0_c_double - if (t(i,j,k) > t0c) then - work2_r = venfac(p(i,j,k), t(i,j,k), den(i,j,k), den0) - if (qs(i,j,k) > 0.0_c_double) then - coeres = rslope2_s * sqrt(max(rslope_s * rslopeb_s, 0.0_c_double)) - psmlt = xka(t(i,j,k), den(i,j,k)) / max(xlf, 1.0e-12_c_double) * (t0c - t(i,j,k)) * pi / 2.0_c_double * & - n0sfac * (precs1 * rslope2_s + precs2 * work2_r * coeres) / max(den(i,j,k), 1.0e-12_c_double) - psmlt = min(max(psmlt * dtcld, -qs(i,j,k)), 0.0_c_double) - qs(i,j,k) = qs(i,j,k) + psmlt - qr(i,j,k) = qr(i,j,k) - psmlt - t(i,j,k) = t(i,j,k) + xlf / max(cpm, 1.0e-12_c_double) * psmlt - end if - if (qg(i,j,k) > 0.0_c_double) then - coeres = rslope2_g * sqrt(max(rslope_g * rslopeb_g, 0.0_c_double)) - pgmlt = xka(t(i,j,k), den(i,j,k)) / max(xlf, 1.0e-12_c_double) * (t0c - t(i,j,k)) * & - (precg1 * rslope2_g + precg2 * work2_r * coeres) / max(den(i,j,k), 1.0e-12_c_double) - pgmlt = min(max(pgmlt * dtcld, -qg(i,j,k)), 0.0_c_double) - qg(i,j,k) = qg(i,j,k) + pgmlt - qr(i,j,k) = qr(i,j,k) - pgmlt - t(i,j,k) = t(i,j,k) + xlf / max(cpm, 1.0e-12_c_double) * pgmlt - end if - end if - - if (t(i,j,k) < t0c - 5.0_c_double) then - freeze_q = min(qr(i,j,k), 0.05_c_double * qr(i,j,k)) - qr(i,j,k) = qr(i,j,k) - freeze_q - qs(i,j,k) = qs(i,j,k) + freeze_q - end if - - qi(i,j,k) = max(qi(i,j,k), 0.0_c_double) - praci = 0.0_c_double - piacr = 0.0_c_double - psaci = 0.0_c_double - - if (supcol > 0.0_c_double .and. qi(i,j,k) > qmin) then - xni = min(max(5.38e7_c_double * (den(i,j,k) * max(qi(i,j,k), qmin))**0.75_c_double, 1.0e3_c_double), 1.0e6_c_double) - eacrs = exp(-0.07_c_double * supcol) - xmi = den(i,j,k) * qi(i,j,k) / max(xni, 1.0e-12_c_double) - diameter = max(min(11.9_c_double * sqrt(max(xmi, 0.0_c_double)), dimax), 1.0e-25_c_double) - vt2i = 1.49e4_c_double * diameter**1.31_c_double - vt2r = pvtr * rslopeb_r * denfac - vt2s = pvts * rslopeb_s * denfac - vt2g = pvtg * rslopeb_g * denfac - qsum = max(qs(i,j,k) + qg(i,j,k), 1.0e-15_c_double) - vt2ave = (vt2s * qs(i,j,k) + vt2g * qg(i,j,k)) / qsum - - if (qr(i,j,k) > qcrmin) then - acrfac = 2.0_c_double * rslope3_r + 2.0_c_double * diameter * rslope2_r + diameter*diameter * rslope_r - praci = pi * qi(i,j,k) * n0r * abs(vt2r - vt2i) * acrfac / 4.0_c_double - frac_qr_qi = min(max(qr(i,j,k) / max(qi(i,j,k), 1.0e-20_c_double), 0.0_c_double), 1.0_c_double) - praci = praci * frac_qr_qi * frac_qr_qi - praci = min(praci, qi(i,j,k) / dtcld) - - piacr = pi*pi * avtr * n0r * denr * xni * denfac * g6pbr * rslope3_r * rslope3_r * rslopeb_r / & - (24.0_c_double * max(den(i,j,k), 1.0e-12_c_double)) - frac_qi_qr = min(max(qi(i,j,k) / max(qr(i,j,k), 1.0e-20_c_double), 0.0_c_double), 1.0_c_double) - piacr = piacr * frac_qi_qr * frac_qi_qr - piacr = min(piacr, qr(i,j,k) / dtcld) - end if - - if (qs(i,j,k) > qcrmin) then - acrfac = 2.0_c_double * rslope3_s + 2.0_c_double * diameter * rslope2_s + diameter*diameter * rslope_s - psaci = pi * qi(i,j,k) * eacrs * n0s * n0sfac * abs(vt2ave - vt2i) * acrfac / 4.0_c_double - psaci = min(psaci, qi(i,j,k) / dtcld) - end if - end if - - qi(i,j,k) = max(qi(i,j,k) - (praci + psaci) * dtcld, 0.0_c_double) - qr(i,j,k) = max(qr(i,j,k) + (praci - piacr) * dtcld, 0.0_c_double) - qs(i,j,k) = max(qs(i,j,k) + (piacr + psaci) * dtcld, 0.0_c_double) - - if (t(i,j,k) < t0c - 10.0_c_double .and. qi(i,j,k) > 0.0_c_double) then - freeze_q = min(qi(i,j,k), 0.02_c_double * qi(i,j,k)) - qi(i,j,k) = qi(i,j,k) - freeze_q - qs(i,j,k) = qs(i,j,k) + freeze_q - end if - end do - end do - end do - - do j = jts, jte - do i = its, ite - rain_flux = den(i,j,kts) * qr(i,j,kts) * max(delz(i,j,kts), 0.0_c_double) - snow_flux = den(i,j,kts) * qs(i,j,kts) * max(delz(i,j,kts), 0.0_c_double) - graup_flux = den(i,j,kts) * qg(i,j,kts) * max(delz(i,j,kts), 0.0_c_double) - - rainncv(i,j) = rainncv(i,j) + rain_flux - snowncv(i,j) = snowncv(i,j) + snow_flux - graupelncv(i,j) = graupelncv(i,j) + graup_flux - - rain(i,j) = rain(i,j) + rain_flux - snow(i,j) = snow(i,j) + snow_flux - graupel(i,j) = graupel(i,j) + graup_flux - sr(i,j) = snow(i,j) / max(snow(i,j) + rain(i,j), 1.0e-12_c_double) - end do - end do - end do - - errmsg = 'mp_wsm6_run OK (ERF phase-1 transitional)' - errflg = 0_c_int - end subroutine mp_wsm6_run - -end module mp_wsm6 + rs(k) = 1.e-12 + l_qs(k) = .false. + endif + + if (qg1d(k) .gt. 1.e-9) then + rg(k) = qg1d(k)*rho(k) + n0_g(k) = n0g + lamg = (xam_g*xcgg(3)*n0_g(k)/rg(k))**(1./xcge(1)) + ilamg(k) = 1./lamg + l_qg(k) = .true. + else + rg(k) = 1.e-12 + l_qg(k) = .false. + endif + enddo + +!+---+-----------------------------------------------------------------+ +!..Locate K-level of start of melting (k_0 is level above). +!+---+-----------------------------------------------------------------+ + melti = .false. + k_0 = kts + do k = kte-1, kts, -1 + if ( (temp(k).gt.273.15) .and. L_qr(k) & + .and. (L_qs(k+1).or.L_qg(k+1)) ) then + k_0 = MAX(k+1, k_0) + melti=.true. + goto 195 + endif + enddo + 195 continue + +!+---+-----------------------------------------------------------------+ +!..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) +!.. and non-water-coated snow and graupel when below freezing are +!.. simple. Integrations of m(D)*m(D)*N(D)*dD. +!+---+-----------------------------------------------------------------+ + + do k = kts, kte + ze_rain(k) = 1.e-22 + ze_snow(k) = 1.e-22 + ze_graupel(k) = 1.e-22 + if (l_qr(k)) ze_rain(k) = n0_r(k)*xcrg(4)*ilamr(k)**xcre(4) + if (l_qs(k)) ze_snow(k) = (0.176/0.93) * (6.0/pi)*(6.0/pi) & + * (xam_s/900.0)*(xam_s/900.0) & + * n0_s(k)*xcsg(4)*ilams(k)**xcse(4) + if (l_qg(k)) ze_graupel(k) = (0.176/0.93) * (6.0/pi)*(6.0/pi) & + * (xam_g/900.0)*(xam_g/900.0) & + * n0_g(k)*xcgg(4)*ilamg(k)**xcge(4) + enddo + + +!+---+-----------------------------------------------------------------+ +!..Special case of melting ice (snow/graupel) particles. Assume the +!.. ice is surrounded by the liquid water. Fraction of meltwater is +!.. extremely simple based on amount found above the melting level. +!.. Uses code from Uli Blahak (rayleigh_soak_wetgraupel and supporting +!.. routines). +!+---+-----------------------------------------------------------------+ + + if (melti .and. k_0.ge.kts+1) then + do k = k_0-1, kts, -1 + +!..Reflectivity contributed by melting snow + if (L_qs(k) .and. L_qs(k_0) ) then + fmelt_s = MAX(0.005d0, MIN(1.0d0-rs(k)/rs(k_0), 0.99d0)) + eta = 0.d0 + lams = 1./ilams(k) + do n = 1, nrbins + x = xam_s * xxDs(n)**xbm_s + call rayleigh_soak_wetgraupel (x,dble(xocms),dble(xobms), & + fmelt_s, melt_outside_s, m_w_0, m_i_0, lamda_radar, & + cback, mixingrulestring_s, matrixstring_s, & + inclusionstring_s, hoststring_s, & + hostmatrixstring_s, hostinclusionstring_s) + f_d = n0_s(k)*xxds(n)**xmu_s * dexp(-lams*xxds(n)) + eta = eta + f_d * cback * simpson(n) * xdts(n) + enddo + ze_snow(k) = sngl(lamda4 / (pi5 * k_w) * eta) + endif + + +!..Reflectivity contributed by melting graupel + + if (l_qg(k) .and. l_qg(k_0) ) then + fmelt_g = max(0.005d0, min(1.0d0-rg(k)/rg(k_0), 0.99d0)) + eta = 0.d0 + lamg = 1./ilamg(k) + do n = 1, nrbins + x = xam_g * xxdg(n)**xbm_g + call rayleigh_soak_wetgraupel (x,dble(xocmg),dble(xobmg), & + fmelt_g, melt_outside_g, m_w_0, m_i_0, lamda_radar, & + cback, mixingrulestring_g, matrixstring_g, & + inclusionstring_g, hoststring_g, & + hostmatrixstring_g, hostinclusionstring_g) + f_d = n0_g(k)*xxdg(n)**xmu_g * dexp(-lamg*xxdg(n)) + eta = eta + f_d * cback * simpson(n) * xdtg(n) + enddo + ze_graupel(k) = sngl(lamda4 / (pi5 * k_w) * eta) + endif + + enddo + endif + + do k = kte, kts, -1 + dBZ(k) = 10.*log10((ze_rain(k)+ze_snow(k)+ze_graupel(k))*1.d18) + enddo + + + end subroutine refl10cm_wsm6 + + +!================================================================================================================= + end module mp_wsm6 +!================================================================================================================= diff --git a/Source/Microphysics/WSM6/Make.package b/Source/Microphysics/WSM6/Make.package index 06571d7174..ec50de469b 100644 --- a/Source/Microphysics/WSM6/Make.package +++ b/Source/Microphysics/WSM6/Make.package @@ -5,6 +5,8 @@ CEXE_headers += ERF_WSM6.H CEXE_headers += ERF_WSM6_Fortran_Interface.H ifeq ($(USE_WSM6_FORT),TRUE) + F90EXE_sources += ERF_module_libmassv.F90 + F90EXE_sources += ERF_mp_radar.F90 F90EXE_sources += ERF_module_mp_wsm6.F90 F90EXE_sources += ERF_module_mp_wsm6_isohelper.F90 endif diff --git a/Source/Microphysics/WSM6/README b/Source/Microphysics/WSM6/README index 5b0540b86f..fbfaa3ddad 100644 --- a/Source/Microphysics/WSM6/README +++ b/Source/Microphysics/WSM6/README @@ -8,10 +8,11 @@ Set `ERF_HOME` and derived paths once: ```bash export ERF_HOME="/path/to/ERF" -export BUILD_DIR="${ERF_HOME}/build_wsm6_contract_debug" +export BUILD_DIR="${ERF_HOME}/build" +export INSTALL_DIR="${ERF_HOME}/install" export CASE_DIR="${ERF_HOME}/Exec/CanonicalTests/SquallLine_2D" export ERF_EXE="${BUILD_DIR}/Exec/erf_exec" -export FCOMPARE="${FCOMPARE:-fcompare}" +export FCOMPARE="${FCOMPARE:-${INSTALL_DIR}/bin/amrex_fcompare}" ``` Required inputs in `${CASE_DIR}`: @@ -24,19 +25,26 @@ Required inputs in `${CASE_DIR}`: cmake -S "${ERF_HOME}" -B "${BUILD_DIR}" \ -DERF_ENABLE_NETCDF=OFF \ -DERF_ENABLE_WSM6_FORT=ON \ - -DCMAKE_BUILD_TYPE=Debug \ - -DCMAKE_INSTALL_PREFIX="${ERF_HOME}/install" \ - -DCMAKE_Fortran_FLAGS_DEBUG='-O0 -g -fcheck=all -fbacktrace -ffpe-trap=invalid,zero,overflow' + -DERF_ENABLE_FCOMPARE=ON \ + -DCMAKE_BUILD_TYPE=Release \ + -DCMAKE_INSTALL_PREFIX="${INSTALL_DIR}" -cmake --build "${BUILD_DIR}" --target erf_exec -j 8 +cmake --build "${BUILD_DIR}" -j 8 +cmake --install "${BUILD_DIR}" ``` -Optional (if you want `fcompare` from this same WSM6 build): +Optional strict-contract debug build (for bounds/FPE debugging): ```bash -cmake --build "${BUILD_DIR}" -j 8 -cmake --install "${BUILD_DIR}" -export FCOMPARE="${ERF_HOME}/install/bin/amrex_fcompare" +cmake -S "${ERF_HOME}" -B "${ERF_HOME}/build_debug" \ + -DERF_ENABLE_NETCDF=OFF \ + -DERF_ENABLE_WSM6_FORT=ON \ + -DERF_ENABLE_FCOMPARE=ON \ + -DCMAKE_BUILD_TYPE=Debug \ + -DCMAKE_INSTALL_PREFIX="${INSTALL_DIR}" \ + -DCMAKE_Fortran_FLAGS_DEBUG='-O0 -g -fcheck=all -fbacktrace -ffpe-trap=invalid,zero,overflow' + +cmake --build "${ERF_HOME}/build_debug" -j 8 ``` ## Run WSM6 (120 steps) @@ -83,13 +91,33 @@ Expected final outputs: ```bash "${FCOMPARE}" \ plt_wsm6_run00120 \ - plt_morr_run00120 \ - > fcompare_wsm6_vs_morr_step120.log 2>&1 + plt_morr_run00120 ``` -Result file: -- `fcompare_wsm6_vs_morr_step120.log` +Exact example from this branch (step-120 parity check): + +```bash +"${FCOMPARE}" \ + plt_wsm6_run00120 \ + plt_morr_run00120 +``` + +```text + variable name absolute error relative error + (||A - B||) (||A - B||/||A||) + ---------------------------------------------------------------------------- + level = 0 + density 9.103828802e-15 8.068305415e-15 + rhotheta 1.307398634e-12 3.86091667e-15 + x_velocity 5.080380561e-13 4.182172327e-14 + z_velocity 9.108771951e-13 1.541701669e-12 + pressure 5.238689482e-10 5.285028379e-15 + rain_accum 0 0 + snow_accum 0 0 + graup_accum 0 0 +``` Notes: +- If `${FCOMPARE}` is not executable on your machine, set `FCOMPARE` to your local `amrex_fcompare` path. - If your `fcompare` is MPI-enabled, run it in an environment where MPI singleton/process launch is supported. - Morrison GNUmake docs sometimes mention `-fdefault-real-8`; this README uses the CMake path shown above. From 357ab3b672e28b85a58f012faca19475ba8ebdc3 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Mon, 6 Apr 2026 10:21:45 -0700 Subject: [PATCH 16/20] WSM6/Morrison debug + restart consistency instrumentation --- Source/ERF.cpp | 2 + Source/IO/ERF_Checkpoint.cpp | 70 ++++- .../Morrison/ERF_AdvanceMorrison.cpp | 245 +++++++++++++++- Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp | 261 ++++++++++++++++++ Source/Microphysics/WSM6/ERF_InitWSM6.cpp | 4 +- Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp | 12 +- Source/Microphysics/WSM6/ERF_WSM6.H | 2 +- .../WSM6/ERF_module_mp_wsm6_isohelper.F90 | 14 + 8 files changed, 594 insertions(+), 16 deletions(-) diff --git a/Source/ERF.cpp b/Source/ERF.cpp index 1dab16e945..8a2a0a024f 100644 --- a/Source/ERF.cpp +++ b/Source/ERF.cpp @@ -1873,6 +1873,8 @@ ERF::InitData_post () void ERF::Interp2DArrays (int lev, const BoxArray& my_ba2d, const DistributionMapping& my_dm) { + if (lev == 0) { return; } + if (lon_m[lev-1] && !lon_m[lev]) { auto ngv = lon_m[lev-1]->nGrowVect(); ngv[2] = 0; lon_m[lev] = std::make_unique(my_ba2d,my_dm,1,ngv); diff --git a/Source/IO/ERF_Checkpoint.cpp b/Source/IO/ERF_Checkpoint.cpp index fdcc72bceb..39071ecff2 100644 --- a/Source/IO/ERF_Checkpoint.cpp +++ b/Source/IO/ERF_Checkpoint.cpp @@ -582,6 +582,12 @@ ERF::ReadCheckpointFile () } } + Real morrison_ndcnst = Real(250.0); + { + ParmParse pp("erf"); + pp.query("morrison_ndcnst", morrison_ndcnst); + } + // read in the MultiFab data for (int lev = 0; lev <= finest_level; ++lev) { @@ -733,8 +739,68 @@ ERF::ReadCheckpointFile () const int ncomp = 1; IntVect ng_moist = qmoist[lev][qmoist_indices[var]]->nGrowVect(); MultiFab moist_vars(grids[lev],dmap[lev],ncomp,ng_moist); - VisMF::Read(moist_vars, amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", qmoist_names[var])); - MultiFab::Copy(*(qmoist[lev][qmoist_indices[var]]),moist_vars,0,0,ncomp,ng_moist); + std::string moist_name = qmoist_names[var]; + std::string moist_file = amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", moist_name); + bool loaded_from_file = false; + auto has_mf = [](const std::string& mf_prefix) { + return amrex::FileExists(mf_prefix + "_H"); + }; + + // Backward-compatible aliasing for historical WSM6 checkpoints. + if (!has_mf(moist_file)) { + if (moist_name == "GraupAccum") { + const std::string alt_name = "GraupelAccum"; + const std::string alt_file = amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", alt_name); + if (has_mf(alt_file)) { + moist_name = alt_name; + moist_file = alt_file; + } + } else if (moist_name == "GraupelAccum") { + const std::string alt_name = "GraupAccum"; + const std::string alt_file = amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", alt_name); + if (has_mf(alt_file)) { + moist_name = alt_name; + moist_file = alt_file; + } + } + } + if (has_mf(moist_file)) { + VisMF::Read(moist_vars, moist_file); + MultiFab::Copy(*(qmoist[lev][qmoist_indices[var]]),moist_vars,0,0,ncomp,ng_moist); + loaded_from_file = true; + } + + if (!loaded_from_file) { + auto& qmoist_var = *(qmoist[lev][qmoist_indices[var]]); + qmoist_var.setVal(Real(0.0)); + + if (qmoist_names[var] == "Nc") { + const Real one_million = Real(1.0e6); + const Real rho_floor = Real(1.0e-12); + for (MFIter mfi(qmoist_var, TilingIfNotGPU()); mfi.isValid(); ++mfi) + { + const Box& bx = mfi.tilebox(); + Array4 const& cons_arr = vars_new[lev][Vars::cons].const_array(mfi); + Array4 const& nc_arr = qmoist_var.array(mfi); + ParallelFor(bx, [=] AMREX_GPU_DEVICE (int i, int j, int k) + { + const Real rho = amrex::max(cons_arr(i,j,k,Rho_comp), rho_floor); + nc_arr(i,j,k) = morrison_ndcnst * one_million / rho; + }); + } + } + + if (ParallelDescriptor::IOProcessor()) { + amrex::Print() << "WARNING: Missing restart moisture field '" << qmoist_names[var] + << "' at level " << lev << " in " << restart_chkfile + << "; using fallback initialization." + << (qmoist_names[var] == "Nc" ? " (Nc = morrison_ndcnst*1e6/rho)." : " (filled with 0).") + << std::endl; + } + } + + // Keep qmoist auxiliaries ghost-consistent after either file load or fallback init. + qmoist[lev][qmoist_indices[var]]->FillBoundary(geom[lev].periodicity()); } #if defined(ERF_USE_WINDFARM) diff --git a/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp b/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp index bfa8c32169..7a83ac746d 100644 --- a/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp +++ b/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp @@ -3,12 +3,16 @@ #include #include #include +#include +#include #include #include #include #include #include +#include +#include #include "ERF.H" #include "ERF_Constants.H" @@ -331,6 +335,7 @@ amrex::Real wrf_gamma (amrex::Real x) res = xinf; return res; } + } // Argument is positive @@ -346,6 +351,7 @@ amrex::Real wrf_gamma (amrex::Real x) res = xinf; return res; } + } else if (y < twelve) { // Medium range argument @@ -390,6 +396,7 @@ amrex::Real wrf_gamma (amrex::Real x) // printf("wrf_gamma: Multiplication %d: res = %g, y = %g\n", i+1, res, y); } } + } else { // Large argument @@ -526,6 +533,73 @@ AMREX_GPU_HOST_DEVICE AMREX_FORCE_INLINE Real m_ndcnst = Real(250.0); // Droplet number concentration (cm^-3) pp.query("morrison_ndcnst", m_ndcnst); + static int mpdbg_step = 0; + int microphysics_debug = 0; + pp.query("microphysics_debug", microphysics_debug); + microphysics_debug = std::max(0, std::min(2, microphysics_debug)); + int microphysics_debug_seam = 0; + pp.query("microphysics_debug_seam", microphysics_debug_seam); + int seam_i_lo = 94; + int seam_i_hi = 97; + int seam_j_lo = 0; + int seam_j_hi = 0; + int seam_k_lo = 0; + int seam_k_hi = 38; + pp.query("microphysics_debug_seam_i_lo", seam_i_lo); + pp.query("microphysics_debug_seam_i_hi", seam_i_hi); + pp.query("microphysics_debug_seam_j_lo", seam_j_lo); + pp.query("microphysics_debug_seam_j_hi", seam_j_hi); + pp.query("microphysics_debug_seam_k_lo", seam_k_lo); + pp.query("microphysics_debug_seam_k_hi", seam_k_hi); + + struct MPDbgVarStats { + double min = std::numeric_limits::infinity(); + double max = -std::numeric_limits::infinity(); + double l1 = 0.0; + long long n = 0; + }; + struct MPDbgStats { + MPDbgVarStats qrain, qc, rhoQ2, qsnow, qgraup, zvel; + }; + auto update_stat = [](MPDbgVarStats& s, double v) { + s.min = std::min(s.min, v); + s.max = std::max(s.max, v); + s.l1 += std::abs(v); + s.n += 1; + }; + auto reduce_stat = [](MPDbgVarStats& s) { + ParallelDescriptor::ReduceRealMin(s.min); + ParallelDescriptor::ReduceRealMax(s.max); + ParallelDescriptor::ReduceRealSum(s.l1); + amrex::Long n = static_cast(s.n); + ParallelDescriptor::ReduceLongSum(n); + s.n = static_cast(n); + }; + auto reduce_stats = [&](MPDbgStats& s) { + reduce_stat(s.qrain); reduce_stat(s.qc); reduce_stat(s.rhoQ2); + reduce_stat(s.qsnow); reduce_stat(s.qgraup); reduce_stat(s.zvel); + }; + auto print_stats = [](const char* tag, int step, const MPDbgStats& s) { + if (!ParallelDescriptor::IOProcessor()) return; + std::printf( + "%s MORR step=%04d " + "qrain_min=%.12e qrain_max=%.12e qrain_L1=%.12e " + "qc_min=%.12e qc_max=%.12e qc_L1=%.12e " + "rhoQ2_min=%.12e rhoQ2_max=%.12e rhoQ2_L1=%.12e " + "qsnow_min=%.12e qsnow_max=%.12e qsnow_L1=%.12e " + "qgraup_min=%.12e qgraup_max=%.12e qgraup_L1=%.12e " + "z_velocity_min=%.12e z_velocity_max=%.12e z_velocity_L1=%.12e\n", + tag, step, + s.qrain.min, s.qrain.max, s.qrain.l1, + s.qc.min, s.qc.max, s.qc.l1, + s.rhoQ2.min, s.rhoQ2.max, s.rhoQ2.l1, + s.qsnow.min, s.qsnow.max, s.qsnow.l1, + s.qgraup.min, s.qgraup.max, s.qgraup.l1, + s.zvel.min, s.zvel.max, s.zvel.l1); + std::fflush(stdout); + }; + MPDbgStats pre_stats, post_stats; + // Loop through the grids for (MFIter mfi(*mic_fab_vars[MicVar_Morr::qcl],TileNoZ()); mfi.isValid(); ++mfi) { @@ -575,15 +649,93 @@ AMREX_GPU_HOST_DEVICE AMREX_FORCE_INLINE const int jhi = box.hiVect()[1]; const int klo = box.loVect()[2]; const int khi = box.hiVect()[2]; + const Box fab_box = mfi.fabbox(); + const int imlo = fab_box.loVect()[0]; + const int ihim = fab_box.hiVect()[0]; + const int jmlo = fab_box.loVect()[1]; + const int jmhi = fab_box.hiVect()[1]; + const int kmlo = fab_box.loVect()[2]; + const int kmhi = fab_box.hiVect()[2]; + + if (microphysics_debug > 0) { + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + const double qr = qpr_arr(i,j,k); + const double qc = qcl_arr(i,j,k); + const double rhoqc = rho_arr(i,j,k) * qc; + const double qs = qps_arr(i,j,k); + const double qg = qpg_arr(i,j,k); + const double w = w_arr(i,j,k); + update_stat(pre_stats.qrain, qr); + update_stat(pre_stats.qc, qc); + update_stat(pre_stats.rhoQ2, rhoqc); + update_stat(pre_stats.qsnow, qs); + update_stat(pre_stats.qgraup, qg); + update_stat(pre_stats.zvel, w); + } + } + } + } + + if (microphysics_debug > 1) { + const int rank = ParallelDescriptor::MyProc(); + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + std::printf( + "MPDBG PRE MORR rank=%d step=%04d i=%d j=%d k=%d " + "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e z_velocity=%.12e\n", + rank, mpdbg_step, i, j, k, + static_cast(qpr_arr(i,j,k)), + static_cast(qcl_arr(i,j,k)), + static_cast(rho_arr(i,j,k) * qcl_arr(i,j,k)), + static_cast(qps_arr(i,j,k)), + static_cast(qpg_arr(i,j,k)), + static_cast(w_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } + + if (microphysics_debug_seam > 0) { + const int rank = ParallelDescriptor::MyProc(); + const int si_lo = std::max(imlo, seam_i_lo); + const int si_hi = std::min(ihim, seam_i_hi); + const int sj_lo = std::max(jmlo, seam_j_lo); + const int sj_hi = std::min(jmhi, seam_j_hi); + const int sk_lo = std::max(kmlo, seam_k_lo); + const int sk_hi = std::min(kmhi, seam_k_hi); + for (int k = sk_lo; k <= sk_hi; ++k) { + for (int j = sj_lo; j <= sj_hi; ++j) { + for (int i = si_lo; i <= si_hi; ++i) { + const int in_valid = (i >= ilo && i <= ihi && + j >= jlo && j <= jhi && + k >= klo && k <= khi) ? 1 : 0; + std::printf( + "MPDBG SEAM PRE MORR rank=%d step=%04d i=%d j=%d k=%d valid=%d " + "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", + rank, mpdbg_step, i, j, k, in_valid, + static_cast(qv_arr(i,j,k)), + static_cast(qcl_arr(i,j,k)), + static_cast(qci_arr(i,j,k)), + static_cast(qpr_arr(i,j,k)), + static_cast(qps_arr(i,j,k)), + static_cast(qpg_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } Box grown_box(box); grown_box.grow(3); #ifdef ERF_USE_MORR_FORT - const int ilom = grown_box.loVect()[0]; - const int ihim = grown_box.hiVect()[0]; - const int jlom = grown_box.loVect()[1]; - const int jhim = grown_box.hiVect()[1]; - const int klom = grown_box.loVect()[2]; - const int khim = grown_box.hiVect()[2]; + const int ilom = imlo; + const int jlom = jmlo; + const int jhim = jmhi; + const int klom = kmlo; + const int khim = kmhi; #endif // Calculate Exner function (PII) to convert potential temperature to temperature // PII = (P/P0)^(R/cp) @@ -3670,9 +3822,90 @@ AMREX_GPU_HOST_DEVICE AMREX_FORCE_INLINE amrex::Abort("Trying to run fortran without compiling with USE_MORR_FORT=TRUE"); #endif } + + if (microphysics_debug > 0) { + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + const double qr = qpr_arr(i,j,k); + const double qc = qcl_arr(i,j,k); + const double rhoqc = rho_arr(i,j,k) * qc; + const double qs = qps_arr(i,j,k); + const double qg = qpg_arr(i,j,k); + const double w = w_arr(i,j,k); + update_stat(post_stats.qrain, qr); + update_stat(post_stats.qc, qc); + update_stat(post_stats.rhoQ2, rhoqc); + update_stat(post_stats.qsnow, qs); + update_stat(post_stats.qgraup, qg); + update_stat(post_stats.zvel, w); + } + } + } + } + + if (microphysics_debug > 1) { + const int rank = ParallelDescriptor::MyProc(); + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + std::printf( + "MPDBG POST MORR rank=%d step=%04d i=%d j=%d k=%d " + "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e z_velocity=%.12e\n", + rank, mpdbg_step, i, j, k, + static_cast(qpr_arr(i,j,k)), + static_cast(qcl_arr(i,j,k)), + static_cast(rho_arr(i,j,k) * qcl_arr(i,j,k)), + static_cast(qps_arr(i,j,k)), + static_cast(qpg_arr(i,j,k)), + static_cast(w_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } + + if (microphysics_debug_seam > 0) { + const int rank = ParallelDescriptor::MyProc(); + const int si_lo = std::max(imlo, seam_i_lo); + const int si_hi = std::min(ihim, seam_i_hi); + const int sj_lo = std::max(jmlo, seam_j_lo); + const int sj_hi = std::min(jmhi, seam_j_hi); + const int sk_lo = std::max(kmlo, seam_k_lo); + const int sk_hi = std::min(kmhi, seam_k_hi); + for (int k = sk_lo; k <= sk_hi; ++k) { + for (int j = sj_lo; j <= sj_hi; ++j) { + for (int i = si_lo; i <= si_hi; ++i) { + const int in_valid = (i >= ilo && i <= ihi && + j >= jlo && j <= jhi && + k >= klo && k <= khi) ? 1 : 0; + std::printf( + "MPDBG SEAM POST MORR rank=%d step=%04d i=%d j=%d k=%d valid=%d " + "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", + rank, mpdbg_step, i, j, k, in_valid, + static_cast(qv_arr(i,j,k)), + static_cast(qcl_arr(i,j,k)), + static_cast(qci_arr(i,j,k)), + static_cast(qpr_arr(i,j,k)), + static_cast(qps_arr(i,j,k)), + static_cast(qpg_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } // amrex::Print()< 0) { + reduce_stats(pre_stats); + reduce_stats(post_stats); + print_stats("MPDBG PRE", mpdbg_step, pre_stats); + print_stats("MPDBG POST", mpdbg_step, post_stats); + print_stats("MPDBG STEP", mpdbg_step, post_stats); + } + ++mpdbg_step; } diff --git a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp index 2072e2efd3..9502e720da 100644 --- a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp @@ -1,8 +1,97 @@ #include "ERF_WSM6.H" #include "ERF_WSM6_Fortran_Interface.H" +#include +#include +#include +#include +#include +#include using namespace amrex; +namespace { + +struct MPDbgVarStats { + double min = std::numeric_limits::infinity(); + double max = -std::numeric_limits::infinity(); + double l1 = 0.0; + long long n = 0; +}; + +struct MPDbgStats { + MPDbgVarStats qrain; + MPDbgVarStats qc; + MPDbgVarStats rhoQ2; + MPDbgVarStats qsnow; + MPDbgVarStats qgraup; + MPDbgVarStats zvel; +}; + +inline void +update_stat (MPDbgVarStats& s, double v) +{ + s.min = std::min(s.min, v); + s.max = std::max(s.max, v); + s.l1 += std::abs(v); + s.n += 1; +} + +inline void +reduce_stat (MPDbgVarStats& s) +{ + ParallelDescriptor::ReduceRealMin(s.min); + ParallelDescriptor::ReduceRealMax(s.max); + ParallelDescriptor::ReduceRealSum(s.l1); + amrex::Long n = static_cast(s.n); + ParallelDescriptor::ReduceLongSum(n); + s.n = static_cast(n); +} + +inline void +reduce_stats (MPDbgStats& s) +{ + reduce_stat(s.qrain); + reduce_stat(s.qc); + reduce_stat(s.rhoQ2); + reduce_stat(s.qsnow); + reduce_stat(s.qgraup); + reduce_stat(s.zvel); +} + +inline void +print_stats (const char* tag, const char* model, int step, const MPDbgStats& s) +{ + if (!ParallelDescriptor::IOProcessor()) { return; } + std::printf( + "%s %s step=%04d " + "qrain_min=%.12e qrain_max=%.12e qrain_L1=%.12e " + "qc_min=%.12e qc_max=%.12e qc_L1=%.12e " + "rhoQ2_min=%.12e rhoQ2_max=%.12e rhoQ2_L1=%.12e " + "qsnow_min=%.12e qsnow_max=%.12e qsnow_L1=%.12e " + "qgraup_min=%.12e qgraup_max=%.12e qgraup_L1=%.12e " + "z_velocity_min=%.12e z_velocity_max=%.12e z_velocity_L1=%.12e\n", + tag, model, step, + s.qrain.min, s.qrain.max, s.qrain.l1, + s.qc.min, s.qc.max, s.qc.l1, + s.rhoQ2.min, s.rhoQ2.max, s.rhoQ2.l1, + s.qsnow.min, s.qsnow.max, s.qsnow.l1, + s.qgraup.min, s.qgraup.max, s.qgraup.l1, + s.zvel.min, s.zvel.max, s.zvel.l1); + std::fflush(stdout); +} + +inline void +mark_zvel_nan (MPDbgVarStats& s) +{ + const double nan = std::numeric_limits::quiet_NaN(); + s.min = nan; + s.max = nan; + s.l1 = nan; + s.n = 1; +} + +} // namespace + void WSM6::Advance(const Real& dt_advance, const SolverChoice&) @@ -42,6 +131,29 @@ WSM6::Advance(const Real& dt_advance, constexpr double cice = 2106.0; constexpr double psat = 610.78; + static int mpdbg_step = 0; + ParmParse pp("erf"); + int microphysics_debug = 0; + pp.query("microphysics_debug", microphysics_debug); + microphysics_debug = std::max(0, std::min(2, microphysics_debug)); + int microphysics_debug_seam = 0; + pp.query("microphysics_debug_seam", microphysics_debug_seam); + int seam_i_lo = 94; + int seam_i_hi = 97; + int seam_j_lo = 0; + int seam_j_hi = 0; + int seam_k_lo = 0; + int seam_k_hi = 38; + pp.query("microphysics_debug_seam_i_lo", seam_i_lo); + pp.query("microphysics_debug_seam_i_hi", seam_i_hi); + pp.query("microphysics_debug_seam_j_lo", seam_j_lo); + pp.query("microphysics_debug_seam_j_hi", seam_j_hi); + pp.query("microphysics_debug_seam_k_lo", seam_k_lo); + pp.query("microphysics_debug_seam_k_hi", seam_k_hi); + + MPDbgStats pre_stats; + MPDbgStats post_stats; + for (MFIter mfi(*mic_fab_vars[MicVar_WSM6::qv], TileNoZ()); mfi.isValid(); ++mfi) { const Box box = mfi.tilebox(); const Box fab_box = mfi.fabbox(); @@ -113,6 +225,75 @@ WSM6::Advance(const Real& dt_advance, graupelncv_arr(i,j,0) = Real(0.0); }); + if (microphysics_debug > 0) { + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + const double qr = qr_arr(i,j,k); + const double qc = qc_arr(i,j,k); + const double rhoqc = den_arr(i,j,k) * qc; + const double qs = qs_arr(i,j,k); + const double qg = qg_arr(i,j,k); + update_stat(pre_stats.qrain, qr); + update_stat(pre_stats.qc, qc); + update_stat(pre_stats.rhoQ2, rhoqc); + update_stat(pre_stats.qsnow, qs); + update_stat(pre_stats.qgraup, qg); + } + } + } + } + + if (microphysics_debug > 1) { + const int rank = ParallelDescriptor::MyProc(); + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + std::printf( + "MPDBG PRE WSM6 rank=%d step=%04d i=%d j=%d k=%d " + "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e\n", + rank, mpdbg_step, i, j, k, + static_cast(qr_arr(i,j,k)), + static_cast(qc_arr(i,j,k)), + static_cast(den_arr(i,j,k) * qc_arr(i,j,k)), + static_cast(qs_arr(i,j,k)), + static_cast(qg_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } + + if (microphysics_debug_seam > 0) { + const int rank = ParallelDescriptor::MyProc(); + const int si_lo = std::max(imlo, seam_i_lo); + const int si_hi = std::min(imhi, seam_i_hi); + const int sj_lo = std::max(jmlo, seam_j_lo); + const int sj_hi = std::min(jmhi, seam_j_hi); + const int sk_lo = std::max(kmlo, seam_k_lo); + const int sk_hi = std::min(kmhi, seam_k_hi); + for (int k = sk_lo; k <= sk_hi; ++k) { + for (int j = sj_lo; j <= sj_hi; ++j) { + for (int i = si_lo; i <= si_hi; ++i) { + const int in_valid = (i >= ilo && i <= ihi && + j >= jlo && j <= jhi && + k >= klo && k <= khi) ? 1 : 0; + std::printf( + "MPDBG SEAM PRE WSM6 rank=%d step=%04d i=%d j=%d k=%d valid=%d " + "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", + rank, mpdbg_step, i, j, k, in_valid, + static_cast(qv_arr(i,j,k)), + static_cast(qc_arr(i,j,k)), + static_cast(qi_arr(i,j,k)), + static_cast(qr_arr(i,j,k)), + static_cast(qs_arr(i,j,k)), + static_cast(qg_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } + mp_wsm6_run_c( t_arr.dataPtr(), qv_arr.dataPtr(), qc_arr.dataPtr(), qi_arr.dataPtr(), @@ -131,7 +312,87 @@ WSM6::Advance(const Real& dt_advance, snow_arr(i,j,klo) = snowacc_arr(i,j,0); graup_arr(i,j,klo) = graupacc_arr(i,j,0); }); + + if (microphysics_debug > 0) { + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + const double qr = qr_arr(i,j,k); + const double qc = qc_arr(i,j,k); + const double rhoqc = den_arr(i,j,k) * qc; + const double qs = qs_arr(i,j,k); + const double qg = qg_arr(i,j,k); + update_stat(post_stats.qrain, qr); + update_stat(post_stats.qc, qc); + update_stat(post_stats.rhoQ2, rhoqc); + update_stat(post_stats.qsnow, qs); + update_stat(post_stats.qgraup, qg); + } + } + } + } + + if (microphysics_debug > 1) { + const int rank = ParallelDescriptor::MyProc(); + for (int k = klo; k <= khi; ++k) { + for (int j = jlo; j <= jhi; ++j) { + for (int i = ilo; i <= ihi; ++i) { + std::printf( + "MPDBG POST WSM6 rank=%d step=%04d i=%d j=%d k=%d " + "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e\n", + rank, mpdbg_step, i, j, k, + static_cast(qr_arr(i,j,k)), + static_cast(qc_arr(i,j,k)), + static_cast(den_arr(i,j,k) * qc_arr(i,j,k)), + static_cast(qs_arr(i,j,k)), + static_cast(qg_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } + + if (microphysics_debug_seam > 0) { + const int rank = ParallelDescriptor::MyProc(); + const int si_lo = std::max(imlo, seam_i_lo); + const int si_hi = std::min(imhi, seam_i_hi); + const int sj_lo = std::max(jmlo, seam_j_lo); + const int sj_hi = std::min(jmhi, seam_j_hi); + const int sk_lo = std::max(kmlo, seam_k_lo); + const int sk_hi = std::min(kmhi, seam_k_hi); + for (int k = sk_lo; k <= sk_hi; ++k) { + for (int j = sj_lo; j <= sj_hi; ++j) { + for (int i = si_lo; i <= si_hi; ++i) { + const int in_valid = (i >= ilo && i <= ihi && + j >= jlo && j <= jhi && + k >= klo && k <= khi) ? 1 : 0; + std::printf( + "MPDBG SEAM POST WSM6 rank=%d step=%04d i=%d j=%d k=%d valid=%d " + "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", + rank, mpdbg_step, i, j, k, in_valid, + static_cast(qv_arr(i,j,k)), + static_cast(qc_arr(i,j,k)), + static_cast(qi_arr(i,j,k)), + static_cast(qr_arr(i,j,k)), + static_cast(qs_arr(i,j,k)), + static_cast(qg_arr(i,j,k))); + } + } + } + std::fflush(stdout); + } + } + + if (microphysics_debug > 0) { + mark_zvel_nan(pre_stats.zvel); + mark_zvel_nan(post_stats.zvel); + reduce_stats(pre_stats); + reduce_stats(post_stats); + print_stats("MPDBG PRE", "WSM6", mpdbg_step, pre_stats); + print_stats("MPDBG POST", "WSM6", mpdbg_step, post_stats); + print_stats("MPDBG STEP", "WSM6", mpdbg_step, post_stats); } + ++mpdbg_step; #else amrex::Abort("WSM6 Fortran bridge requested but ERF was not built with ERF_USE_WSM6_FORT"); #endif diff --git a/Source/Microphysics/WSM6/ERF_InitWSM6.cpp b/Source/Microphysics/WSM6/ERF_InitWSM6.cpp index f44ec3dfb1..902a2a46b2 100644 --- a/Source/Microphysics/WSM6/ERF_InitWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_InitWSM6.cpp @@ -37,7 +37,9 @@ void WSM6::Copy_State_to_Micro(const MultiFab& cons_in) { for (MFIter mfi(cons_in); mfi.isValid(); ++mfi) { - const auto& box3d = mfi.tilebox(); + // Match Morrison behavior: refresh microphysics ghost zones from state. + // WSM6 Fortran reads the full (ims:ime, jms:jme, kms:kme) slab. + const auto& box3d = mfi.growntilebox(); auto states = cons_in.array(mfi); auto rho = mic_fab_vars[MicVar_WSM6::rho]->array(mfi); diff --git a/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp b/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp index 721a443f08..723863edc3 100644 --- a/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_UpdateWSM6.cpp @@ -21,12 +21,12 @@ WSM6::Copy_Micro_to_State(MultiFab& cons) ParallelFor(box3d, [=] AMREX_GPU_DEVICE(int i, int j, int k) { states(i,j,k,RhoTheta_comp) = rho(i,j,k) * theta(i,j,k); - states(i,j,k,RhoQ1_comp) = rho(i,j,k) * qv(i,j,k); - states(i,j,k,RhoQ2_comp) = rho(i,j,k) * qc(i,j,k); - states(i,j,k,RhoQ3_comp) = rho(i,j,k) * qi(i,j,k); - states(i,j,k,RhoQ4_comp) = rho(i,j,k) * qr(i,j,k); - states(i,j,k,RhoQ5_comp) = rho(i,j,k) * qs(i,j,k); - states(i,j,k,RhoQ6_comp) = rho(i,j,k) * qg(i,j,k); + states(i,j,k,RhoQ1_comp) = rho(i,j,k) * amrex::max(Real(0), qv(i,j,k)); + states(i,j,k,RhoQ2_comp) = rho(i,j,k) * amrex::max(Real(0), qc(i,j,k)); + states(i,j,k,RhoQ3_comp) = rho(i,j,k) * amrex::max(Real(0), qi(i,j,k)); + states(i,j,k,RhoQ4_comp) = rho(i,j,k) * amrex::max(Real(0), qr(i,j,k)); + states(i,j,k,RhoQ5_comp) = rho(i,j,k) * amrex::max(Real(0), qs(i,j,k)); + states(i,j,k,RhoQ6_comp) = rho(i,j,k) * amrex::max(Real(0), qg(i,j,k)); }); } diff --git a/Source/Microphysics/WSM6/ERF_WSM6.H b/Source/Microphysics/WSM6/ERF_WSM6.H index f58621fd8c..d96cb79ada 100644 --- a/Source/Microphysics/WSM6/ERF_WSM6.H +++ b/Source/Microphysics/WSM6/ERF_WSM6.H @@ -88,7 +88,7 @@ public: std::vector& a_names) const override { a_idx = {0, 1, 2}; - a_names = {"RainAccum", "SnowAccum", "GraupelAccum"}; + a_names = {"RainAccum", "SnowAccum", "GraupAccum"}; } private: diff --git a/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 b/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 index a70a0062a4..a4da5070d4 100644 --- a/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 +++ b/Source/Microphysics/WSM6/ERF_module_mp_wsm6_isohelper.F90 @@ -42,6 +42,18 @@ subroutine mp_wsm6_run_c(t, qv, qc, qi, qr, qs, qg, den, p, delz, & real(c_double), allocatable :: rain_col(:), rainncv_col(:), sr_col(:) real(c_double), allocatable :: snow_col(:), snowncv_col(:), graupel_col(:), graupelncv_col(:) + if (its < ims .or. ite > ime .or. jts < jms .or. jte > jme .or. kts < kms .or. kte > kme) then + write(*,'(A)') 'mp_wsm6_run_c bounds error: run-window outside storage bounds' + write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme + write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte + stop 1 + end if + if (its > ite .or. jts > jte .or. kts > kte) then + write(*,'(A)') 'mp_wsm6_run_c bounds error: invalid active index ordering' + write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte + stop 1 + end if + kdim = kte - kts + 1 allocate(t_col(ims:ime,1:kdim), q_col(ims:ime,1:kdim), qc_col(ims:ime,1:kdim), qi_col(ims:ime,1:kdim)) @@ -84,6 +96,8 @@ subroutine mp_wsm6_run_c(t, qv, qc, qi, qr, qs, qg, den, p, delz, & if (errflg /= 0) then write(*,'(A,1X,I0,2A)') 'mp_wsm6_run_c error at j=', j, ': ', trim(errmsg) + write(*,'(A,6(1X,I0))') ' storage ims ime jms jme kms kme =', ims, ime, jms, jme, kms, kme + write(*,'(A,6(1X,I0))') ' active its ite jts jte kts kte =', its, ite, jts, jte, kts, kte stop 1 end if From 145ab83560bb699eb35739124f518265b6f3cd89 Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Mon, 6 Apr 2026 10:51:16 -0700 Subject: [PATCH 17/20] Fill state ghosts before moisture Copy_State_to_Micro --- Source/TimeIntegration/ERF_AdvanceMicrophysics.cpp | 1 + 1 file changed, 1 insertion(+) diff --git a/Source/TimeIntegration/ERF_AdvanceMicrophysics.cpp b/Source/TimeIntegration/ERF_AdvanceMicrophysics.cpp index 23d6d79e10..38754be2c6 100644 --- a/Source/TimeIntegration/ERF_AdvanceMicrophysics.cpp +++ b/Source/TimeIntegration/ERF_AdvanceMicrophysics.cpp @@ -10,6 +10,7 @@ void ERF::advance_microphysics (int lev, { if (solverChoice.moisture_type != MoistureType::None) { micro->Set_RealWidth(lev, real_width); + cons.FillBoundary(geom[lev].periodicity()); micro->Update_Micro_Vars_Lev(lev, cons); micro->Advance(lev, dt_advance, iteration, time, solverChoice, vars_new, z_phys_nd, phys_bc_type); micro->Update_State_Vars_Lev(lev, cons); From bb28fea388be763e21e96fd94179a18be4c38a4a Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Mon, 6 Apr 2026 11:57:02 -0700 Subject: [PATCH 18/20] WSM6: fix CI unused-function warnings and drop noisy restart fallbacks --- Source/IO/ERF_Checkpoint.cpp | 70 +------------------- Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp | 2 + 2 files changed, 4 insertions(+), 68 deletions(-) diff --git a/Source/IO/ERF_Checkpoint.cpp b/Source/IO/ERF_Checkpoint.cpp index 39071ecff2..fdcc72bceb 100644 --- a/Source/IO/ERF_Checkpoint.cpp +++ b/Source/IO/ERF_Checkpoint.cpp @@ -582,12 +582,6 @@ ERF::ReadCheckpointFile () } } - Real morrison_ndcnst = Real(250.0); - { - ParmParse pp("erf"); - pp.query("morrison_ndcnst", morrison_ndcnst); - } - // read in the MultiFab data for (int lev = 0; lev <= finest_level; ++lev) { @@ -739,68 +733,8 @@ ERF::ReadCheckpointFile () const int ncomp = 1; IntVect ng_moist = qmoist[lev][qmoist_indices[var]]->nGrowVect(); MultiFab moist_vars(grids[lev],dmap[lev],ncomp,ng_moist); - std::string moist_name = qmoist_names[var]; - std::string moist_file = amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", moist_name); - bool loaded_from_file = false; - auto has_mf = [](const std::string& mf_prefix) { - return amrex::FileExists(mf_prefix + "_H"); - }; - - // Backward-compatible aliasing for historical WSM6 checkpoints. - if (!has_mf(moist_file)) { - if (moist_name == "GraupAccum") { - const std::string alt_name = "GraupelAccum"; - const std::string alt_file = amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", alt_name); - if (has_mf(alt_file)) { - moist_name = alt_name; - moist_file = alt_file; - } - } else if (moist_name == "GraupelAccum") { - const std::string alt_name = "GraupAccum"; - const std::string alt_file = amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", alt_name); - if (has_mf(alt_file)) { - moist_name = alt_name; - moist_file = alt_file; - } - } - } - if (has_mf(moist_file)) { - VisMF::Read(moist_vars, moist_file); - MultiFab::Copy(*(qmoist[lev][qmoist_indices[var]]),moist_vars,0,0,ncomp,ng_moist); - loaded_from_file = true; - } - - if (!loaded_from_file) { - auto& qmoist_var = *(qmoist[lev][qmoist_indices[var]]); - qmoist_var.setVal(Real(0.0)); - - if (qmoist_names[var] == "Nc") { - const Real one_million = Real(1.0e6); - const Real rho_floor = Real(1.0e-12); - for (MFIter mfi(qmoist_var, TilingIfNotGPU()); mfi.isValid(); ++mfi) - { - const Box& bx = mfi.tilebox(); - Array4 const& cons_arr = vars_new[lev][Vars::cons].const_array(mfi); - Array4 const& nc_arr = qmoist_var.array(mfi); - ParallelFor(bx, [=] AMREX_GPU_DEVICE (int i, int j, int k) - { - const Real rho = amrex::max(cons_arr(i,j,k,Rho_comp), rho_floor); - nc_arr(i,j,k) = morrison_ndcnst * one_million / rho; - }); - } - } - - if (ParallelDescriptor::IOProcessor()) { - amrex::Print() << "WARNING: Missing restart moisture field '" << qmoist_names[var] - << "' at level " << lev << " in " << restart_chkfile - << "; using fallback initialization." - << (qmoist_names[var] == "Nc" ? " (Nc = morrison_ndcnst*1e6/rho)." : " (filled with 0).") - << std::endl; - } - } - - // Keep qmoist auxiliaries ghost-consistent after either file load or fallback init. - qmoist[lev][qmoist_indices[var]]->FillBoundary(geom[lev].periodicity()); + VisMF::Read(moist_vars, amrex::MultiFabFileFullPrefix(lev, restart_chkfile, "Level_", qmoist_names[var])); + MultiFab::Copy(*(qmoist[lev][qmoist_indices[var]]),moist_vars,0,0,ncomp,ng_moist); } #if defined(ERF_USE_WINDFARM) diff --git a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp index 9502e720da..56c6260b92 100644 --- a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp @@ -9,6 +9,7 @@ using namespace amrex; +#ifdef ERF_USE_WSM6_FORT namespace { struct MPDbgVarStats { @@ -91,6 +92,7 @@ mark_zvel_nan (MPDbgVarStats& s) } } // namespace +#endif void WSM6::Advance(const Real& dt_advance, From 5f6d5057854d8dc5d8191cf7c6603f65fe727f8a Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Mon, 6 Apr 2026 12:01:51 -0700 Subject: [PATCH 19/20] WSM6: remove remaining microphysics debug print paths --- Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp | 262 ------------------- 1 file changed, 262 deletions(-) diff --git a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp index 56c6260b92..a5c146438a 100644 --- a/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp +++ b/Source/Microphysics/WSM6/ERF_AdvanceWSM6.cpp @@ -1,99 +1,9 @@ #include "ERF_WSM6.H" #include "ERF_WSM6_Fortran_Interface.H" -#include -#include -#include #include -#include -#include using namespace amrex; -#ifdef ERF_USE_WSM6_FORT -namespace { - -struct MPDbgVarStats { - double min = std::numeric_limits::infinity(); - double max = -std::numeric_limits::infinity(); - double l1 = 0.0; - long long n = 0; -}; - -struct MPDbgStats { - MPDbgVarStats qrain; - MPDbgVarStats qc; - MPDbgVarStats rhoQ2; - MPDbgVarStats qsnow; - MPDbgVarStats qgraup; - MPDbgVarStats zvel; -}; - -inline void -update_stat (MPDbgVarStats& s, double v) -{ - s.min = std::min(s.min, v); - s.max = std::max(s.max, v); - s.l1 += std::abs(v); - s.n += 1; -} - -inline void -reduce_stat (MPDbgVarStats& s) -{ - ParallelDescriptor::ReduceRealMin(s.min); - ParallelDescriptor::ReduceRealMax(s.max); - ParallelDescriptor::ReduceRealSum(s.l1); - amrex::Long n = static_cast(s.n); - ParallelDescriptor::ReduceLongSum(n); - s.n = static_cast(n); -} - -inline void -reduce_stats (MPDbgStats& s) -{ - reduce_stat(s.qrain); - reduce_stat(s.qc); - reduce_stat(s.rhoQ2); - reduce_stat(s.qsnow); - reduce_stat(s.qgraup); - reduce_stat(s.zvel); -} - -inline void -print_stats (const char* tag, const char* model, int step, const MPDbgStats& s) -{ - if (!ParallelDescriptor::IOProcessor()) { return; } - std::printf( - "%s %s step=%04d " - "qrain_min=%.12e qrain_max=%.12e qrain_L1=%.12e " - "qc_min=%.12e qc_max=%.12e qc_L1=%.12e " - "rhoQ2_min=%.12e rhoQ2_max=%.12e rhoQ2_L1=%.12e " - "qsnow_min=%.12e qsnow_max=%.12e qsnow_L1=%.12e " - "qgraup_min=%.12e qgraup_max=%.12e qgraup_L1=%.12e " - "z_velocity_min=%.12e z_velocity_max=%.12e z_velocity_L1=%.12e\n", - tag, model, step, - s.qrain.min, s.qrain.max, s.qrain.l1, - s.qc.min, s.qc.max, s.qc.l1, - s.rhoQ2.min, s.rhoQ2.max, s.rhoQ2.l1, - s.qsnow.min, s.qsnow.max, s.qsnow.l1, - s.qgraup.min, s.qgraup.max, s.qgraup.l1, - s.zvel.min, s.zvel.max, s.zvel.l1); - std::fflush(stdout); -} - -inline void -mark_zvel_nan (MPDbgVarStats& s) -{ - const double nan = std::numeric_limits::quiet_NaN(); - s.min = nan; - s.max = nan; - s.l1 = nan; - s.n = 1; -} - -} // namespace -#endif - void WSM6::Advance(const Real& dt_advance, const SolverChoice&) @@ -133,29 +43,6 @@ WSM6::Advance(const Real& dt_advance, constexpr double cice = 2106.0; constexpr double psat = 610.78; - static int mpdbg_step = 0; - ParmParse pp("erf"); - int microphysics_debug = 0; - pp.query("microphysics_debug", microphysics_debug); - microphysics_debug = std::max(0, std::min(2, microphysics_debug)); - int microphysics_debug_seam = 0; - pp.query("microphysics_debug_seam", microphysics_debug_seam); - int seam_i_lo = 94; - int seam_i_hi = 97; - int seam_j_lo = 0; - int seam_j_hi = 0; - int seam_k_lo = 0; - int seam_k_hi = 38; - pp.query("microphysics_debug_seam_i_lo", seam_i_lo); - pp.query("microphysics_debug_seam_i_hi", seam_i_hi); - pp.query("microphysics_debug_seam_j_lo", seam_j_lo); - pp.query("microphysics_debug_seam_j_hi", seam_j_hi); - pp.query("microphysics_debug_seam_k_lo", seam_k_lo); - pp.query("microphysics_debug_seam_k_hi", seam_k_hi); - - MPDbgStats pre_stats; - MPDbgStats post_stats; - for (MFIter mfi(*mic_fab_vars[MicVar_WSM6::qv], TileNoZ()); mfi.isValid(); ++mfi) { const Box box = mfi.tilebox(); const Box fab_box = mfi.fabbox(); @@ -227,75 +114,6 @@ WSM6::Advance(const Real& dt_advance, graupelncv_arr(i,j,0) = Real(0.0); }); - if (microphysics_debug > 0) { - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - const double qr = qr_arr(i,j,k); - const double qc = qc_arr(i,j,k); - const double rhoqc = den_arr(i,j,k) * qc; - const double qs = qs_arr(i,j,k); - const double qg = qg_arr(i,j,k); - update_stat(pre_stats.qrain, qr); - update_stat(pre_stats.qc, qc); - update_stat(pre_stats.rhoQ2, rhoqc); - update_stat(pre_stats.qsnow, qs); - update_stat(pre_stats.qgraup, qg); - } - } - } - } - - if (microphysics_debug > 1) { - const int rank = ParallelDescriptor::MyProc(); - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - std::printf( - "MPDBG PRE WSM6 rank=%d step=%04d i=%d j=%d k=%d " - "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e\n", - rank, mpdbg_step, i, j, k, - static_cast(qr_arr(i,j,k)), - static_cast(qc_arr(i,j,k)), - static_cast(den_arr(i,j,k) * qc_arr(i,j,k)), - static_cast(qs_arr(i,j,k)), - static_cast(qg_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } - - if (microphysics_debug_seam > 0) { - const int rank = ParallelDescriptor::MyProc(); - const int si_lo = std::max(imlo, seam_i_lo); - const int si_hi = std::min(imhi, seam_i_hi); - const int sj_lo = std::max(jmlo, seam_j_lo); - const int sj_hi = std::min(jmhi, seam_j_hi); - const int sk_lo = std::max(kmlo, seam_k_lo); - const int sk_hi = std::min(kmhi, seam_k_hi); - for (int k = sk_lo; k <= sk_hi; ++k) { - for (int j = sj_lo; j <= sj_hi; ++j) { - for (int i = si_lo; i <= si_hi; ++i) { - const int in_valid = (i >= ilo && i <= ihi && - j >= jlo && j <= jhi && - k >= klo && k <= khi) ? 1 : 0; - std::printf( - "MPDBG SEAM PRE WSM6 rank=%d step=%04d i=%d j=%d k=%d valid=%d " - "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", - rank, mpdbg_step, i, j, k, in_valid, - static_cast(qv_arr(i,j,k)), - static_cast(qc_arr(i,j,k)), - static_cast(qi_arr(i,j,k)), - static_cast(qr_arr(i,j,k)), - static_cast(qs_arr(i,j,k)), - static_cast(qg_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } - mp_wsm6_run_c( t_arr.dataPtr(), qv_arr.dataPtr(), qc_arr.dataPtr(), qi_arr.dataPtr(), @@ -314,87 +132,7 @@ WSM6::Advance(const Real& dt_advance, snow_arr(i,j,klo) = snowacc_arr(i,j,0); graup_arr(i,j,klo) = graupacc_arr(i,j,0); }); - - if (microphysics_debug > 0) { - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - const double qr = qr_arr(i,j,k); - const double qc = qc_arr(i,j,k); - const double rhoqc = den_arr(i,j,k) * qc; - const double qs = qs_arr(i,j,k); - const double qg = qg_arr(i,j,k); - update_stat(post_stats.qrain, qr); - update_stat(post_stats.qc, qc); - update_stat(post_stats.rhoQ2, rhoqc); - update_stat(post_stats.qsnow, qs); - update_stat(post_stats.qgraup, qg); - } - } - } - } - - if (microphysics_debug > 1) { - const int rank = ParallelDescriptor::MyProc(); - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - std::printf( - "MPDBG POST WSM6 rank=%d step=%04d i=%d j=%d k=%d " - "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e\n", - rank, mpdbg_step, i, j, k, - static_cast(qr_arr(i,j,k)), - static_cast(qc_arr(i,j,k)), - static_cast(den_arr(i,j,k) * qc_arr(i,j,k)), - static_cast(qs_arr(i,j,k)), - static_cast(qg_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } - - if (microphysics_debug_seam > 0) { - const int rank = ParallelDescriptor::MyProc(); - const int si_lo = std::max(imlo, seam_i_lo); - const int si_hi = std::min(imhi, seam_i_hi); - const int sj_lo = std::max(jmlo, seam_j_lo); - const int sj_hi = std::min(jmhi, seam_j_hi); - const int sk_lo = std::max(kmlo, seam_k_lo); - const int sk_hi = std::min(kmhi, seam_k_hi); - for (int k = sk_lo; k <= sk_hi; ++k) { - for (int j = sj_lo; j <= sj_hi; ++j) { - for (int i = si_lo; i <= si_hi; ++i) { - const int in_valid = (i >= ilo && i <= ihi && - j >= jlo && j <= jhi && - k >= klo && k <= khi) ? 1 : 0; - std::printf( - "MPDBG SEAM POST WSM6 rank=%d step=%04d i=%d j=%d k=%d valid=%d " - "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", - rank, mpdbg_step, i, j, k, in_valid, - static_cast(qv_arr(i,j,k)), - static_cast(qc_arr(i,j,k)), - static_cast(qi_arr(i,j,k)), - static_cast(qr_arr(i,j,k)), - static_cast(qs_arr(i,j,k)), - static_cast(qg_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } - } - - if (microphysics_debug > 0) { - mark_zvel_nan(pre_stats.zvel); - mark_zvel_nan(post_stats.zvel); - reduce_stats(pre_stats); - reduce_stats(post_stats); - print_stats("MPDBG PRE", "WSM6", mpdbg_step, pre_stats); - print_stats("MPDBG POST", "WSM6", mpdbg_step, post_stats); - print_stats("MPDBG STEP", "WSM6", mpdbg_step, post_stats); } - ++mpdbg_step; #else amrex::Abort("WSM6 Fortran bridge requested but ERF was not built with ERF_USE_WSM6_FORT"); #endif From 0e3749e63163ed106546fb98e82d30dc45419a2c Mon Sep 17 00:00:00 2001 From: "Jean M. Sexton" Date: Mon, 6 Apr 2026 13:49:32 -0700 Subject: [PATCH 20/20] Morrison: remove microphysics debug print paths --- .../Morrison/ERF_AdvanceMorrison.cpp | 245 +----------------- 1 file changed, 6 insertions(+), 239 deletions(-) diff --git a/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp b/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp index 7a83ac746d..bfa8c32169 100644 --- a/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp +++ b/Source/Microphysics/Morrison/ERF_AdvanceMorrison.cpp @@ -3,16 +3,12 @@ #include #include #include -#include -#include #include #include #include #include #include -#include -#include #include "ERF.H" #include "ERF_Constants.H" @@ -335,7 +331,6 @@ amrex::Real wrf_gamma (amrex::Real x) res = xinf; return res; } - } // Argument is positive @@ -351,7 +346,6 @@ amrex::Real wrf_gamma (amrex::Real x) res = xinf; return res; } - } else if (y < twelve) { // Medium range argument @@ -396,7 +390,6 @@ amrex::Real wrf_gamma (amrex::Real x) // printf("wrf_gamma: Multiplication %d: res = %g, y = %g\n", i+1, res, y); } } - } else { // Large argument @@ -533,73 +526,6 @@ AMREX_GPU_HOST_DEVICE AMREX_FORCE_INLINE Real m_ndcnst = Real(250.0); // Droplet number concentration (cm^-3) pp.query("morrison_ndcnst", m_ndcnst); - static int mpdbg_step = 0; - int microphysics_debug = 0; - pp.query("microphysics_debug", microphysics_debug); - microphysics_debug = std::max(0, std::min(2, microphysics_debug)); - int microphysics_debug_seam = 0; - pp.query("microphysics_debug_seam", microphysics_debug_seam); - int seam_i_lo = 94; - int seam_i_hi = 97; - int seam_j_lo = 0; - int seam_j_hi = 0; - int seam_k_lo = 0; - int seam_k_hi = 38; - pp.query("microphysics_debug_seam_i_lo", seam_i_lo); - pp.query("microphysics_debug_seam_i_hi", seam_i_hi); - pp.query("microphysics_debug_seam_j_lo", seam_j_lo); - pp.query("microphysics_debug_seam_j_hi", seam_j_hi); - pp.query("microphysics_debug_seam_k_lo", seam_k_lo); - pp.query("microphysics_debug_seam_k_hi", seam_k_hi); - - struct MPDbgVarStats { - double min = std::numeric_limits::infinity(); - double max = -std::numeric_limits::infinity(); - double l1 = 0.0; - long long n = 0; - }; - struct MPDbgStats { - MPDbgVarStats qrain, qc, rhoQ2, qsnow, qgraup, zvel; - }; - auto update_stat = [](MPDbgVarStats& s, double v) { - s.min = std::min(s.min, v); - s.max = std::max(s.max, v); - s.l1 += std::abs(v); - s.n += 1; - }; - auto reduce_stat = [](MPDbgVarStats& s) { - ParallelDescriptor::ReduceRealMin(s.min); - ParallelDescriptor::ReduceRealMax(s.max); - ParallelDescriptor::ReduceRealSum(s.l1); - amrex::Long n = static_cast(s.n); - ParallelDescriptor::ReduceLongSum(n); - s.n = static_cast(n); - }; - auto reduce_stats = [&](MPDbgStats& s) { - reduce_stat(s.qrain); reduce_stat(s.qc); reduce_stat(s.rhoQ2); - reduce_stat(s.qsnow); reduce_stat(s.qgraup); reduce_stat(s.zvel); - }; - auto print_stats = [](const char* tag, int step, const MPDbgStats& s) { - if (!ParallelDescriptor::IOProcessor()) return; - std::printf( - "%s MORR step=%04d " - "qrain_min=%.12e qrain_max=%.12e qrain_L1=%.12e " - "qc_min=%.12e qc_max=%.12e qc_L1=%.12e " - "rhoQ2_min=%.12e rhoQ2_max=%.12e rhoQ2_L1=%.12e " - "qsnow_min=%.12e qsnow_max=%.12e qsnow_L1=%.12e " - "qgraup_min=%.12e qgraup_max=%.12e qgraup_L1=%.12e " - "z_velocity_min=%.12e z_velocity_max=%.12e z_velocity_L1=%.12e\n", - tag, step, - s.qrain.min, s.qrain.max, s.qrain.l1, - s.qc.min, s.qc.max, s.qc.l1, - s.rhoQ2.min, s.rhoQ2.max, s.rhoQ2.l1, - s.qsnow.min, s.qsnow.max, s.qsnow.l1, - s.qgraup.min, s.qgraup.max, s.qgraup.l1, - s.zvel.min, s.zvel.max, s.zvel.l1); - std::fflush(stdout); - }; - MPDbgStats pre_stats, post_stats; - // Loop through the grids for (MFIter mfi(*mic_fab_vars[MicVar_Morr::qcl],TileNoZ()); mfi.isValid(); ++mfi) { @@ -649,93 +575,15 @@ AMREX_GPU_HOST_DEVICE AMREX_FORCE_INLINE const int jhi = box.hiVect()[1]; const int klo = box.loVect()[2]; const int khi = box.hiVect()[2]; - const Box fab_box = mfi.fabbox(); - const int imlo = fab_box.loVect()[0]; - const int ihim = fab_box.hiVect()[0]; - const int jmlo = fab_box.loVect()[1]; - const int jmhi = fab_box.hiVect()[1]; - const int kmlo = fab_box.loVect()[2]; - const int kmhi = fab_box.hiVect()[2]; - - if (microphysics_debug > 0) { - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - const double qr = qpr_arr(i,j,k); - const double qc = qcl_arr(i,j,k); - const double rhoqc = rho_arr(i,j,k) * qc; - const double qs = qps_arr(i,j,k); - const double qg = qpg_arr(i,j,k); - const double w = w_arr(i,j,k); - update_stat(pre_stats.qrain, qr); - update_stat(pre_stats.qc, qc); - update_stat(pre_stats.rhoQ2, rhoqc); - update_stat(pre_stats.qsnow, qs); - update_stat(pre_stats.qgraup, qg); - update_stat(pre_stats.zvel, w); - } - } - } - } - - if (microphysics_debug > 1) { - const int rank = ParallelDescriptor::MyProc(); - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - std::printf( - "MPDBG PRE MORR rank=%d step=%04d i=%d j=%d k=%d " - "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e z_velocity=%.12e\n", - rank, mpdbg_step, i, j, k, - static_cast(qpr_arr(i,j,k)), - static_cast(qcl_arr(i,j,k)), - static_cast(rho_arr(i,j,k) * qcl_arr(i,j,k)), - static_cast(qps_arr(i,j,k)), - static_cast(qpg_arr(i,j,k)), - static_cast(w_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } - - if (microphysics_debug_seam > 0) { - const int rank = ParallelDescriptor::MyProc(); - const int si_lo = std::max(imlo, seam_i_lo); - const int si_hi = std::min(ihim, seam_i_hi); - const int sj_lo = std::max(jmlo, seam_j_lo); - const int sj_hi = std::min(jmhi, seam_j_hi); - const int sk_lo = std::max(kmlo, seam_k_lo); - const int sk_hi = std::min(kmhi, seam_k_hi); - for (int k = sk_lo; k <= sk_hi; ++k) { - for (int j = sj_lo; j <= sj_hi; ++j) { - for (int i = si_lo; i <= si_hi; ++i) { - const int in_valid = (i >= ilo && i <= ihi && - j >= jlo && j <= jhi && - k >= klo && k <= khi) ? 1 : 0; - std::printf( - "MPDBG SEAM PRE MORR rank=%d step=%04d i=%d j=%d k=%d valid=%d " - "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", - rank, mpdbg_step, i, j, k, in_valid, - static_cast(qv_arr(i,j,k)), - static_cast(qcl_arr(i,j,k)), - static_cast(qci_arr(i,j,k)), - static_cast(qpr_arr(i,j,k)), - static_cast(qps_arr(i,j,k)), - static_cast(qpg_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } Box grown_box(box); grown_box.grow(3); #ifdef ERF_USE_MORR_FORT - const int ilom = imlo; - const int jlom = jmlo; - const int jhim = jmhi; - const int klom = kmlo; - const int khim = kmhi; + const int ilom = grown_box.loVect()[0]; + const int ihim = grown_box.hiVect()[0]; + const int jlom = grown_box.loVect()[1]; + const int jhim = grown_box.hiVect()[1]; + const int klom = grown_box.loVect()[2]; + const int khim = grown_box.hiVect()[2]; #endif // Calculate Exner function (PII) to convert potential temperature to temperature // PII = (P/P0)^(R/cp) @@ -3822,90 +3670,9 @@ AMREX_GPU_HOST_DEVICE AMREX_FORCE_INLINE amrex::Abort("Trying to run fortran without compiling with USE_MORR_FORT=TRUE"); #endif } - - if (microphysics_debug > 0) { - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - const double qr = qpr_arr(i,j,k); - const double qc = qcl_arr(i,j,k); - const double rhoqc = rho_arr(i,j,k) * qc; - const double qs = qps_arr(i,j,k); - const double qg = qpg_arr(i,j,k); - const double w = w_arr(i,j,k); - update_stat(post_stats.qrain, qr); - update_stat(post_stats.qc, qc); - update_stat(post_stats.rhoQ2, rhoqc); - update_stat(post_stats.qsnow, qs); - update_stat(post_stats.qgraup, qg); - update_stat(post_stats.zvel, w); - } - } - } - } - - if (microphysics_debug > 1) { - const int rank = ParallelDescriptor::MyProc(); - for (int k = klo; k <= khi; ++k) { - for (int j = jlo; j <= jhi; ++j) { - for (int i = ilo; i <= ihi; ++i) { - std::printf( - "MPDBG POST MORR rank=%d step=%04d i=%d j=%d k=%d " - "qrain=%.12e qc=%.12e rhoQ2=%.12e qsnow=%.12e qgraup=%.12e z_velocity=%.12e\n", - rank, mpdbg_step, i, j, k, - static_cast(qpr_arr(i,j,k)), - static_cast(qcl_arr(i,j,k)), - static_cast(rho_arr(i,j,k) * qcl_arr(i,j,k)), - static_cast(qps_arr(i,j,k)), - static_cast(qpg_arr(i,j,k)), - static_cast(w_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } - - if (microphysics_debug_seam > 0) { - const int rank = ParallelDescriptor::MyProc(); - const int si_lo = std::max(imlo, seam_i_lo); - const int si_hi = std::min(ihim, seam_i_hi); - const int sj_lo = std::max(jmlo, seam_j_lo); - const int sj_hi = std::min(jmhi, seam_j_hi); - const int sk_lo = std::max(kmlo, seam_k_lo); - const int sk_hi = std::min(kmhi, seam_k_hi); - for (int k = sk_lo; k <= sk_hi; ++k) { - for (int j = sj_lo; j <= sj_hi; ++j) { - for (int i = si_lo; i <= si_hi; ++i) { - const int in_valid = (i >= ilo && i <= ihi && - j >= jlo && j <= jhi && - k >= klo && k <= khi) ? 1 : 0; - std::printf( - "MPDBG SEAM POST MORR rank=%d step=%04d i=%d j=%d k=%d valid=%d " - "qv=%.12e qc=%.12e qi=%.12e qrain=%.12e qsnow=%.12e qgraup=%.12e\n", - rank, mpdbg_step, i, j, k, in_valid, - static_cast(qv_arr(i,j,k)), - static_cast(qcl_arr(i,j,k)), - static_cast(qci_arr(i,j,k)), - static_cast(qpr_arr(i,j,k)), - static_cast(qps_arr(i,j,k)), - static_cast(qpg_arr(i,j,k))); - } - } - } - std::fflush(stdout); - } // amrex::Print()< 0) { - reduce_stats(pre_stats); - reduce_stats(post_stats); - print_stats("MPDBG PRE", mpdbg_step, pre_stats); - print_stats("MPDBG POST", mpdbg_step, post_stats); - print_stats("MPDBG STEP", mpdbg_step, post_stats); - } - ++mpdbg_step; }