diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml
index 9922840420..1f5a64ac56 100644
--- a/.github/workflows/coverage.yml
+++ b/.github/workflows/coverage.yml
@@ -19,19 +19,22 @@ jobs:
- uses: ./.github/actions/testing-setup
- - name: Compile unit testing
- run: make -j build/unit/MOM_unit_tests
+ - name: Compile file parser unit tests
+ run: make -j build/unit/test_MOM_file_parser
- - name: Run unit tests
+ - name: Run file parser unit tests
run: make run.cov.unit
- - name: Report unit test coverage to CI (PR)
- if: github.event_name == 'pull_request'
- run: make report.cov.unit REQUIRE_COVERAGE_UPLOAD=true
+ - name: Compile unit testing
+ run: make -j build.unit
+
+ - name: Run (single processor) unit tests
+ run: make run.unit
- - name: Report unit test coverage to CI (Push)
- if: github.event_name != 'pull_request'
+ - name: Report unit test coverage to CI
run: make report.cov.unit
+ env:
+ CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
- name: Compile ocean-only MOM6 with code coverage
run: make -j build/cov/MOM6
@@ -39,10 +42,7 @@ jobs:
- name: Run coverage tests
run: make -j -k run.cov
- - name: Report coverage to CI (PR)
- if: github.event_name == 'pull_request'
- run: make report.cov REQUIRE_COVERAGE_UPLOAD=true
-
- - name: Report coverage to CI (Push)
- if: github.event_name != 'pull_request'
+ - name: Report coverage to CI
run: make report.cov
+ env:
+ CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
diff --git a/.github/workflows/perfmon.yml b/.github/workflows/perfmon.yml
index 09b4d617a2..76140c9469 100644
--- a/.github/workflows/perfmon.yml
+++ b/.github/workflows/perfmon.yml
@@ -1,6 +1,6 @@
name: Performance Monitor
-on: [pull_request]
+on: [push, pull_request]
jobs:
build-test-perfmon:
@@ -20,6 +20,7 @@ jobs:
- uses: ./.github/actions/testing-setup
- name: Compile optimized models
+ if: ${{ github.event_name == 'pull_request' }}
run: >-
make -j build.prof
MOM_TARGET_SLUG=$GITHUB_REPOSITORY
@@ -27,12 +28,26 @@ jobs:
DO_REGRESSION_TESTS=true
- name: Generate profile data
+ if: ${{ github.event_name == 'pull_request' }}
run: >-
pip install f90nml &&
make profile
DO_REGRESSION_TESTS=true
- name: Generate perf data
+ if: ${{ github.event_name == 'pull_request' }}
run: |
sudo sysctl -w kernel.perf_event_paranoid=2
make perf DO_REGRESSION_TESTS=true
+
+ - name: Compile timing tests
+ run: |
+ make -j build.timing
+
+ - name: Run timing tests
+ run: |
+ make -j run.timing
+
+ - name: Display timing results
+ run: |
+ make -j show.timing
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 6be281c8cd..5bc90daca4 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -10,7 +10,6 @@ stages:
# We use the "fetch" strategy to speed up the startup of stages
variables:
JOB_DIR: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/builds/$CI_PIPELINE_ID"
- WORKSPACE: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/$CI_RUNNER_ID"
GIT_STRATEGY: fetch
# Always eport value of $JOB_DIR
@@ -185,9 +184,9 @@ actions:gnu:
- make -s -j
- MPIRUN= make preproc -s -j
- echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K"
- - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh
- - sbatch --clusters=c5 --nodes=2 --time=0:10:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s
- - make WORKSPACE=$WORKSPACE test.summary
+ - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh
+ - sbatch --clusters=c5 --nodes=2 --time=0:10:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make test -s
+ - make test.summary
actions:intel:
stage: tests
@@ -205,9 +204,9 @@ actions:intel:
- make -s -j
- MPIRUN= make preproc -s -j
- echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K"
- - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh
- - sbatch --clusters=c5 --nodes=2 --time=0:10:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s
- - make WORKSPACE=$WORKSPACE test.summary
+ - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh
+ - sbatch --clusters=c5 --nodes=2 --time=0:10:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make test -s
+ - make test.summary
# Tests
#
diff --git a/.readthedocs.yml b/.readthedocs.yml
index f7ad4421b4..4fe8d6300d 100644
--- a/.readthedocs.yml
+++ b/.readthedocs.yml
@@ -1,5 +1,14 @@
+# Read the Docs configuration file for Sphinx projects
+# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details
+
+# Required
version: 2
+build:
+ os: ubuntu-22.04
+ tools:
+ python: "3.11"
+
# Extra formats
# PDF generation is failing for now; disabled on 2020-12-02
#formats:
@@ -10,7 +19,5 @@ sphinx:
configuration: docs/conf.py
python:
- # make sure we're using Python 3
- version: 3
install:
- requirements: docs/requirements.txt
diff --git a/.testing/Makefile b/.testing/Makefile
index 942f44d4c3..aabe51c8b6 100644
--- a/.testing/Makefile
+++ b/.testing/Makefile
@@ -75,7 +75,7 @@ MAKEFLAGS += -R
-include config.mk
# Set the infra framework
-FRAMEWORK ?= fms1
+FRAMEWORK ?= fms2
# Set the MPI launcher here
# TODO: This needs more automated configuration
@@ -116,6 +116,9 @@ DO_PROFILE ?=
# Enable code coverage runs
DO_COVERAGE ?=
+# Enable code coverage runs
+DO_UNIT_TESTS ?=
+
# Report failure if coverage report is not uploaded
REQUIRE_COVERAGE_UPLOAD ?=
@@ -151,10 +154,16 @@ ifeq ($(DO_PROFILE), true)
BUILDS += opt/MOM6 opt_target/MOM6
endif
-# Unit testing
-UNIT_EXECS ?= MOM_unit_tests
+# Coverage
ifeq ($(DO_COVERAGE), true)
- BUILDS += cov/MOM6 $(foreach e, $(UNIT_EXECS), unit/$(e))
+ BUILDS += cov/MOM6
+endif
+
+# Unit testing (or coverage)
+UNIT_EXECS ?= $(basename $(notdir $(wildcard ../config_src/drivers/unit_tests/*.F90) ) )
+TIMING_EXECS ?= $(basename $(notdir $(wildcard ../config_src/drivers/timing_tests/*.F90) ) )
+ifneq (X$(DO_COVERAGE)$(DO_UNIT_TESTS)X, XX)
+ BUILDS += $(foreach e, $(UNIT_EXECS), unit/$(e))
endif
ifeq ($(DO_PROFILE), false)
@@ -245,31 +254,28 @@ COV_LDFLAGS := LDFLAGS="$(LDFLAGS_COVERAGE) $(LDFLAGS_DEPS) $(LDFLAGS_USER)"
# Environment variable configuration
-build/symmetric/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS)
-build/asymmetric/Makefile: MOM_ENV=$(PATH_FMS) $(ASYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) \
+MOM_ENV := $(PATH_FMS)
+build/symmetric/Makefile: MOM_ENV += $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS)
+build/asymmetric/Makefile: MOM_ENV += $(ASYMMETRIC_FCFLAGS) $(MOM_LDFLAGS) \
MOM_MEMORY=../../../config_src/memory/dynamic_nonsymmetric/MOM_memory.h
-build/repro/Makefile: MOM_ENV=$(PATH_FMS) $(REPRO_FCFLAGS) $(MOM_LDFLAGS)
-build/openmp/Makefile: MOM_ENV=$(PATH_FMS) $(OPENMP_FCFLAGS) $(MOM_LDFLAGS)
-build/target/Makefile: MOM_ENV=$(PATH_FMS) $(TARGET_FCFLAGS) $(MOM_LDFLAGS)
-build/opt/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS)
-build/opt_target/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS)
-build/coupled/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS)
-build/nuopc/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS)
-build/cov/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS)
-build/unit/Makefile: MOM_ENV=$(PATH_FMS) $(COV_FCFLAGS) $(COV_LDFLAGS)
+build/repro/Makefile: MOM_ENV += $(REPRO_FCFLAGS) $(MOM_LDFLAGS)
+build/openmp/Makefile: MOM_ENV += $(OPENMP_FCFLAGS) $(MOM_LDFLAGS)
+build/target/Makefile: MOM_ENV += $(TARGET_FCFLAGS) $(MOM_LDFLAGS)
+build/opt/Makefile: MOM_ENV += $(OPT_FCFLAGS) $(MOM_LDFLAGS)
+build/opt_target/Makefile: MOM_ENV += $(OPT_FCFLAGS) $(MOM_LDFLAGS)
+build/coupled/Makefile: MOM_ENV += $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS)
+build/nuopc/Makefile: MOM_ENV += $(SYMMETRIC_FCFLAGS) $(MOM_LDFLAGS)
+build/cov/Makefile: MOM_ENV += $(COV_FCFLAGS) $(COV_LDFLAGS)
+build/unit/Makefile: MOM_ENV += $(COV_FCFLAGS) $(COV_LDFLAGS)
+build/timing/Makefile: MOM_ENV += $(OPT_FCFLAGS) $(MOM_LDFLAGS)
# Configure script flags
-build/symmetric/Makefile: MOM_ACFLAGS=
-build/asymmetric/Makefile: MOM_ACFLAGS=
-build/repro/Makefile: MOM_ACFLAGS=
-build/openmp/Makefile: MOM_ACFLAGS=--enable-openmp
-build/target/Makefile: MOM_ACFLAGS=
-build/opt/Makefile: MOM_ACFLAGS=
-build/opt_target/Makefile: MOM_ACFLAGS=
-build/coupled/Makefile: MOM_ACFLAGS=--with-driver=FMS_cap
-build/nuopc/Makefile: MOM_ACFLAGS=--with-driver=nuopc_cap
-build/cov/Makefile: MOM_ACFLAGS=
-build/unit/Makefile: MOM_ACFLAGS=--with-driver=unit_tests
+MOM_ACFLAGS := --with-framework=$(FRAMEWORK)
+build/openmp/Makefile: MOM_ACFLAGS += --enable-openmp
+build/coupled/Makefile: MOM_ACFLAGS += --with-driver=FMS_cap
+build/nuopc/Makefile: MOM_ACFLAGS += --with-driver=nuopc_cap
+build/unit/Makefile: MOM_ACFLAGS += --with-driver=unit_tests
+build/timing/Makefile: MOM_ACFLAGS += --with-driver=timing_tests
# Fetch regression target source code
build/target/Makefile: | $(TARGET_CODEBASE)
@@ -277,17 +283,19 @@ build/opt_target/Makefile: | $(TARGET_CODEBASE)
# Define source code dependencies
-# NOTE: ./configure is too much, but Makefile is not enough!
-# Ideally we only want to re-run both Makefile and mkmf, but the mkmf call
-# is inside ./configure, so we must re-run ./configure as well.
build/target_codebase/configure: $(TARGET_SOURCE)
# Build executables
-$(foreach e,$(UNIT_EXECS),build/unit/$(e)): build/unit/Makefile $(MOM_SOURCE)
- cd $(@D) && $(TIME) $(MAKE) -j
-build/%/MOM6: build/%/Makefile $(MOM_SOURCE)
- cd $(@D) && $(TIME) $(MAKE) -j
+build/unit/test_%: build/unit/Makefile FORCE
+ cd $(@D) && $(TIME) $(MAKE) $(@F) -j
+build/unit/Makefile: $(foreach e,$(UNIT_EXECS),../config_src/drivers/unit_tests/$(e).F90)
+build/timing/time_%: build/timing/Makefile FORCE
+ cd $(@D) && $(TIME) $(MAKE) $(@F) -j
+build/timing/Makefile: $(foreach e,$(TIMING_EXECS),../config_src/drivers/timing_tests/$(e).F90)
+build/%/MOM6: build/%/Makefile FORCE
+ cd $(@D) && $(TIME) $(MAKE) $(@F) -j
+FORCE: ;
# Use autoconf to construct the Makefile for each target
@@ -295,8 +303,8 @@ build/%/MOM6: build/%/Makefile $(MOM_SOURCE)
build/%/Makefile: ../ac/configure ../ac/Makefile.in deps/lib/libFMS.a
mkdir -p $(@D)
cd $(@D) \
- && $(MOM_ENV) ../../../ac/configure $(MOM_ACFLAGS) --with-framework=$(FRAMEWORK) \
- || (cat config.log && false)
+ && $(MOM_ENV) ../../../ac/configure $(MOM_ACFLAGS) \
+ || (cat config.log && false)
../ac/configure: ../ac/configure.ac ../ac/m4
@@ -308,8 +316,8 @@ build/target/Makefile build/opt_target/Makefile: \
$(TARGET_CODEBASE)/ac/configure deps/lib/libFMS.a
mkdir -p $(@D)
cd $(@D) \
- && $(MOM_ENV) ../../$(TARGET_CODEBASE)/ac/configure $(MOM_ACFLAGS) \
- || (cat config.log && false)
+ && $(MOM_ENV) ../../$(TARGET_CODEBASE)/ac/configure $(MOM_ACFLAGS) \
+ || (cat config.log && false)
$(TARGET_CODEBASE)/ac/configure: $(TARGET_CODEBASE)
@@ -547,8 +555,8 @@ $(WORKSPACE)/work/%/$(1)/ocean.stats $(WORKSPACE)/work/%/$(1)/chksum_diag: build
&& $(TIME) $(5) $(MPIRUN) -n $(6) $(abspath $$<) 2> std.err > std.out \
|| !( \
mkdir -p ../../../results/$$*/ ; \
- cat std.out | tee ../../../results/$$*/std.$(1).out | tail -n 20 ; \
- cat std.err | tee ../../../results/$$*/std.$(1).err | tail -n 20 ; \
+ cat std.out | tee ../../../results/$$*/std.$(1).out | tail -n 40 ; \
+ cat std.err | tee ../../../results/$$*/std.$(1).err | tail -n 40 ; \
rm ocean.stats chksum_diag ; \
echo -e "$(FAIL): $$*.$(1) failed at runtime." \
)
@@ -564,13 +572,21 @@ endef
# Upload coverage reports
CODECOV_UPLOADER_URL ?= https://uploader.codecov.io/latest/linux/codecov
+CODECOV_TOKEN ?=
+
+ifdef CODECOV_TOKEN
+ CODECOV_TOKEN_ARG = -t $(CODECOV_TOKEN)
+else
+ CODECOV_TOKEN_ARG =
+endif
+
codecov:
curl -s $(CODECOV_UPLOADER_URL) -o $@
chmod +x codecov
.PHONY: report.cov
report.cov: run.cov codecov
- ./codecov -R build/cov -Z -f "*.gcov" \
+ ./codecov $(CODECOV_TOKEN_ARG) -R build/cov -Z -f "*.gcov" \
> build/cov/codecov.out \
2> build/cov/codecov.err \
&& echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" \
@@ -623,8 +639,8 @@ $(WORKSPACE)/work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc
# Run the first half-period
cd $(@D) && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std1.err > std1.out \
|| !( \
- cat std1.out | tee ../../../results/$*/std.restart1.out | tail -n 20 ; \
- cat std1.err | tee ../../../results/$*/std.restart1.err | tail -n 20 ; \
+ cat std1.out | tee ../../../results/$*/std.restart1.out | tail -n 40 ; \
+ cat std1.err | tee ../../../results/$*/std.restart1.err | tail -n 40 ; \
echo -e "$(FAIL): $*.restart failed at runtime." \
)
# Setup the next inputs
@@ -634,8 +650,8 @@ $(WORKSPACE)/work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc
# Run the second half-period
cd $(@D) && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std2.err > std2.out \
|| !( \
- cat std2.out | tee ../../../results/$*/std.restart2.out | tail -n 20 ; \
- cat std2.err | tee ../../../results/$*/std.restart2.err | tail -n 20 ; \
+ cat std2.out | tee ../../../results/$*/std.restart2.out | tail -n 40 ; \
+ cat std2.err | tee ../../../results/$*/std.restart2.err | tail -n 40 ; \
echo -e "$(FAIL): $*.restart failed at runtime." \
)
@@ -645,26 +661,7 @@ $(WORKSPACE)/work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc
# Not a true rule; only call this after `make test` to summarize test results.
.PHONY: test.summary
test.summary:
- @if ls $(WORKSPACE)/results/*/* &> /dev/null; then \
- if ls $(WORKSPACE)/results/*/std.*.err &> /dev/null; then \
- echo "The following tests failed to complete:" ; \
- ls $(WORKSPACE)/results/*/std.*.out \
- | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[2]; if(length(t)>3) v=v"."t[3]; print a[2],":",v}'; \
- fi; \
- if ls $(WORKSPACE)/results/*/ocean.stats.*.diff &> /dev/null; then \
- echo "The following tests report solution regressions:" ; \
- ls $(WORKSPACE)/results/*/ocean.stats.*.diff \
- | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[3]; if(length(t)>4) v=v"."t[4]; print a[2],":",v}'; \
- fi; \
- if ls $(WORKSPACE)/results/*/chksum_diag.*.diff &> /dev/null; then \
- echo "The following tests report diagnostic regressions:" ; \
- ls $(WORKSPACE)/results/*/chksum_diag.*.diff \
- | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[2]; if(length(t)>3) v=v"."t[3]; print a[2],":",v}'; \
- fi; \
- false ; \
- else \
- echo -e "$(PASS): All tests passed!"; \
- fi
+ @./tools/report_test_results.sh $(WORKSPACE)/results
#---
@@ -674,35 +671,54 @@ test.summary:
.PHONY: run.cov.unit
run.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov
-$(WORKSPACE)/work/unit/std.out: build/unit/MOM_unit_tests
+.PHONY: build.unit
+build.unit: $(foreach f, $(UNIT_EXECS), build/unit/$(f))
+.PHONY: run.unit
+run.unit: $(foreach f, $(UNIT_EXECS), work/unit/$(f).out)
+.PHONY: build.timing
+build.timing: $(foreach f, $(TIMING_EXECS), build/timing/$(f))
+.PHONY: run.timing
+run.timing: $(foreach f, $(TIMING_EXECS), work/timing/$(f).out)
+.PHONY: show.timing
+show.timing: $(foreach f, $(TIMING_EXECS), work/timing/$(f).show)
+$(WORKSPACE)/work/timing/%.show:
+ ./tools/disp_timing.py $(@:.show=.out)
+
+# General rule to run a unit test executable
+# Pattern is to run build/unit/executable and direct output to executable.out
+$(WORKSPACE)/work/unit/%.out: build/unit/%
+ @mkdir -p $(@D)
+ cd $(@D) ; $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> >(tee $*.err) > $*.out
+
+$(WORKSPACE)/work/unit/test_MOM_file_parser.out: build/unit/test_MOM_file_parser
if [ $(REPORT_COVERAGE) ]; then \
find build/unit -name *.gcda -exec rm -f '{}' \; ; \
fi
- rm -rf $(@D)
mkdir -p $(@D)
cd $(@D) \
- && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std.err > std.out \
+ && rm -f input.nml logfile.0000*.out *_input MOM_parameter_doc.* \
+ && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> test_MOM_file_parser.err > test_MOM_file_parser.out \
|| !( \
- cat std.out | tail -n 100 ; \
- cat std.err | tail -n 100 ; \
+ cat test_MOM_file_parser.out | tail -n 100 ; \
+ cat test_MOM_file_parser.err | tail -n 100 ; \
)
cd $(@D) \
- && $(TIME) $(MPIRUN) -n 2 $(abspath $<) 2> p2.std.err > p2.std.out \
+ && $(TIME) $(MPIRUN) -n 2 $(abspath $<) 2> p2.test_MOM_file_parser.err > p2.test_MOM_file_parser.out \
|| !( \
- cat p2.std.out | tail -n 100 ; \
- cat p2.std.err | tail -n 100 ; \
+ cat p2.test_MOM_file_parser.out | tail -n 100 ; \
+ cat p2.test_MOM_file_parser.err | tail -n 100 ; \
)
# NOTE: .gcov actually depends on .gcda, but .gcda is produced with std.out
# TODO: Replace $(WORKSPACE)/work/unit/std.out with *.gcda?
-build/unit/MOM_file_parser_tests.F90.gcov: $(WORKSPACE)/work/unit/std.out
+build/unit/MOM_file_parser_tests.F90.gcov: $(WORKSPACE)/work/unit/test_MOM_file_parser.out
cd $(@D) \
&& gcov -b *.gcda > gcov.unit.out
find $(@D) -name "*.gcov" -exec sed -i -r 's/^( *[0-9]*)\*:/ \1:/g' {} \;
.PHONY: report.cov.unit
report.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov codecov
- ./codecov -R build/unit -f "*.gcov" -Z -n "Unit tests" \
+ ./codecov $(CODECOV_TOKEN_ARG) -R build/unit -f "*.gcov" -Z -n "Unit tests" \
> build/unit/codecov.out \
2> build/unit/codecov.err \
&& echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" \
@@ -712,6 +728,10 @@ report.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov codecov
if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \
}
+$(WORKSPACE)/work/timing/%.out: build/timing/% FORCE
+ @mkdir -p $(@D)
+ @echo Running $< in $(@D)
+ @cd $(@D) ; $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> $*.err > $*.out
#---
# Profiling based on FMS clocks
diff --git a/.testing/README.rst b/.testing/README.rst
index 5bab076707..49103da718 100644
--- a/.testing/README.rst
+++ b/.testing/README.rst
@@ -22,6 +22,17 @@ Usage
``make clean``
Delete the MOM6 test executables and dependency builds (FMS).
+``make -j build.unit``
+ Build the unit test programs in config_src/drivers/unit_tests
+
+``make -j run.unit``
+ Run the unit test programs from config_src/drivers/unit_tests in $(WORKSPACE)/work/unit
+
+``make -j build.timing``
+ Build the timing test programs in config_src/drivers/timing_tests
+
+``make -j run.timing``
+ Run the timing test programs from config_src/drivers/timing_tests in $(WORKSPACE)/work/timing
Configuration
=============
diff --git a/.testing/tc3/MOM_input b/.testing/tc3/MOM_input
index a034960d1e..6963feee98 100644
--- a/.testing/tc3/MOM_input
+++ b/.testing/tc3/MOM_input
@@ -283,10 +283,10 @@ HMIX_FIXED = 20.0 ! [m]
KV = 1.0E-04 ! [m2 s-1]
! The background kinematic viscosity in the interior.
! The molecular value, ~1e-6 m2 s-1, may be used.
-KVML = 0.01 ! [m2 s-1] default = 1.0E-04
- ! The kinematic viscosity in the mixed layer. A typical
- ! value is ~1e-2 m2 s-1. KVML is not used if
- ! BULKMIXEDLAYER is true. The default is set by KV.
+KV_ML_INVZ2 = 0.01 ! [m2 s-1] default = 0.0
+ ! An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, with
+ ! the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the distance
+ ! from the surface, to allow for finite wind stresses to be transmitted through.
HBBL = 10.0 ! [m]
! The thickness of a bottom boundary layer with a
! viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or
diff --git a/.testing/tools/disp_timing.py b/.testing/tools/disp_timing.py
new file mode 100755
index 0000000000..ac90ef2b55
--- /dev/null
+++ b/.testing/tools/disp_timing.py
@@ -0,0 +1,133 @@
+#!/usr/bin/env python3
+
+from __future__ import print_function
+
+import argparse
+import json
+import math
+
+scale = 1e6 # micro-seconds (should make this dynamic)
+
+
+def display_timing_file(file, show_all):
+ """Parse a JSON file of timing results and pretty-print the results"""
+
+ with open(file) as json_file:
+ timing_dict = json.load(json_file)
+
+ print("(Times measured in %5.0e seconds)" % (1./scale))
+ print(" Min time Module & function")
+ for sub in timing_dict.keys():
+ tmin = timing_dict[sub]['min'] * scale
+ print("%10.4e %s" % (tmin, sub))
+
+ if show_all:
+ tmean = timing_dict[sub]['mean'] * scale
+ tmax = timing_dict[sub]['max'] * scale
+ tstd = timing_dict[sub]['std'] * scale
+ nsamp = timing_dict[sub]['n_samples']
+ tsstd = tstd / math.sqrt(nsamp)
+ print(" (" +
+ "mean = %10.4e " % (tmean) +
+ "±%7.1e, " % (tsstd) +
+ "max = %10.4e, " % (tmax) +
+ "std = %8.2e, " % (tstd) +
+ "# = %d)" % (nsamp))
+
+
+def compare_timing_files(file, ref, show_all, significance_threshold):
+ """Read and compare two JSON files of timing results"""
+
+ with open(file) as json_file:
+ timing_dict = json.load(json_file)
+
+ with open(ref) as json_file:
+ ref_dict = json.load(json_file)
+
+ print("(Times measured in %5.0e seconds)" % (1./scale))
+ print(" Delta (%) Module & function")
+ for sub in {**ref_dict, **timing_dict}.keys():
+ T1 = ref_dict.get(sub)
+ T2 = timing_dict.get(sub)
+ if T1 is not None:
+ # stats for reference (old)
+ tmin1 = T1['min'] * scale
+ tmean1 = T1['mean'] * scale
+ if T2 is not None:
+ # stats for reference (old)
+ tmin2 = T2['min'] * scale
+ tmean2 = T2['mean'] * scale
+ if (T1 is not None) and (T2 is not None):
+ # change in actual minimum as percentage of old
+ dt = (tmin2 - tmin1) * 100 / tmin1
+ if dt < -significance_threshold:
+ color = '\033[92m'
+ elif dt > significance_threshold:
+ color = '\033[91m'
+ else:
+ color = ''
+ print("%s%+10.4f%%\033[0m %s" % (color, dt, sub))
+ else:
+ if T2 is None:
+ print(" removed %s" % (sub))
+ else:
+ print(" added %s" % (sub))
+
+ if show_all:
+ if T2 is None:
+ print(" --")
+ else:
+ tmax2 = T2['max'] * scale
+ tstd2 = T2['std'] * scale
+ n2 = T2['n_samples']
+ tsstd2 = tstd2 / math.sqrt(n2)
+ print(" %10.4e (" % (tmin2) +
+ "mean = %10.4e " % (tmean2) +
+ "±%7.1e, " % (tsstd2) +
+ "max=%10.4e, " % (tmax2) +
+ "std=%8.2e, " % (tstd2) +
+ "# = %d)" % (n2))
+ if T1 is None:
+ print(" --")
+ else:
+ tmax1 = T1['max'] * scale
+ tstd1 = T1['std'] * scale
+ n1 = T1['n_samples']
+ tsstd1 = tstd1 / math.sqrt(n1)
+ print(" %10.4e (" % (tmin1) +
+ "mean = %10.4e " % (tmean1) +
+ "±%7.1e, " % (tsstd1) +
+ "max=%10.4e, " % (tmax1) +
+ "std=%8.2e, " % (tstd1) +
+ "# = %d)" % (n1))
+
+
+# Parse arguments
+parser = argparse.ArgumentParser(
+ description="Beautify timing output from MOM6 timing tests."
+)
+parser.add_argument(
+ 'file',
+ help="File to process."
+)
+parser.add_argument(
+ '-a', '--all',
+ action='store_true',
+ help="Display all metrics rather than just the minimum time."
+)
+parser.add_argument(
+ '-t', '--threshold',
+ default=6.0, type=float,
+ help="Significance threshold to flag (percentage)."
+)
+parser.add_argument(
+ '-r', '--reference',
+ help="Reference file to compare against."
+)
+args = parser.parse_args()
+
+# Do the thing
+if args.reference is None:
+ display_timing_file(args.file, args.all)
+else:
+ compare_timing_files(args.file, args.reference, args.all, args.threshold)
diff --git a/.testing/tools/report_test_results.sh b/.testing/tools/report_test_results.sh
new file mode 100755
index 0000000000..24bab45507
--- /dev/null
+++ b/.testing/tools/report_test_results.sh
@@ -0,0 +1,42 @@
+#!/bin/sh
+RESULTS=${1:-${PWD}/results}
+
+GREEN="\033[0;32m"
+RESET="\033[0m"
+PASS="${GREEN}PASS${RESET}"
+
+if [ -d ${RESULTS} ]; then
+ if ls ${RESULTS}/*/std.*.err &> /dev/null; then
+ echo "The following tests failed to complete:"
+ ls ${RESULTS}/*/std.*.out \
+ | awk '{ \
+ split($$0,a,"/"); \
+ split(a[length(a)],t,"."); \
+ v=t[2]; \
+ if(length(t)>4) v=v"."t[4]; print a[length(a)-1],":",v}'
+ fi
+
+ if ls ${RESULTS}/*/ocean.stats.*.diff &> /dev/null; then
+ echo "The following tests report solution regressions:"
+ ls ${RESULTS}/*/ocean.stats.*.diff \
+ | awk '{ \
+ split($$0,a,"/"); \
+ split(a[length(a)],t,"."); \
+ v=t[3]; \
+ if(length(t)>4) v=v"."t[4]; print a[length(a)-1],":",v}'
+ fi
+
+ if ls ${RESULTS}/*/chksum_diag.*.diff &> /dev/null; then
+ echo "The following tests report diagnostic regressions:"
+ ls ${RESULTS}/*/chksum_diag.*.diff \
+ | awk '{ \
+ split($$0,a,"/"); \
+ split(a[length(a)],t,"."); \
+ v=t[2]; \
+ if(length(t)>4) v=v"."t[4]; print a[length(a)-1],":",v}'
+ fi
+
+ exit 1
+else
+ printf "${PASS}: All tests passed!\n"
+fi
diff --git a/ac/Makefile.in b/ac/Makefile.in
index 43262027e6..64a60e70d1 100644
--- a/ac/Makefile.in
+++ b/ac/Makefile.in
@@ -56,3 +56,4 @@ ac-clean: distclean
rm -f @srcdir@/ac/aclocal.m4
rm -rf @srcdir@/ac/autom4te.cache
rm -f @srcdir@/ac/configure
+ rm -f @srcdir@/ac/configure~
diff --git a/ac/configure.ac b/ac/configure.ac
index 7ea1870816..9d87240506 100644
--- a/ac/configure.ac
+++ b/ac/configure.ac
@@ -238,8 +238,13 @@ AC_COMPILE_IFELSE(
# Python interpreter test
+# Declare the Python interpreter variable
AC_ARG_VAR([PYTHON], [Python interpreter command])
+# If PYTHON is set to an empty string, then unset it
+AS_VAR_IF([PYTHON], [], [AS_UNSET([PYTHON])], [])
+
+# Now attempt to find a Python interpreter if PYTHON is unset
AS_VAR_SET_IF([PYTHON], [
AC_PATH_PROGS([PYTHON], ["$PYTHON"], [none])
], [
diff --git a/ac/deps/Makefile b/ac/deps/Makefile
index 3263dde678..01431cef8c 100644
--- a/ac/deps/Makefile
+++ b/ac/deps/Makefile
@@ -8,7 +8,7 @@ MAKEFLAGS += -R
# FMS framework
FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git
-FMS_COMMIT ?= 2019.01.03
+FMS_COMMIT ?= 2023.03
# List of source files to link this Makefile's dependencies to model Makefiles
diff --git a/ac/deps/Makefile.fms.in b/ac/deps/Makefile.fms.in
index caf4abb9c7..71c46f082a 100644
--- a/ac/deps/Makefile.fms.in
+++ b/ac/deps/Makefile.fms.in
@@ -23,4 +23,4 @@ ARFLAGS = @ARFLAGS@
.PHONY: depend
depend: Makefile.dep
Makefile.dep:
- $(PYTHON) $(MAKEDEP) -o Makefile.dep -e -x libFMS.a @srcdir@
+ $(PYTHON) $(MAKEDEP) -o Makefile.dep -e -x libFMS.a -s @srcdir@/test_fms @srcdir@
diff --git a/ac/deps/m4/ax_fc_check_c_lib.m4 b/ac/deps/m4/ax_fc_check_c_lib.m4
new file mode 100644
index 0000000000..af5765282a
--- /dev/null
+++ b/ac/deps/m4/ax_fc_check_c_lib.m4
@@ -0,0 +1,45 @@
+dnl AX_FC_CHECK_C_LIB(LIBRARY, FUNCTION,
+dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND],
+dnl [OTHER-LDFLAGS], [OTHER-LIBS])
+dnl
+dnl This macro checks if a C library can be referenced by a Fortran compiler.
+dnl
+dnl Results are cached in `ax_fc_cv_c_lib_LIBRARY_FUNCTION`.
+dnl
+dnl NOTE: Might be possible to rewrite this to use `AX_FC_CHECK_BIND_C`.
+dnl
+AC_DEFUN([AX_FC_CHECK_C_LIB], [
+ AS_VAR_PUSHDEF([ax_fc_C_Lib], [ax_fc_cv_c_lib_$1_$2])
+ m4_ifval([$5],
+ [ax_fc_c_lib_msg_LDFLAGS=" with $5"],
+ [ax_fc_c_lib_msg_LDFLAGS=""]
+ )
+ AC_CACHE_CHECK(
+ [for $2 in -l$1$ax_fc_c_lib_msg_LDFLAGS], [ax_fc_cv_c_lib_$1_$2], [
+ ax_fc_check_c_lib_save_LDFLAGS=$LDFLAGS
+ LDFLAGS="$6 $LDFLAGS"
+ ax_fc_check_c_lib_save_LIBS=$LIBS
+ LIBS="-l$1 $7 $LIBS"
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([],[dnl
+dnl begin code block
+ interface
+ subroutine test() bind(c, name="$2")
+ end subroutine test
+ end interface
+ call test])
+dnl end code block
+ ],
+ [AS_VAR_SET([ax_fc_C_Lib], [yes])],
+ [AS_VAR_SET([ax_fc_C_Lib], [no])]
+ )
+ LDFLAGS=$ax_fc_check_c_lib_save_LDFLAGS
+ LIBS=$ax_fc_check_c_lib_save_LIBS
+ ]
+ )
+ AS_VAR_IF([ax_fc_C_Lib], [yes],
+ [m4_default([$3], [LIBS="-l$1 $LIBS"])],
+ [$4]
+ )
+ AS_VAR_POPDEF([ax_fc_C_Lib])
+])
diff --git a/ac/deps/m4/ax_fc_check_lib.m4 b/ac/deps/m4/ax_fc_check_lib.m4
index c0accab6cd..a7f848cd60 100644
--- a/ac/deps/m4/ax_fc_check_lib.m4
+++ b/ac/deps/m4/ax_fc_check_lib.m4
@@ -18,7 +18,7 @@ dnl library with different -L flags, or perhaps other ld configurations.
dnl
dnl Results are cached in the ax_fc_cv_lib_LIBRARY_FUNCTION variable.
dnl
-AC_DEFUN([AX_FC_CHECK_LIB],[dnl
+AC_DEFUN([AX_FC_CHECK_LIB],[
AS_VAR_PUSHDEF([ax_fc_Lib], [ax_fc_cv_lib_$1_$2])
m4_ifval([$6],
[ax_fc_lib_msg_LDFLAGS=" with $6"],
@@ -29,14 +29,15 @@ AC_DEFUN([AX_FC_CHECK_LIB],[dnl
LDFLAGS="$6 $LDFLAGS"
ax_fc_check_lib_save_LIBS=$LIBS
LIBS="-l$1 $7 $LIBS"
- AS_IF([test -n $3],
+ AS_IF([test -n "$3"],
[ax_fc_use_mod="use $3"],
[ax_fc_use_mod=""])
- AC_LINK_IFELSE([
- AC_LANG_PROGRAM([], [dnl
+ AC_LINK_IFELSE([dnl
+dnl Begin 7-column code block
+AC_LANG_PROGRAM([], [dnl
$ax_fc_use_mod
- call $2]dnl
- )
+ call $2])dnl
+dnl End code block
],
[AS_VAR_SET([ax_fc_Lib], [yes])],
[AS_VAR_SET([ax_fc_Lib], [no])]
diff --git a/ac/makedep b/ac/makedep
index 225a241b93..99c2ef6ce6 100755
--- a/ac/makedep
+++ b/ac/makedep
@@ -16,20 +16,28 @@ re_use = re.compile(r"^ *use +([a-z_0-9]+)")
re_cpp_include = re.compile(r"^ *# *include *[<\"']([a-zA-Z_0-9\.]+)[>\"']")
re_f90_include = re.compile(r"^ *include +[\"']([a-zA-Z_0-9\.]+)[\"']")
re_program = re.compile(r"^ *[pP][rR][oO][gG][rR][aA][mM] +([a-zA-Z_0-9]+)")
+re_end = re.compile(r"^ *end *(module|procedure) ", re.IGNORECASE)
+# NOTE: This excludes comments and tokens with substrings containing `function`
+# or `subroutine`, but will fail if the keywords appear in other contexts.
+re_procedure = re.compile(
+ r"^[^!]*(? 0:
for h in cpp+inc:
if h not in hlst and h in f2F.keys():
@@ -246,10 +265,11 @@ def nested_inc(inc_files, f2F):
hlst.append(h)
return
return
- hlst = []
+
for h in inc_files:
recur(h)
- return inc_files + sorted(set(hlst))
+
+ return inc_files + sorted(set(hlst)), used_mods
def scan_fortran_file(src_file):
@@ -258,25 +278,51 @@ def scan_fortran_file(src_file):
module_decl, used_modules, cpp_includes, f90_includes, programs = [], [], [], [], []
with io.open(src_file, 'r', errors='replace') as file:
lines = file.readlines()
+
+ external_namespace = True
+ # True if we are in the external (i.e. global) namespace
+
+ file_has_externals = False
+ # True if the file contains any external objects
+
for line in lines:
match = re_module.match(line.lower())
if match:
if match.group(1) not in 'procedure': # avoid "module procedure" statements
module_decl.append(match.group(1))
+ external_namespace = False
+
match = re_use.match(line.lower())
if match:
used_modules.append(match.group(1))
+
match = re_cpp_include.match(line)
if match:
cpp_includes.append(match.group(1))
+
match = re_f90_include.match(line)
if match:
f90_includes.append(match.group(1))
+
match = re_program.match(line)
if match:
programs.append(match.group(1))
+ external_namespace = False
+
+ match = re_end.match(line)
+ if match:
+ external_namespace = True
+
+ # Check for any external procedures; if present, flag the file
+ # as a potential source of
+ # NOTE: This a very weak test that needs further modification
+ if external_namespace and not file_has_externals:
+ match = re_procedure.match(line)
+ if match:
+ file_has_externals = True
+
used_modules = [m for m in sorted(set(used_modules)) if m not in module_decl]
- return add_suff(module_decl, '.mod'), add_suff(used_modules, '.mod'), cpp_includes, f90_includes, programs
+ return add_suff(module_decl, '.mod'), add_suff(used_modules, '.mod'), cpp_includes, f90_includes, programs, file_has_externals
# return add_suff(module_decl, '.mod'), add_suff(sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs
@@ -286,19 +332,28 @@ def object_file(src_file):
return os.path.splitext(os.path.basename(src_file))[0] + '.o'
-def find_files(src_dirs):
+def find_files(src_dirs, skip_dirs):
"""Return sorted list of all source files starting from each directory in
the list "src_dirs"."""
+
+ if skip_dirs is not None:
+ skip = [os.path.normpath(s) for s in skip_dirs]
+ else:
+ skip = []
+
+ # TODO: Make this a user-defined argument
+ extensions = ('.f90', '.f', '.c', '.inc', '.h', '.fh')
+
files = []
+
for path in src_dirs:
if not os.path.isdir(path):
raise ValueError("Directory '{}' was not found".format(path))
for p, d, f in os.walk(os.path.normpath(path), followlinks=True):
+ d[:] = [s for s in d if os.path.join(p, s) not in skip]
+
for file in f:
- # TODO: use any()
- if (file.endswith('.F90') or file.endswith('.f90')
- or file.endswith('.h') or file.endswith('.inc')
- or file.endswith('.c')):
+ if any(file.lower().endswith(ext) for ext in extensions):
files.append(p+'/'+file)
return sorted(set(files))
@@ -344,8 +399,13 @@ parser.add_argument(
action='store_true',
help="Annotate the makefile with extra information."
)
+parser.add_argument(
+ '-s', '--skip',
+ action='append',
+ help="Skip directory in source code search."
+)
args = parser.parse_args()
# Do the thing
-create_deps(args.path, args.makefile, args.debug, args.exec_target,
+create_deps(args.path, args.skip, args.makefile, args.debug, args.exec_target,
args.fc_rule, args.link_externals, sys.argv[0])
diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
index 251f37290d..f9f7fe88a0 100644
--- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
+++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
@@ -62,7 +62,8 @@ module MOM_surface_forcing_gfdl
!! from MOM_domains) to indicate the staggering of
!! the winds that are being provided in calls to
!! update_ocean_model.
- logical :: use_temperature !< If true, temp and saln used as state variables
+ logical :: use_temperature !< If true, temp and saln used as state variables.
+ logical :: nonBous !< If true, this run is fully non-Boussinesq
real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress [nondim].
real :: Rho0 !< Boussinesq reference density [R ~> kg m-3]
@@ -112,8 +113,10 @@ module MOM_surface_forcing_gfdl
!! salinity to a specified value.
logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea
!! surface temperature to a specified value.
- real :: Flux_const_salt !< Piston velocity for surface salt restoring [Z T-1 ~> m s-1]
- real :: Flux_const_temp !< Piston velocity for surface temp restoring [Z T-1 ~> m s-1]
+ real :: Flux_const_salt !< Piston velocity for surface salinity restoring [Z T-1 ~> m s-1]
+ real :: Flux_const_temp !< Piston velocity for surface temperature restoring [Z T-1 ~> m s-1]
+ real :: rho_restore !< The density that is used to convert piston velocities into salt
+ !! or heat fluxes with salinity or temperature restoring [R ~> kg m-3]
logical :: trestore_SPEAR_ECDA !< If true, modify restoring data wrt local SSS
real :: SPEAR_dTf_dS !< The derivative of the freezing temperature with
!! salinity [C S-1 ~> degC ppt-1].
@@ -175,6 +178,7 @@ module MOM_surface_forcing_gfdl
real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux [W m-2]
real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg m-2 s-1]
real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg m-2 s-1]
+ real, pointer, dimension(:,:) :: excess_salt =>NULL() !< salt left behind by brine rejection [kg m-2 s-1]
real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W m-2]
real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W m-2]
real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W m-2]
@@ -267,7 +271,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1
kg_m2_s_conversion = US%kg_m2s_to_RZ_T
- if (CS%restore_temp) rhoXcp = CS%Rho0 * fluxes%C_p
+ if (CS%restore_temp) rhoXcp = CS%rho_restore * fluxes%C_p
open_ocn_mask(:,:) = 1.0
fluxes%vPrecGlobalAdj = 0.0
fluxes%vPrecGlobalScl = 0.0
@@ -279,8 +283,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
! allocation and initialization if this is the first time that this
! flux type has been used.
if (fluxes%dt_buoy_accum < 0) then
- call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., press=.true., &
- fix_accum_bug=CS%fix_ustar_gustless_bug)
+ call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.not.CS%nonBous, press=.true., &
+ fix_accum_bug=CS%fix_ustar_gustless_bug, tau_mag=CS%nonBous)
call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed)
@@ -304,6 +308,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed)
+ if (associated(IOB%excess_salt)) call safe_alloc_ptr(fluxes%salt_left_behind,isd,ied,jsd,jed)
+
do j=js-2,je+2 ; do i=is-2,ie+2
fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j)
fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j)
@@ -360,7 +366,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
do j=js,je ; do i=is,ie
delta_sss = data_restore(i,j) - sfc_state%SSS(i,j)
delta_sss = sign(1.0,delta_sss) * min(abs(delta_sss), CS%max_delta_srestore)
- fluxes%salt_flux(i,j) = 1.e-3*US%S_to_ppt*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const_salt)* &
+ fluxes%salt_flux(i,j) = 1.e-3*US%S_to_ppt*G%mask2dT(i,j) * (CS%rho_restore*CS%Flux_const_salt)* &
(CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) * delta_sss ! R Z T-1 ~> kg Salt m-2 s-1
enddo ; enddo
if (CS%adjust_net_srestore_to_zero) then
@@ -383,7 +389,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
delta_sss = sfc_state%SSS(i,j) - data_restore(i,j)
delta_sss = sign(1.0,delta_sss) * min(abs(delta_sss), CS%max_delta_srestore)
fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* &
- (CS%Rho0*CS%Flux_const_salt) * &
+ (CS%rho_restore*CS%Flux_const_salt) * &
delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j)))
endif
enddo ; enddo
@@ -576,6 +582,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G)
enddo ; enddo
endif
+ if (associated(IOB%excess_salt)) then
+ do j=js,je ; do i=is,ie
+ fluxes%salt_left_behind(i,j) = G%mask2dT(i,j)*(kg_m2_s_conversion*IOB%excess_salt(i-i0,j-j0))
+ enddo ; enddo
+ endif
!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then
!#CTRL# do j=js,je ; do i=is,ie
@@ -708,8 +719,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_
! allocation and initialization if this is the first time that this
! mechanical forcing type has been used.
if (.not.forces%initialized) then
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., &
- press=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.not.CS%nonBous, &
+ press=.true., tau_mag=CS%nonBous)
call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed)
call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed)
@@ -782,14 +793,26 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_
! Set the wind stresses and ustar.
if (wt1 <= 0.0) then
call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux=forces%taux, tauy=forces%tauy, &
- ustar=forces%ustar, mag_tau=forces%tau_mag, tau_halo=1)
+ tau_halo=1)
+ if (associated(forces%ustar)) &
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, ustar=forces%ustar)
+ if (associated(forces%tau_mag)) &
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, mag_tau=forces%tau_mag)
else
call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux=forces%taux, tauy=forces%tauy, &
- ustar=ustar_tmp, mag_tau=tau_mag_tmp, tau_halo=1)
- do j=js,je ; do i=is,ie
- forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j)
- forces%tau_mag(i,j) = wt1*forces%tau_mag(i,j) + wt2*tau_mag_tmp(i,j)
- enddo ; enddo
+ tau_halo=1)
+ if (associated(forces%ustar)) then
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, ustar=ustar_tmp)
+ do j=js,je ; do i=is,ie
+ forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j)
+ enddo ; enddo
+ endif
+ if (associated(forces%tau_mag)) then
+ call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, mag_tau=tau_mag_tmp)
+ do j=js,je ; do i=is,ie
+ forces%tau_mag(i,j) = wt1*forces%tau_mag(i,j) + wt2*tau_mag_tmp(i,j)
+ enddo ; enddo
+ endif
endif
! Find the net mass source in the input forcing without other adjustments.
@@ -950,7 +973,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
! Set surface momentum stress related fields as a function of staggering.
if (present(taux) .or. present(tauy) .or. &
- ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then
+ ((do_ustar .or. do_tau_mag .or. do_gustless) .and. .not.associated(IOB%stress_mag)) ) then
if (wind_stagger == BGRID_NE) then
taux_in_B(:,:) = 0.0 ; tauy_in_B(:,:) = 0.0
@@ -1268,14 +1291,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
! Local variables
real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1].
real :: Flux_const_dflt ! A default piston velocity for restoring surface properties [m day-1]
+ logical :: Boussinesq ! If true, this run is fully Boussinesq
+ logical :: semi_Boussinesq ! If true, this run is partially non-Boussinesq
+ real :: rho_TKE_tidal ! The constant bottom density used to translate tidal amplitudes into the
+ ! tidal bottom TKE input used with INT_TIDE_DISSIPATION [R ~> kg m-3]
logical :: new_sim ! False if this simulation was started from a restart file
! or other equivalent files.
logical :: iceberg_flux_diags ! If true, diagnostics of fluxes from icebergs are available.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover
- ! the answers from the end of 2018. Otherwise, use a simpler
- ! expression to calculate gustiness.
type(time_type) :: Time_frc
type(directories) :: dirs ! A structure containing relevant directory paths and input filenames.
character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names.
@@ -1312,12 +1335,20 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, &
"If true, Temperature and salinity are used as state "//&
"variables.", default=.true.)
+ call get_param(param_file, mdl, "BOUSSINESQ", Boussinesq, &
+ "If true, make the Boussinesq approximation.", default=.true., do_not_log=.true.)
+ call get_param(param_file, mdl, "SEMI_BOUSSINESQ", semi_Boussinesq, &
+ "If true, do non-Boussinesq pressure force calculations and use mass-based "//&
+ "thicknesses, but use RHO_0 to convert layer thicknesses into certain "//&
+ "height changes. This only applies if BOUSSINESQ is false.", &
+ default=.true., do_not_log=.true.)
+ CS%nonBous = .not.(Boussinesq .or. semi_Boussinesq)
call get_param(param_file, mdl, "RHO_0", CS%Rho0, &
"The mean ocean density used with BOUSSINESQ true to "//&
"calculate accelerations and the mass for conservation "//&
"properties, or with BOUSSINSEQ false to convert some "//&
"parameters from vertical units of m to kg m-2.", &
- units="kg m-3", default=1035.0, scale=US%kg_m3_to_R)
+ units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) ! (, do_not_log=CS%nonBous)
call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, &
"The latent heat of fusion.", units="J/kg", default=hlf, scale=US%J_kg_to_Q)
call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, &
@@ -1493,6 +1524,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
"The derivative of the freezing temperature with salinity.", &
units="deg C PSU-1", default=-0.054, scale=US%degC_to_C*US%S_to_ppt, &
do_not_log=.not.CS%trestore_SPEAR_ECDA)
+ call get_param(param_file, mdl, "RESTORE_FLUX_RHO", CS%rho_restore, &
+ "The density that is used to convert piston velocities into salt or heat "//&
+ "fluxes with RESTORE_SALINITY or RESTORE_TEMPERATURE.", &
+ units="kg m-3", default=CS%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=.not.(CS%restore_temp.or.CS%restore_salt))
! Optionally read tidal amplitude from input file [Z T-1 ~> m s-1] on model grid.
! Otherwise use default tidal amplitude for bottom frictionally-generated
@@ -1517,6 +1553,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
"The constant tidal amplitude used with INT_TIDE_DISSIPATION.", &
units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s)
endif
+ call get_param(param_file, mdl, "TKE_TIDAL_RHO", rho_TKE_tidal, &
+ "The constant bottom density used to translate tidal amplitudes into the tidal "//&
+ "bottom TKE input used with INT_TIDE_DISSIPATION.", &
+ units="kg m-3", default=CS%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=.not.(CS%read_TIDEAMP.or.(CS%utide>0.0)))
call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed)
call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed)
@@ -1529,13 +1570,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
rescale=US%m_to_Z*US%T_to_s)
do j=jsd, jed; do i=isd, ied
utide = CS%TKE_tidal(i,j)
- CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide)
+ CS%TKE_tidal(i,j) = G%mask2dT(i,j)*rho_TKE_tidal*CS%cd_tides*(utide*utide*utide)
CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide
enddo ; enddo
else
do j=jsd,jed; do i=isd,ied
utide = CS%utide
- CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide)
+ CS%TKE_tidal(i,j) = rho_TKE_tidal*CS%cd_tides*(utide*utide*utide)
CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide
enddo ; enddo
endif
@@ -1564,22 +1605,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "SURFACE_FORCING_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the answers "//&
- "from the end of 2018. Otherwise, use a simpler expression to calculate gustiness.", &
- default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "SURFACE_FORCING_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the gustiness "//&
"calculations. Values below 20190101 recover the answers from the end "//&
- "of 2018, while higher values use a simpler expression to calculate gustiness. "//&
- "If both SURFACE_FORCING_2018_ANSWERS and SURFACE_FORCING_ANSWER_DATE are "//&
- "specified, the latter takes precedence.", default=default_answer_date)
+ "of 2018, while higher values use a simpler expression to calculate gustiness.", &
+ default=default_answer_date)
call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, &
"If true correct a bug in the time-averaging of the gustless wind friction velocity", &
@@ -1729,6 +1759,9 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)
if (associated(iobt%mass_berg)) then
chks = field_chksum( iobt%mass_berg ) ; if (root) write(outunit,100) 'iobt%mass_berg ', chks
endif
+ if (associated(iobt%excess_salt)) then
+ chks = field_chksum( iobt%excess_salt ) ; if (root) write(outunit,100) 'iobt%excess_salt ', chks
+ endif
100 FORMAT(" CHECKSUM::",A20," = ",Z20)
call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%')
diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90
index 005e3a6723..18bb0dbd06 100644
--- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90
+++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90
@@ -15,6 +15,7 @@ module ocean_model_mod
use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization
use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized
use MOM, only : get_ocean_stocks, step_offline
+use MOM, only : save_MOM_restart
use MOM_coms, only : field_chksum
use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf
use MOM_coupler_types, only : coupler_1d_bc_type, coupler_2d_bc_type
@@ -37,7 +38,6 @@ module ocean_model_mod
use MOM_grid, only : ocean_grid_type
use MOM_io, only : write_version_number, stdout_if_root
use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
-use MOM_restart, only : MOM_restart_CS, save_restart
use MOM_string_functions, only : uppercase
use MOM_surface_forcing_gfdl, only : surface_forcing_init, convert_IOB_to_fluxes
use MOM_surface_forcing_gfdl, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum
@@ -209,9 +209,6 @@ module ocean_model_mod
Waves => NULL() !< A pointer to the surface wave control structure
type(surface_forcing_CS), pointer :: &
forcing_CSp => NULL() !< A pointer to the MOM forcing control structure
- type(MOM_restart_CS), pointer :: &
- restart_CSp => NULL() !< A pointer set to the restart control structure
- !! that will be used for MOM restart files.
type(diag_ctrl), pointer :: &
diag => NULL() !< A pointer to the diagnostic regulatory structure
end type ocean_state_type
@@ -279,7 +276,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas
! initialization of ice shelf parameters and arrays.
call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, &
- OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
+ Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
diag_ptr=OS%diag, count_calls=.true., ice_shelf_CSp=OS%ice_shelf_CSp, &
waves_CSp=OS%Waves)
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
@@ -572,7 +569,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
endif
if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model.
- call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp)
+ call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp)
endif
Time_thermo_start = OS%Time
@@ -693,8 +690,8 @@ subroutine ocean_model_restart(OS, timestamp)
"restart files can only be created after the buoyancy forcing is applied.")
if (BTEST(OS%Restart_control,1)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, .true., GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, time_stamped=.true., GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
OS%dirs%restart_output_dir, .true.)
if (OS%use_ice_shelf) then
@@ -702,8 +699,8 @@ subroutine ocean_model_restart(OS, timestamp)
endif
endif
if (BTEST(OS%Restart_control,0)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
OS%dirs%restart_output_dir)
if (OS%use_ice_shelf) then
@@ -756,14 +753,13 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
if (present(directory)) then ; restart_dir = directory
else ; restart_dir = OS%dirs%restart_output_dir ; endif
- call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, restart_dir, Time, OS%grid, GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir)
if (OS%use_ice_shelf) then
call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir)
endif
-
end subroutine ocean_model_save_restart
!> Initialize the public ocean type
@@ -1201,6 +1197,14 @@ subroutine ocean_model_get_UV_surf(OS, Ocean, name, array2D, isc, jsc)
array2D(i,j) = G%mask2dBu(I+i0,J+j0) * &
0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0))
enddo ; enddo
+ case('uc')
+ do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
+ array2D(i,j) = G%mask2dCu(I+i0,J+j0) * sfc_state%u(I+i0,j+j0)
+ enddo ; enddo
+ case('vc')
+ do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
+ array2D(i,j) = G%mask2dCv(I+i0,J+j0) * sfc_state%v(i+i0,J+j0)
+ enddo ; enddo
case default
call MOM_error(FATAL,'ocean_model_get_UV_surf: unknown argument name='//name)
end select
diff --git a/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90
index 1a15760d00..d1c46f4254 100644
--- a/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90
+++ b/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90
@@ -15,6 +15,7 @@ module MOM_ocean_model_mct
use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization
use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized
use MOM, only : get_ocean_stocks, step_offline
+use MOM, only : save_MOM_restart
use MOM_coms, only : field_chksum
use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf
use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging
@@ -34,7 +35,6 @@ module MOM_ocean_model_mct
use MOM_grid, only : ocean_grid_type
use MOM_io, only : close_file, file_exists, read_data, write_version_number
use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
-use MOM_restart, only : MOM_restart_CS, save_restart
use MOM_string_functions, only : uppercase
use MOM_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes
use MOM_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum
@@ -207,9 +207,6 @@ module MOM_ocean_model_mct
Waves => NULL() !< A pointer to the surface wave control structure
type(surface_forcing_CS), pointer :: &
forcing_CSp => NULL() !< A pointer to the MOM forcing control structure
- type(MOM_restart_CS), pointer :: &
- restart_CSp => NULL() !< A pointer set to the restart control structure
- !! that will be used for MOM restart files.
type(diag_ctrl), pointer :: &
diag => NULL() !< A pointer to the diagnostic regulatory structure
end type ocean_state_type
@@ -271,7 +268,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
OS%Time = Time_in
call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, &
- OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
+ Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
input_restart_file=input_restart_file, &
diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves)
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
@@ -372,7 +369,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
if (OS%use_ice_shelf) then
call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, &
- OS%diag, OS%forces, OS%fluxes)
+ OS%diag, Time_init, OS%dirs%output_directory, OS%forces, OS%fluxes)
endif
if (OS%icebergs_alter_ocean) then
@@ -575,7 +572,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
endif
if (OS%nstep==0) then
- call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp)
+ call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp)
endif
call disable_averaging(OS%diag)
@@ -689,8 +686,8 @@ subroutine ocean_model_restart(OS, timestamp, restartname)
"restart files can only be created after the buoyancy forcing is applied.")
if (present(restartname)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, GV=OS%GV, filename=restartname)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, GV=OS%GV, filename=restartname)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
OS%dirs%restart_output_dir) ! Is this needed?
if (OS%use_ice_shelf) then
@@ -699,8 +696,8 @@ subroutine ocean_model_restart(OS, timestamp, restartname)
endif
else
if (BTEST(OS%Restart_control,1)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, .true., GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, time_stamped=.true., GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
OS%dirs%restart_output_dir, .true.)
if (OS%use_ice_shelf) then
@@ -708,8 +705,8 @@ subroutine ocean_model_restart(OS, timestamp, restartname)
endif
endif
if (BTEST(OS%Restart_control,0)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
OS%dirs%restart_output_dir)
if (OS%use_ice_shelf) then
@@ -765,7 +762,7 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
if (present(directory)) then ; restart_dir = directory
else ; restart_dir = OS%dirs%restart_output_dir ; endif
- call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, restart_dir, Time, OS%grid, GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir)
diff --git a/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
index ec5dab57a7..a5c2db6974 100644
--- a/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
+++ b/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
@@ -276,7 +276,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
! flux type has been used.
if (fluxes%dt_buoy_accum < 0) then
call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., &
- press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug)
+ press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug, tau_mag=.true.)
call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed)
@@ -649,7 +649,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
! mechanical forcing type has been used.
if (.not.forces%initialized) then
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true., tau_mag=.true.)
call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed)
call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed)
diff --git a/config_src/drivers/ice_solo_driver/atmos_ocean_fluxes.F90 b/config_src/drivers/ice_solo_driver/atmos_ocean_fluxes.F90
index 5494954398..4a4ddf6da3 100644
--- a/config_src/drivers/ice_solo_driver/atmos_ocean_fluxes.F90
+++ b/config_src/drivers/ice_solo_driver/atmos_ocean_fluxes.F90
@@ -13,7 +13,7 @@ module atmos_ocean_fluxes_mod
!> This subroutine duplicates an interface used by the FMS coupler, but only
!! returns a value of -1. None of the arguments are used for anything.
function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, &
- param, flag, ice_restart_file, ocean_restart_file, &
+ param, flag, mol_wt, ice_restart_file, ocean_restart_file, &
units, caller, verbosity) result (coupler_index)
character(len=*), intent(in) :: name !< An unused argument
@@ -22,6 +22,7 @@ function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index,
integer, optional, intent(in) :: atm_tr_index !< An unused argument
real, dimension(:), optional, intent(in) :: param !< An unused argument
logical, dimension(:), optional, intent(in) :: flag !< An unused argument
+ real, optional, intent(in) :: mol_wt !< An unused argument
character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument
character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument
character(len=*), optional, intent(in) :: units !< An unused argument
diff --git a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90
index 8ea0867d03..c4be8c769d 100644
--- a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90
+++ b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90
@@ -24,7 +24,7 @@ program Shelf_main
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
use MOM_cpu_clock, only : CLOCK_COMPONENT
use MOM_debugging, only : MOM_debugging_init
- use MOM_diag_mediator, only : diag_mediator_init, diag_mediator_infrastructure_init
+ use MOM_diag_mediator, only : diag_mediator_init, diag_mediator_infrastructure_init, set_axes_info
use MOM_diag_mediator, only : diag_mediator_end, diag_ctrl, diag_mediator_close_registration
use MOM_domains, only : MOM_infra_init, MOM_infra_end
use MOM_domains, only : MOM_domains_init, clone_MOM_domain, pass_var
@@ -54,6 +54,8 @@ program Shelf_main
use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd
use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init
use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS
+ use MOM_forcing_type, only : forcing
+ use MOM_ice_shelf_initialize, only : initialize_ice_SMB
use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS
use MOM_ice_shelf, only : ice_shelf_save_restart, solo_step_ice_shelf
@@ -75,7 +77,9 @@ program Shelf_main
! CPU time limit. nmax is determined by evaluating the CPU time used between successive calls to
! write_cputime. Initially it is set to be very large.
integer :: nmax=2000000000
-
+ ! A structure containing pointers to the thermodynamic forcing fields
+ ! at the ocean surface.
+ type(forcing) :: fluxes
! A structure containing several relevant directory paths.
type(directories) :: dirs
@@ -104,7 +108,7 @@ program Shelf_main
real :: time_step ! The time step [T ~> s]
! A pointer to a structure containing metrics and related information.
- type(ocean_grid_type), pointer :: ocn_grid
+ type(ocean_grid_type), pointer :: ocn_grid => NULL()
type(dyn_horgrid_type), pointer :: dG => NULL() ! A dynamic version of the horizontal grid
type(hor_index_type), pointer :: HI => NULL() ! A hor_index_type for array extents
@@ -114,7 +118,7 @@ program Shelf_main
type(ocean_OBC_type), pointer :: OBC => NULL()
! A pointer to a structure containing dimensional unit scaling factors.
- type(unit_scale_type), pointer :: US
+ type(unit_scale_type), pointer :: US => NULL()
type(diag_ctrl), pointer :: &
diag => NULL() ! A pointer to the diagnostic regulatory structure
@@ -138,8 +142,9 @@ program Shelf_main
integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date.
type(param_file_type) :: param_file ! The structure indicating the file(s)
! containing all run-time parameters.
+ real :: smb !A constant surface mass balance that can be specified in the param_file
character(len=9) :: month
- character(len=16) :: calendar = 'julian'
+ character(len=16) :: calendar = 'noleap'
integer :: calendar_type=-1
integer :: unit, io_status, ierr
@@ -184,6 +189,8 @@ program Shelf_main
endif
endif
+ ! Get the names of the I/O directories and initialization file.
+ ! Also calls the subroutine that opens run-time parameter files.
call Get_MOM_Input(param_file, dirs)
! Read ocean_solo restart, which can override settings from the namelist.
@@ -252,8 +259,11 @@ program Shelf_main
! Set up the ocean model domain and grid; the ice model grid is set in initialize_ice_shelf,
! but the grids have strong commonalities in this configuration, and the ocean grid is required
! to set up the diag mediator control structure.
- call MOM_domains_init(ocn_grid%domain, param_file)
+ allocate(ocn_grid)
+ call MOM_domains_init(ocn_grid%domain, param_file) !, domain_name='MOM')
+ allocate(HI)
call hor_index_init(ocn_grid%Domain, HI, param_file)
+ allocate(dG)
call create_dyn_horgrid(dG, HI)
call clone_MOM_domain(ocn_grid%Domain, dG%Domain)
@@ -266,11 +276,17 @@ program Shelf_main
! Initialize the diag mediator. The ocean's vertical grid is not really used here, but at
! present the interface to diag_mediator_init assumes the presence of ocean-specific information.
call verticalGridInit(param_file, GV, US)
+ allocate(diag)
call diag_mediator_init(ocn_grid, GV, US, GV%ke, param_file, diag, doc_file_dir=dirs%output_directory)
call callTree_waypoint("returned from diag_mediator_init()")
- call initialize_ice_shelf(param_file, ocn_grid, Time, ice_shelf_CSp, diag)
+ call set_axes_info(ocn_grid, GV, US, param_file, diag)
+
+ call initialize_ice_shelf(param_file, ocn_grid, Time, ice_shelf_CSp, diag, &
+ Start_time, dirs%output_directory, fluxes_in=fluxes, solo_ice_sheet_in=.true.)
+
+ call initialize_ice_SMB(fluxes%shelf_sfc_mass_flux, ocn_grid, US, param_file)
! This is the end of the code that is the counterpart of MOM_initialization.
call callTree_waypoint("End of ice shelf initialization.")
@@ -378,7 +394,7 @@ program Shelf_main
! This call steps the model over a time time_step.
Time1 = Master_Time ; Time = Master_Time
- call solo_step_ice_shelf(ice_shelf_CSp, Time_step_shelf, ns_ice, Time)
+ call solo_step_ice_shelf(ice_shelf_CSp, Time_step_shelf, ns_ice, Time, fluxes_in=fluxes)
! Time = Time + Time_step_shelf
! This is here to enable fractional-second time steps.
@@ -412,6 +428,20 @@ program Shelf_main
if (BTEST(Restart_control,0)) then
call ice_shelf_save_restart(ice_shelf_CSp, Time, dirs%restart_output_dir)
endif
+ ! Write ice shelf solo restart file.
+ if (is_root_pe())then
+ call open_ASCII_file(unit, trim(dirs%restart_output_dir)//'shelf.res')
+ write(unit, '(i6,8x,a)') calendar_type, &
+ '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)'
+
+ call get_date(Start_time, yr, mon, day, hr, mins, sec)
+ write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, &
+ 'Model start time: year, month, day, hour, minute, second'
+ call get_date(Time, yr, mon, day, hr, mins, sec)
+ write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, &
+ 'Current model time: year, month, day, hour, minute, second'
+ call close_file(unit)
+ endif
restart_time = restart_time + restint
endif
@@ -456,12 +486,11 @@ program Shelf_main
endif
call callTree_waypoint("End Shelf_main")
+ call ice_shelf_end(ice_shelf_CSp)
call diag_mediator_end(Time, diag, end_diag_manager=.true.)
if (cpu_steps > 0) call write_cputime(Time, ns-1, write_CPU_CSp, call_end=.true.)
call cpu_clock_end(termClock)
call io_infra_end ; call MOM_infra_end
- call ice_shelf_end(ice_shelf_CSp)
-
end program Shelf_main
diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90
index f4e510f3e5..3574943918 100644
--- a/config_src/drivers/nuopc_cap/mom_cap.F90
+++ b/config_src/drivers/nuopc_cap/mom_cap.F90
@@ -130,6 +130,7 @@ module MOM_cap_mod
character(len=256) :: tmpstr
logical :: write_diagnostics = .false.
logical :: overwrite_timeslice = .false.
+logical :: write_runtimelog = .false.
character(len=32) :: runtype !< run type
logical :: profile_memory = .true.
logical :: grid_attach_area = .false.
@@ -151,6 +152,9 @@ module MOM_cap_mod
#endif
character(len=8) :: restart_mode = 'alarms'
character(len=16) :: inst_suffix = ''
+real(8) :: timere
+
+type(ESMF_Time), allocatable :: restartFhTimes(:)
contains
@@ -234,6 +238,8 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
integer :: iostat
character(len=64) :: value, logmsg
character(len=*),parameter :: subname='(MOM_cap:InitializeP0)'
+ type(ESMF_VM) :: vm
+ integer :: mype
rc = ESMF_SUCCESS
@@ -251,6 +257,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
write(logmsg,*) write_diagnostics
call ESMF_LogWrite('MOM_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO)
+ write_runtimelog = .false.
+ call NUOPC_CompAttributeGet(gcomp, name="RunTimeLog", value=value, &
+ isPresent=isPresent, isSet=isSet, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ if (isPresent .and. isSet) write_runtimelog=(trim(value)=="true")
+ write(logmsg,*) write_runtimelog
+ call ESMF_LogWrite('MOM_cap:RunTimeLog = '//trim(logmsg), ESMF_LOGMSG_INFO)
+
overwrite_timeslice = .false.
call NUOPC_CompAttributeGet(gcomp, name="OverwriteSlice", value=value, &
isPresent=isPresent, isSet=isSet, rc=rc)
@@ -367,6 +381,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
geomtype = ESMF_GEOMTYPE_GRID
endif
+
end subroutine
!> Called by NUOPC to advertise import and export fields. "Advertise"
@@ -428,9 +443,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
character(len=32) :: calendar
character(len=:), allocatable :: rpointer_filename
integer :: inst_index
+ real(8) :: MPI_Wtime, timeiads
!--------------------------------
rc = ESMF_SUCCESS
+ if(write_runtimelog) timeiads = MPI_Wtime()
call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO)
@@ -480,8 +497,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
if (cesm_coupled) then
! Multiinstance logfile name needs a correction
- if(logfile(4:4) == '_') then
- logfile = logfile(1:3)//trim(inst_suffix)//logfile(9:)
+ if(len_trim(inst_suffix) > 0) then
+ n = index(logfile, '.')
+ logfile = logfile(1:n-1)//trim(inst_suffix)//logfile(n:)
endif
endif
@@ -599,7 +617,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
open(newunit=readunit, file=rpointer_filename, form='formatted', status='old', iostat=iostat)
if (iostat /= 0) then
call ESMF_LogSetError(ESMF_RC_FILE_OPEN, msg=subname//' ERROR opening '//rpointer_filename, &
- line=__LINE__, file=u_FILE_u, rcToReturn=rc)
+ line=__LINE__, file=u_FILE_u, rcToReturn=rc)
return
endif
do
@@ -730,40 +748,37 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide")
endif
-
!--------- import fields -------------
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff
- call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff
- call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") !-> ice fraction
- call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") !-> wind^2 at 10m
- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fresh_water_to_ocean_rate", "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "net_heat_flx_to_ocn" , "will provide")
-
- if (cesm_coupled) then
- call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_lprec", "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_fprec", "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_evap" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_cond" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofl" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofi" , "will provide")
- endif
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! from ice
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwnet" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") !-> ice fraction
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") !-> wind^2 at 10m
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide")
+
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hrain" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hsnow" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hevap" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hcond" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hrofl" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hrofi" , "will provide")
if (use_waves) then
if (wave_method == "EFACTOR") then
- call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide")
else if (wave_method == "SURFACE_BANDS") then
call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_pstokes_x", "will provide", &
ungridded_lbound=1, ungridded_ubound=Ice_ocean_boundary%num_stk_bands)
@@ -775,15 +790,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
endif
!--------- export fields -------------
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide")
- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide")
+ call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide")
do n = 1,fldsToOcn_num
call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc)
@@ -794,7 +809,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
enddo
- if(is_root_pe()) write(stdout,*) 'InitializeAdvertise complete'
+ if(write_runtimelog .and. is_root_pe()) write(stdout,*) 'In ',trim(subname),' time ', MPI_Wtime()-timeiads
+
end subroutine InitializeAdvertise
!> Called by NUOPC to realize import and export fields. "Realizing" a field
@@ -884,9 +900,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
integer :: num_elim_blocks ! number of blocks to be eliminated
integer :: num_elim_cells_global, num_elim_cells_local, num_elim_cells_remaining
integer, allocatable :: cell_mask(:,:)
+ real(8) :: MPI_Wtime, timeirls
!--------------------------------
rc = ESMF_SUCCESS
+ if(write_runtimelog) timeirls = MPI_Wtime()
call shr_log_setLogUnit (stdout)
@@ -1467,6 +1485,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
! timeslice=1, relaxedFlag=.true., rc=rc)
!if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ timere = 0.
+ if(write_runtimelog .and. is_root_pe()) write(stdout,*) 'In ',trim(subname),' time ', MPI_Wtime()-timeirls
+
end subroutine InitializeRealize
!> TODO
@@ -1495,8 +1516,11 @@ subroutine DataInitialize(gcomp, rc)
type(ESMF_Field) :: field
character(len=64),allocatable :: fieldNameList(:)
character(len=*),parameter :: subname='(MOM_cap:DataInitialize)'
+ real(8) :: MPI_Wtime, timedis
!--------------------------------
+ if(write_runtimelog) timedis = MPI_Wtime()
+
! query the Component for its clock, importState and exportState
call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -1557,6 +1581,8 @@ subroutine DataInitialize(gcomp, rc)
enddo
endif
+ if(write_runtimelog .and. is_root_pe()) write(stdout,*) 'In ',trim(subname),' time ', MPI_Wtime()-timedis
+
end subroutine DataInitialize
!> Called by NUOPC to advance the model a single timestep.
@@ -1608,9 +1634,16 @@ subroutine ModelAdvance(gcomp, rc)
character(len=8) :: suffix
character(len=:), allocatable :: rpointer_filename
integer :: num_rest_files
+ real(8) :: MPI_Wtime, timers
+ logical :: write_restart
+ logical :: write_restartfh
rc = ESMF_SUCCESS
if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ")
+ if(write_runtimelog) then
+ timers = MPI_Wtime()
+ if(timere>0. .and. is_root_pe()) write(stdout,*) 'In ',trim(subname),' time since last time step ',timers-timere
+ endif
call shr_log_setLogUnit (stdout)
@@ -1715,7 +1748,7 @@ subroutine ModelAdvance(gcomp, rc)
! Import data
!---------------
- call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc=rc)
+ call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!---------------
@@ -1755,13 +1788,26 @@ subroutine ModelAdvance(gcomp, rc)
call ESMF_ClockGetAlarm(clock, alarmname='restart_alarm', alarm=restart_alarm, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ write_restartfh = .false.
+ ! check if next time is == to any restartfhtime
+ if (allocated(RestartFhTimes)) then
+ do n = 1,size(RestartFhTimes)
+ call ESMF_ClockGetNextTime(clock, MyTime, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ if (MyTime == RestartFhTimes(n)) write_restartfh = .true.
+ end do
+ end if
+
+ write_restart = .false.
if (ESMF_AlarmIsRinging(restart_alarm, rc=rc)) then
if (ChkErr(rc,__LINE__,u_FILE_u)) return
-
+ write_restart = .true.
! turn off the alarm
call ESMF_AlarmRingerOff(restart_alarm, rc=rc )
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ end if
+ if (write_restart .or. write_restartfh) then
! determine restart filename
call ESMF_ClockGetNextTime(clock, MyTime, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -1784,7 +1830,7 @@ subroutine ModelAdvance(gcomp, rc)
! write restart file(s)
call ocean_model_restart(ocean_state, restartname=restartname, num_rest_files=num_rest_files)
if (localPet == 0) then
- ! Write name of restart file in the rpointer file - this is currently hard-coded for the ocean
+ ! Write name of restart file in the rpointer file - this is currently hard-coded for the ocean
open(newunit=writeunit, file=rpointer_filename, form='formatted', status='unknown', iostat=iostat)
if (iostat /= 0) then
call ESMF_LogSetError(ESMF_RC_FILE_OPEN, &
@@ -1850,31 +1896,45 @@ subroutine ModelAdvance(gcomp, rc)
enddo
endif
+ if(write_runtimelog) then
+ timere = MPI_Wtime()
+ if(is_root_pe()) write(stdout,*) 'In ',trim(subname),' time ', timere-timers
+ endif
+
if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ")
end subroutine ModelAdvance
subroutine ModelSetRunClock(gcomp, rc)
+
+ use ESMF, only : ESMF_TimeIntervalSet
+
type(ESMF_GridComp) :: gcomp
integer, intent(out) :: rc
! local variables
+ type(ESMF_VM) :: vm
type(ESMF_Clock) :: mclock, dclock
type(ESMF_Time) :: mcurrtime, dcurrtime
type(ESMF_Time) :: mstoptime, dstoptime
type(ESMF_TimeInterval) :: mtimestep, dtimestep
+ type(ESMF_TimeInterval) :: fhInterval
character(len=128) :: mtimestring, dtimestring
+ character(len=256) :: timestr
character(len=256) :: cvalue
character(len=256) :: restart_option ! Restart option units
integer :: restart_n ! Number until restart interval
integer :: restart_ymd ! Restart date (YYYYMMDD)
+ integer :: dt_cpl ! coupling timestep
type(ESMF_Alarm) :: restart_alarm
type(ESMF_Alarm) :: stop_alarm
logical :: isPresent, isSet
logical :: first_time = .true.
- character(len=*),parameter :: subname='MOM_cap:(ModelSetRunClock) '
- character(len=256) :: timestr
+ integer :: localPet
+ integer :: n, nfh
+ integer, allocatable :: restart_fh(:)
+ character(len=*),parameter :: subname='(MOM_cap:ModelSetRunClock) '
!--------------------------------
rc = ESMF_SUCCESS
@@ -1890,6 +1950,11 @@ subroutine ModelSetRunClock(gcomp, rc)
call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call ESMF_GridCompGet(gcomp, vm=vm, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call ESMF_VMGet(vm, localPet=localPet, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
!--------------------------------
! check that the current time in the model and driver are the same
!--------------------------------
@@ -2013,8 +2078,41 @@ subroutine ModelSetRunClock(gcomp, rc)
call ESMF_TimeGet(dstoptime, timestring=timestr, rc=rc)
call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO)
- first_time = .false.
+ ! set up Times to write non-interval restarts
+ call NUOPC_CompAttributeGet(gcomp, name='restart_fh', isPresent=isPresent, isSet=isSet, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ if (isPresent .and. isSet) then
+ call ESMF_TimeIntervalGet(dtimestep, s=dt_cpl, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call NUOPC_CompAttributeGet(gcomp, name='restart_fh', value=cvalue, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ ! convert string to a list of integer restart_fh values
+ nfh = 1 + count(transfer(trim(cvalue), 'a', len(cvalue)) == ",")
+ allocate(restart_fh(1:nfh))
+ allocate(restartFhTimes(1:nfh))
+ read(cvalue,*)restart_fh(1:nfh)
+
+ ! create a list of times at each restart_fh
+ do n = 1,nfh
+ call ESMF_TimeIntervalSet(fhInterval, h=restart_fh(n), rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ restartFhTimes(n) = mcurrtime + fhInterval
+ call ESMF_TimePrint(restartFhTimes(n), options="string", preString="Restart_Fh at ", unit=timestr, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ if (localPet == 0) then
+ if (mod(3600*restart_fh(n),dt_cpl) /= 0) then
+ write(stdout,'(A)')trim(subname)//trim(timestr)//' will not be written'
+ else
+ write(stdout,'(A)')trim(subname)//trim(timestr)//' will be written'
+ end if
+ end if
+ end do
+ deallocate(restart_fh)
+ end if
+
+ first_time = .false.
endif
!--------------------------------
@@ -2052,11 +2150,13 @@ subroutine ocean_model_finalize(gcomp, rc)
character(len=64) :: timestamp
logical :: write_restart
character(len=*),parameter :: subname='(MOM_cap:ocean_model_finalize)'
+ real(8) :: MPI_Wtime, timefs
if (is_root_pe()) then
write(stdout,*) 'MOM: --- finalize called ---'
endif
rc = ESMF_SUCCESS
+ if(write_runtimelog) timefs = MPI_Wtime()
call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -2085,9 +2185,7 @@ subroutine ocean_model_finalize(gcomp, rc)
call io_infra_end()
call MOM_infra_end()
- if (is_root_pe()) then
- write(stdout,*) 'MOM: --- completed ---'
- endif
+ if(write_runtimelog .and. is_root_pe()) write(stdout,*) 'In ',trim(subname),' time ', MPI_Wtime()-timefs
end subroutine ocean_model_finalize
@@ -2522,7 +2620,7 @@ end subroutine shr_log_setLogUnit
!! | Description
!! | Notes
!! |
-!! | inst_pres_height_surface |
+!! Sa_pslv |
!! Pa |
!! p |
!! pressure of overlying sea ice and atmosphere |
@@ -2536,14 +2634,14 @@ end subroutine shr_log_setLogUnit
!! |
!!
!!
-!! | seaice_melt_heat |
+!! Fioi_melth |
!! W m-2 |
!! seaice_melt_heat |
!! sea ice and snow melt heat flux |
!! |
!!
!!
-!! | seaice_melt |
+!! Fioi_meltw |
!! kg m-2 s-1 |
!! seaice_melt |
!! water flux due to sea ice and snow melting |
@@ -2557,138 +2655,145 @@ end subroutine shr_log_setLogUnit
!! |
!!
!!
-!! | mean_evap_rate |
+!! Foxx_evap |
!! kg m-2 s-1 |
!! q_flux |
!! specific humidity flux |
!! |
!!
!!
-!! | mean_fprec_rate |
+!! Faxa_snow |
!! kg m-2 s-1 |
!! fprec |
!! mass flux of frozen precip |
!! |
!!
!!
-!! | mean_merid_moment_flx |
-!! Pa |
-!! v_flux |
-!! j-directed wind stress into ocean |
-!! [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar |
-!!
-!!
-!! | mean_net_lw_flx |
+!! Foxx_lwnet |
!! W m-2 |
!! lw_flux |
!! long wave radiation |
!! |
!!
!!
-!! | mean_net_sw_ir_dif_flx |
+!! Foxx_swnet_idf |
!! W m-2 |
!! sw_flux_nir_dif |
!! diffuse near IR shortwave radiation |
!! |
!!
!!
-!! | mean_net_sw_ir_dir_flx |
+!! Foxx_swnet_idr |
!! W m-2 |
!! sw_flux_nir_dir |
!! direct near IR shortwave radiation |
!! |
!!
!!
-!! | mean_net_sw_vis_dif_flx |
+!! Foxx_swnet_vdf |
!! W m-2 |
!! sw_flux_vis_dif |
!! diffuse visible shortware radiation |
!! |
!!
!!
-!! | mean_net_sw_vis_dir_flx |
+!! Foxx_swnet_idr |
!! W m-2 |
!! sw_flux_vis_dir |
!! direct visible shortware radiation |
!! |
!!
!!
-!! | mean_prec_rate |
+!! Faxa_rain |
!! kg m-2 s-1 |
!! lprec |
!! mass flux of liquid precip |
!! |
!!
!!
-!! | heat_content_lprec |
+!! Foxx_hrain |
!! W m-2 |
!! hrain |
!! heat content (enthalpy) of liquid water entering the ocean |
!! |
!!
!!
-!! | heat_content_fprec |
+!! Foxx_hsnow |
!! W m-2 |
!! hsnow |
!! heat content (enthalpy) of frozen water entering the ocean |
!! |
!!
!!
-!! | heat_content_evap |
+!! Foxx_hevap |
!! W m-2 |
!! hevap |
!! heat content (enthalpy) of water leaving the ocean |
!! |
!!
!!
-!! | heat_content_cond |
+!! Foxx_hcond |
!! W m-2 |
!! hcond |
!! heat content (enthalpy) of liquid water entering the ocean due to condensation |
!! |
!!
!!
-!! | heat_content_rofl |
+!! Foxx_hrofl |
!! W m-2 |
!! hrofl |
!! heat content (enthalpy) of liquid runoff |
!! |
!!
!!
-!! | heat_content_rofi |
+!! Foxx_hrofi |
!! W m-2 |
!! hrofi |
!! heat content (enthalpy) of frozen runoff |
!! |
!!
!!
-!! | mean_runoff_rate |
+!! Foxx_rofl |
!! kg m-2 s-1 |
!! runoff |
!! mass flux of liquid runoff |
!! |
!!
!!
-!! | mean_salt_rate |
+!! Foxx_rofi |
+!! kg m-2 s-1 |
+!! runoff |
+!! mass flux of frozen runoff |
+!! |
+!!
+!!
+!! | Fioi_salt |
!! kg m-2 s-1 |
!! salt_flux |
!! salt flux |
!! |
!!
!!
-!! | mean_sensi_heat_flx |
+!! Foxx_sen |
!! W m-2 |
!! t_flux |
!! sensible heat flux into ocean |
!! |
!!
!!
-!! | mean_zonal_moment_flx |
+!! Foxx_taux |
!! Pa |
!! u_flux |
!! i-directed wind stress into ocean |
!! [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar |
!!
+!!
+!! | Foxx_tauy |
+!! Pa |
+!! v_flux |
+!! j-directed wind stress into ocean |
+!! [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar |
+!!
!!
!!
!! @subsection ExportField Export Fields
@@ -2705,63 +2810,63 @@ end subroutine shr_log_setLogUnit
!! Notes |
!!
!!
-!! | freezing_melting_potential |
+!! Fioo_q |
!! W m-2 |
!! combination of frazil and melt_potential |
!! cap converts model units (J m-2) to (W m-2) for export |
!! |
!!
!!
-!! | ocean_mask |
+!! So_omask |
!! |
!! |
!! ocean mask |
!! |
!!
!!
-!! | ocn_current_merid |
+!! So_v |
!! m s-1 |
!! v_surf |
!! j-directed surface velocity on u-cell |
!! [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon |
!!
!!
-!! | ocn_current_zonal |
+!! So_u |
!! m s-1 |
!! u_surf |
!! i-directed surface velocity on u-cell |
!! [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon |
!!
!!
-!! | s_surf |
+!! So_s |
!! psu |
!! s_surf |
!! sea surface salinity on t-cell |
!! |
!!
!!
-!! | sea_surface_temperature |
+!! So_t |
!! K |
!! t_surf |
!! sea surface temperature on t-cell |
!! |
!!
!!
-!! | sea_surface_slope_zonal |
+!! So_dhdx |
!! unitless |
!! created from ssh |
!! sea surface zonal slope |
!! |
!!
!!
-!! | sea_surface_slope_merid |
+!! So_dhy |
!! unitless |
!! created from ssh |
!! sea surface meridional slope |
!! |
!!
!!
-!! | so_bldepth |
+!! So_bldepth |
!! m |
!! obld |
!! ocean surface boundary layer depth |
diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90
index 3aa6278e9f..125bae5748 100644
--- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90
+++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90
@@ -72,12 +72,11 @@ end subroutine mom_set_geomtype
!> This function has a few purposes:
!! (1) it imports surface fluxes using data from the mediator; and
!! (2) it can apply restoring in SST and SSS.
-subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc)
+subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc)
type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state
type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid
type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator
type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing
- logical , intent(in) :: cesm_coupled !< Flag to check if coupled with cesm
integer , intent(inout) :: rc !< Return code
! Local Variables
@@ -103,43 +102,42 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
!----
! surface height pressure
!----
- call state_getimport(importState, 'inst_pres_height_surface', &
- isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc)
+ call state_getimport(importState, 'Sa_pslv', isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! near-IR, direct shortwave (W/m2)
!----
- call state_getimport(importState, 'mean_net_sw_ir_dir_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Foxx_swnet_idr', isc, iec, jsc, jec, &
+ ice_ocean_boundary%sw_flux_nir_dir, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! near-IR, diffuse shortwave (W/m2)
!----
- call state_getimport(importState, 'mean_net_sw_ir_dif_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Foxx_swnet_idf', isc, iec, jsc, jec, &
+ ice_ocean_boundary%sw_flux_nir_dif, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! visible, direct shortwave (W/m2)
!----
- call state_getimport(importState, 'mean_net_sw_vis_dir_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Foxx_swnet_vdr', isc, iec, jsc, jec, &
+ ice_ocean_boundary%sw_flux_vis_dir, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! visible, diffuse shortwave (W/m2)
!----
- call state_getimport(importState, 'mean_net_sw_vis_dif_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Foxx_swnet_vdf', isc, iec, jsc, jec, &
+ ice_ocean_boundary%sw_flux_vis_dif, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! -------
! Net longwave radiation (W/m2)
! -------
- call state_getimport(importState, 'mean_net_lw_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Foxx_lwnet', isc, iec, jsc, jec, &
+ ice_ocean_boundary%lw_flux, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
@@ -148,10 +146,10 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
allocate (taux(isc:iec,jsc:jec))
allocate (tauy(isc:iec,jsc:jec))
- call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, &
+ call state_getimport(importState, 'Foxx_taux', isc, iec, jsc, jec, taux, &
areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, &
+ call state_getimport(importState, 'Foxx_tauy', isc, iec, jsc, jec, tauy, &
areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -172,29 +170,29 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
!----
! sensible heat flux (W/m2)
!----
- call state_getimport(importState, 'mean_sensi_heat_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%t_flux, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Foxx_sen', isc, iec, jsc, jec, &
+ ice_ocean_boundary%t_flux, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! evaporation flux (W/m2)
!----
- call state_getimport(importState, 'mean_evap_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%q_flux, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Foxx_evap', isc, iec, jsc, jec, &
+ ice_ocean_boundary%q_flux, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! liquid precipitation (rain)
!----
- call state_getimport(importState, 'mean_prec_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%lprec, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Faxa_rain', isc, iec, jsc, jec, &
+ ice_ocean_boundary%lprec, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! frozen precipitation (snow)
!----
- call state_getimport(importState, 'mean_fprec_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%fprec, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Faxa_snow', isc, iec, jsc, jec, &
+ ice_ocean_boundary%fprec, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
@@ -216,75 +214,85 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
- ! Enthalpy terms (only in CESM)
+ ! Enthalpy terms
!----
- if (cesm_coupled) then
- !----
- ! enthalpy from liquid precipitation (hrain)
- !----
- call state_getimport(importState, 'heat_content_lprec', &
- isc, iec, jsc, jec, ice_ocean_boundary%hrain, areacor=med2mod_areacor, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- !----
- ! enthalpy from frozen precipitation (hsnow)
- !----
- call state_getimport(importState, 'heat_content_fprec', &
- isc, iec, jsc, jec, ice_ocean_boundary%hsnow, areacor=med2mod_areacor, rc=rc)
+ !----
+ ! enthalpy from liquid precipitation (hrain)
+ !----
+ if ( associated(ice_ocean_boundary%hrain) ) then
+ call state_getimport(importState, 'Foxx_hrain', isc, iec, jsc, jec, &
+ ice_ocean_boundary%hrain, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ end if
- !----
- ! enthalpy from liquid runoff (hrofl)
- !----
- call state_getimport(importState, 'heat_content_rofl', &
- isc, iec, jsc, jec, ice_ocean_boundary%hrofl, areacor=med2mod_areacor, rc=rc)
+ !----
+ ! enthalpy from frozen precipitation (hsnow)
+ !----
+ if ( associated(ice_ocean_boundary%hsnow) ) then
+ call state_getimport(importState, 'Foxx_hsnow', isc, iec, jsc, jec, &
+ ice_ocean_boundary%hsnow, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ end if
- !----
- ! enthalpy from frozen runoff (hrofi)
- !----
- call state_getimport(importState, 'heat_content_rofi', &
- isc, iec, jsc, jec, ice_ocean_boundary%hrofi, areacor=med2mod_areacor, rc=rc)
+ !----
+ ! enthalpy from liquid runoff (hrofl)
+ !----
+ if ( associated(ice_ocean_boundary%hrofl) ) then
+ call state_getimport(importState, 'Foxx_hrofl', isc, iec, jsc, jec, &
+ ice_ocean_boundary%hrofl, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ end if
- !----
- ! enthalpy from evaporation (hevap)
- !----
- call state_getimport(importState, 'heat_content_evap', &
- isc, iec, jsc, jec, ice_ocean_boundary%hevap, areacor=med2mod_areacor, rc=rc)
+ !----
+ ! enthalpy from frozen runoff (hrofi)
+ !----
+ if ( associated(ice_ocean_boundary%hrofi) ) then
+ call state_getimport(importState, 'Foxx_hrofi', isc, iec, jsc, jec, &
+ ice_ocean_boundary%hrofi, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ end if
- !----
- ! enthalpy from condensation (hcond)
- !----
- call state_getimport(importState, 'heat_content_cond', &
- isc, iec, jsc, jec, ice_ocean_boundary%hcond, areacor=med2mod_areacor, rc=rc)
+ !----
+ ! enthalpy from evaporation (hevap)
+ !----
+ if ( associated(ice_ocean_boundary%hevap) ) then
+ call state_getimport(importState, 'Foxx_hevap', isc, iec, jsc, jec, &
+ ice_ocean_boundary%hevap, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ end if
+ !----
+ ! enthalpy from condensation (hcond)
+ !----
+ if ( associated(ice_ocean_boundary%hcond) ) then
+ call state_getimport(importState, 'Foxx_hcond', isc, iec, jsc, jec, &
+ ice_ocean_boundary%hcond, areacor=med2mod_areacor, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
endif
!----
! salt flux from ice
!----
ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_salt_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%salt_flux, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Fioi_salt', isc, iec, jsc, jec, &
+ ice_ocean_boundary%salt_flux, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! snow&ice melt heat flux (W/m^2)
!----
ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'net_heat_flx_to_ocn', &
- isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Fioi_melth', isc, iec, jsc, jec, &
+ ice_ocean_boundary%seaice_melt_heat, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! snow&ice melt water flux (W/m^2)
!----
ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', &
- isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt, areacor=med2mod_areacor, rc=rc)
+ call state_getimport(importState, 'Fioi_meltw', isc, iec, jsc, jec, &
+ ice_ocean_boundary%seaice_melt, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
@@ -293,24 +301,24 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
! Note - preset values to 0, if field does not exist in importState, then will simply return
! and preset value will be used
ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mass_of_overlying_ice', &
- isc, iec, jsc, jec, ice_ocean_boundary%mi,rc=rc)
+ call state_getimport(importState, 'mass_of_overlying_ice', isc, iec, jsc, jec, &
+ ice_ocean_boundary%mi,rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! sea-ice fraction
!----
ice_ocean_boundary%ice_fraction(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'Si_ifrac', &
- isc, iec, jsc, jec, ice_ocean_boundary%ice_fraction, rc=rc)
+ call state_getimport(importState, 'Si_ifrac', isc, iec, jsc, jec, &
+ ice_ocean_boundary%ice_fraction, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
! 10m wind squared
!----
ice_ocean_boundary%u10_sqr(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'So_duu10n', &
- isc, iec, jsc, jec, ice_ocean_boundary%u10_sqr, rc=rc)
+ call state_getimport(importState, 'So_duu10n', isc, iec, jsc, jec, &
+ ice_ocean_boundary%u10_sqr, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!----
@@ -318,8 +326,8 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
!----
if ( associated(ice_ocean_boundary%lamult) ) then
ice_ocean_boundary%lamult (:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'Sw_lamult', &
- isc, iec, jsc, jec, ice_ocean_boundary%lamult, rc=rc)
+ call state_getimport(importState, 'Sw_lamult', isc, iec, jsc, jec, &
+ ice_ocean_boundary%lamult, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
endif
@@ -424,8 +432,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock,
enddo
enddo
- call State_SetExport(exportState, 'ocean_mask', &
- isc, iec, jsc, jec, omask, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_omask', isc, iec, jsc, jec, omask, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(omask)
@@ -433,15 +440,13 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock,
! -------
! Sea surface temperature
! -------
- call State_SetExport(exportState, 'sea_surface_temperature', &
- isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_t', isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! -------
! Sea surface salinity
! -------
- call State_SetExport(exportState, 's_surf', &
- isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_s', isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! -------
@@ -467,12 +472,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock,
enddo
enddo
- call State_SetExport(exportState, 'ocn_current_zonal', &
- isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_u', isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call State_SetExport(exportState, 'ocn_current_merid', &
- isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_v', isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(ocz, ocm, ocz_rot, ocm_rot)
@@ -482,8 +485,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock,
! -------
call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc)
if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then
- call State_SetExport(exportState, 'So_bldepth', &
- isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_bldepth', isc, iec, jsc, jec, &
+ ocean_public%obld, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
endif
@@ -506,8 +509,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock,
enddo
enddo
- call State_SetExport(exportState, 'freezing_melting_potential', &
- isc, iec, jsc, jec, melt_potential, ocean_grid, areacor=mod2med_areacor, rc=rc)
+ call State_SetExport(exportState, 'Fioo_q', isc, iec, jsc, jec, &
+ melt_potential, ocean_grid, areacor=mod2med_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(melt_potential)
@@ -620,12 +623,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock,
enddo
enddo
- call State_SetExport(exportState, 'sea_surface_slope_zonal', &
- isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_dhdx', isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call State_SetExport(exportState, 'sea_surface_slope_merid', &
- isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc)
+ call State_SetExport(exportState, 'So_dhdy', isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot)
diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90
index 04b60b0d37..9ac40daaa4 100644
--- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90
+++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90
@@ -15,6 +15,7 @@ module MOM_ocean_model_nuopc
use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization
use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized
use MOM, only : get_ocean_stocks, step_offline
+use MOM, only : save_MOM_restart
use MOM_coms, only : field_chksum
use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf
use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging
@@ -34,7 +35,6 @@ module MOM_ocean_model_nuopc
use MOM_grid, only : ocean_grid_type
use MOM_io, only : close_file, file_exists, read_data, write_version_number
use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
-use MOM_restart, only : MOM_restart_CS, save_restart
use MOM_string_functions, only : uppercase
use MOM_time_manager, only : time_type, get_time, set_time, operator(>)
use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/)
@@ -216,9 +216,6 @@ module MOM_ocean_model_nuopc
Waves => NULL() !< A pointer to the surface wave control structure
type(surface_forcing_CS), pointer :: &
forcing_CSp => NULL() !< A pointer to the MOM forcing control structure
- type(MOM_restart_CS), pointer :: &
- restart_CSp => NULL() !< A pointer set to the restart control structure
- !! that will be used for MOM restart files.
type(diag_ctrl), pointer :: &
diag => NULL() !< A pointer to the diagnostic regulatory structure
end type ocean_state_type
@@ -283,7 +280,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
OS%Time = Time_in
call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, &
- OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
+ Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
input_restart_file=input_restart_file, &
diag_ptr=OS%diag, count_calls=.true., tracer_flow_CSp=OS%tracer_flow_CSp, &
waves_CSp=OS%Waves, ensemble_num=inst_index)
@@ -393,7 +390,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
if (OS%use_ice_shelf) then
call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, &
- OS%diag, OS%forces, OS%fluxes)
+ OS%diag, Time_init, OS%dirs%output_directory, OS%forces, OS%fluxes)
endif
if (OS%icebergs_alter_ocean) then
call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp)
@@ -408,7 +405,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
! MOM_wave_interface_init is called regardless of the value of USE_WAVES because
! it also initializes statistical waves.
- call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag, OS%restart_CSp)
+ call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag)
if (associated(OS%grid%Domain%maskmap)) then
call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, &
@@ -609,7 +606,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
endif
if (OS%nstep==0) then
- call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp)
+ call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp)
endif
if (do_thermo) &
@@ -736,8 +733,8 @@ subroutine ocean_model_restart(OS, timestamp, restartname, stoch_restartname, nu
"restart files can only be created after the buoyancy forcing is applied.")
if (present(restartname)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, GV=OS%GV, filename=restartname, num_rest_files=num_rest_files)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, GV=OS%GV, filename=restartname, num_rest_files=num_rest_files)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
OS%dirs%restart_output_dir) ! Is this needed?
if (OS%use_ice_shelf) then
@@ -746,17 +743,17 @@ subroutine ocean_model_restart(OS, timestamp, restartname, stoch_restartname, nu
endif
else
if (BTEST(OS%Restart_control,1)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, .true., GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, time_stamped=.true., GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
- OS%dirs%restart_output_dir, .true.)
+ OS%dirs%restart_output_dir, time_stamped=.true.)
if (OS%use_ice_shelf) then
call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.)
endif
endif
if (BTEST(OS%Restart_control,0)) then
- call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, &
- OS%restart_CSp, GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, &
+ OS%grid, GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, &
OS%dirs%restart_output_dir)
if (OS%use_ice_shelf) then
@@ -816,14 +813,13 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
if (present(directory)) then ; restart_dir = directory
else ; restart_dir = OS%dirs%restart_output_dir ; endif
- call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV)
+ call save_MOM_restart(OS%MOM_CSp, restart_dir, Time, OS%grid, GV=OS%GV)
call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir)
if (OS%use_ice_shelf) then
call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir)
endif
-
end subroutine ocean_model_save_restart
!> Initialize the public ocean type
diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
index 0ac99a3940..d699697140 100644
--- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
+++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
@@ -147,7 +147,6 @@ module MOM_surface_forcing_nuopc
!< Handle for time-interpolated salt restoration field
type(external_field) :: trestore_handle
!< Handle for time-interpolated temperature restoration field
-
! Diagnostics handles
type(forcing_diags), public :: handles
@@ -298,8 +297,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
if (fluxes%dt_buoy_accum < 0) then
call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., &
press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug, &
- cfc=CS%use_CFC, hevap=CS%enthalpy_cpl)
- call safe_alloc_ptr(fluxes%omega_w2x,isd,ied,jsd,jed)
+ cfc=CS%use_CFC, hevap=CS%enthalpy_cpl, tau_mag=.true.)
+ !call safe_alloc_ptr(fluxes%omega_w2x,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed)
@@ -701,11 +700,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
! mechanical forcing type has been used.
if (.not.forces%initialized) then
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true., tau_mag=.true.)
call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed)
call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed)
- call safe_alloc_ptr(forces%omega_w2x,isd,ied,jsd,jed)
+ !call safe_alloc_ptr(forces%omega_w2x,isd,ied,jsd,jed)
if (CS%rigid_sea_ice) then
call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed)
@@ -866,7 +865,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
forces%tau_mag(i,j) = gustiness + G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)
forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * &
sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2))
- forces%omega_w2x(i,j) = atan(tauy_at_h(i,j), taux_at_h(i,j))
+ !forces%omega_w2x(i,j) = atan(tauy_at_h(i,j), taux_at_h(i,j))
enddo ; enddo
call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1)
else ! C-grid wind stresses.
diff --git a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 b/config_src/drivers/solo_driver/MESO_surface_forcing.F90
index a3007326b7..f1f3daa52e 100644
--- a/config_src/drivers/solo_driver/MESO_surface_forcing.F90
+++ b/config_src/drivers/solo_driver/MESO_surface_forcing.F90
@@ -9,7 +9,7 @@ module MESO_surface_forcing
use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_forcing_type, only : forcing, mech_forcing
-use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing
+use MOM_forcing_type, only : allocate_forcing_type
use MOM_grid, only : ocean_grid_type
use MOM_io, only : file_exists, MOM_read_data, slasher
use MOM_time_manager, only : time_type, operator(+), operator(/)
@@ -30,6 +30,8 @@ module MESO_surface_forcing
real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3].
real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2].
real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1].
+ real :: rho_restore !< The density that is used to convert piston velocities into salt
+ !! or heat fluxes with salinity or temperature restoring [R ~> kg m-3]
real :: gust_const !< A constant unresolved background gustiness
!! that contributes to ustar [R L Z T-2 ~> Pa]
real, dimension(:,:), pointer :: &
@@ -166,14 +168,14 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
! call MOM_error(FATAL, "MESO_buoyancy_surface_forcing: " // &
! "Temperature and salinity restoring used without modification." )
- rhoXcp = CS%Rho0 * fluxes%C_p
+ rhoXcp = CS%rho_restore * fluxes%C_p
do j=js,je ; do i=is,ie
! Set Temp_restore and Salin_restore to the temperature (in degC) and
! salinity (in ppt or PSU) that are being restored toward.
if (G%mask2dT(i,j) > 0.0) then
fluxes%heat_added(i,j) = G%mask2dT(i,j) * &
((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const)
- fluxes%vprec(i,j) = - (CS%Rho0 * CS%Flux_const) * &
+ fluxes%vprec(i,j) = - (CS%rho_restore * CS%Flux_const) * &
(CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / &
(0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)))
else
@@ -188,7 +190,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
"Buoyancy restoring used without modification." )
! The -1 is because density has the opposite sign to buoyancy.
- buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0
+ buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%rho_restore
do j=js,je ; do i=is,ie
! Set density_restore to an expression for the surface potential
! density [R ~> kg m-3] that is being restored toward.
@@ -272,7 +274,11 @@ subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS)
"variable NET_SOL.", fail_if_missing=.true.)
call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".")
CS%inputdir = slasher(CS%inputdir)
-
+ call get_param(param_file, mdl, "RESTORE_FLUX_RHO", CS%rho_restore, &
+ "The density that is used to convert piston velocities into salt or heat "//&
+ "fluxes with RESTORE_SALINITY or RESTORE_TEMPERATURE.", &
+ units="kg m-3", default=CS%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=(CS%Flux_const==0.0).or.(.not.CS%restorebuoy))
endif
end subroutine MESO_surface_forcing_init
diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90
index 974843c10f..0e355f8638 100644
--- a/config_src/drivers/solo_driver/MOM_driver.F90
+++ b/config_src/drivers/solo_driver/MOM_driver.F90
@@ -32,6 +32,7 @@ program MOM6
use MOM, only : extract_surface_state, finish_MOM_initialization
use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized
use MOM, only : step_offline
+ use MOM, only : save_MOM_restart
use MOM_coms, only : Set_PElist
use MOM_domains, only : MOM_infra_init, MOM_infra_end, set_MOM_thread_affinity
use MOM_ensemble_manager, only : ensemble_manager_init, get_ensemble_size
@@ -48,11 +49,11 @@ program MOM6
use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart
use MOM_ice_shelf, only : initialize_ice_shelf_fluxes, initialize_ice_shelf_forces
use MOM_ice_shelf, only : ice_shelf_query
+ use MOM_ice_shelf_initialize, only : initialize_ice_SMB
use MOM_interpolate, only : time_interp_external_init
use MOM_io, only : file_exists, open_ASCII_file, close_file
use MOM_io, only : check_nml_error, io_infra_init, io_infra_end
use MOM_io, only : APPEND_FILE, READONLY_FILE
- use MOM_restart, only : MOM_restart_CS, save_restart
use MOM_string_functions,only : uppercase
use MOM_surface_forcing, only : set_forcing, forcing_save_restart
use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS
@@ -134,7 +135,7 @@ program MOM6
real :: dtdia ! The diabatic timestep [T ~> s]
real :: t_elapsed_seg ! The elapsed time in this run segment [T ~> s]
integer :: n, ns, n_max, nts, n_last_thermo
- logical :: diabatic_first, single_step_call
+ logical :: diabatic_first, single_step_call, initialize_smb
type(time_type) :: Time2, time_chg ! Temporary time variables
integer :: Restart_control ! An integer that is bit-tested to determine whether
@@ -177,9 +178,6 @@ program MOM6
logical :: override_shelf_fluxes !< If true, and shelf dynamics are active,
!! the data_override feature is enabled (only for MOSAIC grid types)
type(wave_parameters_cs), pointer :: waves_CSp => NULL()
- type(MOM_restart_CS), pointer :: &
- restart_CSp => NULL() !< A pointer to the restart control structure
- !! that will be used for MOM restart files.
type(diag_ctrl), pointer :: &
diag => NULL() !< A pointer to the diagnostic regulatory structure
!-----------------------------------------------------------------------
@@ -281,7 +279,7 @@ program MOM6
if (segment_start_time_set) then
! In this case, the segment starts at a time fixed by ocean_solo.res
Time = segment_start_time
- call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, &
+ call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, &
segment_start_time, offline_tracer_mode=offline_tracer_mode, &
diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, &
waves_CSp=Waves_CSp)
@@ -289,7 +287,7 @@ program MOM6
! In this case, the segment starts at a time read from the MOM restart file
! or is left at Start_time by MOM_initialize.
Time = Start_time
- call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, &
+ call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, &
offline_tracer_mode=offline_tracer_mode, diag_ptr=diag, &
tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, waves_CSp=Waves_CSp)
endif
@@ -305,6 +303,9 @@ program MOM6
call initialize_ice_shelf_forces(ice_shelf_CSp, grid, US, forces)
call ice_shelf_query(ice_shelf_CSp, grid, data_override_shelf_fluxes=override_shelf_fluxes)
if (override_shelf_fluxes) call data_override_init(Ocean_Domain_in=grid%domain%mpp_domain)
+ call get_param(param_file, mod_name, "INITIALIZE_ICE_SHEET_SMB", &
+ initialize_smb, "Read in a constant SMB for the ice sheet", default=.false.)
+ if (initialize_smb) call initialize_ice_SMB(fluxes%shelf_sfc_mass_flux, grid, US, param_file)
endif
@@ -473,7 +474,7 @@ program MOM6
endif
if (ns==1) then
- call finish_MOM_initialization(Time, dirs, MOM_CSp, restart_CSp)
+ call finish_MOM_initialization(Time, dirs, MOM_CSp)
endif
! This call steps the model over a time dt_forcing.
@@ -564,16 +565,15 @@ program MOM6
if ((permit_incr_restart) .and. (fluxes%fluxes_used) .and. &
(Time + (Time_step_ocean/2) > restart_time)) then
if (BTEST(Restart_control,1)) then
- call save_restart(dirs%restart_output_dir, Time, grid, &
- restart_CSp, .true., GV=GV)
+ call save_MOM_restart(MOM_CSp, dirs%restart_output_dir, Time, grid, &
+ time_stamped=.true., GV=GV)
call forcing_save_restart(surface_forcing_CSp, grid, Time, &
dirs%restart_output_dir, .true.)
if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, &
dirs%restart_output_dir, .true.)
endif
if (BTEST(Restart_control,0)) then
- call save_restart(dirs%restart_output_dir, Time, grid, &
- restart_CSp, GV=GV)
+ call save_MOM_restart(MOM_CSp, dirs%restart_output_dir, Time, grid, GV=GV)
call forcing_save_restart(surface_forcing_CSp, grid, Time, &
dirs%restart_output_dir)
if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, &
@@ -598,9 +598,10 @@ program MOM6
"For conservation, the ocean restart files can only be "//&
"created after the buoyancy forcing is applied.")
- call save_restart(dirs%restart_output_dir, Time, grid, restart_CSp, GV=GV)
+ call save_MOM_restart(MOM_CSp, dirs%restart_output_dir, Time, grid, GV=GV)
if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, &
dirs%restart_output_dir)
+
! Write the ocean solo restart file.
call write_ocean_solo_res(Time, Start_time, calendar_type, &
trim(dirs%restart_output_dir)//'ocean_solo.res')
diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90
index c99402446f..d17db5a9a1 100644
--- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90
+++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90
@@ -72,6 +72,7 @@ module MOM_surface_forcing
logical :: use_temperature !< if true, temp & salinity used as state variables
logical :: restorebuoy !< if true, use restoring surface buoyancy forcing
logical :: adiabatic !< if true, no diapycnal mass fluxes or surface buoyancy forcing
+ logical :: nonBous !< If true, this run is fully non-Boussinesq
logical :: variable_winds !< if true, wind stresses vary with time
logical :: variable_buoyforce !< if true, buoyancy forcing varies with time.
real :: south_lat !< southern latitude of the domain [degrees_N] or [km] or [m]
@@ -79,9 +80,11 @@ module MOM_surface_forcing
real :: Rho0 !< Boussinesq reference density [R ~> kg m-3]
real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2]
- real :: Flux_const !< piston velocity for surface restoring [Z T-1 ~> m s-1]
- real :: Flux_const_T !< piston velocity for surface temperature restoring [Z T-1 ~> m s-1]
- real :: Flux_const_S !< piston velocity for surface salinity restoring [Z T-1 ~> m s-1]
+ real :: Flux_const = 0.0 !< piston velocity for surface restoring [Z T-1 ~> m s-1]
+ real :: Flux_const_T = 0.0 !< piston velocity for surface temperature restoring [Z T-1 ~> m s-1]
+ real :: Flux_const_S = 0.0 !< piston velocity for surface salinity restoring [Z T-1 ~> m s-1]
+ real :: rho_restore !< The density that is used to convert piston velocities into salt
+ !! or heat fluxes with salinity or temperature restoring [R ~> kg m-3]
real :: latent_heat_fusion !< latent heat of fusion times [Q ~> J kg-1]
real :: latent_heat_vapor !< latent heat of vaporization [Q ~> J kg-1]
real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const"
@@ -250,9 +253,10 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US
if (CS%first_call_set_forcing) then
! Allocate memory for the mechanical and thermodynamic forcing fields.
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.not.CS%nonBous, press=.true., tau_mag=CS%nonBous)
- call allocate_forcing_type(G, fluxes, ustar=.true., fix_accum_bug=CS%fix_ustar_gustless_bug)
+ call allocate_forcing_type(G, fluxes, ustar=.not.CS%nonBous, tau_mag=CS%nonBous, &
+ fix_accum_bug=CS%fix_ustar_gustless_bug)
if (trim(CS%buoy_config) /= "NONE") then
if ( CS%use_temperature ) then
call allocate_forcing_type(G, fluxes, water=.true., heat=.true., press=.true.)
@@ -528,13 +532,15 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS)
! set the friction velocity
if (CS%answer_date < 20190101) then
- do j=js,je ; do i=is,ie
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust_const + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
(forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt(US%L_to_Z * ((CS%gust_const/CS%Rho0) + &
sqrt(0.5*(forces%tauy(i,J-1)*forces%tauy(i,J-1) + forces%tauy(i,J)*forces%tauy(i,J) + &
forces%taux(I-1,j)*forces%taux(I-1,j) + forces%taux(I,j)*forces%taux(I,j)))/CS%Rho0) )
- enddo ; enddo
+ enddo ; enddo ; endif
else
call stresses_to_ustar(forces, G, US, CS)
endif
@@ -673,6 +679,9 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS)
character(len=200) :: filename ! The name of the input file.
real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-2 ~> Pa]
real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-2 ~> Pa]
+ real :: ustar_loc(SZI_(G),SZJ_(G)) ! The local value of ustar [Z T-1 ~> m s-1]
+ real :: tau_mag ! The magnitude of the wind stress including any contributions from
+ ! sub-gridscale variability or gustiness [R L Z T-2 ~> Pa]
integer :: time_lev_daily ! The time levels to read for fields with
integer :: time_lev_monthly ! daily and monthly cycles.
integer :: time_lev ! The time level that is used for a field.
@@ -733,16 +742,21 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS)
if (.not.read_Ustar) then
if (CS%read_gust_2d) then
- do j=js,je ; do i=is,ie
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust(i,j) + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)
- forces%ustar(i,j) = sqrt(forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0)
- enddo ; enddo
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
+ tau_mag = CS%gust(i,j) + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)
+ forces%ustar(i,j) = sqrt(tau_mag * US%L_to_Z / CS%Rho0)
+ enddo ; enddo ; endif
else
- do j=js,je ; do i=is,ie
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust_const + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt(US%L_to_Z * (CS%gust_const/CS%Rho0 + &
sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j)) / CS%Rho0) )
- enddo ; enddo
+ enddo ; enddo ; endif
endif
endif
case ("C")
@@ -781,21 +795,28 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS)
call pass_vector(forces%taux, forces%tauy, G%Domain, To_All)
if (.not.read_Ustar) then
if (CS%read_gust_2d) then
- do j=js,je ; do i=is,ie
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust(i,j) + &
sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
(forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
- forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 )
- enddo ; enddo
- else
- do j=js,je ; do i=is,ie
- forces%tau_mag(i,j) = CS%gust_const + &
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
+ tau_mag = CS%gust(i,j) + &
sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
(forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
- forces%ustar(i,j) = sqrt(US%L_to_Z * ( (CS%gust_const/CS%Rho0) + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))/CS%Rho0))
- enddo ; enddo
+ forces%ustar(i,j) = sqrt( tau_mag * US%L_to_Z / CS%Rho0 )
+ enddo ; enddo ; endif
+ else
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
+ forces%tau_mag(i,j) = CS%gust_const + &
+ sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
+ (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
+ forces%ustar(i,j) = sqrt(US%L_to_Z * ( (CS%gust_const/CS%Rho0) + &
+ sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
+ (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))/CS%Rho0))
+ enddo ; enddo ; endif
endif
endif
case default
@@ -804,11 +825,14 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS)
end select
if (read_Ustar) then
- call MOM_read_data(filename, CS%Ustar_var, forces%ustar(:,:), &
+ call MOM_read_data(filename, CS%Ustar_var, ustar_loc(:,:), &
G%Domain, timelevel=time_lev, scale=US%m_to_Z*US%T_to_s)
- do j=js,je ; do i=is,ie
- forces%tau_mag(i,j) = US%Z_to_L * CS%Rho0 * forces%ustar(i,j)**2
- enddo ; enddo
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
+ forces%tau_mag(i,j) = US%Z_to_L * CS%Rho0 * ustar_loc(i,j)**2
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ forces%ustar(i,j) = ustar_loc(i,j)
+ enddo ; enddo ; endif
endif
CS%wind_last_lev = time_lev
@@ -832,13 +856,16 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS)
! Local variables
real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R Z L T-2 ~> Pa].
real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R Z L T-2 ~> Pa].
- real :: ustar_tmp(SZI_(G),SZJ_(G)) ! The pre-override value of ustar [Z T-1 ~> m s-1]
+ real :: ustar_prev(SZI_(G),SZJ_(G)) ! The pre-override value of ustar [Z T-1 ~> m s-1]
+ real :: ustar_loc(SZI_(G),SZJ_(G)) ! The value of ustar, perhaps altered by data override [Z T-1 ~> m s-1]
+ real :: tau_mag ! The magnitude of the wind stress including any contributions from
+ ! sub-gridscale variability or gustiness [R L Z T-2 ~> Pa]
integer :: i, j
call callTree_enter("wind_forcing_by_data_override, MOM_surface_forcing.F90")
if (.not.CS%dataOverrideIsInitialized) then
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.not.CS%nonBous, press=.true., tau_mag=CS%nonBous)
call data_override_init(G%Domain)
CS%dataOverrideIsInitialized = .True.
endif
@@ -857,26 +884,40 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS)
if (CS%read_gust_2d) then
call data_override(G%Domain, 'gust', CS%gust, day, scale=US%Pa_to_RLZ_T2)
- do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ if (associated(forces%tau_mag)) then ; do j=G%jsc,G%jec ; do i=G%isc,G%iec
forces%tau_mag(i,j) = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust(i,j)
- forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 )
+ enddo ; enddo ; endif
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ tau_mag = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust(i,j)
+ ustar_loc(i,j) = sqrt( tau_mag * US%L_to_Z / CS%Rho0 )
enddo ; enddo
else
+ if (associated(forces%tau_mag)) then
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ forces%tau_mag(i,j) = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust_const
+ ! ustar_loc(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 )
+ enddo ; enddo
+ endif
do j=G%jsc,G%jec ; do i=G%isc,G%iec
- forces%tau_mag(i,j) = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust_const
- ! forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 )
- forces%ustar(i,j) = sqrt(US%L_to_Z * (sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)/CS%Rho0 + &
- CS%gust_const/CS%Rho0))
+ ustar_loc(i,j) = sqrt(US%L_to_Z * (sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)/CS%Rho0 + &
+ CS%gust_const/CS%Rho0))
enddo ; enddo
endif
! Give the data override the option to modify the newly calculated forces%ustar.
- ustar_tmp(:,:) = forces%ustar(:,:)
- call data_override(G%Domain, 'ustar', forces%ustar, day, scale=US%m_to_Z*US%T_to_s)
+ ustar_prev(:,:) = ustar_loc(:,:)
+ call data_override(G%Domain, 'ustar', ustar_loc, day, scale=US%m_to_Z*US%T_to_s)
+
! Only reset values where data override of ustar has occurred
- do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ustar_tmp(i,j) /= forces%ustar(i,j)) then
- forces%tau_mag(i,j) = US%Z_to_L * CS%Rho0 * forces%ustar(i,j)**2
- endif ; enddo ; enddo
+ if (associated(forces%tau_mag)) then
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ustar_prev(i,j) /= ustar_loc(i,j)) then
+ forces%tau_mag(i,j) = US%Z_to_L * CS%Rho0 * ustar_loc(i,j)**2
+ endif ; enddo ; enddo
+ endif
+
+ if (associated(forces%ustar)) then ; do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ forces%ustar(i,j) = ustar_loc(i,j)
+ enddo ; enddo ; endif
call pass_vector(forces%taux, forces%tauy, G%Domain, To_All)
@@ -893,6 +934,8 @@ subroutine stresses_to_ustar(forces, G, US, CS)
! Local variables
real :: I_rho ! The inverse of the reference density times a ratio of scaling
! factors [Z L-1 R-1 ~> m3 kg-1]
+ real :: tau_mag ! The magnitude of the wind stress including any contributions from
+ ! sub-gridscale variability or gustiness [R L Z T-2 ~> Pa]
integer :: i, j, is, ie, js, je
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
@@ -900,19 +943,29 @@ subroutine stresses_to_ustar(forces, G, US, CS)
I_rho = US%L_to_Z / CS%Rho0
if (CS%read_gust_2d) then
- do j=js,je ; do i=is,ie
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust(i,j) + &
sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
(forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
- forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * I_rho )
- enddo ; enddo
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
+ tau_mag = CS%gust(i,j) + &
+ sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
+ (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ forces%ustar(i,j) = sqrt( tau_mag * I_rho )
+ enddo ; enddo ; endif
else
- do j=js,je ; do i=is,ie
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust_const + &
sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
(forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
- forces%ustar(i,j) = sqrt( forces%tau_mag(i,j) * I_rho )
- enddo ; enddo
+ enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
+ tau_mag = CS%gust_const + &
+ sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
+ (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ forces%ustar(i,j) = sqrt( tau_mag * I_rho )
+ enddo ; enddo ; endif
endif
end subroutine stresses_to_ustar
@@ -954,7 +1007,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p
+ if (CS%use_temperature) rhoXcp = CS%rho_restore * fluxes%C_p
! Read the buoyancy forcing file
call get_time(day, seconds, days)
@@ -1153,7 +1206,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS)
if (G%mask2dT(i,j) > 0.0) then
fluxes%heat_added(i,j) = G%mask2dT(i,j) * &
((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const_T)
- fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const_S) * &
+ fluxes%vprec(i,j) = - (CS%rho_restore*CS%Flux_const_S) * &
(CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / &
(0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)))
else
@@ -1165,7 +1218,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS)
do j=js,je ; do i=is,ie
if (G%mask2dT(i,j) > 0.0) then
fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * &
- (CS%G_Earth * CS%Flux_const / CS%Rho0)
+ (CS%G_Earth * CS%Flux_const / CS%rho_restore)
else
fluxes%buoy(i,j) = 0.0
endif
@@ -1221,7 +1274,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p
+ if (CS%use_temperature) rhoXcp = CS%rho_restore * fluxes%C_p
if (.not.CS%dataOverrideIsInitialized) then
call data_override_init(G%Domain)
@@ -1259,7 +1312,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US
if (G%mask2dT(i,j) > 0.0) then
fluxes%heat_added(i,j) = G%mask2dT(i,j) * &
((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const_T)
- fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const_S) * &
+ fluxes%vprec(i,j) = - (CS%rho_restore*CS%Flux_const_S) * &
(CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / &
(0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)))
else
@@ -1271,7 +1324,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US
do j=js,je ; do i=is,ie
if (G%mask2dT(i,j) > 0.0) then
fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * &
- (CS%G_Earth * CS%Flux_const / CS%Rho0)
+ (CS%G_Earth * CS%Flux_const / CS%rho_restore)
else
fluxes%buoy(i,j) = 0.0
endif
@@ -1458,8 +1511,8 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS)
S_restore = CS%S_south + (CS%S_north-CS%S_south)*y
if (G%mask2dT(i,j) > 0.0) then
fluxes%heat_added(i,j) = G%mask2dT(i,j) * &
- ((T_Restore - sfc_state%SST(i,j)) * ((CS%Rho0 * fluxes%C_p) * CS%Flux_const))
- fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * &
+ ((T_Restore - sfc_state%SST(i,j)) * ((CS%rho_restore * fluxes%C_p) * CS%Flux_const))
+ fluxes%vprec(i,j) = - (CS%rho_restore*CS%Flux_const) * &
(S_Restore - sfc_state%SSS(i,j)) / &
(0.5*(sfc_state%SSS(i,j) + S_Restore))
else
@@ -1473,7 +1526,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS)
!do j=js,je ; do i=is,ie
! if (G%mask2dT(i,j) > 0.0) then
! fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * &
- ! (CS%G_Earth * CS%Flux_const / CS%Rho0)
+ ! (CS%G_Earth * CS%Flux_const / CS%rho_restore)
! else
! fluxes%buoy(i,j) = 0.0
! endif
@@ -1527,12 +1580,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C
! This include declares and sets the variable "version".
# include "version_variable.h"
real :: flux_const_default ! The unscaled value of FLUXCONST [m day-1]
+ logical :: Boussinesq ! If true, this run is fully Boussinesq
+ logical :: semi_Boussinesq ! If true, this run is partially non-Boussinesq
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover
- ! the answers from the end of 2018. Otherwise, use a form of the gyre
- ! wind stresses that are rotationally invariant and more likely to be
- ! the same between compilers.
character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name.
character(len=200) :: filename, gust_file ! The name of the gustiness input file.
@@ -1554,6 +1604,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C
call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, &
"If true, Temperature and salinity are used as state "//&
"variables.", default=.true.)
+ call get_param(param_file, "MOM", "BOUSSINESQ", Boussinesq, &
+ "If true, make the Boussinesq approximation.", default=.true., do_not_log=.true.)
+ call get_param(param_file, "MOM", "SEMI_BOUSSINESQ", semi_Boussinesq, &
+ "If true, do non-Boussinesq pressure force calculations and use mass-based "//&
+ "thicknesses, but use RHO_0 to convert layer thicknesses into certain "//&
+ "height changes. This only applies if BOUSSINESQ is false.", &
+ default=.true., do_not_log=.true.)
+ CS%nonBous = .not.(Boussinesq .or. semi_Boussinesq)
call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, &
"The directory in which all input files are found.", &
default=".")
@@ -1768,24 +1826,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "WIND_GYRES_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the answers "//&
- "from the end of 2018. Otherwise, use expressions for the gyre friction velocities "//&
- "that are rotationally invariant and more likely to be the same between compilers.", &
- default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "WIND_GYRES_ANSWER_DATE", CS%answer_date, &
"The vintage of the expressions used to set gyre wind stresses. "//&
"Values below 20190101 recover the answers from the end of 2018, "//&
"while higher values use a form of the gyre wind stresses that are "//&
- "rotationally invariant and more likely to be the same between compilers. "//&
- "If both WIND_GYRES_2018_ANSWERS and WIND_GYRES_ANSWER_DATE are specified, "//&
- "the latter takes precedence.", default=default_answer_date)
+ "rotationally invariant and more likely to be the same between compilers.", &
+ default=default_answer_date)
else
CS%answer_date = 20190101
endif
@@ -1828,7 +1874,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C
"calculate accelerations and the mass for conservation "//&
"properties, or with BOUSSINSEQ false to convert some "//&
"parameters from vertical units of m to kg m-2.", &
- units="kg m-3", default=1035.0, scale=US%kg_m3_to_R)
+ units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) ! (, do_not_log=CS%nonBous)
call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, &
"If true, the buoyancy fluxes drive the model back toward some "//&
"specified surface state with a rate given by FLUXCONST.", default=.false.)
@@ -1875,6 +1921,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C
"at the southern end of the domain toward which to "//&
"to restore.", units="PSU", default=35.0, scale=US%ppt_to_S)
endif
+ call get_param(param_file, mdl, "RESTORE_FLUX_RHO", CS%rho_restore, &
+ "The density that is used to convert piston velocities into salt or heat "//&
+ "fluxes with RESTORE_SALINITY or RESTORE_TEMPERATURE.", &
+ units="kg m-3", default=CS%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=(((CS%Flux_const==0.0).and.(CS%Flux_const_T==0.0).and.(CS%Flux_const_S==0.0))&
+ .or.(.not.CS%restorebuoy)))
endif
call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, &
"The gravitational acceleration of the Earth.", &
diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90
index d7d3b89a8a..7d4ea94603 100644
--- a/config_src/drivers/solo_driver/user_surface_forcing.F90
+++ b/config_src/drivers/solo_driver/user_surface_forcing.F90
@@ -35,6 +35,8 @@ module user_surface_forcing
real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3].
real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2].
real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1].
+ real :: rho_restore !< The density that is used to convert piston velocities into salt
+ !! or heat fluxes with salinity or temperature restoring [R ~> kg m-3]
real :: gust_const !< A constant unresolved background gustiness
!! that contributes to ustar [R L Z T-2 ~> Pa].
@@ -69,7 +71,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS)
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
! Allocate the forcing arrays, if necessary.
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., tau_mag=.true.)
! Set the surface wind stresses, in units of [R L Z T-2 ~> Pa]. A positive taux
! accelerates the ocean to the (pseudo-)east.
@@ -91,7 +93,8 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS)
forces%tau_mag(i,j) = G%mask2dT(i,j) * (CS%gust_const + &
sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2)))
- forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(forces%tau_mag(i,j) * (US%L_to_Z/CS%Rho0))
+ if (associated(forces%ustar)) &
+ forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(forces%tau_mag(i,j) * (US%L_to_Z/CS%Rho0))
enddo ; enddo ; endif
end subroutine USER_wind_forcing
@@ -200,7 +203,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // &
"Temperature and salinity restoring used without modification." )
- rhoXcp = CS%Rho0 * fluxes%C_p
+ rhoXcp = CS%rho_restore * fluxes%C_p
do j=js,je ; do i=is,ie
! Set Temp_restore and Salin_restore to the temperature (in [C ~> degC]) and
! salinity (in [S ~> ppt]) that are being restored toward.
@@ -209,7 +212,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * &
(Temp_restore - sfc_state%SST(i,j))
- fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * &
+ fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%rho_restore*CS%Flux_const)) * &
((Salin_restore - sfc_state%SSS(i,j)) / (0.5 * (Salin_restore + sfc_state%SSS(i,j))))
enddo ; enddo
else
@@ -219,7 +222,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
"Buoyancy restoring used without modification." )
! The -1 is because density has the opposite sign to buoyancy.
- buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0
+ buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%rho_restore
do j=js,je ; do i=is,ie
! Set density_restore to an expression for the surface potential
! density [R ~> kg m-3] that is being restored toward.
@@ -284,6 +287,11 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS)
"surface anomalies (akin to a piston velocity). Note the non-MKS units.", &
default=0.0, units="m day-1", scale=US%m_to_Z/(86400.0*US%s_to_T))
endif
+ call get_param(param_file, mdl, "RESTORE_FLUX_RHO", CS%rho_restore, &
+ "The density that is used to convert piston velocities into salt or heat "//&
+ "fluxes with RESTORE_SALINITY or RESTORE_TEMPERATURE.", &
+ units="kg m-3", default=CS%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=(CS%Flux_const==0.0).or.(.not.CS%restorebuoy))
end subroutine USER_surface_forcing_init
diff --git a/config_src/drivers/timing_tests/time_MOM_EOS.F90 b/config_src/drivers/timing_tests/time_MOM_EOS.F90
new file mode 100644
index 0000000000..29bd4a30ab
--- /dev/null
+++ b/config_src/drivers/timing_tests/time_MOM_EOS.F90
@@ -0,0 +1,206 @@
+program time_MOM_EOS
+
+! This file is part of MOM6. See LICENSE.md for the license.
+
+use MOM_EOS, only : EOS_type
+use MOM_EOS, only : EOS_manual_init
+use MOM_EOS, only : calculate_density, calculate_spec_vol
+use MOM_EOS, only : list_of_eos, get_EOS_name
+
+implicit none
+
+! This macro is used to write out timings of a single test rather than conduct
+! a suite of tests. It is not meant for general consumption.
+#undef PDF_ONLY
+
+integer, parameter :: n_fns = 4
+character(len=40) :: fn_labels(n_fns)
+
+! Testing parameters:
+! nic is number of elements to compute density for (array size), per call
+! halo is data on either end of the array that should not be used
+! nits is how many times to repeat the call between turning the timer on/off
+! to overcome limited resolution of the timer
+! nsamp repeats the timing to collect statistics on the measurement
+#ifdef PDF_ONLY
+integer, parameter :: nic=26, halo=4, nits=10000, nsamp=400
+#else
+integer, parameter :: nic=23, halo=4, nits=1000, nsamp=400
+#endif
+
+real :: times(nsamp) ! For observing the PDF
+
+! Arrays to hold timings:
+! first axis corresponds to the form of EOS
+! second axis corresponds to the function being timed
+real, dimension(:,:), allocatable :: timings, tmean, tstd, tmin, tmax
+integer :: n_eos, i, j
+
+n_eos = size(list_of_eos)
+allocate( timings(n_eos,n_fns), tmean(n_eos,n_fns) )
+allocate( tstd(n_eos,n_fns), tmin(n_eos,n_fns), tmax(n_eos,n_fns) )
+
+fn_labels(1) = 'calculate_density_scalar()'
+fn_labels(2) = 'calculate_density_array()'
+fn_labels(3) = 'calculate_spec_vol_scalar()'
+fn_labels(4) = 'calculate_spec_vol_array()'
+
+tmean(:,:) = 0.
+tstd(:,:) = 0.
+tmin(:,:) = 1.e9
+tmax(:,:) = 0.
+do i = 1, nsamp
+#ifdef PDF_ONLY
+ call run_one(list_of_EOS, nic, halo, nits, times(i))
+#else
+ call run_suite(list_of_EOS, nic, halo, nits, timings)
+ tmean(:,:) = tmean(:,:) + timings(:,:)
+ tstd(:,:) = tstd(:,:) + timings(:,:)**2 ! tstd contains sum or squares here
+ tmin(:,:) = min( tmin(:,:), timings(:,:) )
+ tmax(:,:) = max( tmax(:,:), timings(:,:) )
+#endif
+enddo
+tmean(:,:) = tmean(:,:) / real(nsamp)
+tstd(:,:) = tstd(:,:) / real(nsamp) ! convert to mean of squares
+tstd(:,:) = tstd(:,:) - tmean(:,:)**2 ! convert to variance
+tstd(:,:) = sqrt( tstd(:,:) * ( real(nsamp) / real(nsamp-1) ) ) ! Standard deviation
+
+#ifdef PDF_ONLY
+open(newunit=i, file='times.txt', status='replace', action='write')
+write(i,'(1pE9.3)') times(:)
+close(i)
+#else
+
+! Display results in YAML
+write(*,'(a)') "{"
+do i = 1, n_eos
+ do j = 1, n_fns
+ write(*,"(2x,5a)") '"MOM_EOS_', trim(get_EOS_name(list_of_EOS(i))), &
+ ' ', trim(fn_labels(j)), '": {'
+ write(*,"(4x,a,1pe11.4,',')") '"min": ',tmin(i,j)
+ write(*,"(4x,a,1pe11.4,',')") '"mean":',tmean(i,j)
+ write(*,"(4x,a,1pe11.4,',')") '"std": ',tstd(i,j)
+ write(*,"(4x,a,i7,',')") '"n_samples": ',nsamp
+ if (i*j.ne.n_eos*n_fns) then
+ write(*,"(4x,a,1pe11.4,'},')") '"max": ',tmax(i,j)
+ else
+ write(*,"(4x,a,1pe11.4,'}')") '"max": ',tmax(i,j)
+ endif
+ enddo
+enddo
+write(*,'(a)') "}"
+#endif
+
+contains
+
+subroutine run_suite(EOS_list, nic, halo, nits, timings)
+ integer, intent(in) :: EOS_list(n_eos) !< IDs of EOS forms to loop over
+ integer, intent(in) :: nic !< Width of computational domain
+ integer, intent(in) :: halo !< Width of halo to add on either end
+ integer, intent(in) :: nits !< Number of calls to sample
+ !! (large enough that the CPU timers can resolve
+ !! the loop)
+ real, intent(out) :: timings(n_eos,n_fns) !< The average time taken for nits calls
+ !! First index corresponds to EOS
+ !! Second index: 1 = scalar args,
+ !! 2 = array args without halo,
+ !! 3 = array args with halo and "dom".
+ type(EOS_type) :: EOS
+ integer :: e, i, dom(2)
+ real :: start, finish, T, S, P, rho
+ real, dimension(nic+2*halo) :: T1, S1, P1, rho1
+
+ T = 10.
+ S = 35.
+ P = 2000.e4
+
+ ! Time the scalar interface
+ do e = 1, n_eos
+ call EOS_manual_init(EOS, form_of_EOS=EOS_list(e), &
+ Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7)
+
+ call cpu_time(start)
+ do i = 1, nits*nic ! Calling nic* to make similar cost to array call
+ call calculate_density(T, S, P, rho, EOS)
+ enddo
+ call cpu_time(finish)
+ timings(e,1) = (finish - start) / real(nits)
+
+ call cpu_time(start)
+ do i = 1, nits*nic ! Calling nic* to make similar cost to array call
+ call calculate_spec_vol(T, S, P, rho, EOS)
+ enddo
+ call cpu_time(finish)
+ timings(e,2) = (finish - start) / real(nits)
+
+ enddo
+
+ ! Time the "dom" interface, 1D array + halos
+ T1(:) = T
+ S1(:) = S
+ P1(:) = P
+ dom(:) = [1+halo,nic+halo]
+
+ do e = 1, n_eos
+ call EOS_manual_init(EOS, form_of_EOS=EOS_list(e), &
+ Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7)
+
+ call cpu_time(start)
+ do i = 1, nits
+ call calculate_density(T1, S1, P1, rho1, EOS, dom)
+ enddo
+ call cpu_time(finish)
+ timings(e,3) = (finish - start) / real(nits)
+
+ call cpu_time(start)
+ do i = 1, nits
+ call calculate_spec_vol(T1, S1, P1, rho1, EOS, dom)
+ enddo
+ call cpu_time(finish)
+ timings(e,4) = (finish - start) / real(nits)
+
+ enddo
+
+end subroutine run_suite
+
+!> Return timing for just one fixed call to explore the PDF
+subroutine run_one(EOS_list, nic, halo, nits, timing)
+ integer, intent(in) :: EOS_list(n_eos) !< IDs of EOS forms to loop over
+ integer, intent(in) :: nic !< Width of computational domain
+ integer, intent(in) :: halo !< Width of halo to add on either end
+ integer, intent(in) :: nits !< Number of calls to sample
+ !! (large enough that the CPU timers can resolve
+ !! the loop)
+ real, intent(out) :: timing !< The average time taken for nits calls
+ !! First index corresponds to EOS
+ !! Second index: 1 = scalar args,
+ !! 2 = array args without halo,
+ !! 3 = array args with halo and "dom".
+ type(EOS_type) :: EOS
+ integer :: i, dom(2)
+ real :: start, finish
+ real, dimension(nic+2*halo) :: T1, S1, P1, rho1
+
+ ! Time the scalar interface
+ call EOS_manual_init(EOS, form_of_EOS=EOS_list(5), &
+ Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7)
+
+ ! Time the "dom" interface, 1D array + halos
+ T1(:) = 10.
+ S1(:) = 35.
+ P1(:) = 2000.e4
+ dom(:) = [1+halo,nic+halo]
+
+ call EOS_manual_init(EOS, form_of_EOS=EOS_list(5), &
+ Rho_T0_S0=1030., dRho_dT=0.2, dRho_dS=-0.7)
+
+ call cpu_time(start)
+ do i = 1, nits
+ call calculate_density(T1, S1, P1, rho1, EOS, dom)
+ enddo
+ call cpu_time(finish)
+ timing = (finish-start)/real(nits)
+
+end subroutine run_one
+
+end program time_MOM_EOS
diff --git a/config_src/drivers/unit_tests/test_MOM_EOS.F90 b/config_src/drivers/unit_tests/test_MOM_EOS.F90
new file mode 100644
index 0000000000..070bec04f6
--- /dev/null
+++ b/config_src/drivers/unit_tests/test_MOM_EOS.F90
@@ -0,0 +1,10 @@
+program test_MOM_EOS
+
+use MOM_EOS, only : EOS_unit_tests
+use MOM_error_handler, only : set_skip_mpi
+
+call set_skip_mpi(.true.) ! This unit tests is not expecting MPI to be used
+
+if ( EOS_unit_tests(.true.) ) stop 1
+
+end program test_MOM_EOS
diff --git a/config_src/drivers/unit_tests/MOM_unit_test_driver.F90 b/config_src/drivers/unit_tests/test_MOM_file_parser.F90
similarity index 96%
rename from config_src/drivers/unit_tests/MOM_unit_test_driver.F90
rename to config_src/drivers/unit_tests/test_MOM_file_parser.F90
index eafa8fa722..55f57d5fc2 100644
--- a/config_src/drivers/unit_tests/MOM_unit_test_driver.F90
+++ b/config_src/drivers/unit_tests/test_MOM_file_parser.F90
@@ -1,4 +1,4 @@
-program MOM_unit_tests
+program test_MOM_file_parser
use MPI
use MOM_domains, only : MOM_infra_init
@@ -62,4 +62,4 @@ program MOM_unit_tests
close(io_unit, status='delete')
endif
-end program MOM_unit_tests
+end program test_MOM_file_parser
diff --git a/config_src/drivers/unit_tests/test_MOM_mixedlayer_restrat.F90 b/config_src/drivers/unit_tests/test_MOM_mixedlayer_restrat.F90
new file mode 100644
index 0000000000..3e5eec64fc
--- /dev/null
+++ b/config_src/drivers/unit_tests/test_MOM_mixedlayer_restrat.F90
@@ -0,0 +1,10 @@
+program test_MOM_mixedlayer_restrat
+
+use MOM_mixed_layer_restrat, only : mixedlayer_restrat_unit_tests
+use MOM_error_handler, only : set_skip_mpi
+
+call set_skip_mpi(.true.) ! This unit tests is not expecting MPI to be used
+
+if ( mixedlayer_restrat_unit_tests(.true.) ) stop 1
+
+end program test_MOM_mixedlayer_restrat
diff --git a/config_src/drivers/unit_tests/test_MOM_string_functions.F90 b/config_src/drivers/unit_tests/test_MOM_string_functions.F90
new file mode 100644
index 0000000000..2376afbbae
--- /dev/null
+++ b/config_src/drivers/unit_tests/test_MOM_string_functions.F90
@@ -0,0 +1,10 @@
+program test_MOM_string_functions
+
+use MOM_string_functions, only : string_functions_unit_tests
+use MOM_error_handler, only : set_skip_mpi
+
+call set_skip_mpi(.true.) ! This unit tests is not expecting MPI to be used
+
+if ( string_functions_unit_tests(.true.) ) stop 1
+
+end program test_MOM_string_functions
diff --git a/config_src/external/drifters/MOM_particles.F90 b/config_src/external/drifters/MOM_particles.F90
index aad918e5a4..95470e6510 100644
--- a/config_src/external/drifters/MOM_particles.F90
+++ b/config_src/external/drifters/MOM_particles.F90
@@ -11,51 +11,75 @@ module MOM_particles_mod
implicit none ; private
public particles, particles_run, particles_init, particles_save_restart, particles_end
+public particles_to_k_space, particles_to_z_space
contains
!> Initializes particles container "parts"
-subroutine particles_init(parts, Grid, Time, dt, u, v)
+subroutine particles_init(parts, Grid, Time, dt, u, v, h)
! Arguments
type(particles), pointer, intent(out) :: parts !< Container for all types and memory
type(ocean_grid_type), target, intent(in) :: Grid !< Grid type from parent model
type(time_type), intent(in) :: Time !< Time type from parent model
- real, intent(in) :: dt !< particle timestep [s]
- real, dimension(:,:,:), intent(in) :: u !< Zonal velocity field [m s-1]
- real, dimension(:,:,:), intent(in) :: v !< Meridional velocity field [m s-1]
-
+ real, intent(in) :: dt !< particle timestep in seconds [T ~> s]
+ real, dimension(:,:,:),intent(in) :: u !< Zonal velocity field [L T-1 ~> m s-1]
+ real, dimension(:,:,:),intent(in) :: v !< Meridional velocity field [L T-1 ~> m s-1]
+ real, dimension(:,:,:),intent(in) :: h !< Thickness of each layer [H ~> m or kg m-2]
end subroutine particles_init
!> The main driver the steps updates particles
-subroutine particles_run(parts, time, uo, vo, ho, tv, stagger)
+subroutine particles_run(parts, time, uo, vo, ho, tv, use_uh, stagger)
! Arguments
type(particles), pointer :: parts !< Container for all types and memory
type(time_type), intent(in) :: time !< Model time
- real, dimension(:,:,:), intent(in) :: uo !< Ocean zonal velocity [m s-1]
- real, dimension(:,:,:), intent(in) :: vo !< Ocean meridional velocity [m s-1]
+ real, dimension(:,:,:), intent(in) :: uo !< If use_uh is false, ocean zonal velocity [L T-1 ~>m s-1].
+ !! If use_uh is true, accumulated zonal thickness fluxes
+ !! that are used to advect tracers [H L2 ~> m3 or kg]
+ real, dimension(:,:,:), intent(in) :: vo !< If use_uh is false, ocean meridional velocity [L T-1 ~>m s-1].
+ !! If use_uh is true, accumulated meridional thickness fluxes
+ !! that are used to advect tracers [H L2 ~> m3 or kg]
real, dimension(:,:,:), intent(in) :: ho !< Ocean layer thickness [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(in) :: tv !< structure containing pointers to available thermodynamic fields
+ logical :: use_uh !< Flag for whether u and v are weighted by thickness
integer, optional, intent(in) :: stagger !< Flag for whether velocities are staggered
end subroutine particles_run
!>Save particle locations (and sometimes other vars) to restart file
-subroutine particles_save_restart(parts, temp, salt)
+subroutine particles_save_restart(parts, h, directory, time, time_stamped)
! Arguments
type(particles), pointer :: parts !< Container for all types and memory
- real, dimension(:,:,:), optional, intent(in) :: temp !< Optional container for temperature
- real, dimension(:,:,:), optional, intent(in) :: salt !< Optional container for salinity
+ real, dimension(:,:,:),intent(in) :: h !< Thickness of each layer [H ~> m or kg m-2]
+ character(len=*), intent(in) :: directory !< The directory where the restart files are to be written
+ type(time_type), intent(in) :: time !< The current model time
+ logical, optional, intent(in) :: time_stamped !< If present and true, add time-stamp to the restart file names
end subroutine particles_save_restart
!> Deallocate all memory and disassociated pointer
-subroutine particles_end(parts, temp, salt)
+subroutine particles_end(parts, h, temp, salt)
! Arguments
type(particles), pointer :: parts !< Container for all types and memory
- real, dimension(:,:,:), optional, intent(in) :: temp !< Optional container for temperature
- real, dimension(:,:,:), optional, intent(in) :: salt !< Optional container for salinity
+ real, dimension(:,:,:),intent(in) :: h !< Thickness of each layer [H ~> m or kg m-2]
+ real, dimension(:,:,:), optional, intent(in) :: temp !< Optional container for temperature [C ~> degC]
+ real, dimension(:,:,:), optional, intent(in) :: salt !< Optional container for salinity [S ~> ppt]
end subroutine particles_end
+subroutine particles_to_k_space(parts, h)
+ ! Arguments
+ type(particles), pointer :: parts !< Container for all types and memory
+ real, dimension(:,:,:),intent(in) :: h !< Thickness of layers [H ~> m or kg m-2]
+
+end subroutine particles_to_k_space
+
+
+subroutine particles_to_z_space(parts, h)
+ ! Arguments
+ type(particles), pointer :: parts !< Container for all types and memory
+ real, dimension(:,:,:),intent(in) :: h !< Thickness of layers [H ~> m or kg m-2]
+
+end subroutine particles_to_z_space
+
end module MOM_particles_mod
diff --git a/config_src/infra/FMS2/MOM_ensemble_manager_infra.F90 b/config_src/infra/FMS2/MOM_ensemble_manager_infra.F90
index c9eb067e54..f4028f7af7 100644
--- a/config_src/infra/FMS2/MOM_ensemble_manager_infra.F90
+++ b/config_src/infra/FMS2/MOM_ensemble_manager_infra.F90
@@ -10,7 +10,6 @@ module MOM_ensemble_manager_infra
use ensemble_manager_mod, only : FMS_get_ensemble_pelist => get_ensemble_pelist
use ensemble_manager_mod, only : FMS_get_ensemble_filter_pelist => get_ensemble_filter_pelist
use fms2_io_mod, only : fms2_io_set_filename_appendix=>set_filename_appendix
-use fms_io_mod, only : fms_io_set_filename_appendix=>set_filename_appendix
implicit none ; private
@@ -28,7 +27,6 @@ subroutine ensemble_manager_init(ensemble_suffix)
if (present(ensemble_suffix)) then
call fms2_io_set_filename_appendix(trim(ensemble_suffix))
- call fms_io_set_filename_appendix(trim(ensemble_suffix))
else
call FMS_ensemble_manager_init()
endif
diff --git a/docs/requirements.txt b/docs/requirements.txt
index 52fcf95bc0..ff627c61c7 100644
--- a/docs/requirements.txt
+++ b/docs/requirements.txt
@@ -8,3 +8,5 @@ sphinxcontrib-bibtex
numpy
six
future
+# Old Sphinx requires an old Jinja2
+jinja2<3.1
diff --git a/docs/zotero.bib b/docs/zotero.bib
index c0c7ee3bd9..c0f1ddccbb 100644
--- a/docs/zotero.bib
+++ b/docs/zotero.bib
@@ -2738,3 +2738,25 @@ @article{kraus1967
journal = {Tellus}
}
+@article{Nguyen2009,
+ doi = {10.1029/2008JC005121},
+ year = {2009},
+ journal = {JGR Oceans},
+ volume = {114},
+ author = {A. T. Nguyen and D. Menemenlis and R. Kwok},
+ title = {Improved modeling of the Arctic halocline with a subgrid-scale brine rejection parameterization},
+ pages = {C11014}
+}
+
+@article{Adcroft2019,
+ doi = {10.1029/2019ms001726},
+ year = 2019,
+ publisher = {American Geophysical Union ({AGU})},
+ volume = {11},
+ number = {10},
+ pages = {3167--3211},
+ author = {A. Adcroft and W. Anderson and V. Balaji and C. Blanton and M. Bushuk and C. O. Dufour and J. P. Dunne and S. M. Griffies and R. Hallberg and M. J. Harrison and I. M. Held and M. F. Jansen and J. G. John and J. P. Krasting and A. R. Langenhorst and S. Legg and Z. Liang and C. McHugh and A. Radhakrishnan and B. G. Reichl and T. Rosati and B. L. Samuels and A. Shao and R. Stouffer and M. Winton and A. T. Wittenberg and B. Xiang and N. Zadeh and R. Zhang},
+ title = {The {GFDL} Global Ocean and Sea Ice Model {OM}4.0: Model Description and Simulation Features},
+ journal = {J. Adv. Mod. Earth Sys.}
+}
+
diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90
index a341fd1835..600439d5b2 100644
--- a/src/ALE/MOM_ALE.F90
+++ b/src/ALE/MOM_ALE.F90
@@ -20,7 +20,7 @@ module MOM_ALE
use MOM_hybgen_unmix, only : hybgen_unmix, init_hybgen_unmix, end_hybgen_unmix, hybgen_unmix_CS
use MOM_hybgen_regrid, only : hybgen_regrid_CS
use MOM_file_parser, only : get_param, param_file_type, log_param
-use MOM_interface_heights,only : find_eta
+use MOM_interface_heights,only : find_eta, calc_derived_thermo
use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W
use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S
use MOM_regridding, only : initialize_regridding, regridding_main, end_regridding
@@ -97,6 +97,9 @@ module MOM_ALE
!! values result in the use of more robust and accurate forms of
!! mathematically equivalent expressions.
+ logical :: conserve_ke !< Apply a correction to the baroclinic velocity after remapping to
+ !! conserve KE.
+
logical :: debug !< If true, write verbose checksums for debugging purposes.
logical :: show_call_tree !< For debugging
@@ -117,6 +120,8 @@ module MOM_ALE
integer :: id_e_preale = -1 !< diagnostic id for interface heights before ALE.
integer :: id_vert_remap_h = -1 !< diagnostic id for layer thicknesses used for remapping
integer :: id_vert_remap_h_tendency = -1 !< diagnostic id for layer thickness tendency due to ALE
+ integer :: id_remap_delta_integ_u2 = -1 !< Change in depth-integrated rho0*u**2/2
+ integer :: id_remap_delta_integ_v2 = -1 !< Change in depth-integrated rho0*v**2/2
end type
@@ -129,6 +134,7 @@ module MOM_ALE
public ALE_remap_scalar
public ALE_remap_tracers
public ALE_remap_velocities
+public ALE_remap_set_h_vel, ALE_remap_set_h_vel_via_dz
public ALE_remap_interface_vals
public ALE_remap_vertex_vals
public ALE_PLM_edge_values
@@ -170,10 +176,6 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS)
character(len=80) :: string, vel_string ! Temporary strings
real :: filter_shallow_depth, filter_deep_depth ! Depth ranges of filtering [H ~> m or kg m-2]
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions for remapping
- ! that recover the answers from the end of 2018. Otherwise, use more
- ! robust and accurate forms of mathematically equivalent expressions.
logical :: check_reconstruction
logical :: check_remapping
logical :: force_bounds_in_subcell
@@ -231,23 +233,13 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
call initialize_remapping( CS%remapCS, string, &
boundary_extrapolation=remap_boundary_extrap, &
@@ -311,6 +303,11 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS)
if (CS%use_hybgen_unmix) &
call init_hybgen_unmix(CS%hybgen_unmixCS, GV, US, param_file, hybgen_regridCS)
+ call get_param(param_file, mdl, "REMAP_VEL_CONSERVE_KE", CS%conserve_ke, &
+ "If true, a correction is applied to the baroclinic component of velocity "//&
+ "after remapping so that total KE is conserved. KE may not be conserved "//&
+ "when (CS%BBL_h_vel_mask > 0.0) .and. (CS%h_vel_mask > 0.0)", &
+ default=.false.)
call get_param(param_file, "MOM", "DEBUG", CS%debug, &
"If true, write out verbose debugging data.", &
default=.false., debuggingParam=.true.)
@@ -354,13 +351,23 @@ subroutine ALE_register_diags(Time, G, GV, US, diag, CS)
CS%id_dzRegrid = register_diag_field('ocean_model', 'dzRegrid', diag%axesTi, Time, &
'Change in interface height due to ALE regridding', 'm', conversion=GV%H_to_m)
- cs%id_vert_remap_h = register_diag_field('ocean_model', 'vert_remap_h', diag%axestl, Time, &
+ CS%id_vert_remap_h = register_diag_field('ocean_model', 'vert_remap_h', diag%axestl, Time, &
'layer thicknesses after ALE regridding and remapping', &
thickness_units, conversion=GV%H_to_MKS, v_extensive=.true.)
- cs%id_vert_remap_h_tendency = register_diag_field('ocean_model', &
+ CS%id_vert_remap_h_tendency = register_diag_field('ocean_model', &
'vert_remap_h_tendency', diag%axestl, Time, &
'Layer thicknesses tendency due to ALE regridding and remapping', &
trim(thickness_units)//" s-1", conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.)
+ CS%id_remap_delta_integ_u2 = register_diag_field('ocean_model', 'ale_u2', diag%axesCu1, Time, &
+ 'Rate of change in half rho0 times depth integral of squared zonal'//&
+ ' velocity by remapping. If REMAP_VEL_CONSERVE_KE is .true. then '//&
+ ' this measures the change before the KE-conserving correction is applied.', &
+ 'W m-2', conversion=US%RZ3_T3_to_W_m2 * US%L_to_Z**2)
+ CS%id_remap_delta_integ_v2 = register_diag_field('ocean_model', 'ale_v2', diag%axesCv1, Time, &
+ 'Rate of change in half rho0 times depth integral of squared meridional'//&
+ ' velocity by remapping. If REMAP_VEL_CONSERVE_KE is .true. then '//&
+ ' this measures the change before the KE-conserving correction is applied.', &
+ 'W m-2', conversion=US%RZ3_T3_to_W_m2 * US%L_to_Z**2)
end subroutine ALE_register_diags
@@ -483,7 +490,7 @@ subroutine ALE_regrid( G, GV, US, h, h_new, dzRegrid, tv, CS, frac_shelf_h, PCM_
! Build the new grid and store it in h_new. The old grid is retained as h.
! Both are needed for the subsequent remapping of variables.
dzRegrid(:,:,:) = 0.0
- call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, &
+ call regridding_main( CS%remapCS, CS%regridCS, G, GV, US, h, tv, h_new, dzRegrid, &
frac_shelf_h=frac_shelf_h, PCM_cell=PCM_cell)
if (CS%id_dzRegrid>0) then ; if (query_averaging_enabled(CS%diag)) then
@@ -497,16 +504,18 @@ end subroutine ALE_regrid
!> Regrid/remap stored fields used for offline tracer integrations. These input fields are assumed to have
!! the same layer thicknesses at the end of the last offline interval (which should be a Zstar grid). This
!! routine builds a grid on the runtime specified vertical coordinate
-subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC)
+subroutine ALE_offline_inputs(CS, G, GV, US, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC)
type(ALE_CS), pointer :: CS !< Regridding parameters and options
type(ocean_grid_type), intent(in ) :: G !< Ocean grid informations
type(verticalGrid_type), intent(in ) :: GV !< Ocean vertical grid structure
+ type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure
type(tracer_registry_type), pointer :: Reg !< Tracer registry structure
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg]
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivities [Z2 T-1 ~> m2 s-1]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivities
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
logical, intent(in ) :: debug !< If true, then turn checksums
type(ocean_OBC_type), pointer :: OBC !< Open boundary structure
! Local variables
@@ -526,11 +535,12 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC)
! Build new grid from the Zstar state onto the requested vertical coordinate. The new grid is stored
! in h_new. The old grid is h. Both are needed for the subsequent remapping of variables. Convective
! adjustment right now is not used because it is unclear what to do with vanished layers
- call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid)
+ call regridding_main( CS%remapCS, CS%regridCS, G, GV, US, h, tv, h_new, dzRegrid)
if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_offline_inputs)")
! Remap all variables from old grid h onto new grid h_new
call ALE_remap_tracers(CS, G, GV, h, h_new, Reg, debug=CS%show_call_tree)
+ if (allocated(tv%SpV_avg)) tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_inputs)")
! Reintegrate mass transports from Zstar to the offline vertical coordinate
@@ -570,16 +580,19 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC)
h(i,j,k) = h_new(i,j,k)
enddo ; enddo ; enddo
+ if (allocated(tv%SpV_avg)) tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
+
if (CS%show_call_tree) call callTree_leave("ALE_offline_inputs()")
end subroutine ALE_offline_inputs
!> For a state-based coordinate, accelerate the process of regridding by
!! repeatedly applying the grid calculation algorithm
-subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, dzRegrid, initial)
+subroutine ALE_regrid_accelerated(CS, G, GV, US, h, tv, n_itt, u, v, OBC, Reg, dt, dzRegrid, initial)
type(ALE_CS), pointer :: CS !< ALE control structure
type(ocean_grid_type), intent(inout) :: G !< Ocean grid
type(verticalGrid_type), intent(in) :: GV !< Vertical grid
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: h !< Original thicknesses [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS)
@@ -605,6 +618,15 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_orig ! The original layer thicknesses [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: T ! local temporary temperatures [C ~> degC]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: S ! local temporary salinities [S ~> ppt]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: h_old_u ! Source grid thickness at zonal
+ ! velocity points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: h_old_v ! Source grid thickness at meridional
+ ! velocity points [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: h_new_u ! Destination grid thickness at zonal
+ ! velocity points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: h_new_v ! Destination grid thickness at meridional
+ ! velocity points [H ~> m or kg m-2]
+
! we have to keep track of the total dzInterface if for some reason
! we're using the old remapping algorithm for u/v
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzInterface ! Interface height changes within
@@ -615,7 +637,8 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d
nz = GV%ke
! initial total interface displacement due to successive regridding
- dzIntTotal(:,:,:) = 0.
+ if (CS%remap_uv_using_old_alg) &
+ dzIntTotal(:,:,:) = 0.
call create_group_pass(pass_T_S_h, T, G%domain)
call create_group_pass(pass_T_S_h, S, G%domain)
@@ -651,8 +674,12 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d
! generate new grid
if (CS%do_conv_adj) call convective_adjustment(G, GV, h_loc, tv_local)
- call regridding_main(CS%remapCS, CS%regridCS, G, GV, h_loc, tv_local, h, dzInterface)
- dzIntTotal(:,:,:) = dzIntTotal(:,:,:) + dzInterface(:,:,:)
+ ! Update the layer specific volumes if necessary
+ if (allocated(tv_local%SpV_avg)) call calc_derived_thermo(tv_local, h, G, GV, US, halo=1)
+
+ call regridding_main(CS%remapCS, CS%regridCS, G, GV, US, h_loc, tv_local, h, dzInterface)
+ if (CS%remap_uv_using_old_alg) &
+ dzIntTotal(:,:,:) = dzIntTotal(:,:,:) + dzInterface(:,:,:)
! remap from original grid onto new grid
do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1
@@ -668,10 +695,21 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d
! remap all state variables (including those that weren't needed for regridding)
call ALE_remap_tracers(CS, G, GV, h_orig, h, Reg)
- call ALE_remap_velocities(CS, G, GV, h_orig, h, u, v, OBC, dzIntTotal)
+
+ call ALE_remap_set_h_vel(CS, G, GV, h_orig, h_old_u, h_old_v, OBC)
+ if (CS%remap_uv_using_old_alg) then
+ call ALE_remap_set_h_vel_via_dz(CS, G, GV, h, h_new_u, h_new_v, OBC, h_orig, dzIntTotal)
+ else
+ call ALE_remap_set_h_vel(CS, G, GV, h, h_new_u, h_new_v, OBC)
+ endif
+
+ call ALE_remap_velocities(CS, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, u, v)
! save total dzregrid for diags if needed?
if (present(dzRegrid)) dzRegrid(:,:,:) = dzIntTotal(:,:,:)
+
+ if (allocated(tv%SpV_avg)) tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
+
end subroutine ALE_regrid_accelerated
!> This routine takes care of remapping all tracer variables between the old and the
@@ -810,36 +848,226 @@ subroutine ALE_remap_tracers(CS, G, GV, h_old, h_new, Reg, debug, dt, PCM_cell)
end subroutine ALE_remap_tracers
-!> This routine remaps velocity components between the old and the new grids,
-!! with thicknesses at velocity points taken to be arithmetic averages of tracer thicknesses.
-!! This routine may be called during initialization of the model at time=0, to
-!! remap initial conditions to the model grid. It is also called during a
-!! time step to update the state.
-subroutine ALE_remap_velocities(CS, G, GV, h_old, h_new, u, v, OBC, dzInterface, debug, dt)
+!> This routine sets the thicknesses at velocity points used for vertical remapping.
+subroutine ALE_remap_set_h_vel(CS, G, GV, h_new, h_u, h_v, OBC, debug)
+ type(ALE_CS), intent(in) :: CS !< ALE control structure
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness at tracer points of the
+ !! grid being interpolated to velocity
+ !! points [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(inout) :: h_u !< Grid thickness at zonal velocity
+ !! points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(inout) :: h_v !< Grid thickness at meridional velocity
+ !! points [H ~> m or kg m-2]
+ type(ocean_OBC_type), pointer :: OBC !< Open boundary structure
+ logical, optional, intent(in) :: debug !< If true, show the call tree
+
+ ! Local variables
+ logical :: show_call_tree
+ integer :: i, j, k
+
+ show_call_tree = .false.
+ if (present(debug)) show_call_tree = debug
+ if (show_call_tree) call callTree_enter("ALE_remap_set_h_vel()")
+
+ ! Build the u- and v-velocity grid thicknesses for remapping.
+
+ !$OMP parallel do default(shared)
+ do k=1,GV%ke ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (G%mask2dCu(I,j)>0.) then
+ h_u(I,j,k) = 0.5*(h_new(i,j,k) + h_new(i+1,j,k))
+ endif ; enddo ; enddo ; enddo
+ !$OMP parallel do default(shared)
+ do k=1,GV%ke ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (G%mask2dCv(i,J)>0.) then
+ h_v(i,J,k) = 0.5*(h_new(i,j,k) + h_new(i,j+1,k))
+ endif ; enddo ; enddo ; enddo
+
+ ! Mask out blocked portions of velocity cells.
+ if (CS%partial_cell_vel_remap) call ALE_remap_set_h_vel_partial(CS, G, GV, h_new, h_u, h_v)
+
+ ! Take open boundary conditions into account.
+ if (associated(OBC)) call ALE_remap_set_h_vel_OBC(G, GV, h_new, h_u, h_v, OBC)
+
+ if (show_call_tree) call callTree_leave("ALE_remap_set_h_vel()")
+
+end subroutine ALE_remap_set_h_vel
+
+!> This routine sets the thicknesses at velocity points used for vertical remapping using a
+!! combination of the old grid and interface movements.
+subroutine ALE_remap_set_h_vel_via_dz(CS, G, GV, h_new, h_u, h_v, OBC, h_old, dzInterface, debug)
type(ALE_CS), intent(in) :: CS !< ALE control structure
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid
- !! [H ~> m or kg m-2]
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid
- !! [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness at tracer points of the
+ !! grid being interpolated to velocity
+ !! points [H ~> m or kg m-2]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
- intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1]
+ intent(inout) :: h_u !< Grid thickness at zonal velocity
+ !! points [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
- intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1]
+ intent(inout) :: h_v !< Grid thickness at meridional velocity
+ !! points [H ~> m or kg m-2]
type(ocean_OBC_type), pointer :: OBC !< Open boundary structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h_old !< Thickness of source grid when generating
+ !! the destination grid via the old
+ !! algorithm [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- optional, intent(in) :: dzInterface !< Change in interface position
+ intent(in) :: dzInterface !< Change in interface position
!! [H ~> m or kg m-2]
- logical, optional, intent(in) :: debug !< If true, show the call tree
- real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s]
+ logical, optional, intent(in) :: debug !< If true, show the call tree
+ ! Local variables
+ logical :: show_call_tree
+ integer :: i, j, k
+
+ show_call_tree = .false.
+ if (present(debug)) show_call_tree = debug
+ if (show_call_tree) call callTree_enter("ALE_remap_set_h_vel()")
+
+ ! Build the u- and v-velocity grid thicknesses for remapping using the old grid and interface movement.
+
+ !$OMP parallel do default(shared)
+ do k=1,GV%ke ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (G%mask2dCu(I,j)>0.) then
+ h_u(I,j,k) = max( 0., 0.5*(h_old(i,j,k) + h_old(i+1,j,k)) + &
+ 0.5 * (( dzInterface(i,j,k) + dzInterface(i+1,j,k) ) - &
+ ( dzInterface(i,j,k+1) + dzInterface(i+1,j,k+1) )) )
+ endif ; enddo ; enddo ; enddo
+
+ !$OMP parallel do default(shared)
+ do k=1,GV%ke ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (G%mask2dCv(i,J)>0.) then
+ h_v(i,J,k) = max( 0., 0.5*(h_old(i,j,k) + h_old(i,j+1,k)) + &
+ 0.5 * (( dzInterface(i,j,k) + dzInterface(i,j+1,k) ) - &
+ ( dzInterface(i,j,k+1) + dzInterface(i,j+1,k+1) )) )
+ endif ; enddo ; enddo ; enddo
+
+ ! Mask out blocked portions of velocity cells.
+ if (CS%partial_cell_vel_remap) call ALE_remap_set_h_vel_partial(CS, G, GV, h_old, h_u, h_v)
+
+ ! Take open boundary conditions into account.
+ if (associated(OBC)) call ALE_remap_set_h_vel_OBC(G, GV, h_new, h_u, h_v, OBC)
+
+ if (show_call_tree) call callTree_leave("ALE_remap_set_h_vel()")
+
+end subroutine ALE_remap_set_h_vel_via_dz
+
+!> Mask out the thicknesses at velocity points where they are below the minimum depth
+!! at adjacent tracer points
+subroutine ALE_remap_set_h_vel_partial(CS, G, GV, h_mask, h_u, h_v)
+ type(ALE_CS), intent(in) :: CS !< ALE control structure
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_mask !< Thickness at tracer points
+ !! used to apply the partial
+ !! cell masking [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(inout) :: h_u !< Grid thickness at zonal velocity
+ !! points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(inout) :: h_v !< Grid thickness at meridional velocity
+ !! points [H ~> m or kg m-2]
! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: h_tot ! The vertically summed thicknesses [H ~> m or kg m-2]
real :: h_mask_vel ! A depth below which the thicknesses at a velocity point are masked out [H ~> m or kg m-2]
- real, dimension(GV%ke+1) :: dz ! The change in interface heights interpolated to
- ! a velocity point [H ~> m or kg m-2]
- logical :: PCM(GV%ke) ! If true, do PCM remapping from a cell.
+ integer :: i, j, k
+
+ h_tot(:,:) = 0.0
+ do k=1,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1
+ h_tot(i,j) = h_tot(i,j) + h_mask(i,j,k)
+ enddo ; enddo ; enddo
+
+ !$OMP parallel do default(shared) private(h_mask_vel)
+ do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (G%mask2dCu(I,j)>0.) then
+ h_mask_vel = min(h_tot(i,j), h_tot(i+1,j))
+ call apply_partial_cell_mask(h_u(I,j,:), h_mask_vel)
+ endif ; enddo ; enddo
+
+ !$OMP parallel do default(shared) private(h_mask_vel)
+ do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (G%mask2dCv(i,J)>0.) then
+ h_mask_vel = min(h_tot(i,j), h_tot(i,j+1))
+ call apply_partial_cell_mask(h_v(i,J,:), h_mask_vel)
+ endif ; enddo ; enddo
+
+end subroutine ALE_remap_set_h_vel_partial
+
+! Reset thicknesses at velocity points on open boundary condition segments
+subroutine ALE_remap_set_h_vel_OBC(G, GV, h_new, h_u, h_v, OBC)
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness at tracer points of the
+ !! grid being interpolated to velocity
+ !! points [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(inout) :: h_u !< Grid thickness at zonal velocity
+ !! points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(inout) :: h_v !< Grid thickness at meridional velocity
+ !! points [H ~> m or kg m-2]
+ type(ocean_OBC_type), pointer :: OBC !< Open boundary structure
+
+ ! Local variables
+ integer :: i, j, k, nz
+
+ if (.not.associated(OBC)) return
+
+ nz = GV%ke
+
+ ! Take open boundary conditions into account.
+ !$OMP parallel do default(shared)
+ do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (OBC%segnum_u(I,j) /= 0) then
+ if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
+ do k=1,nz ; h_u(I,j,k) = h_new(i,j,k) ; enddo
+ else ! (OBC%segment(n)%direction == OBC_DIRECTION_W)
+ do k=1,nz ; h_u(I,j,k) = h_new(i+1,j,k) ; enddo
+ endif
+ endif ; enddo ; enddo
+
+ !$OMP parallel do default(shared)
+ do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (OBC%segnum_v(i,J) /= 0) then
+ if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
+ do k=1,nz ; h_v(i,J,k) = h_new(i,j,k) ; enddo
+ else ! (OBC%segment(n)%direction == OBC_DIRECTION_S)
+ do k=1,nz ; h_v(i,J,k) = h_new(i,j+1,k) ; enddo
+ endif
+ endif ; enddo ; enddo
+
+end subroutine ALE_remap_set_h_vel_OBC
+
+!> This routine remaps velocity components between the old and the new grids,
+!! with thicknesses at velocity points taken to be arithmetic averages of tracer thicknesses.
+!! This routine may be called during initialization of the model at time=0, to
+!! remap initial conditions to the model grid. It is also called during a
+!! time step to update the state.
+subroutine ALE_remap_velocities(CS, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, u, v, debug, &
+ dt, allow_preserve_variance)
+ type(ALE_CS), intent(in) :: CS !< ALE control structure
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h_old_u !< Source grid thickness at zonal
+ !! velocity points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(in) :: h_old_v !< Source grid thickness at meridional
+ !! velocity points [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h_new_u !< Destination grid thickness at zonal
+ !! velocity points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(in) :: h_new_v !< Destination grid thickness at meridional
+ !! velocity points [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1]
+ logical, optional, intent(in) :: debug !< If true, show the call tree
+ real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s]
+ logical, optional, intent(in) :: allow_preserve_variance !< If true, enables ke-conserving
+ !! correction
+
+ ! Local variables
+ real :: h_mask_vel ! A depth below which the thicknesses at a velocity point are masked out [H ~> m or kg m-2]
real :: u_src(GV%ke) ! A column of u-velocities on the source grid [L T-1 ~> m s-1]
real :: u_tgt(GV%ke) ! A column of u-velocities on the target grid [L T-1 ~> m s-1]
real :: v_src(GV%ke) ! A column of v-velocities on the source grid [L T-1 ~> m s-1]
@@ -847,6 +1075,16 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old, h_new, u, v, OBC, dzInterface,
real :: h1(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2]
real :: h2(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2]
real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2]
+ real :: rescale_coef ! Factor that scales the baroclinic velocity to conserve ke [nondim]
+ real :: u_bt, v_bt ! Depth-averaged velocity components [L T-1 ~> m s-1]
+ real :: ke_c_src, ke_c_tgt ! \int [u_c or v_c]^2 dz on src and tgt grids [H L2 T-2 ~> m3 s-2]
+ real, dimension(SZIB_(G),SZJ_(G)) :: du2h_tot ! The rate of change of vertically integrated
+ ! 0.5 * rho0 * u**2 [R Z L2 T-3 ~> W m-2]
+ real, dimension(SZI_(G),SZJB_(G)) :: dv2h_tot ! The rate of change of vertically integrated
+ ! 0.5 * rho0 * v**2 [R Z L2 T-3 ~> W m-2]
+ real :: u2h_tot, v2h_tot ! The vertically integrated u**2 and v**2 [H L2 T-2 ~> m3 s-2 or kg s-2]
+ real :: I_dt ! 1 / dt [T-1 ~> s-1]
+ logical :: variance_option ! Contains the value of allow_preserve_variance when present, else false
logical :: show_call_tree
integer :: i, j, k, nz
@@ -854,10 +1092,16 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old, h_new, u, v, OBC, dzInterface,
if (present(debug)) show_call_tree = debug
if (show_call_tree) call callTree_enter("ALE_remap_velocities()")
- ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dzInterface. Otherwise,
- ! u and v can be remapped without dzInterface
- if (CS%remap_uv_using_old_alg .and. .not.present(dzInterface) ) call MOM_error(FATAL, &
- "ALE_remap_velocities: dzInterface must be present if using old algorithm.")
+ ! Setup related to KE conservation
+ variance_option = .false.
+ if (present(allow_preserve_variance)) variance_option=allow_preserve_variance
+ if (present(dt)) I_dt = 1.0 / dt
+
+ if (CS%id_remap_delta_integ_u2>0) du2h_tot(:,:) = 0.
+ if (CS%id_remap_delta_integ_v2>0) dv2h_tot(:,:) = 0.
+
+ if (((CS%id_remap_delta_integ_u2>0) .or. (CS%id_remap_delta_integ_v2>0)) .and. .not.present(dt))&
+ call MOM_error(FATAL, "ALE KE diagnostics requires passing dt into ALE_remap_velocities")
if (CS%answer_date >= 20190101) then
h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff
@@ -869,107 +1113,139 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old, h_new, u, v, OBC, dzInterface,
nz = GV%ke
- if (CS%partial_cell_vel_remap) then
- h_tot(:,:) = 0.0
- do k=1,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1
- h_tot(i,j) = h_tot(i,j) + h_old(i,j,k)
- enddo ; enddo ; enddo
- endif
+ ! --- Remap u profiles from the source vertical grid onto the new target grid.
- ! Remap u velocity component
- if ( .true. ) then
+ !$OMP parallel do default(shared) private(h1,h2,u_src,h_mask_vel,u_tgt, &
+ !$OMP u_bt,ke_c_src,ke_c_tgt,rescale_coef, &
+ !$OMP u2h_tot,v2h_tot)
+ do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (G%mask2dCu(I,j)>0.) then
+ ! Make a 1-d copy of the start and final grids and the source velocity
+ do k=1,nz
+ h1(k) = h_old_u(I,j,k)
+ h2(k) = h_new_u(I,j,k)
+ u_src(k) = u(I,j,k)
+ enddo
- !$OMP parallel do default(shared) private(h1,h2,dz,u_src,h_mask_vel,u_tgt)
- do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (G%mask2dCu(I,j)>0.) then
- ! Build the start and final grids
+ if (CS%id_remap_delta_integ_u2>0) then
+ u2h_tot = 0.
do k=1,nz
- h1(k) = 0.5*(h_old(i,j,k) + h_old(i+1,j,k))
- h2(k) = 0.5*(h_new(i,j,k) + h_new(i+1,j,k))
+ u2h_tot = u2h_tot - h1(k) * (u_src(k)**2)
enddo
- if (CS%remap_uv_using_old_alg) then
- dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i+1,j,:) )
- do k = 1, nz
- h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) )
- enddo
- endif
+ endif
- if (CS%partial_cell_vel_remap) then
- h_mask_vel = min(h_tot(i,j), h_tot(i+1,j))
- call apply_partial_cell_mask(h1, h_mask_vel)
- call apply_partial_cell_mask(h2, h_mask_vel)
- endif
+ call remapping_core_h(CS%vel_remapCS, nz, h1, u_src, nz, h2, u_tgt, &
+ h_neglect, h_neglect_edge)
- if (associated(OBC)) then ; if (OBC%segnum_u(I,j) /= 0) then
- if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
- do k=1,nz ; h1(k) = h_old(i,j,k) ; h2(k) = h_new(i,j,k) ; enddo
- else ! (OBC%segment(n)%direction == OBC_DIRECTION_W)
- do k=1,nz ; h1(k) = h_old(i+1,j,k) ; h2(k) = h_new(i+1,j,k) ; enddo
- endif
- endif ; endif
+ if (variance_option .and. CS%conserve_ke) then
+ ! Conserve ke_u by correcting baroclinic component.
+ ! Assumes total depth doesn't change during remap, and
+ ! that \int u(z) dz doesn't change during remap.
+ ! First get barotropic component
+ u_bt = 0.0
+ do k=1,nz
+ u_bt = u_bt + h2(k) * u_tgt(k) ! Dimensions [H L T-1]
+ enddo
+ u_bt = u_bt / (sum(h2(1:nz)) + h_neglect) ! Dimensions return to [L T-1]
+ ! Next get baroclinic ke = \int (u-u_bt)^2 from source and target
+ ke_c_src = 0.0
+ ke_c_tgt = 0.0
+ do k=1,nz
+ ke_c_src = ke_c_src + h1(k) * (u_src(k) - u_bt)**2
+ ke_c_tgt = ke_c_tgt + h2(k) * (u_tgt(k) - u_bt)**2
+ enddo
+ ! Next rescale baroclinic component on target grid to conserve ke
+ rescale_coef = min(1.25, sqrt(ke_c_src / (ke_c_tgt + 1.E-19)))
+ do k=1,nz
+ u_tgt(k) = u_bt + rescale_coef * (u_tgt(k) - u_bt)
+ enddo
+ endif
- ! --- Remap u profiles from the source vertical grid onto the new target grid.
+ if (CS%id_remap_delta_integ_u2>0) then
do k=1,nz
- u_src(k) = u(I,j,k)
+ u2h_tot = u2h_tot + h2(k) * (u_tgt(k)**2)
enddo
- call remapping_core_h(CS%vel_remapCS, nz, h1, u_src, nz, h2, u_tgt, &
- h_neglect, h_neglect_edge)
+ du2h_tot(I,j) = GV%H_to_RZ * u2h_tot * I_dt
+ endif
- if ((CS%BBL_h_vel_mask > 0.0) .and. (CS%h_vel_mask > 0.0)) then
- call mask_near_bottom_vel(u_tgt, h2, CS%BBL_h_vel_mask, CS%h_vel_mask, nz)
- endif
+ if ((CS%BBL_h_vel_mask > 0.0) .and. (CS%h_vel_mask > 0.0)) &
+ call mask_near_bottom_vel(u_tgt, h2, CS%BBL_h_vel_mask, CS%h_vel_mask, nz)
- do k=1,nz
- u(I,j,k) = u_tgt(k)
- enddo !k
- endif ; enddo ; enddo
- endif
+ ! Copy the column of new velocities back to the 3-d array
+ do k=1,nz
+ u(I,j,k) = u_tgt(k)
+ enddo !k
+ endif ; enddo ; enddo
+
+ if (CS%id_remap_delta_integ_u2>0) call post_data(CS%id_remap_delta_integ_u2, du2h_tot, CS%diag)
if (show_call_tree) call callTree_waypoint("u remapped (ALE_remap_velocities)")
- ! Remap v velocity component
- if ( .true. ) then
- !$OMP parallel do default(shared) private(h1,h2,v_src,dz,h_mask_vel,v_tgt)
- do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (G%mask2dCv(i,J)>0.) then
- ! Build the start and final grids
+
+ ! --- Remap v profiles from the source vertical grid onto the new target grid.
+
+ !$OMP parallel do default(shared) private(h1,h2,v_src,h_mask_vel,v_tgt, &
+ !$OMP v_bt,ke_c_src,ke_c_tgt,rescale_coef, &
+ !$OMP u2h_tot,v2h_tot)
+ do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (G%mask2dCv(i,J)>0.) then
+
+ do k=1,nz
+ h1(k) = h_old_v(i,J,k)
+ h2(k) = h_new_v(i,J,k)
+ v_src(k) = v(i,J,k)
+ enddo
+
+ if (CS%id_remap_delta_integ_v2>0) then
+ v2h_tot = 0.
do k=1,nz
- h1(k) = 0.5*(h_old(i,j,k) + h_old(i,j+1,k))
- h2(k) = 0.5*(h_new(i,j,k) + h_new(i,j+1,k))
+ v2h_tot = v2h_tot - h1(k) * (v_src(k)**2)
enddo
- if (CS%remap_uv_using_old_alg) then
- dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i,j+1,:) )
- do k = 1, nz
- h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) )
- enddo
- endif
- if (CS%partial_cell_vel_remap) then
- h_mask_vel = min(h_tot(i,j), h_tot(i,j+1))
- call apply_partial_cell_mask(h1, h_mask_vel)
- call apply_partial_cell_mask(h2, h_mask_vel)
- endif
- if (associated(OBC)) then ; if (OBC%segnum_v(i,J) /= 0) then
- if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
- do k=1,nz ; h1(k) = h_old(i,j,k) ; h2(k) = h_new(i,j,k) ; enddo
- else ! (OBC%segment(n)%direction == OBC_DIRECTION_S)
- do k=1,nz ; h1(k) = h_old(i,j+1,k) ; h2(k) = h_new(i,j+1,k) ; enddo
- endif
- endif ; endif
+ endif
- ! --- Remap v profiles from the source vertical grid onto the new target grid.
+ call remapping_core_h(CS%vel_remapCS, nz, h1, v_src, nz, h2, v_tgt, &
+ h_neglect, h_neglect_edge)
+
+ if (variance_option .and. CS%conserve_ke) then
+ ! Conserve ke_v by correcting baroclinic component.
+ ! Assumes total depth doesn't change during remap, and
+ ! that \int v(z) dz doesn't change during remap.
+ ! First get barotropic component
+ v_bt = 0.0
do k=1,nz
- v_src(k) = v(i,J,k)
+ v_bt = v_bt + h2(k) * v_tgt(k) ! Dimensions [H L T-1]
enddo
- call remapping_core_h(CS%vel_remapCS, nz, h1, v_src, nz, h2, v_tgt, &
- h_neglect, h_neglect_edge)
-
- if ((CS%BBL_h_vel_mask > 0.0) .and. (CS%h_vel_mask > 0.0)) then
- call mask_near_bottom_vel(v_tgt, h2, CS%BBL_h_vel_mask, CS%h_vel_mask, nz)
- endif
+ v_bt = v_bt / (sum(h2(1:nz)) + h_neglect) ! Dimensions return to [L T-1]
+ ! Next get baroclinic ke = \int (u-u_bt)^2 from source and target
+ ke_c_src = 0.0
+ ke_c_tgt = 0.0
+ do k=1,nz
+ ke_c_src = ke_c_src + h1(k) * (v_src(k) - v_bt)**2
+ ke_c_tgt = ke_c_tgt + h2(k) * (v_tgt(k) - v_bt)**2
+ enddo
+ ! Next rescale baroclinic component on target grid to conserve ke
+ rescale_coef = min(1.25, sqrt(ke_c_src / (ke_c_tgt + 1.E-19)))
+ do k=1,nz
+ v_tgt(k) = v_bt + rescale_coef * (v_tgt(k) - v_bt)
+ enddo
+ endif
+ if (CS%id_remap_delta_integ_v2>0) then
do k=1,nz
- v(i,J,k) = v_tgt(k)
- enddo !k
- endif ; enddo ; enddo
- endif
+ v2h_tot = v2h_tot + h2(k) * (v_tgt(k)**2)
+ enddo
+ dv2h_tot(I,j) = GV%H_to_RZ * v2h_tot * I_dt
+ endif
+
+ if ((CS%BBL_h_vel_mask > 0.0) .and. (CS%h_vel_mask > 0.0)) then
+ call mask_near_bottom_vel(v_tgt, h2, CS%BBL_h_vel_mask, CS%h_vel_mask, nz)
+ endif
+
+ ! Copy the column of new velocities back to the 3-d array
+ do k=1,nz
+ v(i,J,k) = v_tgt(k)
+ enddo !k
+ endif ; enddo ; enddo
+
+ if (CS%id_remap_delta_integ_v2>0) call post_data(CS%id_remap_delta_integ_v2, dv2h_tot, CS%diag)
if (show_call_tree) call callTree_waypoint("v remapped (ALE_remap_velocities)")
if (show_call_tree) call callTree_leave("ALE_remap_velocities()")
diff --git a/src/ALE/MOM_hybgen_regrid.F90 b/src/ALE/MOM_hybgen_regrid.F90
index dc7c90a079..524f9b8ff2 100644
--- a/src/ALE/MOM_hybgen_regrid.F90
+++ b/src/ALE/MOM_hybgen_regrid.F90
@@ -61,7 +61,21 @@ module MOM_hybgen_regrid
!> Nominal density of interfaces [R ~> kg m-3]
real, allocatable, dimension(:) :: target_density
- real :: onem !< Nominally one m in thickness units [H ~> m or kg m-2]
+ real :: dp_far_from_sfc !< A distance that determines when an interface is suffiently far from
+ !! the surface that certain adjustments can be made in the Hybgen regridding
+ !! code [H ~> m or kg m-2]. In Hycom, this is set to tenm (nominally 10 m).
+ real :: dp_far_from_bot !< A distance that determines when an interface is suffiently far from
+ !! the bottom that certain adjustments can be made in the Hybgen regridding
+ !! code [H ~> m or kg m-2]. In Hycom, this is set to onem (nominally 1 m).
+ real :: h_thin !< A layer thickness below which a layer is considered to be too thin for
+ !! certain adjustments to be made in the Hybgen regridding code.
+ !! In Hycom, this is set to onemm (nominally 0.001 m).
+
+ real :: rho_eps !< A small nonzero density that is used to prevent division by zero
+ !! in several expressions in the Hybgen regridding code [R ~> kg m-3].
+
+ real :: onem !< Nominally one m in thickness units [H ~> m or kg m-2], used only in
+ !! certain debugging tests.
end type hybgen_regrid_CS
@@ -166,6 +180,28 @@ subroutine init_hybgen_regrid(CS, GV, US, param_file)
"A bottom boundary layer thickness within which Hybgen is able to move "//&
"overlying layers upward to match a target density.", &
units="m", default=0.0, scale=GV%m_to_H)
+ call get_param(param_file, mdl, "HYBGEN_FAR_FROM_SURFACE", CS%dp_far_from_sfc, &
+ "A distance that determines when an interface is suffiently far "//&
+ "from the surface that certain adjustments can be made in the Hybgen "//&
+ "regridding code. In Hycom, this is set to tenm (nominally 10 m).", &
+ units="m", default=10.0, scale=GV%m_to_H)
+ call get_param(param_file, mdl, "HYBGEN_FAR_FROM_BOTTOM", CS%dp_far_from_bot, &
+ "A distance that determines when an interface is suffiently far "//&
+ "from the bottom that certain adjustments can be made in the Hybgen "//&
+ "regridding code. In Hycom, this is set to onem (nominally 1 m).", &
+ units="m", default=1.0, scale=GV%m_to_H)
+ call get_param(param_file, mdl, "HYBGEN_H_THIN", CS%h_thin, &
+ "A layer thickness below which a layer is considered to be too thin for "//&
+ "certain adjustments to be made in the Hybgen regridding code. "//&
+ "In Hycom, this is set to onemm (nominally 0.001 m).", &
+ units="m", default=0.001, scale=GV%m_to_H)
+
+ call get_param(param_file, mdl, "HYBGEN_DENSITY_EPSILON", CS%rho_eps, &
+ "A small nonzero density that is used to prevent division by zero "//&
+ "in several expressions in the Hybgen regridding code.", &
+ units="kg m-3", default=1e-11, scale=US%kg_m3_to_R)
+
+
call get_param(param_file, mdl, "HYBGEN_REMAP_DENSITY_MATCH", CS%hybiso, &
"A tolerance between the layer densities and their target, within which "//&
"Hybgen determines that remapping uses PCM for a layer.", &
@@ -300,12 +336,17 @@ end subroutine get_hybgen_regrid_params
!> Modify the input grid to give a new vertical grid based on the HYCOM hybgen code.
-subroutine hybgen_regrid(G, GV, US, dp, tv, CS, dzInterface, PCM_cell)
+subroutine hybgen_regrid(G, GV, US, dp, nom_depth_H, tv, CS, dzInterface, PCM_cell)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: dp !< Source grid layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: nom_depth_H !< The bathymetric depth of this column
+ !! relative to mean sea level or another locally
+ !! valid reference height, converted to thickness
+ !! units [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
type(hybgen_regrid_CS), intent(in) :: CS !< hybgen control structure
real, dimension(SZI_(G),SZJ_(G),CS%nk+1), &
@@ -457,7 +498,7 @@ subroutine hybgen_regrid(G, GV, US, dp, tv, CS, dzInterface, PCM_cell)
enddo
! The following block of code is used to trigger z* stretching of the targets heights.
- nominalDepth = (G%bathyT(i,j) + G%Z_ref)*GV%Z_to_H
+ nominalDepth = nom_depth_H(i,j)
if (h_tot <= CS%min_dilate*nominalDepth) then
dilate = CS%min_dilate
elseif (h_tot >= CS%max_dilate*nominalDepth) then
@@ -482,8 +523,7 @@ subroutine hybgen_regrid(G, GV, US, dp, tv, CS, dzInterface, PCM_cell)
enddo !k
! Determine the new layer thicknesses.
- call hybgen_column_regrid(CS, nk, CS%thkbot, CS%onem, &
- 1.0e-11*US%kg_m3_to_R, Rcv_tgt, fixlay, qhrlx, dp0ij, &
+ call hybgen_column_regrid(CS, nk, CS%thkbot, Rcv_tgt, fixlay, qhrlx, dp0ij, &
dp0cum, Rcv, h_col, dz_int)
! Store the output from hybgenaij_regrid in 3-d arrays.
@@ -669,13 +709,11 @@ real function cushn(delp, dp0)
end function cushn
!> Create a new grid for a column of water using the Hybgen algorithm.
-subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
+subroutine hybgen_column_regrid(CS, nk, thkbot, Rcv_tgt, &
fixlay, qhrlx, dp0ij, dp0cum, Rcv, h_in, dp_int)
type(hybgen_regrid_CS), intent(in) :: CS !< hybgen regridding control structure
integer, intent(in) :: nk !< number of layers
real, intent(in) :: thkbot !< thickness of bottom boundary layer [H ~> m or kg m-2]
- real, intent(in) :: onem !< one m in pressure units [H ~> m or kg m-2]
- real, intent(in) :: epsil !< small nonzero density to prevent division by zero [R ~> kg m-3]
real, intent(in) :: Rcv_tgt(nk) !< Target potential density [R ~> kg m-3]
integer, intent(in) :: fixlay !< deepest fixed coordinate layer
real, intent(in) :: qhrlx( nk+1) !< relaxation coefficient per timestep [nondim]
@@ -702,20 +740,14 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
real :: h_hat0 ! A first guess at thickness movement upward across the interface
! between layers k and k-1 [H ~> m or kg m-2]
real :: dh_cor ! Thickness changes [H ~> m or kg m-2]
- real :: tenm ! ten m in pressure units [H ~> m or kg m-2]
- real :: onemm ! one mm in pressure units [H ~> m or kg m-2]
logical :: trap_errors
integer :: k
character(len=256) :: mesg ! A string for output messages
! This line needs to be consistent with the parameters set in cushn().
- real, parameter :: qqmn=-4.0, qqmx=2.0 ! shifted range for cushn
-! real, parameter :: qqmn=-2.0, qqmx=4.0 ! traditional range for cushn
-! real, parameter :: qqmn=-4.0, qqmx=6.0 ! somewhat wider range for cushn
-
- !### These hard-coded parameters should be changed to run-time variables.
- tenm = 10.0*onem
- onemm = 0.001*onem
+ real, parameter :: qqmn=-4.0, qqmx=2.0 ! shifted range for cushn [nondim]
+! real, parameter :: qqmn=-2.0, qqmx=4.0 ! traditional range for cushn [nondim]
+! real, parameter :: qqmn=-4.0, qqmx=6.0 ! somewhat wider range for cushn [nondim]
trap_errors = .true.
@@ -769,26 +801,26 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
! Remap the non-fixed layers.
- ! In the Hycom version, this loop was fused the loop correcting water that is
+ ! In the Hycom version, this loop was fused with the loop correcting water that is
! too light, and it ran down the water column, but if there are a set of layers
! that are very dense, that structure can lead to all of the water being remapped
! into a single thick layer. Splitting the loops and running the loop upwards
- ! (as is done here avoids that catastrophic problem for layers that are far from
+ ! (as is done here) avoids that catastrophic problem for layers that are far from
! their targets. However, this code is still prone to a thin-thick-thin null mode.
do k=nk,fixlay+2,-1
! This is how the Hycom code would do this loop: do k=fixlay+1,nk ; if (k>fixlay+1) then
- if ((Rcv(k) > Rcv_tgt(k) + epsil)) then
+ if ((Rcv(k) > Rcv_tgt(k) + CS%rho_eps)) then
! Water in layer k is too dense, so try to dilute with water from layer k-1
! Do not move interface if k = fixlay + 1
if ((Rcv(k-1) >= Rcv_tgt(k-1)) .or. &
- (p_int(k) <= dp0cum(k) + onem) .or. &
+ (p_int(k) <= dp0cum(k) + CS%dp_far_from_bot) .or. &
(h_col(k) <= h_col(k-1))) then
! If layer k-1 is too light, there is a conflict in the direction the
! inteface between them should move, so thicken the thinner of the two.
- if ((Rcv_tgt(k) - Rcv(k-1)) <= epsil) then
+ if ((Rcv_tgt(k) - Rcv(k-1)) <= CS%rho_eps) then
! layer k-1 is far too dense, take the entire layer
! If this code is working downward and this branch is repeated in a series
! of successive layers, it can accumulate into a very thick homogenous layers.
@@ -814,7 +846,7 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
! layer (thinner than its minimum thickness) in the interior ocean,
! move interface k-1 (and k-2 if necessary) upward
! Only work on layers that are sufficiently far from the fixed near-surface layers.
- if ((h_hat >= 0.0) .and. (k > fixlay+2) .and. (p_int(k-1) > dp0cum(k-1) + tenm)) then
+ if ((h_hat >= 0.0) .and. (k > fixlay+2) .and. (p_int(k-1) > dp0cum(k-1) + CS%dp_far_from_sfc)) then
! Only act if interface k-1 is near the bottom or layer k-2 could donate water.
if ( (p_int(nk+1) - p_int(k-1) < thkbot) .or. &
@@ -828,7 +860,7 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
h_hat2 = cushn(h_col(k-2) + (h_hat0 - h_hat), dp0ij(k-2)) - h_col(k-2)
endif !fixlay+3:else
- if (h_hat2 < -onemm) then
+ if (h_hat2 < -CS%h_thin) then
dh_cor = qhrlx(k-1) * max(h_hat2, -h_hat - h_col(k-1))
h_col(k-2) = h_col(k-2) + dh_cor
h_col(k-1) = h_col(k-1) - dh_cor
@@ -838,9 +870,9 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
h_hat = cushn(h_hat0 + h_col(k-1), dp0ij(k-1)) - h_col(k-1)
elseif (k <= fixlay+3) then
! Do nothing.
- elseif (p_int(k-2) > dp0cum(k-2) + tenm .and. &
- (p_int(nk+1) - p_int(k-2) < thkbot .or. &
- h_col(k-3) > qqmx*dp0ij(k-3))) then
+ elseif ( (p_int(k-2) > dp0cum(k-2) + CS%dp_far_from_sfc) .and. &
+ ( (p_int(nk+1) - p_int(k-2) < thkbot) .or. &
+ (h_col(k-3) > qqmx*dp0ij(k-3)) ) ) then
! Determine how much water layer k-3 could supply without becoming too thin.
if (k == fixlay+4) then
@@ -850,7 +882,7 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
! Maintain minimum thickess of layer k-3.
h_hat3 = cushn(h_col(k-3) + (h_hat0 - h_hat), dp0ij(k-3)) - h_col(k-3)
endif !fixlay+4:else
- if (h_hat3 < -onemm) then
+ if (h_hat3 < -CS%h_thin) then
! Water is moved from layer k-3 to k-2, but do not dilute layer k-2 too much.
dh_cor = qhrlx(k-2) * max(h_hat3, -h_col(k-2))
h_col(k-3) = h_col(k-3) + dh_cor
@@ -860,7 +892,7 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
! Now layer k-2 might be able donate to layer k-1.
h_hat2 = cushn(h_col(k-2) + (h_hat0 - h_hat), dp0ij(k-2)) - h_col(k-2)
- if (h_hat2 < -onemm) then
+ if (h_hat2 < -CS%h_thin) then
dh_cor = qhrlx(k-1) * (max(h_hat2, -h_hat - h_col(k-1)) )
h_col(k-2) = h_col(k-2) + dh_cor
h_col(k-1) = h_col(k-1) - dh_cor
@@ -890,17 +922,17 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, onem, epsil, Rcv_tgt, &
enddo
do k=fixlay+1,nk
- if (Rcv(k) < Rcv_tgt(k) - epsil) then ! layer too light
+ if (Rcv(k) < Rcv_tgt(k) - CS%rho_eps) then ! layer too light
! Water in layer k is too light, so try to dilute with water from layer k+1.
! Entrainment is not possible if layer k touches the bottom.
if (p_int(k+1) < p_int(nk+1)) then ! k 1.0e-13*max(p_int(nk+1), onem)) then
+ if (abs((h_col(k) - h_in(k)) + (dp_int(K) - dp_int(K+1))) > 1.0e-13*max(p_int(nk+1), CS%onem)) then
write(mesg, '("k ",i4," h ",es13.4," h_in ",es13.4, " dp ",2es13.4," err ",es13.4)') &
k, h_col(k), h_in(k), dp_int(K), dp_int(K+1), (h_col(k) - h_in(k)) + (dp_int(K) - dp_int(K+1))
call MOM_error(FATAL, "Mismatched thickness changes in hybgen_regrid: "//trim(mesg))
endif
- if (h_col(k) < 0.0) then ! Could instead do: -1.0e-15*max(p_int(nk+1), onem)) then
+ if (h_col(k) < 0.0) then ! Could instead do: -1.0e-15*max(p_int(nk+1), CS%onem)) then
write(mesg, '("k ",i4," h ",es13.4," h_in ",es13.4, " dp ",2es13.4, " fixlay ",i4)') &
k, h_col(k), h_in(k), dp_int(K), dp_int(K+1), fixlay
call MOM_error(FATAL, "Significantly negative final thickness in hybgen_regrid: "//trim(mesg))
endif
enddo
do K=1,nk+1
- if (abs(dp_int(K) - (p_int(K) - pres_in(K))) > 1.0e-13*max(p_int(nk+1), onem)) then
+ if (abs(dp_int(K) - (p_int(K) - pres_in(K))) > 1.0e-13*max(p_int(nk+1), CS%onem)) then
call MOM_error(FATAL, "Mismatched interface height changes in hybgen_regrid.")
endif
enddo
diff --git a/src/ALE/MOM_hybgen_unmix.F90 b/src/ALE/MOM_hybgen_unmix.F90
index 024a9baffa..6ddb828abe 100644
--- a/src/ALE/MOM_hybgen_unmix.F90
+++ b/src/ALE/MOM_hybgen_unmix.F90
@@ -9,6 +9,7 @@ module MOM_hybgen_unmix
use MOM_file_parser, only : get_param, param_file_type, log_param
use MOM_hybgen_regrid, only : hybgen_column_init
use MOM_hybgen_regrid, only : hybgen_regrid_CS, get_hybgen_regrid_params
+use MOM_interface_heights, only : calc_derived_thermo
use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chkinv
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : ocean_grid_type, thermo_var_ptrs
@@ -146,7 +147,8 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h)
real :: p_col(GV%ke) ! A column of reference pressures [R L2 T-2 ~> Pa]
real :: tracer(GV%ke,max(ntr,1)) ! Columns of each tracer [Conc]
real :: h_tot ! Total thickness of the water column [H ~> m or kg m-2]
- real :: nominalDepth ! Depth of ocean bottom (positive downward) [H ~> m or kg m-2]
+ real :: dz_tot ! Vertical distance between the top and bottom of the water column [Z ~> m]
+ real :: nominalDepth ! Depth of ocean bottom in thickness units (positive downward) [H ~> m or kg m-2]
real :: h_thin ! A negligibly small thickness to identify essentially
! vanished layers [H ~> m or kg m-2]
real :: dilate ! A factor by which to dilate the target positions from z to z* [nondim]
@@ -169,6 +171,15 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h)
h_thin = 1e-6*GV%m_to_H
debug_conservation = .false. ! Set this to true for debugging
+ if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < 1)) then
+ if (tv%valid_SpV_halo < 0) then
+ mesg = "invalid values of SpV_avg."
+ else
+ mesg = "insufficiently large SpV_avg halos of width 0 but 1 is needed."
+ endif
+ call MOM_error(FATAL, "hybgen_unmix called in fully non-Boussinesq mode with "//trim(mesg))
+ endif
+
p_col(:) = CS%ref_pressure
do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 ; if (G%mask2dT(i,j)>0.) then
@@ -203,13 +214,27 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h)
endif
! The following block of code is used to trigger z* stretching of the targets heights.
- nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H
- if (h_tot <= CS%min_dilate*nominalDepth) then
- dilate = CS%min_dilate
- elseif (h_tot >= CS%max_dilate*nominalDepth) then
- dilate = CS%max_dilate
+ if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussiesq version
+ dz_tot = 0.0
+ do k=1,nk
+ dz_tot = dz_tot + GV%H_to_RZ * tv%SpV_avg(i,j,k) * h_col(k)
+ enddo
+ if (dz_tot <= CS%min_dilate*(G%bathyT(i,j)+G%Z_ref)) then
+ dilate = CS%min_dilate
+ elseif (dz_tot >= CS%max_dilate*(G%bathyT(i,j)+G%Z_ref)) then
+ dilate = CS%max_dilate
+ else
+ dilate = dz_tot / (G%bathyT(i,j)+G%Z_ref)
+ endif
else
- dilate = h_tot / nominalDepth
+ nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H
+ if (h_tot <= CS%min_dilate*nominalDepth) then
+ dilate = CS%min_dilate
+ elseif (h_tot >= CS%max_dilate*nominalDepth) then
+ dilate = CS%max_dilate
+ else
+ dilate = h_tot / nominalDepth
+ endif
endif
terrain_following = (h_tot < dilate*CS%dpns) .and. (CS%dpns >= CS%dsns)
@@ -268,6 +293,9 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h)
endif
endif ; enddo ; enddo !i & j.
+ ! Update the layer properties
+ if (allocated(tv%SpV_avg)) call calc_derived_thermo(tv, h, G, GV, US, halo=1)
+
end subroutine hybgen_unmix
diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90
index 9da4e95b24..8ef0679358 100644
--- a/src/ALE/MOM_regridding.F90
+++ b/src/ALE/MOM_regridding.F90
@@ -175,7 +175,7 @@ module MOM_regridding
character(len=*), parameter, public :: regriddingDefaultInterpScheme = "P1M_H2"
!> Default mode for boundary extrapolation
logical, parameter, public :: regriddingDefaultBoundaryExtrapolation = .false.
-!> Default minimum thickness for some coordinate generation modes
+!> Default minimum thickness for some coordinate generation modes [m]
real, parameter, public :: regriddingDefaultMinThickness = 1.e-3
!> Maximum length of parameters
@@ -209,11 +209,10 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m
logical :: tmpLogical, do_sum, main_parameters
logical :: coord_is_state_dependent, ierr
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018
integer :: remap_answer_date ! The vintage of the remapping expressions to use.
integer :: regrid_answer_date ! The vintage of the regridding expressions to use.
- real :: tmpReal, P_Ref
+ real :: tmpReal ! A temporary variable used in setting other variables [various]
+ real :: P_Ref ! The coordinate variable reference pression [R L2 T-2 ~> Pa]
real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z).
real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha
real :: adaptDrho0 ! Reference density difference for stratification-dependent diffusion. [R ~> kg m-3]
@@ -262,7 +261,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m
param_name = create_coord_param(param_prefix, "INTERP_SCHEME", param_suffix)
string2 = 'PPM_H4' ! Default for diagnostics
endif
- call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, &
+ call get_param(param_file, mdl, param_name, string, &
"This sets the interpolation scheme to use to "//&
"determine the new grid. These parameters are "//&
"only relevant when REGRIDDING_COORDINATE_MODE is "//&
@@ -274,30 +273,21 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701)
call set_regrid_params(CS, remap_answer_date=remap_answer_date)
call get_param(param_file, mdl, "REGRIDDING_ANSWER_DATE", regrid_answer_date, &
"The vintage of the expressions and order of arithmetic to use for regridding. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
"robust and accurate forms of mathematically equivalent expressions.", &
- default=20181231) ! ### change to default=default_answer_date)
+ default=20181231, do_not_log=.not.GV%Boussinesq) ! ### change to default=default_answer_date)
+ if (.not.GV%Boussinesq) regrid_answer_date = max(regrid_answer_date, 20230701)
call set_regrid_params(CS, regrid_answer_date=regrid_answer_date)
endif
@@ -771,7 +761,7 @@ end subroutine end_regridding
!------------------------------------------------------------------------------
!> Dispatching regridding routine for orchestrating regridding & remapping
-subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, &
+subroutine regridding_main( remapCS, CS, G, GV, US, h, tv, h_new, dzInterface, &
frac_shelf_h, PCM_cell)
!------------------------------------------------------------------------------
! This routine takes care of (1) building a new grid and (2) remapping between
@@ -795,47 +785,89 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, &
type(regridding_CS), intent(in) :: CS !< Regridding control structure
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after
- !! the last time step
+ !! the last time step [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamical variables (T, S, ...)
- real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New 3D grid consistent with target coordinate
- real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in position of each interface
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: frac_shelf_h !< Fractional ice shelf coverage
+ real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New 3D grid consistent with target
+ !! coordinate [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in position of each
+ !! interface [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: frac_shelf_h !< Fractional ice shelf coverage [nomdim]
logical, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
optional, intent(out ) :: PCM_cell !< Use PCM remapping in cells where true
! Local variables
+ real :: nom_depth_H(SZI_(G),SZJ_(G)) !< The nominal ocean depth at each point in thickness units [H ~> m or kg m-2]
+ real :: tot_h(SZI_(G),SZJ_(G)) !< The total thickness of the water column [H ~> m or kg m-2]
+ real :: tot_dz(SZI_(G),SZJ_(G)) !< The total distance between the top and bottom of the water column [Z ~> m]
+ real :: Z_to_H ! A conversion factor used by some routines to convert coordinate
+ ! parameters to depth units [H Z-1 ~> nondim or kg m-3]
real :: trickGnuCompiler
- integer :: i, j
+ character(len=128) :: mesg ! A string for error messages
+ integer :: i, j, k
if (present(PCM_cell)) PCM_cell(:,:,:) = .false.
+ Z_to_H = US%Z_to_m * GV%m_to_H ! Often this is equivalent to GV%Z_to_H.
+
+ if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < 1)) then
+ if (tv%valid_SpV_halo < 0) then
+ mesg = "invalid values of SpV_avg."
+ else
+ mesg = "insufficiently large SpV_avg halos of width 0 but 1 is needed."
+ endif
+ call MOM_error(FATAL, "Regridding_main called in fully non-Boussinesq mode with "//trim(mesg))
+ endif
+
+ if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussinesq case
+ do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1
+ tot_h(i,j) = 0.0 ; tot_dz(i,j) = 0.0
+ enddo ; enddo
+ do k=1,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1
+ tot_h(i,j) = tot_h(i,j) + h(i,j,k)
+ tot_dz(i,j) = tot_dz(i,j) + GV%H_to_RZ * tv%SpV_avg(i,j,k) * h(i,j,k)
+ enddo ; enddo ; enddo
+ do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1
+ if ((tot_dz(i,j) > 0.0) .and. (G%bathyT(i,j)+G%Z_ref > 0.0)) then
+ nom_depth_H(i,j) = (G%bathyT(i,j)+G%Z_ref) * (tot_h(i,j) / tot_dz(i,j))
+ else
+ nom_depth_H(i,j) = 0.0
+ endif
+ enddo ; enddo
+ else
+ do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1
+ nom_depth_H(i,j) = max((G%bathyT(i,j)+G%Z_ref) * Z_to_H, 0.0)
+ enddo ; enddo
+ endif
+
select case ( CS%regridding_scheme )
case ( REGRIDDING_ZSTAR )
- call build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h )
+ call build_zstar_grid( CS, G, GV, h, nom_depth_H, dzInterface, frac_shelf_h, zScale=Z_to_H )
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
case ( REGRIDDING_SIGMA_SHELF_ZSTAR)
- call build_zstar_grid( CS, G, GV, h, dzInterface )
+ call build_zstar_grid( CS, G, GV, h, nom_depth_H, dzInterface, zScale=Z_to_H )
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
case ( REGRIDDING_SIGMA )
- call build_sigma_grid( CS, G, GV, h, dzInterface )
+ call build_sigma_grid( CS, G, GV, h, nom_depth_H, dzInterface )
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
case ( REGRIDDING_RHO )
- call build_rho_grid( G, GV, G%US, h, tv, dzInterface, remapCS, CS, frac_shelf_h )
- call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
- case ( REGRIDDING_ARBITRARY )
- call build_grid_arbitrary( G, GV, h, dzInterface, trickGnuCompiler, CS )
+ call build_rho_grid( G, GV, G%US, h, nom_depth_H, tv, dzInterface, remapCS, CS, frac_shelf_h )
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
case ( REGRIDDING_HYCOM1 )
- call build_grid_HyCOM1( G, GV, G%US, h, tv, h_new, dzInterface, remapCS, CS, frac_shelf_h )
+ call build_grid_HyCOM1( G, GV, G%US, h, nom_depth_H, tv, h_new, dzInterface, remapCS, CS, &
+ frac_shelf_h, zScale=Z_to_H )
case ( REGRIDDING_HYBGEN )
- call hybgen_regrid(G, GV, G%US, h, tv, CS%hybgen_CS, dzInterface, PCM_cell)
+ call hybgen_regrid(G, GV, G%US, h, nom_depth_H, tv, CS%hybgen_CS, dzInterface, PCM_cell)
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
case ( REGRIDDING_ADAPTIVE )
- call build_grid_adaptive(G, GV, G%US, h, tv, dzInterface, remapCS, CS)
+ call build_grid_adaptive(G, GV, G%US, h, nom_depth_H, tv, dzInterface, remapCS, CS)
call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
+ case ( REGRIDDING_ARBITRARY )
+ call MOM_error(FATAL,'MOM_regridding, regridding_main: '//&
+ 'Regridding mode "ARB" is not implemented.')
case default
call MOM_error(FATAL,'MOM_regridding, regridding_main: '//&
'Unknown regridding scheme selected!')
@@ -896,9 +928,12 @@ subroutine calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new)
type(regridding_CS), intent(in) :: CS !< Regridding control structure
type(ocean_grid_type), intent(in) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Old layer thicknesses (arbitrary units)
- real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(in) :: dzInterface !< Change in interface positions (same as h)
- real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (same as h)
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Old layer thicknesses [H ~> m or kg m-2]
+ !! or other units
+ real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(in) :: dzInterface !< Change in interface positions
+ !! in the same units as h [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses in the same
+ !! units as h [H ~> m or kg m-2]
! Local variables
integer :: i, j, k, nki
@@ -1121,21 +1156,29 @@ end subroutine filtered_grid_motion
!> Builds a z*-coordinate grid with partial steps (Adcroft and Campin, 2004).
!! z* is defined as
!! z* = (z-eta)/(H+eta)*H s.t. z*=0 when z=eta and z*=-H when z=-H .
-subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h)
+subroutine build_zstar_grid( CS, G, GV, h, nom_depth_H, dzInterface, frac_shelf_h, zScale)
! Arguments
type(regridding_CS), intent(in) :: CS !< Regridding control structure
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: nom_depth_H !< The bathymetric depth of this column
+ !! relative to mean sea level or another locally
+ !! valid reference height, converted to thickness
+ !! units [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth
!! [H ~> m or kg m-2].
real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: frac_shelf_h !< Fractional
!! ice shelf coverage [nondim].
+ real, optional, intent(in) :: zScale !< Scaling factor from the target coordinate
+ !! resolution in Z to desired units for zInterface,
+ !! usually Z_to_H in which case it is in
+ !! units of [H Z-1 ~> nondim or kg m-3]
! Local variables
real :: nominalDepth, minThickness, totalThickness ! Depths and thicknesses [H ~> m or kg m-2]
#ifdef __DO_SAFETY_CHECKS__
- real :: dh ! [H ~> m or kg m-2]
+ real :: dh ! The larger of the total column thickness or bathymetric depth [H ~> m or kg m-2]
#endif
real, dimension(SZK_(GV)+1) :: zOld ! Previous coordinate interface heights [H ~> m or kg m-2]
real, dimension(CS%nk+1) :: zNew ! New coordinate interface heights [H ~> m or kg m-2]
@@ -1146,13 +1189,13 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h)
minThickness = CS%min_thickness
ice_shelf = present(frac_shelf_h)
-!$OMP parallel do default(none) shared(G,GV,dzInterface,CS,nz,h,frac_shelf_h, &
-!$OMP ice_shelf,minThickness) &
-!$OMP private(nominalDepth,totalThickness, &
+ !$OMP parallel do default(none) shared(G,GV,dzInterface,CS,nz,h,frac_shelf_h, &
+ !$OMP ice_shelf,minThickness,zScale,nom_depth_H) &
+ !$OMP private(nominalDepth,totalThickness, &
#ifdef __DO_SAFETY_CHECKS__
-!$OMP dh, &
+ !$OMP dh, &
#endif
-!$OMP zNew,zOld)
+ !$OMP zNew,zOld)
do j = G%jsc-1,G%jec+1
do i = G%isc-1,G%iec+1
@@ -1161,8 +1204,8 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h)
cycle
endif
- ! Local depth (G%bathyT is positive downward)
- nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H
+ ! Local depth (positive downward)
+ nominalDepth = nom_depth_H(i,j)
! Determine water column thickness
totalThickness = 0.0
@@ -1170,23 +1213,26 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h)
totalThickness = totalThickness + h(i,j,k)
enddo
+ ! if (GV%Boussinesq) then
zOld(nz+1) = - nominalDepth
do k = nz,1,-1
zOld(k) = zOld(k+1) + h(i,j,k)
enddo
+ ! else ! Work downward?
+ ! endif
if (ice_shelf) then
if (frac_shelf_h(i,j) > 0.) then ! under ice shelf
call build_zstar_column(CS%zlike_CS, nominalDepth, totalThickness, zNew, &
- z_rigid_top = totalThickness-nominalDepth, &
- eta_orig=zOld(1), zScale=GV%Z_to_H)
+ z_rigid_top=totalThickness-nominalDepth, &
+ eta_orig=zOld(1), zScale=zScale)
else
call build_zstar_column(CS%zlike_CS, nominalDepth, totalThickness, &
- zNew, zScale=GV%Z_to_H)
+ zNew, zScale=zScale)
endif
else
call build_zstar_column(CS%zlike_CS, nominalDepth, totalThickness, &
- zNew, zScale=GV%Z_to_H)
+ zNew, zScale=zScale)
endif
! Calculate the final change in grid position after blending new and old grids
@@ -1225,7 +1271,7 @@ end subroutine build_zstar_grid
!------------------------------------------------------------------------------
! Build sigma grid
!> This routine builds a grid based on terrain-following coordinates.
-subroutine build_sigma_grid( CS, G, GV, h, dzInterface )
+subroutine build_sigma_grid( CS, G, GV, h, nom_depth_H, dzInterface )
!------------------------------------------------------------------------------
! This routine builds a grid based on terrain-following coordinates.
! The module parameter coordinateResolution(:) determines the resolution in
@@ -1238,18 +1284,22 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface )
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: nom_depth_H !< The bathymetric depth of this column
+ !! relative to mean sea level or another locally
+ !! valid reference height, converted to thickness
+ !! units [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth
!! [H ~> m or kg m-2]
! Local variables
- integer :: i, j, k
- integer :: nz
- real :: nominalDepth, totalThickness
+ real :: nominalDepth ! The nominal depth of the sea-floor in thickness units [H ~> m or kg m-2]
+ real :: totalThickness ! The total thickness of the water column [H ~> m or kg m-2]
#ifdef __DO_SAFETY_CHECKS__
- real :: dh
+ real :: dh ! The larger of the total column thickness or bathymetric depth [H ~> m or kg m-2]
#endif
real, dimension(SZK_(GV)+1) :: zOld ! Previous coordinate interface heights [H ~> m or kg m-2]
real, dimension(CS%nk+1) :: zNew ! New coordinate interface heights [H ~> m or kg m-2]
+ integer :: i, j, k, nz
nz = GV%ke
@@ -1261,28 +1311,35 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface )
cycle
endif
- ! The rest of the model defines grids integrating up from the bottom
- nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H
-
! Determine water column height
totalThickness = 0.0
do k = 1,nz
totalThickness = totalThickness + h(i,j,k)
enddo
+ ! In sigma coordinates, the bathymetric depth is only used as an arbitrary offset that
+ ! cancels out when determining coordinate motion, so referencing the column postions to
+ ! the surface is perfectly acceptable, but for preservation of previous answers the
+ ! referencing is done relative to the bottom when in Boussinesq or semi-Boussinesq mode.
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ nominalDepth = nom_depth_H(i,j)
+ else
+ nominalDepth = totalThickness
+ endif
+
call build_sigma_column(CS%sigma_CS, nominalDepth, totalThickness, zNew)
! Calculate the final change in grid position after blending new and old grids
zOld(nz+1) = -nominalDepth
do k = nz,1,-1
- zOld(k) = zOld(k+1) + h(i, j, k)
+ zOld(k) = zOld(k+1) + h(i,j,k)
enddo
call filtered_grid_motion( CS, nz, zOld, zNew, dzInterface(i,j,:) )
#ifdef __DO_SAFETY_CHECKS__
- dh=max(nominalDepth,totalThickness)
- if (abs(zNew(1)-zOld(1))>(CS%nk-1)*0.5*epsilon(dh)*dh) then
+ dh = max(nominalDepth,totalThickness)
+ if (abs(zNew(1)-zOld(1)) > (CS%nk-1)*0.5*epsilon(dh)*dh) then
write(0,*) 'min_thickness=',CS%min_thickness
write(0,*) 'nominalDepth=',nominalDepth,'totalThickness=',totalThickness
write(0,*) 'dzInterface(1) = ',dzInterface(i,j,1),epsilon(dh),nz,CS%nk
@@ -1314,11 +1371,11 @@ end subroutine build_sigma_grid
! Build grid based on target interface densities
!------------------------------------------------------------------------------
!> This routine builds a new grid based on a given set of target interface densities.
-subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shelf_h )
+subroutine build_rho_grid( G, GV, US, h, nom_depth_H, tv, dzInterface, remapCS, CS, frac_shelf_h )
!------------------------------------------------------------------------------
! This routine builds a new grid based on a given set of target interface
! densities (these target densities are computed by taking the mean value
-! of given layer densities). The algorithn operates as follows within each
+! of given layer densities). The algorithm operates as follows within each
! column:
! 1. Given T & S within each layer, the layer densities are computed.
! 2. Based on these layer densities, a global density profile is reconstructed
@@ -1331,17 +1388,21 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel
!------------------------------------------------------------------------------
! Arguments
- type(regridding_CS), intent(in) :: CS !< Regridding control structure
- type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
- type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
- type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
- real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth
- !! [H ~> m or kg m-2]
- type(remapping_CS), intent(in) :: remapCS !< The remapping control structure
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice
- !! shelf coverage [nondim]
+ type(regridding_CS), intent(in) :: CS !< Regridding control structure
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: nom_depth_H !< The bathymetric depth of this column
+ !! relative to mean sea level or another locally
+ !! valid reference height, converted to thickness
+ !! units [H ~> m or kg m-2]
+ type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
+ real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth
+ !! [H ~> m or kg m-2]
+ type(remapping_CS), intent(in) :: remapCS !< The remapping control structure
+ real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice
+ !! shelf coverage [nondim]
! Local variables
integer :: nz ! The number of layers in the input grid
integer :: i, j, k
@@ -1351,7 +1412,7 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel
real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2]
real :: totalThickness ! Total thicknesses [H ~> m or kg m-2]
#ifdef __DO_SAFETY_CHECKS__
- real :: dh
+ real :: dh ! The larger of the total column thickness or bathymetric depth [H ~> m or kg m-2]
#endif
logical :: ice_shelf
@@ -1378,15 +1439,22 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel
cycle
endif
-
- ! Local depth (G%bathyT is positive downward)
- nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H
-
! Determine total water column thickness
totalThickness = 0.0
do k=1,nz
totalThickness = totalThickness + h(i,j,k)
enddo
+
+ ! In rho coordinates, the bathymetric depth is only used as an arbitrary offset that
+ ! cancels out when determining coordinate motion, so referencing the column postions to
+ ! the surface is perfectly acceptable, but for preservation of previous answers the
+ ! referencing is done relative to the bottom when in Boussinesq or semi-Boussinesq mode.
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ nominalDepth = nom_depth_H(i,j)
+ else
+ nominalDepth = totalThickness
+ endif
+
! Determine absolute interface positions
zOld(nz+1) = - nominalDepth
do k = nz,1,-1
@@ -1394,13 +1462,13 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel
enddo
if (ice_shelf) then
- call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), &
- tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, &
- z_rigid_top = totalThickness - nominalDepth, eta_orig = zOld(1), &
+ call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i,j,:), &
+ tv%T(i,j,:), tv%S(i,j,:), tv%eqn_of_state, zNew, &
+ z_rigid_top=totalThickness - nominalDepth, eta_orig = zOld(1), &
h_neglect=h_neglect, h_neglect_edge=h_neglect_edge)
else
- call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), &
- tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, &
+ call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i,j,:), &
+ tv%T(i,j,:), tv%S(i,j,:), tv%eqn_of_state, zNew, &
h_neglect=h_neglect, h_neglect_edge=h_neglect_edge)
endif
@@ -1441,8 +1509,8 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel
totalThickness = totalThickness + h(i,j,k)
enddo
- dh=max(nominalDepth,totalThickness)
- if (abs(zNew(1)-zOld(1))>(nz-1)*0.5*epsilon(dh)*dh) then
+ dh = max(nominalDepth, totalThickness)
+ if (abs(zNew(1)-zOld(1)) > (nz-1)*0.5*epsilon(dh)*dh) then
write(0,*) 'min_thickness=',CS%min_thickness
write(0,*) 'nominalDepth=',nominalDepth,'totalThickness=',totalThickness
write(0,*) 'zNew(1)-zOld(1) = ',zNew(1)-zOld(1),epsilon(dh),nz
@@ -1475,11 +1543,15 @@ end subroutine build_rho_grid
!! \remark { Based on Bleck, 2002: An ocean-ice general circulation model framed in
!! hybrid isopycnic-Cartesian coordinates, Ocean Modelling 37, 55-88.
!! http://dx.doi.org/10.1016/S1463-5003(01)00012-9 }
-subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, remapCS, CS, frac_shelf_h )
+subroutine build_grid_HyCOM1( G, GV, US, h, nom_depth_H, tv, h_new, dzInterface, remapCS, CS, frac_shelf_h, zScale )
type(ocean_grid_type), intent(in) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: nom_depth_H !< The bathymetric depth of this column
+ !! relative to mean sea level or another locally
+ !! valid reference height, converted to thickness
+ !! units [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
type(remapping_CS), intent(in) :: remapCS !< The remapping control structure
type(regridding_CS), intent(in) :: CS !< Regridding control structure
@@ -1487,6 +1559,10 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, remapCS, CS,
real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position
real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice shelf
!! coverage [nondim]
+ real, optional, intent(in) :: zScale !< Scaling factor from the target coordinate
+ !! resolution in Z to desired units for zInterface,
+ !! usually Z_to_H in which case it is in
+ !! units of [H Z-1 ~> nondim or kg m-3]
! Local variables
real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2]
@@ -1517,12 +1593,12 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, remapCS, CS,
do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1
if (G%mask2dT(i,j)>0.) then
- nominalDepth = (G%bathyT(i,j)+G%Z_ref) * GV%Z_to_H
+ nominalDepth = nom_depth_H(i,j)
if (ice_shelf) then
totalThickness = 0.0
do k=1,GV%ke
- totalThickness = totalThickness + h(i,j,k) * GV%Z_to_H
+ totalThickness = totalThickness + h(i,j,k)
enddo
z_top_col = max(nominalDepth-totalThickness,0.0)
else
@@ -1538,7 +1614,7 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, remapCS, CS,
call build_hycom1_column(CS%hycom_CS, remapCS, tv%eqn_of_state, GV%ke, nominalDepth, &
h(i,j,:), tv%T(i,j,:), tv%S(i,j,:), p_col, &
- z_col, z_col_new, zScale=GV%Z_to_H, &
+ z_col, z_col_new, zScale=zScale, &
h_neglect=h_neglect, h_neglect_edge=h_neglect_edge)
! Calculate the final change in grid position after blending new and old grids
@@ -1562,11 +1638,15 @@ end subroutine build_grid_HyCOM1
!> This subroutine builds an adaptive grid that follows density surfaces where
!! possible, subject to constraints on the smoothness of interface heights.
-subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS)
+subroutine build_grid_adaptive(G, GV, US, h, nom_depth_H, tv, dzInterface, remapCS, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: nom_depth_H !< The bathymetric depth of this column
+ !! relative to mean sea level or another locally
+ !! valid reference height, converted to thickness
+ !! units [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
type(regridding_CS), intent(in) :: CS !< Regridding control structure
@@ -1576,8 +1656,8 @@ subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS)
! local variables
integer :: i, j, k, nz ! indices and dimension lengths
- ! temperature [C ~> degC], salinity [S ~> ppt] and pressure on interfaces
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: tInt, sInt
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: tInt ! Temperature on interfaces [C ~> degC]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: sInt ! Salinity on interfaces [S ~> ppt]
! current interface positions and after tendency term is applied
! positive downward
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: zInt ! Interface depths [H ~> m or kg m-2]
@@ -1614,7 +1694,7 @@ subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS)
cycle
endif
- call build_adapt_column(CS%adapt_CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNext)
+ call build_adapt_column(CS%adapt_CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, nom_depth_H, zNext)
call filtered_grid_motion(CS, nz, zInt(i,j,:), zNext, dzInterface(i,j,:))
! convert from depth to z
@@ -1682,107 +1762,6 @@ subroutine adjust_interface_motion( CS, nk, h_old, dz_int )
end subroutine adjust_interface_motion
-!------------------------------------------------------------------------------
-! Build arbitrary grid
-!------------------------------------------------------------------------------
-subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS )
-!------------------------------------------------------------------------------
-! This routine builds a grid based on arbitrary rules
-!------------------------------------------------------------------------------
-
- ! Arguments
- type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
- type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Original layer thicknesses [H ~> m or kg m-2]
- type(regridding_CS), intent(in) :: CS !< Regridding control structure
- real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface
- !! depth [H ~> m or kg m-2]
- real, intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2]
-
- ! Local variables
- integer :: i, j, k
- integer :: nz
- real :: z_inter(SZK_(GV)+1)
- real :: total_height
- real :: delta_h
- real :: max_depth
- real :: eta ! local elevation [H ~> m or kg m-2]
- real :: local_depth ! The local ocean depth relative to mean sea level in thickness units [H ~> m or kg m-2]
- real :: x1, y1, x2, y2
- real :: x, t
-
- nz = GV%ke
- max_depth = G%max_depth*GV%Z_to_H
-
- do j = G%jsc-1,G%jec+1
- do i = G%isc-1,G%iec+1
-
- ! Local depth
- local_depth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H
-
- ! Determine water column height
- total_height = 0.0
- do k = 1,nz
- total_height = total_height + h(i,j,k)
- enddo
-
- eta = total_height - local_depth
-
- ! Compute new thicknesses based on stretched water column
- delta_h = (max_depth + eta) / nz
-
- ! Define interfaces
- z_inter(1) = eta
- do k = 1,nz
- z_inter(k+1) = z_inter(k) - delta_h
- enddo
-
- ! Refine grid in the middle
- do k = 1,nz+1
- x1 = 0.35; y1 = 0.45; x2 = 0.65; y2 = 0.55
-
- x = - ( z_inter(k) - eta ) / max_depth
-
- if ( x <= x1 ) then
- t = y1*x/x1
- elseif ( (x > x1 ) .and. ( x < x2 )) then
- t = y1 + (y2-y1) * (x-x1) / (x2-x1)
- else
- t = y2 + (1.0-y2) * (x-x2) / (1.0-x2)
- endif
-
- z_inter(k) = -t * max_depth + eta
-
- enddo
-
- ! Modify interface heights to account for topography
- z_inter(nz+1) = - local_depth
-
- ! Modify interface heights to avoid layers of zero thicknesses
- do k = nz,1,-1
- if ( z_inter(k) < (z_inter(k+1) + CS%min_thickness) ) then
- z_inter(k) = z_inter(k+1) + CS%min_thickness
- endif
- enddo
-
- ! Change in interface position
- x = 0. ! Left boundary at x=0
- dzInterface(i,j,1) = 0.
- do k = 2,nz
- x = x + h(i,j,k)
- dzInterface(i,j,k) = z_inter(k) - x
- enddo
- dzInterface(i,j,nz+1) = 0.
-
- enddo
- enddo
-
-stop 'OOOOOOPS' ! For some reason the gnu compiler will not let me delete this
- ! routine????
-
-end subroutine build_grid_arbitrary
-
-
!------------------------------------------------------------------------------
! Check grid integrity
@@ -2373,7 +2352,7 @@ function getStaticThickness( CS, SSH, depth )
real, dimension(CS%nk) :: getStaticThickness !< The returned thicknesses in the units of depth
! Local
integer :: k
- real :: z, dz
+ real :: z, dz ! Vertical positions and grid spacing [Z ~> m]
select case ( CS%regridding_scheme )
case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, &
@@ -2407,10 +2386,13 @@ end function getStaticThickness
subroutine dz_function1( string, dz )
character(len=*), intent(in) :: string !< String with list of parameters in form
!! dz_min, H_total, power, precision
- real, dimension(:), intent(inout) :: dz !< Profile of nominal thicknesses
+ real, dimension(:), intent(inout) :: dz !< Profile of nominal thicknesses [m] or other units
! Local variables
integer :: nk, k
- real :: dz_min, power, prec, H_total
+ real :: dz_min ! minimum grid spacing [m] or other units
+ real :: power ! A power to raise the relative position in index space [nondim]
+ real :: prec ! The precision with which positions are returned [m] or other units
+ real :: H_total ! The sum of the nominal thicknesses [m] or other units
nk = size(dz) ! Number of cells
prec = -1024.
diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90
index 91df78c021..ee612788c9 100644
--- a/src/ALE/coord_adapt.F90
+++ b/src/ALE/coord_adapt.F90
@@ -112,7 +112,7 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom
if (present(adaptDoMin)) CS%adaptDoMin = adaptDoMin
end subroutine set_adapt_params
-subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNext)
+subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, nom_depth_H, zNext)
type(adapt_CS), intent(in) :: CS !< The control structure for this module
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -125,6 +125,10 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures [C ~> degC]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities [S ~> ppt]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: nom_depth_H !< The bathymetric depth of this column
+ !! relative to mean sea level or another locally
+ !! valid reference height, converted to thickness
+ !! units [H ~> m or kg m-2]
real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions
! Local variables
@@ -144,7 +148,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex
zNext(nz+1) = zInt(i,j,nz+1)
! local depth for scaling diffusivity
- depth = (G%bathyT(i,j) + G%Z_ref) * GV%Z_to_H
+ depth = nom_depth_H(i,j)
! initialize del2sigma and the thickness change response to it zero
del2sigma(:) = 0.0 ; dh_d2s(:) = 0.0
@@ -244,9 +248,9 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex
! set vertical grid diffusivity
kGrid(k) = (CS%adaptTimeRatio * nz**2 * depth) * &
- (CS%adaptZoomCoeff / (CS%adaptZoom + 0.5*(zNext(K) + zNext(K+1))) + &
- (CS%adaptBuoyCoeff * drdz / CS%adaptDrho0) + &
- max(1.0 - CS%adaptZoomCoeff - CS%adaptBuoyCoeff, 0.0) / depth)
+ ( CS%adaptZoomCoeff / (CS%adaptZoom + 0.5*(zNext(K) + zNext(K+1))) + &
+ (CS%adaptBuoyCoeff * drdz / CS%adaptDrho0) + &
+ max(1.0 - CS%adaptZoomCoeff - CS%adaptBuoyCoeff, 0.0) / depth)
enddo
! initial denominator (first diagonal element)
diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90
index aa2715eb42..ddc569e45e 100644
--- a/src/ALE/coord_hycom.F90
+++ b/src/ALE/coord_hycom.F90
@@ -117,7 +117,8 @@ subroutine build_hycom1_column(CS, remapCS, eqn_of_state, nz, depth, h, T, S, p_
real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2]
real, dimension(CS%nk+1), intent(inout) :: z_col_new !< Absolute positions of interfaces [H ~> m or kg m-2]
real, optional, intent(in) :: zScale !< Scaling factor from the input coordinate thicknesses in [Z ~> m]
- !! to desired units for zInterface, perhaps GV%Z_to_H.
+ !! to desired units for zInterface, perhaps GV%Z_to_H in which
+ !! case this has units of [H Z-1 ~> nondim or kg m-3]
real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of
!! cell reconstruction [H ~> m or kg m-2]
real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose of
@@ -220,7 +221,6 @@ subroutine build_hycom1_target_anomaly(CS, remapCS, eqn_of_state, nz, depth, h,
real, dimension(nz), intent(in) :: S !< Salinity of column [S ~> ppt]
real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
real, dimension(nz), intent(in) :: p_col !< Layer pressure [R L2 T-2 ~> Pa]
- !! to desired units for zInterface, perhaps GV%Z_to_H.
real, dimension(nz), intent(out) :: R !< Layer density [R ~> kg m-3]
real, dimension(nz+1), intent(out) :: RiAnom !< The interface density anomaly
!! w.r.t. the interface target
diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90
index 8454c4be1d..7b6c0e0f8c 100644
--- a/src/ALE/coord_rho.F90
+++ b/src/ALE/coord_rho.F90
@@ -102,9 +102,9 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, &
real, dimension(CS%nk+1), &
intent(inout) :: z_interface !< Absolute positions of interfaces
real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (positive upward in the same
- !! units as depth) [Z ~> m] or [H ~> m or kg m-2]
+ !! units as depth) [H ~> m or kg m-2]
real, optional, intent(in) :: eta_orig !< The actual original height of the top in the same
- !! units as depth) [Z ~> m] or [H ~> m or kg m-2]
+ !! units as depth) [H ~> m or kg m-2]
real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose
!! of cell reconstructions [H ~> m or kg m-2]
real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose
@@ -119,22 +119,10 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, &
real, dimension(nz+1) :: xTmp ! Temporary positions [H ~> m or kg m-2]
real, dimension(CS%nk) :: h_new ! New thicknesses [H ~> m or kg m-2]
real, dimension(CS%nk+1) :: x1 ! Interface heights [H ~> m or kg m-2]
- real :: z0_top, eta ! Thicknesses or heights [Z ~> m] or [H ~> m or kg m-2]
! Construct source column with vanished layers removed (stored in h_nv)
call copy_finite_thicknesses(nz, h, CS%min_thickness, count_nonzero_layers, h_nv, mapping)
- z0_top = 0.
- eta=0.0
- if (present(z_rigid_top)) then
- z0_top = z_rigid_top
- eta=z0_top
- if (present(eta_orig)) then
- eta=eta_orig
- endif
- endif
-
-
if (count_nonzero_layers > 1) then
xTmp(1) = 0.0
do k = 1,count_nonzero_layers
diff --git a/src/core/MOM.F90 b/src/core/MOM.F90
index 2e23032976..7b080a5537 100644
--- a/src/core/MOM.F90
+++ b/src/core/MOM.F90
@@ -23,7 +23,7 @@ module MOM
use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init
use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids
use MOM_diag_mediator, only : diag_copy_storage_to_diag, diag_copy_diag_to_storage
-use MOM_domains, only : MOM_domains_init
+use MOM_domains, only : MOM_domains_init, MOM_domain_type
use MOM_domains, only : sum_across_PEs, pass_var, pass_vector
use MOM_domains, only : clone_MOM_domain, deallocate_MOM_domain
use MOM_domains, only : To_North, To_East, To_South, To_West
@@ -34,7 +34,7 @@ module MOM
use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery
use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint
use MOM_file_parser, only : read_param, get_param, log_version, param_file_type
-use MOM_forcing_type, only : forcing, mech_forcing
+use MOM_forcing_type, only : forcing, mech_forcing, find_ustar
use MOM_forcing_type, only : MOM_forcing_chksum, MOM_mech_forcing_chksum
use MOM_get_input, only : Get_MOM_Input, directories
use MOM_io, only : MOM_io_init, vardesc, var_desc
@@ -54,6 +54,7 @@ module MOM
use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile
use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, pre_ALE_adjustments
use MOM_ALE, only : ALE_remap_tracers, ALE_remap_velocities
+use MOM_ALE, only : ALE_remap_set_h_vel, ALE_remap_set_h_vel_via_dz
use MOM_ALE, only : ALE_update_regrid_weights, pre_ALE_diagnostics, ALE_register_diags
use MOM_ALE_sponge, only : rotate_ALE_sponge, update_ALE_sponge_field
use MOM_barotropic, only : Barotropic_CS
@@ -62,6 +63,7 @@ module MOM
use MOM_coord_initialization, only : MOM_initialize_coord, write_vertgrid_file
use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS, extract_diabatic_member
use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end
+use MOM_diabatic_driver, only : register_diabatic_restarts
use MOM_stochastics, only : stochastics_init, update_stochastics, stochastic_CS, apply_skeb
use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init
use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics
@@ -88,12 +90,13 @@ module MOM
use MOM_forcing_type, only : copy_common_forcing_fields, set_derived_forcing_fields
use MOM_forcing_type, only : homogenize_forcing, homogenize_mech_forcing
use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end
-use MOM_grid, only : set_first_direction, rescale_grid_bathymetry
+use MOM_grid, only : set_first_direction
use MOM_hor_index, only : hor_index_type, hor_index_init
use MOM_hor_index, only : rotate_hor_index
-use MOM_interface_heights, only : find_eta, calc_derived_thermo
+use MOM_interface_heights, only : find_eta, calc_derived_thermo, thickness_to_dz
use MOM_interface_filter, only : interface_filter, interface_filter_init, interface_filter_end
use MOM_interface_filter, only : interface_filter_CS
+use MOM_internal_tides, only : int_tide_CS
use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init, VarMix_end
use MOM_lateral_mixing_coeffs, only : calc_resoln_function, calc_depth_function, VarMix_CS
use MOM_MEKE, only : MEKE_alloc_register_restart, step_forward_MEKE
@@ -162,7 +165,7 @@ module MOM
use MOM_offline_main, only : offline_advection_layer, offline_transport_end
use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf
use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end
-
+use MOM_particles_mod, only : particles_to_k_space, particles_to_z_space
implicit none ; private
#include
@@ -251,6 +254,8 @@ module MOM
logical :: remap_aux_vars !< If true, apply ALE remapping to all of the auxiliary 3-D
!! variables that are needed to reproduce across restarts,
!! similarly to what is done with the primary state variables.
+ logical :: remap_uv_using_old_alg !< If true, use the old "remapping via a delta z" method for
+ !! velocities. If false, remap between two grids described by thicknesses.
type(MOM_stoch_eos_CS) :: stoch_eos_CS !< structure containing random pattern for stoch EOS
logical :: alternate_first_direction !< If true, alternate whether the x- or y-direction
@@ -289,8 +294,6 @@ module MOM
logical :: useMEKE !< If true, call the MEKE parameterization.
logical :: use_stochastic_EOS !< If true, use the stochastic EOS parameterizations.
logical :: useWaves !< If true, update Stokes drift
- logical :: use_p_surf_in_EOS !< If true, always include the surface pressure contributions
- !! in equation of state calculations.
logical :: use_diabatic_time_bug !< If true, uses the wrong calendar time for diabatic processes,
!! as was done in MOM6 versions prior to February 2018.
real :: dtbt_reset_period !< The time interval between dynamic recalculation of the
@@ -337,14 +340,14 @@ module MOM
! These elements are used to control the calculation and error checking of the surface state
real :: Hmix !< Diagnostic mixed layer thickness over which to
!! average surface tracer properties when a bulk
- !! mixed layer is not used [Z ~> m], or a negative value
+ !! mixed layer is not used [H ~> m or kg m-2], or a negative value
!! if a bulk mixed layer is being used.
- real :: HFrz !< If HFrz > 0, the nominal depth over which melt potential is
- !! computed [Z ~> m]. The actual depth over which melt potential is
+ real :: HFrz !< If HFrz > 0, the nominal depth over which melt potential is computed
+ !! [H ~> m or kg m-2]. The actual depth over which melt potential is
!! computed is min(HFrz, OBLD), where OBLD is the boundary layer depth.
!! If HFrz <= 0 (default), melt potential will not be computed.
real :: Hmix_UV !< Depth scale over which to average surface flow to
- !! feedback to the coupler/driver [Z ~> m] when
+ !! feedback to the coupler/driver [H ~> m or kg m-2] when
!! bulk mixed layer is not used, or a negative value
!! if a bulk mixed layer is being used.
logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values.
@@ -358,6 +361,7 @@ module MOM
!! higher values use more appropriate expressions that differ at
!! roundoff for non-Boussinesq cases.
logical :: use_particles !< Turns on the particles package
+ logical :: use_uh_particles !< particles are advected by uh/h
logical :: use_dbclient !< Turns on the database client used for ML inference/analysis
character(len=10) :: particle_type !< Particle types include: surface(default), profiling and sail drone.
@@ -407,9 +411,11 @@ module MOM
type(sponge_CS), pointer :: sponge_CSp => NULL()
!< Pointer to the layered-mode sponge control structure
type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL()
- !< Pointer to the oda incremental update control structure
- type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL()
!< Pointer to the ALE-mode sponge control structure
+ type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL()
+ !< Pointer to the oda incremental update control structure
+ type(int_tide_CS), pointer :: int_tide_CSp => NULL()
+ !< Pointer to the internal tides control structure
type(ALE_CS), pointer :: ALE_CSp => NULL()
!< Pointer to the Arbitrary Lagrangian Eulerian (ALE) vertical coordinate control structure
@@ -435,6 +441,8 @@ module MOM
type(porous_barrier_type) :: pbv !< porous barrier fractional cell metrics
type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure
+ type(MOM_restart_CS), pointer :: restart_CS => NULL()
+ !< Pointer to MOM's restart control structure
end type MOM_control_struct
public initialize_MOM, finish_MOM_initialization, MOM_end
@@ -442,6 +450,7 @@ module MOM
public extract_surface_state, get_ocean_stocks
public get_MOM_state_elements, MOM_state_is_synchronized
public allocate_surface_state, deallocate_surface_state
+public save_MOM_restart
!>@{ CPU time clock IDs
integer :: id_clock_ocean
@@ -513,6 +522,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
! various unit conversion factors
integer :: ntstep ! time steps between tracer updates or diabatic forcing
integer :: n_max ! number of steps to take in this call
+ integer :: halo_sz, dynamics_stencil
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
@@ -535,14 +545,21 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
! multiple dynamic timesteps.
logical :: do_dyn ! If true, dynamics are updated with this call.
logical :: do_thermo ! If true, thermodynamics and remapping may be applied with this call.
+ logical :: nonblocking_p_surf_update ! A flag to indicate whether surface properties
+ ! can use nonblocking halo updates
logical :: cycle_start ! If true, do calculations that are only done at the start of
! a stepping cycle (whatever that may mean).
logical :: cycle_end ! If true, do calculations and diagnostics that are only done at
! the end of a stepping cycle (whatever that may mean).
logical :: therm_reset ! If true, reset running sums of thermodynamic quantities.
real :: cycle_time ! The length of the coupled time-stepping cycle [T ~> s].
+ real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: &
+ U_star ! The wind friction velocity, calculated using the Boussinesq reference density or
+ ! the time-evolving surface density in non-Boussinesq mode [Z T-1 ~> m s-1]
real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: &
ssh ! sea surface height, which may be based on eta_av [Z ~> m]
+ real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: &
+ dz ! Vertical distance across layers [Z ~> m]
real, dimension(:,:,:), pointer :: &
u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1]
@@ -618,6 +635,9 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
endif
endif
+ ! This will be replaced later with the pressures from forces or fluxes if they are available.
+ if (associated(CS%tv%p_surf)) CS%tv%p_surf(:,:) = 0.0
+
! First determine the time step that is consistent with this call and an
! integer fraction of time_interval.
if (do_dyn) then
@@ -639,13 +659,13 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
dt_therm = dt*ntstep
endif
- if (associated(forces%p_surf)) p_surf => forces%p_surf
- if (.not.associated(forces%p_surf)) CS%interp_p_surf = .false.
- CS%tv%p_surf => NULL()
- if (CS%use_p_surf_in_EOS .and. associated(forces%p_surf)) CS%tv%p_surf => forces%p_surf
-
!---------- Initiate group halo pass of the forcing fields
call cpu_clock_begin(id_clock_pass)
+ ! Halo updates for surface pressure need to be completed before calling calc_resoln_function
+ ! among other routines if the surface pressure is used in the equation of state.
+ nonblocking_p_surf_update = G%nonblocking_updates .and. &
+ .not.(associated(CS%tv%p_surf) .and. associated(forces%p_surf) .and. &
+ allocated(CS%tv%SpV_avg) .and. associated(CS%tv%T))
if (.not.associated(forces%taux) .or. .not.associated(forces%tauy)) &
call MOM_error(FATAL,'step_MOM:forces%taux,tauy not associated')
call create_group_pass(pass_tau_ustar_psurf, forces%taux, forces%tauy, G%Domain)
@@ -655,12 +675,25 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
call create_group_pass(pass_tau_ustar_psurf, forces%tau_mag, G%Domain)
if (associated(forces%p_surf)) &
call create_group_pass(pass_tau_ustar_psurf, forces%p_surf, G%Domain)
- if (G%nonblocking_updates) then
+ if (nonblocking_p_surf_update) then
call start_group_pass(pass_tau_ustar_psurf, G%Domain)
else
call do_group_pass(pass_tau_ustar_psurf, G%Domain)
endif
call cpu_clock_end(id_clock_pass)
+
+ if (associated(forces%p_surf)) p_surf => forces%p_surf
+ if (.not.associated(forces%p_surf)) CS%interp_p_surf = .false.
+ if (associated(CS%tv%p_surf) .and. associated(forces%p_surf)) then
+ do j=jsd,jed ; do i=isd,ied ; CS%tv%p_surf(i,j) = forces%p_surf(i,j) ; enddo ; enddo
+
+ if (allocated(CS%tv%SpV_avg) .and. associated(CS%tv%T)) then
+ ! The internal ocean state depends on the surface pressues, so update SpV_avg.
+ dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
+ call calc_derived_thermo(CS%tv, h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
+ endif
+ endif
+
else
! This step only updates the thermodynamics so setting timesteps is simpler.
n_max = 1
@@ -669,12 +702,23 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
dt = time_interval / real(n_max)
dt_therm = dt ; ntstep = 1
+
+ if (CS%UseWaves .and. associated(fluxes%ustar)) &
+ call pass_var(fluxes%ustar, G%Domain, clock=id_clock_pass, halo=1)
+ if (CS%UseWaves .and. associated(fluxes%tau_mag)) &
+ call pass_var(fluxes%tau_mag, G%Domain, clock=id_clock_pass, halo=1)
+
if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf
- CS%tv%p_surf => NULL()
- if (associated(fluxes%p_surf)) then
- if (CS%use_p_surf_in_EOS) CS%tv%p_surf => fluxes%p_surf
+ if (associated(CS%tv%p_surf) .and. associated(fluxes%p_surf)) then
+ do j=js,je ; do i=is,ie ; CS%tv%p_surf(i,j) = fluxes%p_surf(i,j) ; enddo ; enddo
+ if (allocated(CS%tv%SpV_avg)) then
+ call pass_var(CS%tv%p_surf, G%Domain, clock=id_clock_pass)
+ ! The internal ocean state depends on the surface pressues, so update SpV_avg.
+ call extract_diabatic_member(CS%diabatic_CSp, diabatic_halo=halo_sz)
+ halo_sz = max(halo_sz, 1)
+ call calc_derived_thermo(CS%tv, h, G, GV, US, halo=halo_sz, debug=CS%debug)
+ endif
endif
- if (CS%UseWaves) call pass_var(fluxes%ustar, G%Domain, clock=id_clock_pass)
endif
if (therm_reset) then
@@ -701,7 +745,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
call update_stochastics(CS%stoch_CS)
if (do_dyn) then
- if (G%nonblocking_updates) &
+ if (nonblocking_p_surf_update) &
call complete_group_pass(pass_tau_ustar_psurf, G%Domain, clock=id_clock_pass)
if (CS%interp_p_surf) then
@@ -719,12 +763,16 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
if (CS%UseWaves) then
! Update wave information, which is presently kept static over each call to step_mom
call enable_averages(time_interval, Time_start + real_to_time(US%T_to_s*time_interval), CS%diag)
- call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, time_interval, do_dyn)
+ call find_ustar(forces, CS%tv, U_star, G, GV, US, halo=1)
+ call thickness_to_dz(h, CS%tv, dz, G, GV, US, halo_size=1)
+ call Update_Stokes_Drift(G, GV, US, Waves, dz, U_star, time_interval, do_dyn)
call disable_averaging(CS%diag)
endif
else ! not do_dyn.
if (CS%UseWaves) then ! Diagnostics are not enabled in this call.
- call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, time_interval, do_dyn)
+ call find_ustar(fluxes, CS%tv, U_star, G, GV, US, halo=1)
+ call thickness_to_dz(h, CS%tv, dz, G, GV, US, halo_size=1)
+ call Update_Stokes_Drift(G, GV, US, Waves, dz, U_star, time_interval, do_dyn)
endif
endif
@@ -1090,7 +1138,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
call cpu_clock_end(id_clock_stoch)
call cpu_clock_begin(id_clock_varT)
if (CS%use_stochastic_EOS) then
- call MOM_calc_varT(G, GV, h, CS%tv, CS%stoch_eos_CS, dt)
+ call MOM_calc_varT(G, GV, US, h, CS%tv, CS%stoch_eos_CS, dt)
if (associated(CS%tv%varT)) call pass_var(CS%tv%varT, G%Domain, clock=id_clock_pass, halo=1)
endif
call cpu_clock_end(id_clock_varT)
@@ -1112,6 +1160,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
endif
if (CS%interface_filter) then
+ if (allocated(CS%tv%SpV_avg)) call pass_var(CS%tv%SpV_avg, G%Domain, clock=id_clock_pass)
+ CS%tv%valid_SpV_halo = min(G%Domain%nihalo, G%Domain%njhalo)
call cpu_clock_begin(id_clock_int_filter)
call interface_filter(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, &
CS%CDp, CS%interface_filter_CSp)
@@ -1225,10 +1275,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
enddo; enddo
endif
- if (CS%use_particles .and. CS%do_dynamics) then ! Run particles whether or not stepping is split
- call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model
- endif
-
if ((CS%thickness_diffuse .or. CS%interface_filter) .and. &
.not.CS%thickness_diffuse_first) then
@@ -1249,6 +1295,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
endif
if (CS%interface_filter) then
+ if (allocated(CS%tv%SpV_avg)) call pass_var(CS%tv%SpV_avg, G%Domain, clock=id_clock_pass)
+ CS%tv%valid_SpV_halo = min(G%Domain%nihalo, G%Domain%njhalo)
call cpu_clock_begin(id_clock_int_filter)
call interface_filter(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, &
CS%CDp, CS%interface_filter_CSp)
@@ -1288,6 +1336,17 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
endif
call disable_averaging(CS%diag)
+ if (CS%use_particles .and. CS%do_dynamics .and. CS%use_uh_particles) then
+ !Run particles using thickness-weighted velocity
+ call particles_run(CS%particles, Time_local, CS%uhtr, CS%vhtr, CS%h, &
+ CS%tv, CS%use_uh_particles)
+ elseif (CS%use_particles .and. CS%do_dynamics) then
+ !Run particles using unweighted velocity
+ call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, &
+ CS%tv, CS%use_uh_particles)
+ endif
+
+
! Advance the dynamics time by dt.
CS%t_dyn_rel_adv = CS%t_dyn_rel_adv + dt
CS%n_dyn_steps_in_adv = CS%n_dyn_steps_in_adv + 1
@@ -1396,6 +1455,8 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local)
if (associated(CS%tv%T)) then
call extract_diabatic_member(CS%diabatic_CSp, diabatic_halo=halo_sz)
+ ! The bottom boundary layer calculation may need halo values of SpV_avg, including the corners.
+ if (allocated(CS%tv%SpV_avg)) halo_sz = max(halo_sz, 1)
if (halo_sz > 0) then
call create_group_pass(pass_T_S, CS%tv%T, G%Domain, To_All, halo=halo_sz)
call create_group_pass(pass_T_S, CS%tv%S, G%Domain, To_All, halo=halo_sz)
@@ -1411,7 +1472,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local)
! Update derived thermodynamic quantities.
if (allocated(CS%tv%SpV_avg)) then
- call calc_derived_thermo(CS%tv, h, G, GV, US, halo=halo_sz)
+ call calc_derived_thermo(CS%tv, h, G, GV, US, halo=halo_sz, debug=CS%debug)
endif
endif
@@ -1445,6 +1506,14 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
real :: h_new(SZI_(G),SZJ_(G),SZK_(GV)) ! Layer thicknesses after regridding [H ~> m or kg m-2]
real :: dzRegrid(SZI_(G),SZJ_(G),SZK_(GV)+1) ! The change in grid interface positions due to regridding,
! in the same units as thicknesses [H ~> m or kg m-2]
+ real :: h_old_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! Source grid thickness at zonal
+ ! velocity points [H ~> m or kg m-2]
+ real :: h_old_v(SZI_(G),SZJB_(G),SZK_(GV)) ! Source grid thickness at meridional
+ ! velocity points [H ~> m or kg m-2]
+ real :: h_new_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! Destination grid thickness at zonal
+ ! velocity points [H ~> m or kg m-2]
+ real :: h_new_v(SZI_(G),SZJB_(G),SZK_(GV)) ! Destination grid thickness at meridional
+ ! velocity points [H ~> m or kg m-2]
logical :: PCM_cell(SZI_(G),SZJ_(G),SZK_(GV)) ! If true, PCM remapping should be used in a cell.
logical :: use_ice_shelf ! Needed for selecting the right ALE interface.
logical :: showCallTree
@@ -1542,6 +1611,10 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV)
+ if (CS%use_particles) then
+ call particles_to_z_space(CS%particles, h)
+ endif
+
if (CS%debug) then
call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, omit_corners=.true.)
call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, omit_corners=.true., scale=US%C_to_degC)
@@ -1566,16 +1639,34 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
if (showCallTree) call callTree_waypoint("new grid generated")
! Remap all variables from the old grid h onto the new grid h_new
call ALE_remap_tracers(CS%ALE_CSp, G, GV, h, h_new, CS%tracer_Reg, showCallTree, dtdia, PCM_cell)
- call ALE_remap_velocities(CS%ALE_CSp, G, GV, h, h_new, u, v, CS%OBC, dzRegrid, showCallTree, dtdia)
+
+ ! Determine the old and new grid thicknesses at velocity points.
+ call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, h, h_old_u, h_old_v, CS%OBC, debug=showCallTree)
+ if (CS%remap_uv_using_old_alg) then
+ call ALE_remap_set_h_vel_via_dz(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, h, dzRegrid, showCallTree)
+ else
+ call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, debug=showCallTree)
+ endif
+
+ ! Remap the velocity components.
+ call ALE_remap_velocities(CS%ALE_CSp, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, u, v, showCallTree, &
+ dtdia, allow_preserve_variance=.true.)
+
+ if (allocated(tv%SpV_avg)) tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
if (CS%remap_aux_vars) then
if (CS%split) &
- call remap_dyn_split_RK2_aux_vars(G, GV, CS%dyn_split_RK2_CSp, h, h_new, CS%ALE_CSp, CS%OBC, dzRegrid)
+ call remap_dyn_split_RK2_aux_vars(G, GV, CS%dyn_split_RK2_CSp, h_old_u, h_old_v, h_new_u, h_new_v, CS%ALE_CSp)
- if (associated(CS%OBC)) &
+ if (associated(CS%OBC)) then
+ call pass_var(h, G%Domain, complete=.false.)
+ call pass_var(h_new, G%Domain, complete=.true.)
call remap_OBC_fields(G, GV, h, h_new, CS%OBC, PCM_cell=PCM_cell)
+ endif
call remap_vertvisc_aux_vars(G, GV, CS%visc, h, h_new, CS%ALE_CSp, CS%OBC)
+ if (associated(CS%visc%Kv_shear)) &
+ call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, clock=id_clock_pass, halo=1)
endif
! Replace the old grid with new one. All remapping must be done by this point in the code.
@@ -1588,6 +1679,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
call cpu_clock_end(id_clock_ALE)
endif ! endif for the block "if ( CS%use_ALE_algorithm )"
+
+ if (CS%use_particles) then
+ call particles_to_k_space(CS%particles, h)
+ endif
+
dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
call create_group_pass(pass_uv_T_S_h, u, v, G%Domain, halo=dynamics_stencil)
if (associated(tv%T)) &
@@ -1599,7 +1695,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
! Update derived thermodynamic quantities.
if (allocated(tv%SpV_avg)) then
- call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil)
+ call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
endif
if (CS%debug .and. CS%use_ALE_algorithm) then
@@ -1655,7 +1751,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
! Update derived thermodynamic quantities.
if (allocated(tv%SpV_avg)) then
- call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil)
+ call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
endif
endif
@@ -1779,7 +1875,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS
! The functions related to column physics of tracers is performed separately in ALE mode
if (do_vertical) then
call offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS%offline_CSp, &
- CS%h, eatr, ebtr)
+ CS%h, CS%tv, eatr, ebtr)
endif
! Last thing that needs to be done is the final ALE remapping
@@ -1828,6 +1924,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS
! are used are intended to ensure that in the case where transports don't quite conserve,
! the offline layer thicknesses do not drift too far away from the online model.
call ALE_remap_tracers(CS%ALE_CSp, G, GV, CS%h, h_new, CS%tracer_Reg, debug=CS%debug)
+ if (allocated(CS%tv%SpV_avg)) CS%tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
! Update the tracer grid.
do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1
@@ -1893,7 +1990,7 @@ end subroutine step_offline
!> Initialize MOM, including memory allocation, setting up parameters and diagnostics,
!! initializing the ocean state variables, and initializing subsidiary modules
-subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
+subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
Time_in, offline_tracer_mode, input_restart_file, diag_ptr, &
count_calls, tracer_flow_CSp, ice_shelf_CSp, waves_CSp, ensemble_num)
type(time_type), target, intent(inout) :: Time !< model time, set in this routine
@@ -1901,9 +1998,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse
type(directories), intent(out) :: dirs !< structure with directory paths
type(MOM_control_struct), intent(inout), target :: CS !< pointer set in this routine to MOM control structure
- type(MOM_restart_CS), pointer :: restart_CSp !< pointer set in this routine to the
- !! restart control structure that will
- !! be used for MOM.
type(time_type), optional, intent(in) :: Time_in !< time passed to MOM_initialize_state when
!! model is not being started from a restart file
logical, optional, intent(out) :: offline_tracer_mode !< True is returned if tracers are being run offline
@@ -1926,11 +2020,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
type(ocean_grid_type), pointer :: G_in => NULL() ! Pointer to the input grid
type(hor_index_type), pointer :: HI => NULL() ! A hor_index_type for array extents
type(hor_index_type), target :: HI_in ! HI on the input grid
+ type(hor_index_type) :: HI_in_unmasked ! HI on the unmasked input grid
type(verticalGrid_type), pointer :: GV => NULL()
type(dyn_horgrid_type), pointer :: dG => NULL(), test_dG => NULL()
type(dyn_horgrid_type), pointer :: dG_in => NULL()
+ type(dyn_horgrid_type), pointer :: dG_unmasked_in => NULL()
type(diag_ctrl), pointer :: diag => NULL()
type(unit_scale_type), pointer :: US => NULL()
+ type(MOM_restart_CS), pointer :: restart_CSp => NULL()
character(len=4), parameter :: vers_num = 'v2.0'
integer :: turns ! Number of grid quarter-turns
@@ -1949,7 +2046,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
type(sponge_CS), pointer :: sponge_in_CSp => NULL()
type(ALE_sponge_CS), pointer :: ALE_sponge_in_CSp => NULL()
type(oda_incupd_CS),pointer :: oda_incupd_in_CSp => NULL()
-
! This include declares and sets the variable "version".
# include "version_variable.h"
@@ -1962,9 +2058,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
real, allocatable, dimension(:,:,:) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2]
real, allocatable, dimension(:,:,:) :: dzRegrid ! The change in grid interface positions due to regridding,
! in the same units as thicknesses [H ~> m or kg m-2]
+ real, allocatable, dimension(:,:,:) :: h_old_u ! Source grid thickness at zonal velocity points [H ~> m or kg m-2]
+ real, allocatable, dimension(:,:,:) :: h_old_v ! Source grid thickness at meridional velocity
+ ! points [H ~> m or kg m-2]
+ real, allocatable, dimension(:,:,:) :: h_new_u ! Destination grid thickness at zonal
+ ! velocity points [H ~> m or kg m-2]
+ real, allocatable, dimension(:,:,:) :: h_new_v ! Destination grid thickness at meridional
+ ! velocity points [H ~> m or kg m-2]
logical, allocatable, dimension(:,:,:) :: PCM_cell ! If true, PCM remapping should be used in a cell.
type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h
+ real :: Hmix_z, Hmix_UV_z ! Temporary variables with averaging depths [Z ~> m]
+ real :: HFrz_z ! Temporary variable with the melt potential depth [Z ~> m]
real :: default_val ! default value for a parameter
logical :: write_geom_files ! If true, write out the grid geometry files.
logical :: new_sim ! If true, this has been determined to be a new simulation
@@ -1978,15 +2083,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
logical :: bulkmixedlayer ! If true, a refined bulk mixed layer scheme is used
! with nkml sublayers and nkbl buffer layer.
logical :: use_temperature ! If true, temperature and salinity used as state variables.
+ logical :: use_p_surf_in_EOS ! If true, always include the surface pressure contributions
+ ! in equation of state calculations.
logical :: use_frazil ! If true, liquid seawater freezes if temp below freezing,
! with accumulated heat deficit returned to surface ocean.
logical :: bound_salinity ! If true, salt is added to keep salinity above
! a minimum value, and the deficit is reported.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use expressions for the surface properties that recover
- ! the answers from the end of 2018. Otherwise, use more appropriate
- ! expressions that differ at roundoff for non-Boussinesq cases.
logical :: use_conT_absS ! If true, the prognostics T & S are conservative temperature
! and absolute salinity. Care should be taken to convert them
! to potential temperature and practical salinity before
@@ -2004,6 +2107,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
integer :: first_direction ! An integer that indicates which direction is to be
! updated first in directionally split parts of the
! calculation.
+ logical :: non_Bous ! If true, this run is fully non-Boussinesq
+ logical :: Boussinesq ! If true, this run is fully Boussinesq
+ logical :: semi_Boussinesq ! If true, this run is partially non-Boussinesq
logical :: use_KPP ! If true, diabatic is using KPP vertical mixing
integer :: nkml, nkbl, verbosity, write_geom
integer :: dynamics_stencil ! The computational stencil for the calculations
@@ -2018,6 +2124,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables.
type(time_type) :: Start_time
type(ocean_internal_state) :: MOM_internal_state
+ type(MOM_domain_type), pointer :: MOM_dom_unmasked => null() ! Unmasked MOM domain instance
+ ! (To be used for writing out ocean geometry)
+ character(len=240) :: geom_file ! Name of the ocean geometry file
CS%Time => Time
@@ -2067,10 +2176,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
default=.false.)
endif
+ call get_param(param_file, "MOM", "BOUSSINESQ", Boussinesq, &
+ "If true, make the Boussinesq approximation.", default=.true., do_not_log=.true.)
+ call get_param(param_file, "MOM", "SEMI_BOUSSINESQ", semi_Boussinesq, &
+ "If true, do non-Boussinesq pressure force calculations and use mass-based "//&
+ "thicknesses, but use RHO_0 to convert layer thicknesses into certain "//&
+ "height changes. This only applies if BOUSSINESQ is false.", &
+ default=.true., do_not_log=.true.)
+ non_Bous = .not.(Boussinesq .or. semi_Boussinesq)
call get_param(param_file, "MOM", "CALC_RHO_FOR_SEA_LEVEL", CS%calc_rho_for_sea_lev, &
"If true, the in-situ density is used to calculate the "//&
"effective sea level that is returned to the coupler. If false, "//&
- "the Boussinesq parameter RHO_0 is used.", default=.false.)
+ "the Boussinesq parameter RHO_0 is used.", default=non_Bous)
call get_param(param_file, "MOM", "ENABLE_THERMODYNAMICS", use_temperature, &
"If true, Temperature and salinity are used as state "//&
"variables.", default=.true.)
@@ -2123,6 +2240,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm, &
"If True, use the ALE algorithm (regridding/remapping). "//&
"If False, use the layered isopycnal algorithm.", default=.false. )
+ call get_param(param_file, "MOM", "REMAP_UV_USING_OLD_ALG", CS%remap_uv_using_old_alg, &
+ "If true, uses the old remapping-via-a-delta-z method for "//&
+ "remapping u and v. If false, uses the new method that remaps "//&
+ "between grids described by an old and new thickness.", &
+ default=.false., do_not_log=.not.CS%use_ALE_algorithm)
call get_param(param_file, "MOM", "REMAP_AUXILIARY_VARS", CS%remap_aux_vars, &
"If true, apply ALE remapping to all of the auxiliary 3-dimensional "//&
"variables that are needed to reproduce across restarts, similarly to "//&
@@ -2190,22 +2312,23 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
if (bulkmixedlayer) then
CS%Hmix = -1.0 ; CS%Hmix_UV = -1.0
else
- call get_param(param_file, "MOM", "HMIX_SFC_PROP", CS%Hmix, &
+ call get_param(param_file, "MOM", "HMIX_SFC_PROP", Hmix_z, &
"If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth "//&
"over which to average to find surface properties like "//&
"SST and SSS or density (but not surface velocities).", &
units="m", default=1.0, scale=US%m_to_Z)
- call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, &
+ call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", Hmix_UV_z, &
"If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth "//&
"over which to average to find surface flow properties, "//&
"SSU, SSV. A non-positive value indicates no averaging.", &
units="m", default=0.0, scale=US%m_to_Z)
endif
- call get_param(param_file, "MOM", "HFREEZE", CS%HFrz, &
+ call get_param(param_file, "MOM", "HFREEZE", HFrz_z, &
"If HFREEZE > 0, melt potential will be computed. The actual depth "//&
"over which melt potential is computed will be min(HFREEZE, OBLD), "//&
"where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//&
- "melt potential will not be computed.", units="m", default=-1.0, scale=US%m_to_Z)
+ "melt potential will not be computed.", &
+ units="m", default=-1.0, scale=US%m_to_Z)
call get_param(param_file, "MOM", "INTERPOLATE_P_SURF", CS%interp_p_surf, &
"If true, linearly interpolate the surface pressure "//&
"over the coupling time step, using the specified value "//&
@@ -2231,7 +2354,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
units="s", default=US%T_to_s*CS%dt, scale=US%s_to_T, do_not_log=.not.associated(CS%OBC))
! This is here in case these values are used inappropriately.
- use_frazil = .false. ; bound_salinity = .false.
+ use_frazil = .false. ; bound_salinity = .false. ; use_p_surf_in_EOS = .false.
CS%tv%P_Ref = 2.0e7*US%Pa_to_RL2_T2
if (use_temperature) then
call get_param(param_file, "MOM", "FRAZIL", use_frazil, &
@@ -2260,7 +2383,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
"This is only used if ENABLE_THERMODYNAMICS is true. The default "//&
"value is from the TEOS-10 definition of conservative temperature.", &
units="J kg-1 K-1", default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC)
- call get_param(param_file, "MOM", "USE_PSURF_IN_EOS", CS%use_p_surf_in_EOS, &
+ call get_param(param_file, "MOM", "USE_PSURF_IN_EOS", use_p_surf_in_EOS, &
"If true, always include the surface pressure contributions "//&
"in equation of state calculations.", default=.true.)
endif
@@ -2326,22 +2449,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call get_param(param_file, "MOM", "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, "MOM", "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, "MOM", "SURFACE_2018_ANSWERS", answers_2018, &
- "If true, use expressions for the surface properties that recover the answers "//&
- "from the end of 2018. Otherwise, use more appropriate expressions that differ "//&
- "at roundoff for non-Boussinesq cases.", default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, "MOM", "SURFACE_ANSWER_DATE", CS%answer_date, &
"The vintage of the expressions for the surface properties. Values below "//&
"20190101 recover the answers from the end of 2018, while higher values "//&
- "use updated and more robust forms of the same expressions. "//&
- "If both SURFACE_2018_ANSWERS and SURFACE_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "use updated and more robust forms of the same expressions.", &
+ default=default_answer_date, do_not_log=non_Bous)
+ if (non_Bous) CS%answer_date = 99991231
call get_param(param_file, "MOM", "USE_DIABATIC_TIME_BUG", CS%use_diabatic_time_bug, &
"If true, uses the wrong calendar time for diabatic processes, as was "//&
@@ -2361,6 +2474,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
"vertical grid files. Other values are invalid.", default=1)
if (write_geom<0 .or. write_geom>2) call MOM_error(FATAL,"MOM: "//&
"WRITE_GEOM must be equal to 0, 1 or 2.")
+ call get_param(param_file, "MOM", "GEOM_FILE", geom_file, &
+ "The file into which to write the ocean geometry.", &
+ default="ocean_geometry")
call get_param(param_file, "MOM", "USE_DBCLIENT", CS%use_dbclient, &
"If true, initialize a client to a remote database that can "//&
"be used for online analysis and machine-learning inference.",&
@@ -2389,7 +2505,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call get_param(param_file, "MOM", "USE_PARTICLES", CS%use_particles, &
"If true, use the particles package.", default=.false.)
-
+ call get_param(param_file, "MOM", "USE_UH_PARTICLES", CS%use_uh_particles, &
+ "If true, use the uh velocity in the particles package.",default=.false.)
CS%ensemble_ocean=.false.
call get_param(param_file, "MOM", "ENSEMBLE_OCEAN", CS%ensemble_ocean, &
"If False, The model is being run in serial mode as a single realization. "//&
@@ -2441,10 +2558,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call MOM_domains_init(G_in%domain, US, param_file, symmetric=symmetric, &
static_memory=.true., NIHALO=NIHALO_, NJHALO=NJHALO_, &
NIGLOBAL=NIGLOBAL_, NJGLOBAL=NJGLOBAL_, NIPROC=NIPROC_, &
- NJPROC=NJPROC_)
+ NJPROC=NJPROC_, MOM_dom_unmasked=MOM_dom_unmasked)
#else
call MOM_domains_init(G_in%domain, US, param_file, symmetric=symmetric, &
- domain_name="MOM_in")
+ domain_name="MOM_in", MOM_dom_unmasked=MOM_dom_unmasked)
#endif
! Copy input grid (G_in) domain to active grid G
@@ -2489,6 +2606,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call verticalGridInit( param_file, CS%GV, US )
GV => CS%GV
+ ! Now that the vertical grid has been initialized, rescale parameters that depend on factors
+ ! that are set with the vertical grid to their desired units. This added rescaling step would
+ ! be unnecessary if the vertical grid were initialized earlier in this routine.
+ if (.not.bulkmixedlayer) then
+ CS%Hmix = (US%Z_to_m * GV%m_to_H) * Hmix_z
+ CS%Hmix_UV = (US%Z_to_m * GV%m_to_H) * Hmix_UV_z
+ endif
+ CS%HFrz = (US%Z_to_m * GV%m_to_H) * HFrz_z
+
! Shift from using the temporary dynamic grid type to using the final (potentially static)
! and properly rotated ocean-specific grid type and horizontal index type.
if (CS%rotate_index) then
@@ -2586,6 +2712,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
endif
endif
+ if (use_p_surf_in_EOS) allocate(CS%tv%p_surf(isd:ied,jsd:jed), source=0.0)
if (use_frazil) allocate(CS%tv%frazil(isd:ied,jsd:jed), source=0.0)
if (bound_salinity) allocate(CS%tv%salt_deficit(isd:ied,jsd:jed), source=0.0)
@@ -2657,7 +2784,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
! Set the fields that are needed for bitwise identical restarting
! the time stepping scheme.
- call restart_init(param_file, restart_CSp)
+ call restart_init(param_file, CS%restart_CS)
+ restart_CSp => CS%restart_CS
+
call set_restart_fields(GV, US, param_file, CS, restart_CSp)
if (CS%split) then
call register_restarts_dyn_split_RK2(HI, GV, US, param_file, &
@@ -2676,7 +2805,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
CS%tracer_Reg, restart_CSp)
call MEKE_alloc_register_restart(HI, US, param_file, CS%MEKE, restart_CSp)
- call set_visc_register_restarts(HI, GV, US, param_file, CS%visc, restart_CSp)
+ call set_visc_register_restarts(HI, G, GV, US, param_file, CS%visc, restart_CSp, use_ice_shelf)
call mixedlayer_restrat_register_restarts(HI, GV, US, param_file, &
CS%mixedlayer_restrat_CSp, restart_CSp)
@@ -2720,14 +2849,30 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call stoch_EOS_register_restarts(HI, param_file, CS%stoch_eos_CS, restart_CSp)
endif
+ if (.not. CS%adiabatic) then
+ call register_diabatic_restarts(G, US, param_file, CS%int_tide_CSp, restart_CSp)
+ endif
+
call callTree_waypoint("restart registration complete (initialize_MOM)")
call restart_registry_lock(restart_CSp)
! Write out all of the grid data used by this run.
new_sim = determine_is_new_run(dirs%input_filename, dirs%restart_input_dir, G_in, restart_CSp)
write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. new_sim))
- if (write_geom_files) call write_ocean_geometry_file(dG_in, param_file, dirs%output_directory, US=US)
-
+ if (write_geom_files) then
+ if (associated(MOM_dom_unmasked)) then
+ call hor_index_init(MOM_dom_unmasked, HI_in_unmasked, param_file, &
+ local_indexing=.not.global_indexing)
+ call create_dyn_horgrid(dG_unmasked_in, HI_in_unmasked, bathymetry_at_vel=bathy_at_vel)
+ call clone_MOM_domain(MOM_dom_unmasked, dG_unmasked_in%Domain)
+ call MOM_initialize_fixed(dG_unmasked_in, US, OBC_in, param_file, .false., dirs%output_directory)
+ call write_ocean_geometry_file(dG_unmasked_in, param_file, dirs%output_directory, US=US, geom_file=geom_file)
+ call deallocate_MOM_domain(MOM_dom_unmasked)
+ call destroy_dyn_horgrid(dG_unmasked_in)
+ else
+ call write_ocean_geometry_file(dG_in, param_file, dirs%output_directory, US=US, geom_file=geom_file)
+ endif
+ endif
call destroy_dyn_horgrid(dG_in)
! Initialize dynamically evolving fields, perhaps from restart files.
@@ -2773,7 +2918,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
! These arrays are not initialized in most solo cases, but are needed
! when using an ice shelf. Passing the ice shelf diagnostics CS from MOM
! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf
- call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr)
+ call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr, &
+ Time_init, dirs%output_directory)
allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0)
allocate(mass_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0)
allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0)
@@ -2832,7 +2978,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
deallocate(frac_shelf_in,mass_shelf_in)
else
if (use_ice_shelf) then
- call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr)
+ call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr, Time_init, dirs%output_directory)
allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0)
allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0)
call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf)
@@ -2854,9 +3000,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
endif
endif
- ! Allocate any derived equation of state fields.
- if (use_temperature .and. .not.(GV%Boussinesq .or. GV%semi_Boussinesq)) then
+ ! Allocate any derived densities or other equation of state derived fields.
+ if (.not.(GV%Boussinesq .or. GV%semi_Boussinesq)) then
allocate(CS%tv%SpV_avg(isd:ied,jsd:jed,nz), source=0.0)
+ CS%tv%valid_SpV_halo = -1 ! This array does not yet have any valid data.
endif
if (use_ice_shelf .and. CS%debug) then
@@ -2905,12 +3052,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
endif
call callTree_waypoint("Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)")
call adjustGridForIntegrity(CS%ALE_CSp, G, GV, CS%h )
+ if (allocated(CS%tv%SpV_avg)) call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=1)
call pre_ALE_adjustments(G, GV, US, CS%h, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%u, CS%v)
call callTree_waypoint("Calling ALE_regrid() to remap initial conditions (initialize_MOM)")
allocate(h_new(isd:ied, jsd:jed, nz), source=0.0)
allocate(dzRegrid(isd:ied, jsd:jed, nz+1), source=0.0)
allocate(PCM_cell(isd:ied, jsd:jed, nz), source=.false.)
+ allocate(h_old_u(IsdB:IedB, jsd:jed, nz), source=0.0)
+ allocate(h_new_u(IsdB:IedB, jsd:jed, nz), source=0.0)
+ allocate(h_old_v(isd:ied, JsdB:JedB, nz), source=0.0)
+ allocate(h_new_v(isd:ied, JsdB:JedB, nz), source=0.0)
if (use_ice_shelf) then
call ALE_regrid(G, GV, US, CS%h, h_new, dzRegrid, CS%tv, CS%ALE_CSp, CS%frac_shelf_h, PCM_cell)
else
@@ -2920,22 +3072,35 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
if (callTree_showQuery()) call callTree_waypoint("new grid generated")
! Remap all variables from the old grid h onto the new grid h_new
call ALE_remap_tracers(CS%ALE_CSp, G, GV, CS%h, h_new, CS%tracer_Reg, CS%debug, PCM_cell=PCM_cell)
- call ALE_remap_velocities(CS%ALE_CSp, G, GV, CS%h, h_new, CS%u, CS%v, CS%OBC, dzRegrid, debug=CS%debug)
+
+ ! Determine the old and new grid thicknesses at velocity points.
+ call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, CS%h, h_old_u, h_old_v, CS%OBC, debug=CS%debug)
+ if (CS%remap_uv_using_old_alg) then
+ call ALE_remap_set_h_vel_via_dz(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, CS%h, dzRegrid, CS%debug)
+ else
+ call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, debug=CS%debug)
+ endif
+
+ ! Remap the velocity components.
+ call ALE_remap_velocities(CS%ALE_CSp, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, CS%u, CS%v, CS%debug)
+
+ if (allocated(CS%tv%SpV_avg)) CS%tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
! Replace the old grid with new one. All remapping must be done at this point.
!$OMP parallel do default(shared)
do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1
CS%h(i,j,k) = h_new(i,j,k)
enddo ; enddo ; enddo
- deallocate(h_new, dzRegrid, PCM_cell)
+
+ deallocate(h_new, dzRegrid, PCM_cell, h_old_u, h_new_u, h_old_v, h_new_v)
call cpu_clock_begin(id_clock_pass_init)
call create_group_pass(tmp_pass_uv_T_S_h, CS%u, CS%v, G%Domain)
if (use_temperature) then
- call create_group_pass(tmp_pass_uv_T_S_h, CS%tv%T, G%Domain, halo=1)
- call create_group_pass(tmp_pass_uv_T_S_h, CS%tv%S, G%Domain, halo=1)
+ call create_group_pass(tmp_pass_uv_T_S_h, CS%tv%T, G%Domain)
+ call create_group_pass(tmp_pass_uv_T_S_h, CS%tv%S, G%Domain)
endif
- call create_group_pass(tmp_pass_uv_T_S_h, CS%h, G%Domain, halo=1)
+ call create_group_pass(tmp_pass_uv_T_S_h, CS%h, G%Domain)
call do_group_pass(tmp_pass_uv_T_S_h, G%Domain)
call cpu_clock_end(id_clock_pass_init)
@@ -3000,7 +3165,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call cpu_clock_end(id_clock_MOM_init)
if (CS%use_dbclient) call database_comms_init(param_file, CS%dbcomms_CS)
- CS%useMEKE = MEKE_init(Time, G, US, param_file, diag, CS%dbcomms_CS, CS%MEKE_CSp, CS%MEKE, &
+ CS%useMEKE = MEKE_init(Time, G, GV, US, param_file, diag, CS%dbcomms_CS, CS%MEKE_CSp, CS%MEKE, &
restart_CSp, CS%MEKE_in_dynamics)
call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix)
@@ -3011,13 +3176,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
new_sim = is_new_run(restart_CSp)
if (use_temperature) then
- CS%use_stochastic_EOS = MOM_stoch_eos_init(Time, G, US, param_file, diag, CS%stoch_eos_CS, restart_CSp)
+ CS%use_stochastic_EOS = MOM_stoch_eos_init(Time, G, GV, US, param_file, diag, CS%stoch_eos_CS, restart_CSp)
else
CS%use_stochastic_EOS = .false.
endif
if (CS%use_porbar) &
- call porous_barriers_init(Time, US, param_file, diag, CS%por_bar_CS)
+ call porous_barriers_init(Time, GV, US, param_file, diag, CS%por_bar_CS)
if (CS%split) then
allocate(eta(SZI_(G),SZJ_(G)), source=0.0)
@@ -3082,7 +3247,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
else
call diabatic_driver_init(Time, G, GV, US, param_file, CS%use_ALE_algorithm, diag, &
CS%ADp, CS%CDp, CS%diabatic_CSp, CS%tracer_flow_CSp, &
- CS%sponge_CSp, CS%ALE_sponge_CSp, CS%oda_incupd_CSp)
+ CS%sponge_CSp, CS%ALE_sponge_CSp, CS%oda_incupd_CSp, CS%int_tide_CSp)
endif
if (associated(CS%sponge_CSp)) &
@@ -3113,26 +3278,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp)
endif
- ! This subroutine initializes any tracer packages.
- call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, &
- CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, &
- CS%ALE_sponge_CSp, CS%tv)
- if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp
-
- ! If running in offline tracer mode, initialize the necessary control structure and
- ! parameters
- if (present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode
-
- if (CS%offline_tracer_mode) then
- ! Setup some initial parameterizations and also assign some of the subtypes
- call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US)
- call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, &
- diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, &
- tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, &
- tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug )
- call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US)
- endif
-
!--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM
call cpu_clock_begin(id_clock_pass_init)
dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
@@ -3146,8 +3291,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call do_group_pass(pass_uv_T_S_h, G%Domain)
! Update derived thermodynamic quantities.
+ if (associated(CS%tv%p_surf)) call pass_var(CS%tv%p_surf, G%Domain, halo=dynamics_stencil)
if (allocated(CS%tv%SpV_avg)) then
- call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=dynamics_stencil)
+ call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
endif
if (associated(CS%visc%Kv_shear)) &
@@ -3158,6 +3304,26 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call cpu_clock_end(id_clock_pass_init)
+ ! This subroutine initializes any tracer packages.
+ call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, &
+ CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, &
+ CS%ALE_sponge_CSp, CS%tv)
+ if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp
+
+ ! If running in offline tracer mode, initialize the necessary control structure and
+ ! parameters
+ if (present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode
+
+ if (CS%offline_tracer_mode) then
+ ! Setup some initial parameterizations and also assign some of the subtypes
+ call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US)
+ call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, &
+ diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, &
+ tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, &
+ tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug )
+ call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US)
+ endif
+
call register_obsolete_diagnostics(param_file, CS%diag)
if (use_frazil) then
@@ -3208,13 +3374,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
end subroutine initialize_MOM
!> Finishes initializing MOM and writes out the initial conditions.
-subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp)
+subroutine finish_MOM_initialization(Time, dirs, CS)
type(time_type), intent(in) :: Time !< model time, used in this routine
type(directories), intent(in) :: dirs !< structure with directory paths
type(MOM_control_struct), intent(inout) :: CS !< MOM control structure
- type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control
- !! structure that will be used for MOM.
- ! Local variables
+
type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing
! metrics and related information
type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure
@@ -3230,13 +3394,13 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp)
G => CS%G ; GV => CS%GV ; US => CS%US
if (CS%use_particles) then
- call particles_init(CS%particles, G, CS%Time, CS%dt_therm, CS%u, CS%v)
+ call particles_init(CS%particles, G, CS%Time, CS%dt_therm, CS%u, CS%v, CS%h)
endif
! Write initial conditions
if (CS%write_IC) then
allocate(restart_CSp_tmp)
- restart_CSp_tmp = restart_CSp
+ restart_CSp_tmp = CS%restart_CS
call restart_registry_lock(restart_CSp_tmp, unlocked=.true.)
allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1))
call find_eta(CS%h, CS%tv, G, GV, US, z_interface, dZref=G%Z_ref)
@@ -3368,6 +3532,10 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp)
"Previous ocean surface pressure", "Pa", conversion=US%RL2_T2_to_Pa)
endif
+ if (associated(CS%tv%p_surf)) &
+ call register_restart_field(CS%tv%p_surf, "p_surf_EOS", .false., restart_CSp, &
+ "Ocean surface pressure used in EoS", "Pa", conversion=US%RL2_T2_to_Pa)
+
call register_restart_field(CS%ave_ssh_ibc, "ave_ssh", .false., restart_CSp, &
"Time average sea surface height", "meter", conversion=US%Z_to_m)
@@ -3376,7 +3544,7 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp)
do_not_log=.true.)
if (use_ice_shelf .and. associated(CS%Hml)) then
call register_restart_field(CS%Hml, "hML", .false., restart_CSp, &
- "Mixed layer thickness", "meter", conversion=US%Z_to_m)
+ "Mixed layer thickness", "m", conversion=US%Z_to_m)
endif
! Register scalar unit conversion factors.
@@ -3458,7 +3626,7 @@ subroutine extract_surface_state(CS, sfc_state_in)
! After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1.
real :: T_freeze(SZI_(CS%G)) !< freezing temperature [C ~> degC]
real :: pres(SZI_(CS%G)) !< Pressure to use for the freezing temperature calculation [R L2 T-2 ~> Pa]
- real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [Z C ~> m degC]
+ real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [H C ~> m degC or degC kg m-2]
logical :: use_temperature !< If true, temperature and salinity are used as state variables.
integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg
integer :: isd, ied, jsd, jed
@@ -3533,9 +3701,12 @@ subroutine extract_surface_state(CS, sfc_state_in)
enddo ; enddo
else ! (CS%Hmix >= 0.0)
- H_rescale = 1.0 ; if (CS%answer_date < 20190101) H_rescale = GV%H_to_Z
+ H_rescale = 1.0
depth_ml = CS%Hmix
- if (CS%answer_date >= 20190101) depth_ml = CS%Hmix*GV%Z_to_H
+ if (CS%answer_date < 20190101) then
+ H_rescale = GV%H_to_Z
+ depth_ml = GV%H_to_Z*CS%Hmix
+ endif
! Determine the mean tracer properties of the uppermost depth_ml fluid.
!$OMP parallel do default(shared) private(depth,dh)
@@ -3606,7 +3777,7 @@ subroutine extract_surface_state(CS, sfc_state_in)
! This assumes that u and v halos have already been updated.
if (CS%Hmix_UV>0.) then
depth_ml = CS%Hmix_UV
- if (CS%answer_date >= 20190101) depth_ml = CS%Hmix_UV*GV%Z_to_H
+ if (CS%answer_date < 20190101) depth_ml = GV%H_to_Z*CS%Hmix_UV
!$OMP parallel do default(shared) private(depth,dh,hv)
do J=js-1,ie
do i=is,ie
@@ -3680,9 +3851,9 @@ subroutine extract_surface_state(CS, sfc_state_in)
do k=1,nz
call calculate_TFreeze(CS%tv%S(is:ie,j,k), pres(is:ie), T_freeze(is:ie), CS%tv%eqn_of_state)
do i=is,ie
- depth_ml = min(CS%HFrz, CS%visc%MLD(i,j))
- if (depth(i) + h(i,j,k)*GV%H_to_Z < depth_ml) then
- dh = h(i,j,k)*GV%H_to_Z
+ depth_ml = min(CS%HFrz, (US%Z_to_m*GV%m_to_H)*CS%visc%MLD(i,j))
+ if (depth(i) + h(i,j,k) < depth_ml) then
+ dh = h(i,j,k)
elseif (depth(i) < depth_ml) then
dh = depth_ml - depth(i)
else
@@ -3704,7 +3875,7 @@ subroutine extract_surface_state(CS, sfc_state_in)
if (G%mask2dT(i,j)>0.) then
! instantaneous melt_potential [Q R Z ~> J m-2]
- sfc_state%melt_potential(i,j) = CS%tv%C_p * GV%Rho0 * delT(i)
+ sfc_state%melt_potential(i,j) = CS%tv%C_p * GV%H_to_RZ * delT(i)
endif
enddo
enddo ! end of j loop
@@ -3914,14 +4085,41 @@ subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only)
end subroutine get_ocean_stocks
+
+!> Save restart/pickup files required to initialize the MOM6 internal state.
+subroutine save_MOM_restart(CS, directory, time, G, time_stamped, filename, &
+ GV, num_rest_files, write_IC)
+ type(MOM_control_struct), intent(inout) :: CS
+ !< MOM control structure
+ character(len=*), intent(in) :: directory
+ !< The directory where the restart files are to be written
+ type(time_type), intent(in) :: time
+ !< The current model time
+ type(ocean_grid_type), intent(inout) :: G
+ !< The ocean's grid structure
+ logical, optional, intent(in) :: time_stamped
+ !< If present and true, add time-stamp to the restart file names
+ character(len=*), optional, intent(in) :: filename
+ !< A filename that overrides the name in CS%restartfile
+ type(verticalGrid_type), optional, intent(in) :: GV
+ !< The ocean's vertical grid structure
+ integer, optional, intent(out) :: num_rest_files
+ !< number of restart files written
+ logical, optional, intent(in) :: write_IC
+ !< If present and true, initial conditions are being written
+
+ call save_restart(directory, time, G, CS%restart_CS, &
+ time_stamped=time_stamped, filename=filename, GV=GV, &
+ num_rest_files=num_rest_files, write_IC=write_IC)
+
+ if (CS%use_particles) call particles_save_restart(CS%particles, CS%h, directory, time, time_stamped)
+end subroutine save_MOM_restart
+
+
!> End of ocean model, including memory deallocation
subroutine MOM_end(CS)
type(MOM_control_struct), intent(inout) :: CS !< MOM control structure
- if (CS%use_particles) then
- call particles_save_restart(CS%particles)
- endif
-
call MOM_sum_output_end(CS%sum_output_CSp)
if (CS%use_ALE_algorithm) call ALE_end(CS%ALE_CSp)
@@ -3956,7 +4154,7 @@ subroutine MOM_end(CS)
endif
if (CS%use_particles) then
- call particles_end(CS%particles)
+ call particles_end(CS%particles, CS%h)
deallocate(CS%particles)
endif
diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90
index 844d9db4bc..ad76a9a9f5 100644
--- a/src/core/MOM_PressureForce.F90
+++ b/src/core/MOM_PressureForce.F90
@@ -13,6 +13,7 @@ module MOM_PressureForce
use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss
use MOM_PressureForce_Mont, only : PressureForce_Mont_init
use MOM_PressureForce_Mont, only : PressureForce_Mont_CS
+use MOM_self_attr_load, only : SAL_CS
use MOM_tidal_forcing, only : tidal_forcing_CS
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
@@ -80,7 +81,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e
end subroutine Pressureforce
!> Initialize the pressure force control structure
-subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp)
+subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, SAL_CSp, tides_CSp)
type(time_type), target, intent(in) :: Time !< Current model time
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -88,7 +89,8 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp)
type(param_file_type), intent(in) :: param_file !< Parameter file handles
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure
type(PressureForce_CS), intent(inout) :: CS !< Pressure force control structure
- type(tidal_forcing_CS), intent(inout), optional :: tides_CSp !< Tide control structure
+ type(SAL_CS), intent(in), optional :: SAL_CSp !< SAL control structure
+ type(tidal_forcing_CS), intent(in), optional :: tides_CSp !< Tide control structure
#include "version_variable.h"
character(len=40) :: mdl = "MOM_PressureForce" ! This module's name.
@@ -103,10 +105,10 @@ subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp)
if (CS%Analytic_FV_PGF) then
call PressureForce_FV_init(Time, G, GV, US, param_file, diag, &
- CS%PressureForce_FV, tides_CSp)
+ CS%PressureForce_FV, SAL_CSp, tides_CSp)
else
call PressureForce_Mont_init(Time, G, GV, US, param_file, diag, &
- CS%PressureForce_Mont, tides_CSp)
+ CS%PressureForce_Mont, SAL_CSp, tides_CSp)
endif
end subroutine PressureForce_init
diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90
index 14c9b2e6dc..5fb3ade634 100644
--- a/src/core/MOM_PressureForce_FV.F90
+++ b/src/core/MOM_PressureForce_FV.F90
@@ -9,7 +9,9 @@ module MOM_PressureForce_FV
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
use MOM_PressureForce_Mont, only : set_pbce_Bouss, set_pbce_nonBouss
+use MOM_self_attr_load, only : calc_SAL, SAL_CS
use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS
+use MOM_tidal_forcing, only : calc_tidal_forcing_legacy
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
@@ -35,6 +37,7 @@ module MOM_PressureForce_FV
!> Finite volume pressure gradient control structure
type, public :: PressureForce_FV_CS ; private
logical :: initialized = .false. !< True if this control structure has been initialized.
+ logical :: calculate_SAL !< If true, calculate self-attraction and loading.
logical :: tides !< If true, apply tidal momentum forcing.
real :: Rho0 !< The density used in the Boussinesq
!! approximation [R ~> kg m-3].
@@ -60,10 +63,15 @@ module MOM_PressureForce_FV
!! By the default (1) is for a piecewise linear method
logical :: use_stanley_pgf !< If true, turn on Stanley parameterization in the PGF
- integer :: id_e_tidal = -1 !< Diagnostic identifier
+ integer :: tides_answer_date !< Recover old answers with tides in Boussinesq mode
+ integer :: id_e_tide = -1 !< Diagnostic identifier
+ integer :: id_e_tide_eq = -1 !< Diagnostic identifier
+ integer :: id_e_tide_sal = -1 !< Diagnostic identifier
+ integer :: id_e_sal = -1 !< Diagnostic identifier
integer :: id_rho_pgf = -1 !< Diagnostic identifier
integer :: id_rho_stanley_pgf = -1 !< Diagnostic identifier
integer :: id_p_stanley = -1 !< Diagnostic identifier
+ type(SAL_CS), pointer :: SAL_CSp => NULL() !< SAL control structure
type(tidal_forcing_CS), pointer :: tides_CSp => NULL() !< Tides control structure
end type PressureForce_FV_CS
@@ -115,8 +123,11 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_
real, dimension(SZI_(G),SZJ_(G)) :: &
dp, & ! The (positive) change in pressure across a layer [R L2 T-2 ~> Pa].
SSH, & ! The sea surface height anomaly, in depth units [Z ~> m].
- e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading [Z ~> m].
+ e_sal, & ! The bottom geopotential anomaly due to self-attraction and loading [Z ~> m].
+ e_tide_eq, & ! The bottom geopotential anomaly due to tidal forces from astronomical sources [Z ~> m].
+ e_tide_sal, & ! The bottom geopotential anomaly due to harmonic self-attraction and loading
+ ! specific to tides [Z ~> m].
+ e_sal_tide, & ! The summation of self-attraction and loading and tidal forcing [Z ~> m].
dM, & ! The barotropic adjustment to the Montgomery potential to
! account for a reduced gravity model [L2 T-2 ~> m2 s-2].
za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the
@@ -301,17 +312,40 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_
enddo ; enddo
enddo
- if (CS%tides) then
- ! Find and add the tidal geopotential anomaly.
- !$OMP parallel do default(shared)
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref
- enddo ; enddo
- call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp)
+ ! Calculate and add the self-attraction and loading geopotential anomaly.
+ if (CS%calculate_SAL) then
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- za(i,j) = za(i,j) - GV%g_Earth * e_tidal(i,j)
+ SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref &
+ - max(-G%bathyT(i,j)-G%Z_ref, 0.0)
enddo ; enddo
+ call calc_SAL(SSH, e_sal, G, CS%SAL_CSp, tmp_scale=US%Z_to_m)
+
+ if ((CS%tides_answer_date>20230630) .or. (.not.GV%semi_Boussinesq) .or. (.not.CS%tides)) then
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ za(i,j) = za(i,j) - GV%g_Earth * e_sal(i,j)
+ enddo ; enddo
+ endif
+ endif
+
+ ! Calculate and add the tidal geopotential anomaly.
+ if (CS%tides) then
+ if ((CS%tides_answer_date>20230630) .or. (.not.GV%semi_Boussinesq)) then
+ call calc_tidal_forcing(CS%Time, e_tide_eq, e_tide_sal, G, US, CS%tides_CSp)
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ za(i,j) = za(i,j) - GV%g_Earth * (e_tide_eq(i,j) + e_tide_sal(i,j))
+ enddo ; enddo
+ else ! This block recreates older answers with tides.
+ if (.not.CS%calculate_SAL) e_sal(:,:) = 0.0
+ call calc_tidal_forcing_legacy(CS%Time, e_sal, e_sal_tide, e_tide_eq, e_tide_sal, &
+ G, US, CS%tides_CSp)
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ za(i,j) = za(i,j) - GV%g_Earth * e_sal_tide(i,j)
+ enddo ; enddo
+ endif
endif
if (CS%GFS_scale < 1.0) then
@@ -408,7 +442,12 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_
endif
endif
- if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag)
+ ! To be consistent with old runs, tidal forcing diagnostic also includes total SAL.
+ ! New diagnostics are given for each individual field.
+ if (CS%id_e_tide>0) call post_data(CS%id_e_tide, e_sal+e_tide_eq+e_tide_sal, CS%diag)
+ if (CS%id_e_sal>0) call post_data(CS%id_e_sal, e_sal, CS%diag)
+ if (CS%id_e_tide_eq>0) call post_data(CS%id_e_tide_eq, e_tide_eq, CS%diag)
+ if (CS%id_e_tide_sal>0) call post_data(CS%id_e_tide_sal, e_tide_sal, CS%diag)
end subroutine PressureForce_FV_nonBouss
@@ -441,13 +480,17 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height in depth units [Z ~> m].
real, dimension(SZI_(G),SZJ_(G)) :: &
- e_tidal, & ! The bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading [Z ~> m].
+ e_sal_tide, & ! The summation of self-attraction and loading and tidal forcing [Z ~> m].
+ e_sal, & ! The bottom geopotential anomaly due to self-attraction and loading [Z ~> m].
+ e_tide_eq, & ! The bottom geopotential anomaly due to tidal forces from astronomical sources
+ ! [Z ~> m].
+ e_tide_sal, & ! The bottom geopotential anomaly due to harmonic self-attraction and loading
+ ! specific to tides [Z ~> m].
SSH, & ! The sea surface height anomaly, in depth units [Z ~> m].
dM ! The barotropic adjustment to the Montgomery potential to
! account for a reduced gravity model [L2 T-2 ~> m2 s-2].
real, dimension(SZI_(G)) :: &
- Rho_cv_BL ! The coordinate potential density in the deepest variable
+ Rho_cv_BL ! The coordinate potential density in the deepest variable
! density near-surface layer [R ~> kg m-3].
real, dimension(SZI_(G),SZJ_(G)) :: &
dz_geo, & ! The change in geopotential thickness through a layer [L2 T-2 ~> m2 s-2].
@@ -519,40 +562,86 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS
h_neglect = GV%H_subroundoff
- dz_neglect = GV%H_subroundoff * GV%H_to_Z
+ dz_neglect = GV%dZ_subroundoff
I_Rho0 = 1.0 / GV%Rho0
G_Rho0 = GV%g_Earth / GV%Rho0
rho_ref = CS%Rho0
- if (CS%tides) then
- ! Determine the surface height anomaly for calculating self attraction
- ! and loading. This should really be based on bottom pressure anomalies,
- ! but that is not yet implemented, and the current form is correct for
- ! barotropic tides.
- !$OMP parallel do default(shared)
- do j=Jsq,Jeq+1
- do i=Isq,Ieq+1
- SSH(i,j) = -G%bathyT(i,j) - G%Z_ref
- enddo
- do k=1,nz ; do i=Isq,Ieq+1
- SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z
- enddo ; enddo
- enddo
- call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp)
- endif
-
-! Here layer interface heights, e, are calculated.
- if (CS%tides) then
- !$OMP parallel do default(shared)
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j))
- enddo ; enddo
- else
- !$OMP parallel do default(shared)
+ if (CS%tides_answer_date>20230630) then
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
e(i,j,nz+1) = -G%bathyT(i,j)
enddo ; enddo
+
+ ! Calculate and add the self-attraction and loading geopotential anomaly.
+ if (CS%calculate_SAL) then
+ ! Determine the surface height anomaly for calculating self attraction
+ ! and loading. This should really be based on bottom pressure anomalies,
+ ! but that is not yet implemented, and the current form is correct for
+ ! barotropic tides.
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1
+ do i=Isq,Ieq+1
+ SSH(i,j) = min(-G%bathyT(i,j) - G%Z_ref, 0.0)
+ enddo
+ do k=1,nz ; do i=Isq,Ieq+1
+ SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z
+ enddo ; enddo
+ enddo
+ call calc_SAL(SSH, e_sal, G, CS%SAL_CSp, tmp_scale=US%Z_to_m)
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e(i,j,nz+1) = e(i,j,nz+1) - e_sal(i,j)
+ enddo ; enddo
+ endif
+
+ ! Calculate and add the tidal geopotential anomaly.
+ if (CS%tides) then
+ call calc_tidal_forcing(CS%Time, e_tide_eq, e_tide_sal, G, US, CS%tides_CSp)
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e(i,j,nz+1) = e(i,j,nz+1) - (e_tide_eq(i,j) + e_tide_sal(i,j))
+ enddo ; enddo
+ endif
+ else ! Old answers
+ ! Calculate and add the self-attraction and loading geopotential anomaly.
+ if (CS%calculate_SAL) then
+ ! Determine the surface height anomaly for calculating self attraction
+ ! and loading. This should really be based on bottom pressure anomalies,
+ ! but that is not yet implemented, and the current form is correct for
+ ! barotropic tides.
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1
+ do i=Isq,Ieq+1
+ SSH(i,j) = min(-G%bathyT(i,j) - G%Z_ref, 0.0)
+ enddo
+ do k=1,nz ; do i=Isq,Ieq+1
+ SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z
+ enddo ; enddo
+ enddo
+ call calc_SAL(SSH, e_sal, G, CS%SAL_CSp, tmp_scale=US%Z_to_m)
+ else
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e_sal(i,j) = 0.0
+ enddo ; enddo
+ endif
+
+ ! Calculate and add the tidal geopotential anomaly.
+ if (CS%tides) then
+ call calc_tidal_forcing_legacy(CS%Time, e_sal, e_sal_tide, e_tide_eq, e_tide_sal, &
+ G, US, CS%tides_CSp)
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e(i,j,nz+1) = -(G%bathyT(i,j) + e_sal_tide(i,j))
+ enddo ; enddo
+ else
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e(i,j,nz+1) = -(G%bathyT(i,j) + e_sal(i,j))
+ enddo ; enddo
+ endif
endif
+
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1
e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z
@@ -745,18 +834,37 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
endif
if (present(eta)) then
- if (CS%tides) then
! eta is the sea surface height relative to a time-invariant geoid, for comparison with
! what is used for eta in btstep. See how e was calculated about 200 lines above.
- !$OMP parallel do default(shared)
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H
- enddo ; enddo
- else
+ if (CS%tides_answer_date>20230630) then
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
eta(i,j) = e(i,j,1)*GV%Z_to_H
enddo ; enddo
+ if (CS%tides) then
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ eta(i,j) = eta(i,j) + (e_tide_eq(i,j)+e_tide_sal(i,j))*GV%Z_to_H
+ enddo ; enddo
+ endif
+ if (CS%calculate_SAL) then
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ eta(i,j) = eta(i,j) + e_sal(i,j)*GV%Z_to_H
+ enddo ; enddo
+ endif
+ else ! Old answers
+ if (CS%tides) then
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ eta(i,j) = e(i,j,1)*GV%Z_to_H + (e_sal_tide(i,j))*GV%Z_to_H
+ enddo ; enddo
+ else
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ eta(i,j) = (e(i,j,1) + e_sal(i,j))*GV%Z_to_H
+ enddo ; enddo
+ endif
endif
endif
@@ -797,12 +905,21 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
endif
endif
- if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag)
+ ! To be consistent with old runs, tidal forcing diagnostic also includes total SAL.
+ ! New diagnostics are given for each individual field.
+ if (CS%id_e_tide>0) call post_data(CS%id_e_tide, e_sal_tide, CS%diag)
+ if (CS%id_e_sal>0) call post_data(CS%id_e_sal, e_sal, CS%diag)
+ if (CS%id_e_tide_eq>0) call post_data(CS%id_e_tide_eq, e_tide_eq, CS%diag)
+ if (CS%id_e_tide_sal>0) call post_data(CS%id_e_tide_sal, e_tide_sal, CS%diag)
+
+ if (CS%id_rho_pgf>0) call post_data(CS%id_rho_pgf, rho_pgf, CS%diag)
+ if (CS%id_rho_stanley_pgf>0) call post_data(CS%id_rho_stanley_pgf, rho_stanley_pgf, CS%diag)
+ if (CS%id_p_stanley>0) call post_data(CS%id_p_stanley, p_stanley, CS%diag)
end subroutine PressureForce_FV_Bouss
!> Initializes the finite volume pressure gradient control structure
-subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CSp)
+subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, SAL_CSp, tides_CSp)
type(time_type), target, intent(in) :: Time !< Current model time
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -810,11 +927,13 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS
type(param_file_type), intent(in) :: param_file !< Parameter file handles
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure
type(PressureForce_FV_CS), intent(inout) :: CS !< Finite volume PGF control structure
+ type(SAL_CS), intent(in), target, optional :: SAL_CSp !< SAL control structure
type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure
! Local variables
real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale
! temperature variance [nondim]
+ integer :: default_answer_date ! Global answer date
! This include declares and sets the variable "version".
# include "version_variable.h"
character(len=40) :: mdl ! This module's name.
@@ -824,17 +943,30 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS
CS%diag => diag ; CS%Time => Time
if (present(tides_CSp)) &
CS%tides_CSp => tides_CSp
+ if (present(SAL_CSp)) &
+ CS%SAL_CSp => SAL_CSp
mdl = "MOM_PressureForce_FV"
call log_version(param_file, mdl, version, "")
- call get_param(param_file, mdl, "RHO_0", CS%Rho0, &
- "The mean ocean density used with BOUSSINESQ true to "//&
- "calculate accelerations and the mass for conservation "//&
- "properties, or with BOUSSINSEQ false to convert some "//&
- "parameters from vertical units of m to kg m-2.", &
- units="kg m-3", default=1035.0, scale=US%kg_m3_to_R)
+ call get_param(param_file, mdl, "RHO_PGF_REF", CS%Rho0, &
+ "The reference density that is subtracted off when calculating pressure "//&
+ "gradient forces. Its inverse is subtracted off of specific volumes when "//&
+ "in non-Boussinesq mode. The default is RHO_0.", &
+ units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R)
call get_param(param_file, mdl, "TIDES", CS%tides, &
"If true, apply tidal momentum forcing.", default=.false.)
+ if (CS%tides) then
+ call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
+ "This sets the default value for the various _ANSWER_DATE parameters.", &
+ default=99991231)
+ call get_param(param_file, mdl, "TIDES_ANSWER_DATE", CS%tides_answer_date, &
+ "The vintage of self-attraction and loading (SAL) and tidal forcing calculations in "//&
+ "Boussinesq mode. Values below 20230701 recover the old answers in which the SAL is "//&
+ "part of the tidal forcing calculation. The change is due to a reordered summation "//&
+ "and the difference is only at bit level.", default=20230630)
+ endif
+ call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
+ "If true, calculate self-attraction and loading.", default=CS%tides)
call get_param(param_file, "MOM", "USE_REGRIDDING", use_ALE, &
"If True, use the ALE algorithm (regridding/remapping). "//&
"If False, use the layered isopycnal algorithm.", default=.false. )
@@ -879,9 +1011,17 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS
CS%id_p_stanley = register_diag_field('ocean_model', 'p_stanley', diag%axesTL, &
Time, 'p in PGF with Stanley correction', 'Pa', conversion=US%RL2_T2_to_Pa)
endif
+ if (CS%calculate_SAL) then
+ CS%id_e_sal = register_diag_field('ocean_model', 'e_sal', diag%axesT1, &
+ Time, 'Self-attraction and loading height anomaly', 'meter', conversion=US%Z_to_m)
+ endif
if (CS%tides) then
- CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, &
- Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=US%Z_to_m)
+ CS%id_e_tide = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, Time, &
+ 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=US%Z_to_m)
+ CS%id_e_tide_eq = register_diag_field('ocean_model', 'e_tide_eq', diag%axesT1, Time, &
+ 'Equilibrium tides height anomaly', 'meter', conversion=US%Z_to_m)
+ CS%id_e_tide_sal = register_diag_field('ocean_model', 'e_tide_sal', diag%axesT1, Time, &
+ 'Read-in tidal self-attraction and loading height anomaly', 'meter', conversion=US%Z_to_m)
endif
CS%GFS_scale = 1.0
diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90
index 424e9b1a32..6d982bc7e3 100644
--- a/src/core/MOM_PressureForce_Montgomery.F90
+++ b/src/core/MOM_PressureForce_Montgomery.F90
@@ -9,6 +9,7 @@ module MOM_PressureForce_Mont
use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
+use MOM_self_attr_load, only : calc_SAL, SAL_CS
use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
@@ -31,6 +32,7 @@ module MOM_PressureForce_Mont
!> Control structure for the Montgomery potential form of pressure gradient
type, public :: PressureForce_Mont_CS ; private
logical :: initialized = .false. !< True if this control structure has been initialized.
+ logical :: calculate_SAL !< If true, calculate self-attraction and loading.
logical :: tides !< If true, apply tidal momentum forcing.
real :: Rho0 !< The density used in the Boussinesq
!! approximation [R ~> kg m-3].
@@ -45,8 +47,10 @@ module MOM_PressureForce_Mont
real, allocatable :: PFv_bc(:,:,:) !< Meridional accelerations due to pressure gradients
!! deriving from density gradients within layers [L T-2 ~> m s-2].
!>@{ Diagnostic IDs
- integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1
+ integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_sal = -1
+ integer :: id_e_tide = -1, id_e_tide_eq = -1, id_e_tide_sal = -1
!>@}
+ type(SAL_CS), pointer :: SAL_CSp => NULL() !< SAL control structure
type(tidal_forcing_CS), pointer :: tides_CSp => NULL() !< The tidal forcing control structure
end type PressureForce_Mont_CS
@@ -103,8 +107,10 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb
! of a reduced gravity form of the equations [L2 T-2 ~> m2 s-2].
dp_star, & ! Layer thickness after compensation for compressibility [R L2 T-2 ~> Pa].
SSH, & ! The sea surface height anomaly, in depth units [Z ~> m].
- e_tidal, & ! Bottom geopotential anomaly due to tidal forces from
- ! astronomical sources and self-attraction and loading [Z ~> m].
+ e_sal, & ! Bottom geopotential anomaly due to self-attraction and loading [Z ~> m].
+ e_tide_eq, & ! Bottom geopotential anomaly due to tidal forces from astronomical sources [Z ~> m].
+ e_tide_sal, & ! Bottom geopotential anomaly due to harmonic self-attraction and loading
+ ! specific to tides [Z ~> m].
geopot_bot ! Bottom geopotential relative to a temporally fixed reference value,
! including any tidal contributions [L2 T-2 ~> m2 s-2].
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
@@ -180,12 +186,18 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb
endif
endif
- if (CS%tides) then
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ geopot_bot(i,j) = -GV%g_Earth * G%bathyT(i,j)
+ enddo ; enddo
+
+ ! Calculate and add the self-attraction and loading geopotential anomaly.
+ if (CS%calculate_SAL) then
! Determine the sea surface height anomalies, to enable the calculation
! of self-attraction and loading.
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- SSH(i,j) = -G%bathyT(i,j) - G%Z_ref
+ SSH(i,j) = min(-G%bathyT(i,j) - G%Z_ref, 0.0)
enddo ; enddo
if (use_EOS) then
!$OMP parallel do default(shared)
@@ -204,15 +216,19 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb
enddo ; enddo ; enddo
endif
- call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp)
+ call calc_SAL(SSH, e_sal, G, CS%SAL_CSp, tmp_scale=US%Z_to_m)
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j))
+ geopot_bot(i,j) = geopot_bot(i,j) - GV%g_Earth*e_sal(i,j)
enddo ; enddo
- else
+ endif
+
+ ! Calculate and add the tidal geopotential anomaly.
+ if (CS%tides) then
+ call calc_tidal_forcing(CS%Time, e_tide_eq, e_tide_sal, G, US, CS%tides_CSp)
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j)
+ geopot_bot(i,j) = geopot_bot(i,j) - GV%g_Earth*(e_tide_eq(i,j) + e_tide_sal(i,j))
enddo ; enddo
endif
@@ -348,7 +364,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb
if (CS%id_PFu_bc>0) call post_data(CS%id_PFu_bc, CS%PFu_bc, CS%diag)
if (CS%id_PFv_bc>0) call post_data(CS%id_PFv_bc, CS%PFv_bc, CS%diag)
- if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag)
+ ! To be consistent with old runs, tidal forcing diagnostic also includes total SAL.
+ ! New diagnostics are given for each individual field.
+ if (CS%id_e_tide>0) call post_data(CS%id_e_tide, e_sal+e_tide_eq+e_tide_sal, CS%diag)
+ if (CS%id_e_sal>0) call post_data(CS%id_e_sal, e_sal, CS%diag)
+ if (CS%id_e_tide_eq>0) call post_data(CS%id_e_tide_eq, e_tide_eq, CS%diag)
+ if (CS%id_e_tide_sal>0) call post_data(CS%id_e_tide_sal, e_tide_sal, CS%diag)
end subroutine PressureForce_Mont_nonBouss
@@ -396,16 +417,18 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce,
real :: h_star(SZI_(G),SZJ_(G)) ! Layer thickness after compensation
! for compressibility [Z ~> m].
real :: SSH(SZI_(G),SZJ_(G)) ! The sea surface height anomaly, in depth units [Z ~> m].
- real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal
- ! forces from astronomical sources and self-
- ! attraction and loading, in depth units [Z ~> m].
+ real :: e_sal(SZI_(G),SZJ_(G)) ! The bottom geopotential anomaly due to self-attraction and loading [Z ~> m].
+ real :: e_tide_eq(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal forces from astronomical sources
+ ! [Z ~> m].
+ real :: e_tide_sal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to harmonic self-attraction and loading
+ ! specific to tides, in depth units [Z ~> m].
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar).
real :: I_Rho0 ! 1/Rho0 [R-1 ~> m3 kg-1].
real :: G_Rho0 ! G_Earth / Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1].
real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer
! compensated density gradients [L T-2 ~> m s-2]
- real :: h_neglect ! A thickness that is so small it is usually lost
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
! in roundoff and can be neglected [Z ~> m].
logical :: use_p_atm ! If true, use the atmospheric pressure.
logical :: use_EOS ! If true, density is calculated from T & S using
@@ -436,37 +459,44 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce,
"can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.")
endif
- h_neglect = GV%H_subroundoff * GV%H_to_Z
+ dz_neglect = GV%dZ_subroundoff
I_Rho0 = 1.0/CS%Rho0
G_Rho0 = GV%g_Earth / GV%Rho0
- if (CS%tides) then
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e(i,j,nz+1) = -G%bathyT(i,j)
+ enddo ; enddo
+
+ ! Calculate and add the self-attraction and loading geopotential anomaly.
+ if (CS%calculate_SAL) then
! Determine the surface height anomaly for calculating self attraction
! and loading. This should really be based on bottom pressure anomalies,
! but that is not yet implemented, and the current form is correct for
! barotropic tides.
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1
- do i=Isq,Ieq+1 ; SSH(i,j) = -G%bathyT(i,j) - G%Z_ref ; enddo
+ do i=Isq,Ieq+1 ; SSH(i,j) = min(-G%bathyT(i,j) - G%Z_ref, 0.0) ; enddo
do k=1,nz ; do i=Isq,Ieq+1
SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z
enddo ; enddo
enddo
- call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp)
- endif
-
-! Here layer interface heights, e, are calculated.
- if (CS%tides) then
+ call calc_SAL(SSH, e_sal, G, CS%SAL_CSp, tmp_scale=US%Z_to_m)
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j))
+ e(i,j,nz+1) = e(i,j,nz+1) - e_sal(i,j)
enddo ; enddo
- else
+ endif
+
+ ! Calculate and add the tidal geopotential anomaly.
+ if (CS%tides) then
+ call calc_tidal_forcing(CS%Time, e_tide_eq, e_tide_sal, G, US, CS%tides_CSp)
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- e(i,j,nz+1) = -G%bathyT(i,j)
+ e(i,j,nz+1) = e(i,j,nz+1) - (e_tide_eq(i,j) + e_tide_sal(i,j))
enddo ; enddo
endif
+
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1
e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z
@@ -552,7 +582,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce,
!$OMP parallel do default(shared) private(h_star,PFu_bc,PFv_bc)
do k=1,nz
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect
+ h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + dz_neglect
enddo ; enddo
do j=js,je ; do I=Isq,Ieq
PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (G%IdxCu(I,j) * &
@@ -582,25 +612,35 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce,
endif ! use_EOS
if (present(eta)) then
- if (CS%tides) then
! eta is the sea surface height relative to a time-invariant geoid, for
! comparison with what is used for eta in btstep. See how e was calculated
! about 200 lines above.
+ !$OMP parallel do default(shared)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ eta(i,j) = e(i,j,1)*GV%Z_to_H
+ enddo ; enddo
+ if (CS%tides) then
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H
+ eta(i,j) = eta(i,j) + (e_tide_eq(i,j)+e_tide_sal(i,j))*GV%Z_to_H
enddo ; enddo
- else
+ endif
+ if (CS%calculate_SAL) then
!$OMP parallel do default(shared)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta(i,j) = e(i,j,1)*GV%Z_to_H
+ eta(i,j) = eta(i,j) + e_sal(i,j)*GV%Z_to_H
enddo ; enddo
endif
endif
if (CS%id_PFu_bc>0) call post_data(CS%id_PFu_bc, CS%PFu_bc, CS%diag)
if (CS%id_PFv_bc>0) call post_data(CS%id_PFv_bc, CS%PFv_bc, CS%diag)
- if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag)
+ ! To be consistent with old runs, tidal forcing diagnostic also includes total SAL.
+ ! New diagnostics are given for each individual field.
+ if (CS%id_e_tide>0) call post_data(CS%id_e_tide, e_sal+e_tide_eq+e_tide_sal, CS%diag)
+ if (CS%id_e_sal>0) call post_data(CS%id_e_sal, e_sal, CS%diag)
+ if (CS%id_e_tide_eq>0) call post_data(CS%id_e_tide_eq, e_tide_eq, CS%diag)
+ if (CS%id_e_tide_sal>0) call post_data(CS%id_e_tide_sal, e_tide_sal, CS%diag)
end subroutine PressureForce_Mont_Bouss
@@ -636,7 +676,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star)
real :: Rho0xG ! g_Earth * Rho0 [R L2 Z-1 T-2 ~> kg s-2 m-2]
logical :: use_EOS ! If true, density is calculated from T & S using
! an equation of state.
- real :: z_neglect ! A thickness that is so small it is usually lost
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
! in roundoff and can be neglected [Z ~> m].
integer, dimension(2) :: EOSdom ! The computational domain for the equation of state
integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k
@@ -647,14 +687,14 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star)
Rho0xG = Rho0 * GV%g_Earth
G_Rho0 = GV%g_Earth / GV%Rho0
use_EOS = associated(tv%eqn_of_state)
- z_neglect = GV%H_subroundoff*GV%H_to_Z
+ dz_neglect = GV%dZ_subroundoff
if (use_EOS) then
if (present(rho_star)) then
!$OMP parallel do default(shared) private(Ihtot)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect)
+ Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + dz_neglect)
pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z
enddo
do k=2,nz ; do i=Isq,Ieq+1
@@ -666,7 +706,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star)
!$OMP parallel do default(shared) private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect)
+ Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + dz_neglect)
press(i) = -Rho0xG*(e(i,j,1) - G%Z_ref)
enddo
call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, &
@@ -695,7 +735,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star)
!$OMP parallel do default(shared) private(Ihtot)
do j=Jsq,Jeq+1
do i=Isq,Ieq+1
- Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect)
+ Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + dz_neglect)
pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z
enddo
do k=2,nz ; do i=Isq,Ieq+1
@@ -821,7 +861,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star)
end subroutine Set_pbce_nonBouss
!> Initialize the Montgomery-potential form of PGF control structure
-subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_CSp)
+subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, SAL_CSp, tides_CSp)
type(time_type), target, intent(in) :: Time !< Current model time
type(ocean_grid_type), intent(in) :: G !< ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -829,6 +869,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_
type(param_file_type), intent(in) :: param_file !< Parameter file handles
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure
type(PressureForce_Mont_CS), intent(inout) :: CS !< Montgomery PGF control structure
+ type(SAL_CS), intent(in), target, optional :: SAL_CSp !< SAL control structure
type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure
! Local variables
@@ -841,6 +882,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_
CS%diag => diag ; CS%Time => Time
if (present(tides_CSp)) &
CS%tides_CSp => tides_CSp
+ if (present(SAL_CSp)) &
+ CS%SAL_CSp => SAL_CSp
mdl = "MOM_PressureForce_Mont"
call log_version(param_file, mdl, version, "")
@@ -852,6 +895,8 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_
units="kg m-3", default=1035.0, scale=US%R_to_kg_m3)
call get_param(param_file, mdl, "TIDES", CS%tides, &
"If true, apply tidal momentum forcing.", default=.false.)
+ call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
+ "If true, calculate self-attraction and loading.", default=CS%tides)
call get_param(param_file, mdl, "USE_EOS", use_EOS, default=.true., &
do_not_log=.true.) ! Input for diagnostic use only.
@@ -866,9 +911,17 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_
allocate(CS%PFv_bc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.)
endif
+ if (CS%calculate_SAL) then
+ CS%id_e_sal = register_diag_field('ocean_model', 'e_sal', diag%axesT1, Time, &
+ 'Self-attraction and loading height anomaly', 'meter', conversion=US%Z_to_m)
+ endif
if (CS%tides) then
- CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, &
- Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=US%Z_to_m)
+ CS%id_e_tide = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, Time, &
+ 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=US%Z_to_m)
+ CS%id_e_tide_eq = register_diag_field('ocean_model', 'e_tide_eq', diag%axesT1, Time, &
+ 'Equilibrium tides height anomaly', 'meter', conversion=US%Z_to_m)
+ CS%id_e_tide_sal = register_diag_field('ocean_model', 'e_tide_sal', diag%axesT1, Time, &
+ 'Read-in tidal self-attraction and loading height anomaly', 'meter', conversion=US%Z_to_m)
endif
CS%GFS_scale = 1.0
diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90
index 40f759f4b8..83bfab0820 100644
--- a/src/core/MOM_barotropic.F90
+++ b/src/core/MOM_barotropic.F90
@@ -3,8 +3,9 @@ module MOM_barotropic
! This file is part of MOM6. See LICENSE.md for the license.
-use MOM_debugging, only : hchksum, uvchksum
+use MOM_checksums, only : chksum0
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
+use MOM_debugging, only : hchksum, uvchksum
use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field
use MOM_diag_mediator, only : diag_ctrl, enable_averaging, enable_averages
use MOM_domains, only : min_across_PEs, clone_MOM_domain, deallocate_MOM_domain
@@ -22,7 +23,8 @@ module MOM_barotropic
use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type
use MOM_restart, only : register_restart_field, register_restart_pair
use MOM_restart, only : query_initialized, MOM_restart_CS
-use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS
+use MOM_self_attr_load, only : scalar_SAL_sensitivity
+use MOM_self_attr_load, only : SAL_CS
use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-)
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : BT_cont_type, alloc_bt_cont_type
@@ -69,8 +71,8 @@ module MOM_barotropic
type, private :: BT_OBC_type
real, allocatable :: Cg_u(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1].
real, allocatable :: Cg_v(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1].
- real, allocatable :: H_u(:,:) !< The total thickness at the u-points [H ~> m or kg m-2].
- real, allocatable :: H_v(:,:) !< The total thickness at the v-points [H ~> m or kg m-2].
+ real, allocatable :: dZ_u(:,:) !< The total vertical column extent at the u-points [Z ~> m].
+ real, allocatable :: dZ_v(:,:) !< The total vertical column extent at the v-points [Z ~> m].
real, allocatable :: uhbt(:,:) !< The zonal barotropic thickness fluxes specified
!! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1].
real, allocatable :: vhbt(:,:) !< The meridional barotropic thickness fluxes specified
@@ -79,10 +81,10 @@ module MOM_barotropic
!! as set by the open boundary conditions [L T-1 ~> m s-1].
real, allocatable :: vbt_outer(:,:) !< The meridional velocities just outside the domain,
!! as set by the open boundary conditions [L T-1 ~> m s-1].
- real, allocatable :: eta_outer_u(:,:) !< The surface height outside of the domain
- !! at a u-point with an open boundary condition [H ~> m or kg m-2].
- real, allocatable :: eta_outer_v(:,:) !< The surface height outside of the domain
- !! at a v-point with an open boundary condition [H ~> m or kg m-2].
+ real, allocatable :: SSH_outer_u(:,:) !< The surface height outside of the domain
+ !! at a u-point with an open boundary condition [Z ~> m].
+ real, allocatable :: SSH_outer_v(:,:) !< The surface height outside of the domain
+ !! at a v-point with an open boundary condition [Z ~> m].
logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point.
logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point.
!>@{ Index ranges for the open boundary conditions
@@ -105,7 +107,7 @@ module MOM_barotropic
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv
!< The fraction of the total column thickness interpolated to v grid points in each layer [nondim].
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu
- !< Inverse of the basin depth at u grid points [Z-1 ~> m-1].
+ !< Inverse of the total thickness at u grid points [H-1 ~> m-1 or m2 kg-1].
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u
!< A spatially varying linear drag coefficient acting on the zonal barotropic flow
!! [H T-1 ~> m s-1 or kg m-2 s-1].
@@ -139,11 +141,11 @@ module MOM_barotropic
!< This is a copy of G%IareaT with wide halos, but will
!! still utilize the macro IareaT when referenced, [L-2 ~> m-2].
real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: &
- D_u_Cor, & !< A simply averaged depth at u points [Z ~> m].
+ D_u_Cor, & !< A simply averaged depth at u points recast as a thickness [H ~> m or kg m-2]
dy_Cu, & !< A copy of G%dy_Cu with wide halos [L ~> m].
IdxCu !< A copy of G%IdxCu with wide halos [L-1 ~> m-1].
real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: &
- D_v_Cor, & !< A simply averaged depth at v points [Z ~> m].
+ D_v_Cor, & !< A simply averaged depth at v points recast as a thickness [H ~> m or kg m-2]
dx_Cv, & !< A copy of G%dx_Cv with wide halos [L ~> m].
IdyCv !< A copy of G%IdyCv with wide halos [L-1 ~> m-1].
real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: &
@@ -170,6 +172,10 @@ module MOM_barotropic
!! 0.0 gives a forward-backward scheme, while 1.0
!! give backward Euler. In practice, bebt should be
!! of order 0.2 or greater.
+ real :: Rho_BT_lin !< A density that is used to convert total water column thicknesses
+ !! into mass in non-Boussinesq mode with linearized options in the
+ !! barotropic solver or when estimating the stable barotropic timestep
+ !! without access to the full baroclinic model state [R ~> kg m-3]
logical :: split !< If true, use the split time stepping scheme.
logical :: bound_BT_corr !< If true, the magnitude of the fake mass source
!! in the barotropic equation that drives the two
@@ -216,15 +222,15 @@ module MOM_barotropic
logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous
!! ice shelf, for instance.
- real :: Dmin_dyn_psurf !< The minimum depth to use in limiting the size
- !! of the dynamic surface pressure for stability [Z ~> m].
+ real :: Dmin_dyn_psurf !< The minimum total thickness to use in limiting the size
+ !! of the dynamic surface pressure for stability [H ~> m or kg m-2].
real :: ice_strength_length !< The length scale at which the damping rate
!! due to the ice strength should be the same as if
!! a Laplacian were applied [L ~> m].
real :: const_dyn_psurf !< The constant that scales the dynamic surface
!! pressure [nondim]. Stable values are < ~1.0.
!! The default is 0.9.
- logical :: tides !< If true, apply tidal momentum forcing.
+ logical :: calculate_SAL !< If true, calculate self-attration and loading.
logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the
!! barotropic solver has the wrong sign, replicating a long-standing
!! bug.
@@ -273,12 +279,15 @@ module MOM_barotropic
logical :: use_old_coriolis_bracket_bug !< If True, use an order of operations
!! that is not bitwise rotationally symmetric in the
!! meridional Coriolis term of the barotropic solver.
+ logical :: tidal_sal_flather !< Apply adjustment to external gravity wave speed
+ !! consistent with tidal self-attraction and loading
+ !! used within the barotropic solver
type(time_type), pointer :: Time => NULL() !< A pointer to the ocean models clock.
type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate
!! the timing of diagnostic output.
type(MOM_domain_type), pointer :: BT_Domain => NULL() !< Barotropic MOM domain
type(hor_index_type), pointer :: debug_BT_HI => NULL() !< debugging copy of horizontal index_type
- type(tidal_forcing_CS), pointer :: tides_CSp => NULL() !< Control structure for tides
+ type(SAL_CS), pointer :: SAL_CSp => NULL() !< Control structure for SAL
logical :: module_is_initialized = .false. !< If true, module has been initialized
integer :: isdw !< The lower i-memory limit for the wide halo arrays.
@@ -297,6 +306,7 @@ module MOM_barotropic
type(group_pass_type) :: pass_ubt_Cor !< Handle for a group halo pass
type(group_pass_type) :: pass_ubta_uhbta !< Handle for a group halo pass
type(group_pass_type) :: pass_e_anom !< Handle for a group halo pass
+ type(group_pass_type) :: pass_SpV_avg !< Handle for a group halo pass
!>@{ Diagnostic IDs
integer :: id_PFu_bt = -1, id_PFv_bt = -1, id_Coru_bt = -1, id_Corv_bt = -1
@@ -399,7 +409,7 @@ module MOM_barotropic
!>@}
!> A negligible parameter which avoids division by zero, but is too small to
-!! modify physical values.
+!! modify physical values [nondim].
real, parameter :: subroundoff = 1e-30
contains
@@ -413,7 +423,7 @@ module MOM_barotropic
subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, &
eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, &
eta_out, uhbtav, vhbtav, G, GV, US, CS, &
- visc_rem_u, visc_rem_v, ADp, OBC, BT_cont, eta_PF_start, &
+ visc_rem_u, visc_rem_v, SpV_avg, ADp, OBC, BT_cont, eta_PF_start, &
taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0, etaav)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -463,6 +473,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
!! viscosity is applied, in the zonal direction [nondim].
!! Visc_rem_u is between 0 (at the bottom) and 1 (far above).
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim].
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SpV_avg !< The column average specific volume, used
+ !! in non-Boussinesq OBC calculations [R-1 ~> m3 kg-1]
type(accel_diag_ptrs), pointer :: ADp !< Acceleration diagnostic pointers
type(ocean_OBC_type), pointer :: OBC !< The open boundary condition structure.
type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe
@@ -511,8 +523,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
! These are always allocated with symmetric memory and wide halos.
- real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1]
- ! or [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1]
+ real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1]
real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1].
bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains
@@ -545,7 +556,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1].
PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2].
Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].
- DCor_u, & ! An averaged depth or total thickness at u points [Z ~> m] or [H ~> m or kg m-2].
+ DCor_u, & ! An averaged total thickness at u points [H ~> m or kg m-2].
Datu ! Basin depth at u-velocity grid points times the y-grid
! spacing [H L ~> m2 or kg m-1].
real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
@@ -578,7 +589,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! [L T-2 ~> m s-2].
Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration,
! [L T-2 ~> m s-2].
- DCor_v, & ! An averaged depth or total thickness at v points [Z ~> m] or [H ~> m or kg m-2].
+ DCor_v, & ! An averaged total thickness at v points [H ~> m or kg m-2].
Datv ! Basin depth at v-velocity grid points times the x-grid
! spacing [H L ~> m2 or kg m-1].
real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
@@ -606,6 +617,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
! (See Hallberg, J Comp Phys 1997 for a discussion.)
eta_src, & ! The source of eta per barotropic timestep [H ~> m or kg m-2].
+ SpV_col_avg, & ! The column average specific volume [R-1 ~> m3 kg-1]
dyn_coef_eta, & ! The coefficient relating the changes in eta to the
! dynamic surface pressure under rigid ice
! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
@@ -626,7 +638,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
vhbt_prev, vhbt_sum_prev, & ! Previous transports stored for OBCs [L2 H T-1 ~> m3 s-1]
vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m]
vhbt_int_prev ! Previous value of time-integrated transport stored for OBCs [L2 H ~> m3]
- real :: mass_to_Z ! The inverse of the the mean density (Rho0) [R-1 ~> m3 kg-1]
real :: visc_rem ! A work variable that may equal visc_rem_[uv] [nondim]
real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
real :: dtbt ! The barotropic time step [T ~> s].
@@ -651,7 +662,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
time_bt_start, & ! The starting time of the barotropic steps.
time_step_end, & ! The end time of a barotropic step.
time_end_in ! The end time for diagnostics when this routine started.
- real :: time_int_in ! The diagnostics' time interval when this routine started.
+ real :: time_int_in ! The diagnostics' time interval when this routine started [s]
real :: Htot_avg ! The average total thickness of the tracer columns adjacent to a
! velocity point [H ~> m or kg m-2]
logical :: do_hifreq_output ! If true, output occurs every barotropic step.
@@ -664,6 +675,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta
! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
real :: ice_strength = 0.0 ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2].
+ real :: H_to_Z ! A local unit conversion factor used with rigid ice [Z H-1 ~> nondim or m3 kg-1]
real :: Idt_max2 ! The squared inverse of the local maximum stable
! barotropic time step [T-2 ~> s-2].
real :: H_min_dyn ! The minimum depth to use in limiting the size of the
@@ -765,10 +777,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
apply_OBC_open = open_boundary_query(OBC, apply_open_OBC=.true.)
apply_OBCs = open_boundary_query(OBC, apply_specified_OBC=.true.) .or. &
apply_OBC_flather .or. apply_OBC_open
-
- if (apply_OBC_flather .and. .not.GV%Boussinesq) call MOM_error(FATAL, &
- "btstep: Flather open boundary conditions have not yet been "// &
- "implemented for a non-Boussinesq model.")
endif
num_cycles = 1
@@ -778,7 +786,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
jsvf = js - (num_cycles-1)*stencil ; jevf = je + (num_cycles-1)*stencil
nstep = CEILING(dt/CS%dtbt - 0.0001)
- if (is_root_PE() .and. (nstep /= CS%nstep_last)) then
+ if (is_root_PE() .and. ((nstep /= CS%nstep_last) .or. CS%debug)) then
write(mesg,'("btstep is using a dynamic barotropic timestep of ", ES12.6, &
& " seconds, max ", ES12.6, ".")') (US%T_to_s*dt/nstep), US%T_to_s*CS%dtbt_max
call MOM_mesg(mesg, 3)
@@ -791,7 +799,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
Idtbt = 1.0 / dtbt
bebt = CS%bebt
be_proj = CS%bebt
- mass_to_Z = 1.0 / GV%Rho0
!--- setup the weight when computing vbt_trans and ubt_trans
if (project_velocity) then
@@ -859,6 +866,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (apply_OBC_open) &
call create_group_pass(CS%pass_eta_ubt, uhbt_int, vhbt_int, CS%BT_Domain)
endif
+ if (apply_OBC_flather .and. .not.GV%Boussinesq) &
+ call create_group_pass(CS%pass_SpV_avg, SpV_col_avg, CS%BT_domain)
call create_group_pass(CS%pass_ubt_Cor, ubt_Cor, vbt_Cor, G%Domain)
! These passes occur at the end of the routine, as data is being readied to
@@ -972,6 +981,22 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
Datv(i,J) = 0.0 ; bt_rem_v(i,J) = 0.0 ; vhbt0(i,J) = 0.0
enddo ; enddo
+ if (apply_OBCs) then
+ SpV_col_avg(:,:) = 0.0
+ if (apply_OBC_flather .and. .not.GV%Boussinesq) then
+ ! Copy the column average specific volumes into a wide halo array
+ !$OMP parallel do default(shared)
+ do j=js,je ; do i=is,ie
+ SpV_col_avg(i,j) = Spv_avg(i,j)
+ enddo ; enddo
+ if (nonblock_setup) then
+ call start_group_pass(CS%pass_SpV_avg, CS%BT_domain)
+ else
+ call do_group_pass(CS%pass_SpV_avg, CS%BT_domain)
+ endif
+ endif
+ endif
+
if (CS%linear_wave_drag) then
!$OMP parallel do default(shared)
do j=CS%jsdw,CS%jedw ; do I=CS%isdw-1,CS%iedw
@@ -1085,8 +1110,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
enddo
endif
- if (CS%tides) then
- call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de)
+ if (CS%calculate_SAL) then
+ call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
if (CS%tidal_sal_bug) then
dgeo_de = 1.0 + det_de + CS%G_extra
else
@@ -1118,8 +1143,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! Set up fields related to the open boundary conditions.
if (apply_OBCs) then
- call set_up_BT_OBC(OBC, eta, CS%BT_OBC, CS%BT_Domain, G, GV, US, MS, ievf-ie, use_BT_cont, &
- integral_BT_cont, dt, Datu, Datv, BTCL_u, BTCL_v)
+ if (nonblock_setup .and. apply_OBC_flather .and. .not.GV%Boussinesq) &
+ call complete_group_pass(CS%pass_SpV_avg, CS%BT_domain)
+
+ if (CS%TIDAL_SAL_FLATHER) then
+ call set_up_BT_OBC(OBC, eta, SpV_col_avg, CS%BT_OBC, CS%BT_Domain, G, GV, US, CS, MS, ievf-ie, &
+ use_BT_cont, integral_BT_cont, dt, Datu, Datv, BTCL_u, BTCL_v, dgeo_de)
+ else
+ call set_up_BT_OBC(OBC, eta, SpV_col_avg, CS%BT_OBC, CS%BT_Domain, G, GV, US, CS, MS, ievf-ie, &
+ use_BT_cont, integral_BT_cont, dt, Datu, Datv, BTCL_u, BTCL_v)
+ endif
endif
! Determine the difference between the sum of the layer fluxes and the
@@ -1275,17 +1308,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (Htot_avg*CS%dy_Cu(I,j) <= 0.0) then
CS%IDatu(I,j) = 0.0
elseif (integral_BT_cont) then
- CS%IDatu(I,j) = GV%Z_to_H * CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), &
+ CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), &
CS%dy_Cu(I,j)*Htot_avg) )
elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling.
- CS%IDatu(I,j) = GV%Z_to_H * CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), &
+ CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), &
CS%dy_Cu(I,j)*Htot_avg) )
else
- CS%IDatu(I,j) = GV%Z_to_H / Htot_avg
+ CS%IDatu(I,j) = 1.0 / Htot_avg
endif
endif
- BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1)
+ BT_force_u(I,j) = forces%taux(I,j) * GV%RZ_to_H * CS%IDatu(I,j)*visc_rem_u(I,j,1)
else
BT_force_u(I,j) = 0.0
endif ; enddo ; enddo
@@ -1301,28 +1334,28 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (Htot_avg*CS%dx_Cv(i,J) <= 0.0) then
CS%IDatv(i,J) = 0.0
elseif (integral_BT_cont) then
- CS%IDatv(i,J) = GV%Z_to_H * CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), &
+ CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), &
CS%dx_Cv(i,J)*Htot_avg) )
elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling.
- CS%IDatv(i,J) = GV%Z_to_H * CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), &
+ CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), &
CS%dx_Cv(i,J)*Htot_avg) )
else
- CS%IDatv(i,J) = GV%Z_to_H / Htot_avg
+ CS%IDatv(i,J) = 1.0 / Htot_avg
endif
endif
- BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1)
+ BT_force_v(i,J) = forces%tauy(i,J) * GV%RZ_to_H * CS%IDatv(i,J)*visc_rem_v(i,J,1)
else
BT_force_v(i,J) = 0.0
endif ; enddo ; enddo
if (associated(taux_bot) .and. associated(tauy_bot)) then
!$OMP parallel do default(shared)
do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then
- BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j)
+ BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * GV%RZ_to_H * CS%IDatu(I,j)
endif ; enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then
- BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J)
+ BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * GV%RZ_to_H * CS%IDatv(i,J)
endif ; enddo ; enddo
endif
@@ -1595,10 +1628,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (CS%dynamic_psurf) then
ice_is_rigid = (associated(forces%rigidity_ice_u) .and. &
associated(forces%rigidity_ice_v))
- H_min_dyn = GV%Z_to_H * CS%Dmin_dyn_psurf
+ H_min_dyn = CS%Dmin_dyn_psurf
if (ice_is_rigid .and. use_BT_cont) &
call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0)
if (ice_is_rigid) then
+ if (GV%Boussinesq) then
+ H_to_Z = GV%H_to_Z
+ else
+ H_to_Z = GV%H_to_RZ / CS%Rho_BT_lin
+ endif
!$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength)
do j=js,je ; do i=is,ie
! First determine the maximum stable value for dyn_coef_eta.
@@ -1626,7 +1664,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
(CS%ice_strength_length**2 * dtbt)
! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]
- dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_Z)
+ dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * H_to_Z)
enddo ; enddo ; endif
endif
@@ -1681,9 +1719,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
symmetric=.true., omit_corners=.true., scalar_pair=.true.)
call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, haloshift=0, &
symmetric=.true., omit_corners=.true., scalar_pair=.true.)
+ call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=0, &
+ symmetric=.true., omit_corners=.true., scalar_pair=.true.)
call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0, scale=US%L_T2_to_m_s2)
call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, &
- scale=US%m_to_Z, scalar_pair=.true.)
+ scale=GV%m_to_H, scalar_pair=.true.)
call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, &
haloshift=1, scalar_pair=.true.)
endif
@@ -2318,8 +2358,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
!$OMP single
call apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, &
- ubt_trans, vbt_trans, eta, ubt_old, vbt_old, CS%BT_OBC, &
- G, MS, US, iev-ie, dtbt, bebt, use_BT_cont, integral_BT_cont, &
+ ubt_trans, vbt_trans, eta, SpV_col_avg, ubt_old, vbt_old, CS%BT_OBC, &
+ G, MS, GV, US, CS, iev-ie, dtbt, bebt, use_BT_cont, integral_BT_cont, &
n*dtbt, Datu, Datv, BTCL_u, BTCL_v, uhbt0, vhbt0, &
ubt_int_prev, vbt_int_prev, uhbt_int_prev, vhbt_int_prev)
!$OMP end single
@@ -2772,7 +2812,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
!! the effective open face areas as a
!! function of barotropic flow.
real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational
- !! acceleration [L2 Z-1 T-2 ~> m s-2].
+ !! acceleration [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to
!! provide a margin of error when
!! calculating the external wave speed [Z ~> m].
@@ -2817,6 +2857,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed
+
if (.not.(present(pbce) .or. present(gtot_est))) call MOM_error(FATAL, &
"set_dtbt: Either pbce or gtot_est must be present.")
@@ -2834,7 +2875,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
endif
det_de = 0.0
- if (CS%tides) call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de)
+ if (CS%calculate_SAL) call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
if (CS%tidal_sal_bug) then
dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra)
else
@@ -2853,8 +2894,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
enddo ; enddo ; enddo
else
do j=js,je ; do i=is,ie
- gtot_E(i,j) = gtot_est * GV%H_to_Z ; gtot_W(i,j) = gtot_est * GV%H_to_Z
- gtot_N(i,j) = gtot_est * GV%H_to_Z ; gtot_S(i,j) = gtot_est * GV%H_to_Z
+ gtot_E(i,j) = gtot_est ; gtot_W(i,j) = gtot_est
+ gtot_N(i,j) = gtot_est ; gtot_S(i,j) = gtot_est
enddo ; enddo
endif
@@ -2876,17 +2917,23 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
CS%dtbt = CS%dtbt_fraction * dtbt_max
CS%dtbt_max = dtbt_max
+
+ if (CS%debug) then
+ call chksum0(CS%dtbt, "End set_dtbt dtbt", scale=US%T_to_s)
+ call chksum0(CS%dtbt_max, "End set_dtbt dtbt_max", scale=US%T_to_s)
+ endif
+
end subroutine set_dtbt
!> The following 4 subroutines apply the open boundary conditions.
!! This subroutine applies the open boundary conditions on barotropic
!! velocities and mass transports, as developed by Mehmet Ilicak.
-subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, eta, &
- ubt_old, vbt_old, BT_OBC, G, MS, US, halo, dtbt, bebt, &
+subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, eta, SpV_avg, &
+ ubt_old, vbt_old, BT_OBC, G, MS, GV, US, CS, halo, dtbt, bebt, &
use_BT_cont, integral_BT_cont, dt_elapsed, Datu, Datv, &
BTCL_u, BTCL_v, uhbt0, vhbt0, ubt_int, vbt_int, uhbt_int, vhbt_int)
type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type.
- type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
!! the argument arrays.
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1].
@@ -2902,6 +2949,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
!! transports [L T-1 ~> m s-1].
real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
!! column mass anomaly [H ~> m or kg m-2].
+ real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic
!! step [L T-1 ~> m s-1].
real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic
@@ -2909,7 +2957,9 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
!! related to the open boundary conditions,
!! set by set_up_BT_OBC.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
integer, intent(in) :: halo !< The extra halo size to use here.
real, intent(in) :: dtbt !< The time step [T ~> s].
real, intent(in) :: bebt !< The fractional weighting of the future velocity
@@ -2952,14 +3002,14 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
real :: vel_trans ! The combination of the previous and current velocity
! that does the mass transport [L T-1 ~> m s-1].
- real :: H_u ! The total thickness at the u-point [H ~> m or kg m-2].
- real :: H_v ! The total thickness at the v-point [H ~> m or kg m-2].
real :: cfl ! The CFL number at the point in question [nondim]
real :: u_inlet ! The zonal inflow velocity [L T-1 ~> m s-1]
real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1]
real :: uhbt_int_new ! The updated time-integrated zonal transport [H L2 ~> m3]
real :: vhbt_int_new ! The updated time-integrated meridional transport [H L2 ~> m3]
- real :: h_in ! The inflow thickness [H ~> m or kg m-2].
+ real :: ssh_in ! The inflow sea surface height [Z ~> m]
+ real :: ssh_1 ! The sea surface height in the interior cell adjacent to the an OBC face [Z ~> m]
+ real :: ssh_2 ! The sea surface height in the next cell inward from the OBC face [Z ~> m]
real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1]
integer :: i, j, is, ie, js, je
is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
@@ -2978,12 +3028,22 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_u(I,j))%Flather) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
- h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal
- H_u = BT_OBC%H_u(I,j)
- vel_prev = ubt(I,j)
- ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
- (BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j)))
- vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
+ if (GV%Boussinesq) then
+ ssh_in = GV%H_to_Z*(eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j))) ! internal
+ else
+ ssh_1 = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j) - (CS%bathyT(i,j) + G%Z_ref)
+ ssh_2 = GV%H_to_RZ * eta(i-1,j) * SpV_avg(i-1,j) - (CS%bathyT(i-1,j) + G%Z_ref)
+ ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
+ endif
+ if (BT_OBC%dZ_u(I,j) > 0.0) then
+ vel_prev = ubt(I,j)
+ ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
+ (BT_OBC%Cg_u(I,j)/BT_OBC%dZ_u(I,j)) * (ssh_in-BT_OBC%SSH_outer_u(I,j)))
+ vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
+ else ! This point is now dry.
+ ubt(I,j) = 0.0
+ vel_trans = 0.0
+ endif
elseif (OBC%segment(OBC%segnum_u(I,j))%gradient) then
ubt(I,j) = ubt(I-1,j)
vel_trans = ubt(I,j)
@@ -2992,14 +3052,23 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_u(I,j))%Flather) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
- h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! external
-
- H_u = BT_OBC%H_u(I,j)
- vel_prev = ubt(I,j)
- ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
- (BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in))
+ if (GV%Boussinesq) then
+ ssh_in = GV%H_to_Z*(eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j))) ! internal
+ else
+ ssh_1 = GV%H_to_RZ * eta(i+1,j) * SpV_avg(i+1,j) - (CS%bathyT(i+1,j) + G%Z_ref)
+ ssh_2 = GV%H_to_RZ * eta(i+2,j) * SpV_avg(i+2,j) - (CS%bathyT(i+2,j) + G%Z_ref)
+ ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
+ endif
- vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
+ if (BT_OBC%dZ_u(I,j) > 0.0) then
+ vel_prev = ubt(I,j)
+ ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
+ (BT_OBC%Cg_u(I,j)/BT_OBC%dZ_u(I,j)) * (BT_OBC%SSH_outer_u(I,j)-ssh_in))
+ vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
+ else ! This point is now dry.
+ ubt(I,j) = 0.0
+ vel_trans = 0.0
+ endif
elseif (OBC%segment(OBC%segnum_u(I,j))%gradient) then
ubt(I,j) = ubt(I+1,j)
vel_trans = ubt(I,j)
@@ -3032,14 +3101,23 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_v(i,J))%Flather) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! CFL
v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1
- h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal
-
- H_v = BT_OBC%H_v(i,J)
- vel_prev = vbt(i,J)
- vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
- (BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J)))
+ if (GV%Boussinesq) then
+ ssh_in = GV%H_to_Z*(eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1))) ! internal
+ else
+ ssh_1 = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j) - (CS%bathyT(i,j) + G%Z_ref)
+ ssh_2 = GV%H_to_RZ * eta(i,j-1) * SpV_avg(i,j-1) - (CS%bathyT(i,j-1) + G%Z_ref)
+ ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
+ endif
- vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
+ if (BT_OBC%dZ_v(i,J) > 0.0) then
+ vel_prev = vbt(i,J)
+ vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
+ (BT_OBC%Cg_v(i,J)/BT_OBC%dZ_v(i,J)) * (ssh_in-BT_OBC%SSH_outer_v(i,J)))
+ vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
+ else ! This point is now dry
+ vbt(i,J) = 0.0
+ vel_trans = 0.0
+ endif
elseif (OBC%segment(OBC%segnum_v(i,J))%gradient) then
vbt(i,J) = vbt(i,J-1)
vel_trans = vbt(i,J)
@@ -3048,14 +3126,23 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
if (OBC%segment(OBC%segnum_v(i,J))%Flather) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! CFL
v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1
- h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal
-
- H_v = BT_OBC%H_v(i,J)
- vel_prev = vbt(i,J)
- vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
- (BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in))
+ if (GV%Boussinesq) then
+ ssh_in = GV%H_to_Z*(eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2))) ! internal
+ else
+ ssh_1 = GV%H_to_RZ * eta(i,j+1) * SpV_avg(i,j+1) - (CS%bathyT(i,j+1) + G%Z_ref)
+ ssh_2 = GV%H_to_RZ * eta(i,j+2) * SpV_avg(i,j+2) - (CS%bathyT(i,j+2) + G%Z_ref)
+ ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
+ endif
- vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
+ if (BT_OBC%dZ_v(i,J) > 0.0) then
+ vel_prev = vbt(i,J)
+ vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
+ (BT_OBC%Cg_v(i,J)/BT_OBC%dZ_v(i,J)) * (BT_OBC%SSH_outer_v(i,J)-ssh_in))
+ vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
+ else ! This point is now dry
+ vbt(i,J) = 0.0
+ vel_trans = 0.0
+ endif
elseif (OBC%segment(OBC%segnum_v(i,J))%gradient) then
vbt(i,J) = vbt(i,J+1)
vel_trans = vbt(i,J)
@@ -3082,13 +3169,14 @@ end subroutine apply_velocity_OBCs
!> This subroutine sets up the private structure used to apply the open
!! boundary conditions, as developed by Mehmet Ilicak.
-subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, &
- integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v)
+subroutine set_up_BT_OBC(OBC, eta, SpV_avg, BT_OBC, BT_Domain, G, GV, US, CS, MS, halo, use_BT_cont, &
+ integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v, dgeo_de)
type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type.
type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the
!! argument arrays.
real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
!! column mass anomaly [H ~> m or kg m-2].
+ real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
!! related to the open boundary conditions,
!! set by set_up_BT_OBC.
@@ -3096,6 +3184,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
integer, intent(in) :: halo !< The extra halo size to use here.
logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
!! transports.
@@ -3114,9 +3203,11 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
!! for a dynamic estimate of the face areas at
!! v-points.
-
+ real, optional, intent(in) :: dgeo_de !< The constant of proportionality between
+ !! geopotential and sea surface height [nondim].
! Local variables
real :: I_dt ! The inverse of the time interval of this call [T-1 ~> s-1].
+ real :: dgeo_de_in !< The constant of proportionality between geopotential and sea surface height [nondim].
integer :: i, j, k, is, ie, js, je, n, nz
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
integer :: isdw, iedw, jsdw, jedw
@@ -3134,23 +3225,26 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
"yet fully implemented with wide barotropic halos.")
endif
+ dgeo_de_in = 1.0
+ if (PRESENT(dgeo_de)) dgeo_de_in = dgeo_de
+
if (.not. BT_OBC%is_alloced) then
allocate(BT_OBC%Cg_u(isdw-1:iedw,jsdw:jedw), source=0.0)
- allocate(BT_OBC%H_u(isdw-1:iedw,jsdw:jedw), source=0.0)
+ allocate(BT_OBC%dZ_u(isdw-1:iedw,jsdw:jedw), source=0.0)
allocate(BT_OBC%uhbt(isdw-1:iedw,jsdw:jedw), source=0.0)
allocate(BT_OBC%ubt_outer(isdw-1:iedw,jsdw:jedw), source=0.0)
- allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw), source=0.0)
+ allocate(BT_OBC%SSH_outer_u(isdw-1:iedw,jsdw:jedw), source=0.0)
allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw), source=0.0)
- allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw), source=0.0)
+ allocate(BT_OBC%dZ_v(isdw:iedw,jsdw-1:jedw), source=0.0)
allocate(BT_OBC%vhbt(isdw:iedw,jsdw-1:jedw), source=0.0)
allocate(BT_OBC%vbt_outer(isdw:iedw,jsdw-1:jedw), source=0.0)
- allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw), source=0.0)
+ allocate(BT_OBC%SSH_outer_v(isdw:iedw,jsdw-1:jedw), source=0.0)
BT_OBC%is_alloced = .true.
call create_group_pass(BT_OBC%pass_uv, BT_OBC%ubt_outer, BT_OBC%vbt_outer, BT_Domain)
call create_group_pass(BT_OBC%pass_uhvh, BT_OBC%uhbt, BT_OBC%vhbt, BT_Domain)
- call create_group_pass(BT_OBC%pass_eta_outer, BT_OBC%eta_outer_u, BT_OBC%eta_outer_v, BT_Domain,To_All+Scalar_Pair)
- call create_group_pass(BT_OBC%pass_h, BT_OBC%H_u, BT_OBC%H_v, BT_Domain,To_All+Scalar_Pair)
+ call create_group_pass(BT_OBC%pass_eta_outer, BT_OBC%SSH_outer_u, BT_OBC%SSH_outer_v, BT_Domain,To_All+Scalar_Pair)
+ call create_group_pass(BT_OBC%pass_h, BT_OBC%dZ_u, BT_OBC%dZ_v, BT_Domain,To_All+Scalar_Pair)
call create_group_pass(BT_OBC%pass_cg, BT_OBC%Cg_u, BT_OBC%Cg_v, BT_Domain,To_All+Scalar_Pair)
endif
@@ -3181,18 +3275,18 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
else ! This is assuming Flather as only other option
if (GV%Boussinesq) then
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
- BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j)
+ BT_OBC%dZ_u(I,j) = CS%bathyT(i,j) + GV%H_to_Z*eta(i,j)
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
- BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j)
+ BT_OBC%dZ_u(I,j) = CS%bathyT(i+1,j) + GV%H_to_Z*eta(i+1,j)
endif
else
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
- BT_OBC%H_u(I,j) = eta(i,j)
+ BT_OBC%dZ_u(I,j) = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j)
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
- BT_OBC%H_u(I,j) = eta(i+1,j)
+ BT_OBC%dZ_u(I,j) = GV%H_to_RZ * eta(i+1,j) * SpV_avg(i+1,j)
endif
endif
- BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j))
+ BT_OBC%Cg_u(I,j) = SQRT(dgeo_de_in * GV%g_prime(1) * BT_OBC%dZ_u(i,j))
endif
endif ; enddo ; enddo
if (OBC%Flather_u_BCs_exist_globally) then
@@ -3201,7 +3295,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
if (segment%is_E_or_W .and. segment%Flather) then
do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j)
- BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) + G%Z_ref*GV%Z_to_H
+ BT_OBC%SSH_outer_u(I,j) = segment%SSH(I,j) + G%Z_ref
enddo ; enddo
endif
enddo
@@ -3235,18 +3329,18 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
else ! This is assuming Flather as only other option
if (GV%Boussinesq) then
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
- BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j)
+ BT_OBC%dZ_v(i,J) = CS%bathyT(i,j) + GV%H_to_Z*eta(i,j)
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
- BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1)
+ BT_OBC%dZ_v(i,J) = CS%bathyT(i,j+1) + GV%H_to_Z*eta(i,j+1)
endif
else
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
- BT_OBC%H_v(i,J) = eta(i,j)
+ BT_OBC%dZ_v(i,J) = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j)
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
- BT_OBC%H_v(i,J) = eta(i,j+1)
+ BT_OBC%dZ_v(i,J) = GV%H_to_RZ * eta(i,j+1) * SpV_avg(i,j+1)
endif
endif
- BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J))
+ BT_OBC%Cg_v(i,J) = SQRT(dgeo_de_in * GV%g_prime(1) * BT_OBC%dZ_v(i,J))
endif
endif ; enddo ; enddo
if (OBC%Flather_v_BCs_exist_globally) then
@@ -3255,7 +3349,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B
if (segment%is_N_or_S .and. segment%Flather) then
do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J)
- BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) + G%Z_ref*GV%Z_to_H
+ BT_OBC%SSH_outer_v(i,J) = segment%SSH(i,J) + G%Z_ref
enddo ; enddo
endif
enddo
@@ -3278,16 +3372,16 @@ subroutine destroy_BT_OBC(BT_OBC)
if (BT_OBC%is_alloced) then
deallocate(BT_OBC%Cg_u)
- deallocate(BT_OBC%H_u)
+ deallocate(BT_OBC%dZ_u)
deallocate(BT_OBC%uhbt)
deallocate(BT_OBC%ubt_outer)
- deallocate(BT_OBC%eta_outer_u)
+ deallocate(BT_OBC%SSH_outer_u)
deallocate(BT_OBC%Cg_v)
- deallocate(BT_OBC%H_v)
+ deallocate(BT_OBC%dZ_v)
deallocate(BT_OBC%vhbt)
deallocate(BT_OBC%vbt_outer)
- deallocate(BT_OBC%eta_outer_v)
+ deallocate(BT_OBC%SSH_outer_v)
BT_OBC%is_alloced = .false.
endif
end subroutine destroy_BT_OBC
@@ -3342,6 +3436,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
! around a u-point (positive upward) [H ~> m or kg m-2]
real :: D_shallow_v(SZIB_(G))! The height of the shallower of the adjacent bathymetric depths
! around a v-point (positive upward) [H ~> m or kg m-2]
+ real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3]
real :: htot ! The sum of the layer thicknesses [H ~> m or kg m-2].
real :: Ihtot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1].
@@ -3383,9 +3478,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
! This estimates the fractional thickness of each layer at the velocity
! points, using a harmonic mean estimate.
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_u,CS,h_neglect,h,use_default,G,GV) &
-!$OMP private(hatutot,Ihatutot,e_u,D_shallow_u,h_arith,h_harm,wt_arith)
+ !$OMP parallel do default(none) shared(is,ie,js,je,nz,h_u,CS,h_neglect,h,use_default,G,GV) &
+ !$OMP private(hatutot,Ihatutot,e_u,D_shallow_u,h_arith,h_harm,wt_arith,Z_to_H)
do j=js,je
if (present(h_u)) then
do I=is-1,ie ; hatutot(I) = h_u(I,j,1) ; enddo
@@ -3407,9 +3502,10 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
hatutot(I) = hatutot(I) + CS%frhatu(I,j,k)
enddo ; enddo
elseif (CS%hvel_scheme == HYBRID .or. use_default) then
+ Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
do I=is-1,ie
- e_u(I,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j))
- D_shallow_u(I) = -GV%Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j))
+ e_u(I,nz+1) = -0.5 * Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j))
+ D_shallow_u(I) = -Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j))
hatutot(I) = 0.0
enddo
do k=nz,1,-1 ; do I=is-1,ie
@@ -3447,8 +3543,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
endif
enddo
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h_v,h_neglect,h,use_default) &
-!$OMP private(hatvtot,Ihatvtot,e_v,D_shallow_v,h_arith,h_harm,wt_arith)
+ !$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h_v,h_neglect,h,use_default) &
+ !$OMP private(hatvtot,Ihatvtot,e_v,D_shallow_v,h_arith,h_harm,wt_arith,Z_to_H)
do J=js-1,je
if (present(h_v)) then
do i=is,ie ; hatvtot(i) = h_v(i,J,1) ; enddo
@@ -3470,9 +3566,10 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
hatvtot(i) = hatvtot(i) + CS%frhatv(i,J,k)
enddo ; enddo
elseif (CS%hvel_scheme == HYBRID .or. use_default) then
+ Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
do i=is,ie
- e_v(i,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j))
- D_shallow_v(I) = -GV%Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j))
+ e_v(i,nz+1) = -0.5 * Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j))
+ D_shallow_v(I) = -Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j))
hatvtot(I) = 0.0
enddo
do k=nz,1,-1 ; do i=is,ie
@@ -3875,7 +3972,7 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain
vBT_NN, vBT_SS, & ! Meridional velocities at which the form of the fit changes [L T-1 ~> m s-1]
FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS ! Meridional face areas [H L ~> m2 or kg m-1]
real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim]
- real, parameter :: C1_3 = 1.0/3.0
+ real, parameter :: C1_3 = 1.0/3.0 ! [nondim]
integer :: i, j, is, ie, js, je, hs
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
@@ -4010,7 +4107,7 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
! Local variables
real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim]
- real, parameter :: C1_3 = 1.0/3.0
+ real, parameter :: C1_3 = 1.0/3.0 ! [nondim]
integer :: i, j, is, ie, js, je, hs
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
@@ -4140,23 +4237,23 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max)
! Local variables
real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2].
+ real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3]
integer :: i, j, is, ie, js, je, hs
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
hs = max(halo,0)
-!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,G,CS,Datu,Datv,add_max) &
-!$OMP private(H1,H2)
+ !$OMP parallel default(shared) private(H1,H2,Z_to_H)
if (present(eta)) then
! The use of harmonic mean thicknesses ensure positive definiteness.
if (GV%Boussinesq) then
-!$OMP do
+ !$OMP do
do j=js-hs,je+hs ; do I=is-1-hs,ie+hs
H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j)
Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2)
! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
enddo ; enddo
-!$OMP do
+ !$OMP do
do J=js-1-hs,je+hs ; do i=is-hs,ie+hs
H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1)
Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
@@ -4164,14 +4261,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max)
! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2)
enddo ; enddo
else
-!$OMP do
+ !$OMP do
do j=js-hs,je+hs ; do I=is-1-hs,ie+hs
Datu(I,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) &
Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * eta(i,j) * eta(i+1,j)) / &
(eta(i,j) + eta(i+1,j))
! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j))
enddo ; enddo
-!$OMP do
+ !$OMP do
do J=js-1-hs,je+hs ; do i=is-hs,ie+hs
Datv(i,J) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) &
Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * eta(i,j) * eta(i,j+1)) / &
@@ -4180,33 +4277,37 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max)
enddo ; enddo
endif
elseif (present(add_max)) then
-!$OMP do
+ Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
+
+ !$OMP do
do j=js-hs,je+hs ; do I=is-1-hs,ie+hs
- Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * &
+ Datu(I,j) = CS%dy_Cu(I,j) * Z_to_H * &
max(max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0)
enddo ; enddo
-!$OMP do
+ !$OMP do
do J=js-1-hs,je+hs ; do i=is-hs,ie+hs
- Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * &
+ Datv(i,J) = CS%dx_Cv(i,J) * Z_to_H * &
max(max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0)
enddo ; enddo
else
-!$OMP do
+ Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
+
+ !$OMP do
do j=js-hs,je+hs ; do I=is-1-hs,ie+hs
- H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i+1,j) + G%Z_ref) * GV%Z_to_H
+ H1 = (CS%bathyT(i,j) + G%Z_ref) * Z_to_H ; H2 = (CS%bathyT(i+1,j) + G%Z_ref) * Z_to_H
Datu(I,j) = 0.0
if ((H1 > 0.0) .and. (H2 > 0.0)) &
Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2)
enddo ; enddo
-!$OMP do
+ !$OMP do
do J=js-1-hs,je+hs ; do i=is-hs,ie+hs
- H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i,j+1) + G%Z_ref) * GV%Z_to_H
+ H1 = (CS%bathyT(i,j) + G%Z_ref) * Z_to_H ; H2 = (CS%bathyT(i,j+1) + G%Z_ref) * Z_to_H
Datv(i,J) = 0.0
if ((H1 > 0.0) .and. (H2 > 0.0)) &
Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2)
enddo ; enddo
endif
-!$OMP end parallel
+ !$OMP end parallel
end subroutine find_face_areas
@@ -4273,7 +4374,7 @@ end subroutine bt_mass_source
!! barotropic calculation and initializes any barotropic fields that have not
!! already been initialized.
subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, &
- restart_CS, calc_dtbt, BT_cont, tides_CSp)
+ restart_CS, calc_dtbt, BT_cont, SAL_CSp)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -4297,8 +4398,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the
!! effective open face areas as a function of
!! barotropic flow.
- type(tidal_forcing_CS), target, optional :: tides_CSp !< A pointer to the control structure of the
- !! tide module.
+ type(SAL_CS), target, optional :: SAL_CSp !< A pointer to the control structure of the
+ !! SAL module.
! This include declares and sets the variable "version".
# include "version_variable.h"
@@ -4306,13 +4407,14 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
character(len=40) :: mdl = "MOM_barotropic" ! This module's name.
real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1].
real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H L ~> m2 or kg m-1].
- real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce.
+ real :: gtot_estimate ! Summed GV%g_prime [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2], to give an
+ ! upper-bound estimate for pbce.
real :: SSH_extra ! An estimate of how much higher SSH might get, for use
! in calculating the safe external wave speed [Z ~> m].
real :: dtbt_input ! The input value of DTBT, [nondim] if negative or [s] if positive.
real :: dtbt_tmp ! A temporary copy of CS%dtbt read from a restart file [T ~> s]
real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag
- ! piston velocities.
+ ! piston velocities [nondim].
character(len=200) :: inputdir ! The directory in which to find input files.
character(len=200) :: wave_drag_file ! The file from which to read the wave
! drag piston velocity.
@@ -4320,21 +4422,20 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
! name in wave_drag_file.
real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the
! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m].
+ real :: Z_to_H ! A local unit conversion factor [H Z-1 ~> nondim or kg m-3]
+ real :: H_to_Z ! A local unit conversion factor [Z H-1 ~> nondim or m3 kg-1]
real :: det_de ! The partial derivative due to self-attraction and loading of the reference
- ! geopotential with the sea surface height when tides are enabled [nondim].
+ ! geopotential with the sea surface height when scalar SAL are enabled [nondim].
! This is typically ~0.09 or less.
real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points
- ! that acts on the barotropic flow [Z T-1 ~> m s-1].
+ ! that acts on the barotropic flow [H T-1 ~> m s-1 or kg m-2 s-1].
type(memory_size_type) :: MS
type(group_pass_type) :: pass_static_data, pass_q_D_Cor
type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use expressions for the barotropic solver that recover
- ! the answers from the end of 2018. Otherwise, use more efficient
- ! or general expressions.
logical :: use_BT_cont_type
+ logical :: use_tides
character(len=48) :: thickness_units, flux_units
character*(40) :: hvel_str
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
@@ -4356,8 +4457,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
CS%module_is_initialized = .true.
CS%diag => diag ; CS%Time => Time
- if (present(tides_CSp)) then
- CS%tides_CSp => tides_CSp
+ if (present(SAL_CSp)) then
+ CS%SAL_CSp => SAL_CSp
endif
! Read all relevant parameters and write them to the model log.
@@ -4444,6 +4545,13 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
"If true, use the full depth of the ocean at the start of the barotropic "//&
"step when calculating the surface stress contribution to the barotropic "//&
"acclerations. Otherwise use the depth based on bathyT.", default=.false.)
+ call get_param(param_file, mdl, "BT_RHO_LINEARIZED", CS%Rho_BT_lin, &
+ "A density that is used to convert total water column thicknesses into mass "//&
+ "in non-Boussinesq mode with linearized options in the barotropic solver or "//&
+ "when estimating the stable barotropic timestep without access to the full "//&
+ "baroclinic model state.", &
+ units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=GV%Boussinesq)
call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, &
"If true, add a dynamic pressure due to a viscous ice "//&
@@ -4457,7 +4565,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
"The minimum depth to use in limiting the size of the "//&
"dynamic surface pressure for stability, if "//&
"DYNAMIC_SURFACE_PRESSURE is true..", &
- units="m", default=1.0e-6, scale=US%m_to_Z, do_not_log=.not.CS%dynamic_psurf)
+ units="m", default=1.0e-6, scale=GV%m_to_H, do_not_log=.not.CS%dynamic_psurf)
call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, &
"The constant that scales the dynamic surface pressure, "//&
"if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//&
@@ -4469,33 +4577,33 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "BAROTROPIC_2018_ANSWERS", answers_2018, &
- "If true, use expressions for the barotropic solver that recover the answers "//&
- "from the end of 2018. Otherwise, use more efficient or general expressions.", &
- default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "BAROTROPIC_ANSWER_DATE", CS%answer_date, &
"The vintage of the expressions in the barotropic solver. "//&
"Values below 20190101 recover the answers from the end of 2018, "//&
- "while higher values uuse more efficient or general expressions. "//&
- "If both BAROTROPIC_2018_ANSWERS and BAROTROPIC_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "while higher values uuse more efficient or general expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
- call get_param(param_file, mdl, "TIDES", CS%tides, &
+ call get_param(param_file, mdl, "TIDES", use_tides, &
"If true, apply tidal momentum forcing.", default=.false.)
+ call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
+ "If true, calculate self-attraction and loading.", default=use_tides)
det_de = 0.0
- if (CS%tides .and. associated(CS%tides_CSp)) &
- call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de)
+ if (CS%calculate_SAL .and. associated(CS%SAL_CSp)) &
+ call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, &
"If true, the tidal self-attraction and loading anomaly in the barotropic "//&
"solver has the wrong sign, replicating a long-standing bug with a scalar "//&
"self-attraction and loading term or the SAL term from a previous simulation.", &
default=.false., do_not_log=(det_de==0.0))
+ call get_param(param_file, mdl, "TIDAL_SAL_FLATHER", CS%tidal_sal_flather, &
+ "If true, then apply adjustments to the external gravity "//&
+ "wave speed used with the Flather OBC routine consistent "//&
+ "with the barotropic solver. This applies to cases with "//&
+ "tidal forcing using the scalar self-attraction approximation. "//&
+ "The default is currently False in order to retain previous answers "//&
+ "but should be set to True for new experiments", default=.false.)
+
call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, &
"If true, the Coriolis terms are discretized with the "//&
"Sadourny (1975) energy conserving scheme, otherwise "//&
@@ -4729,21 +4837,23 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw))
CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0
+ Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
+
Mean_SL = G%Z_ref
do j=js,je ; do I=is-1,ie
- CS%D_u_Cor(I,j) = 0.5 * (max(Mean_SL+G%bathyT(i+1,j),0.0) + max(Mean_SL+G%bathyT(i,j),0.0))
+ CS%D_u_Cor(I,j) = 0.5 * (max(Mean_SL+G%bathyT(i+1,j),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) * Z_to_H
enddo ; enddo
do J=js-1,je ; do i=is,ie
- CS%D_v_Cor(i,J) = 0.5 * (max(Mean_SL+G%bathyT(i,j+1),0.0) + max(Mean_SL+G%bathyT(i,j),0.0))
+ CS%D_v_Cor(i,J) = 0.5 * (max(Mean_SL+G%bathyT(i,j+1),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) * Z_to_H
enddo ; enddo
do J=js-1,je ; do I=is-1,ie
if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then
CS%q_D(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / &
- (max(((G%areaT(i,j) * max(Mean_SL+G%bathyT(i,j),0.0) + &
- G%areaT(i+1,j+1) * max(Mean_SL+G%bathyT(i+1,j+1),0.0)) + &
- (G%areaT(i+1,j) * max(Mean_SL+G%bathyT(i+1,j),0.0) + &
- G%areaT(i,j+1) * max(Mean_SL+G%bathyT(i,j+1),0.0))), GV%H_to_Z*GV%H_subroundoff) )
+ (Z_to_H * max(((G%areaT(i,j) * max(Mean_SL+G%bathyT(i,j),0.0) + &
+ G%areaT(i+1,j+1) * max(Mean_SL+G%bathyT(i+1,j+1),0.0)) + &
+ (G%areaT(i+1,j) * max(Mean_SL+G%bathyT(i+1,j),0.0) + &
+ G%areaT(i,j+1) * max(Mean_SL+G%bathyT(i,j+1),0.0))), GV%H_subroundoff) )
else ! All four h points are masked out so q_D(I,J) will is meaningless
CS%q_D(I,J) = 0.
endif
@@ -4767,15 +4877,13 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
allocate(lin_drag_h(isd:ied,jsd:jed), source=0.0)
- call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=US%m_to_Z*US%T_to_s)
+ call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=GV%m_to_H*US%T_to_s)
call pass_var(lin_drag_h, G%Domain)
do j=js,je ; do I=is-1,ie
- CS%lin_drag_u(I,j) = (GV%Z_to_H * wave_drag_scale) * &
- 0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
+ CS%lin_drag_u(I,j) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
enddo ; enddo
do J=js-1,je ; do i=is,ie
- CS%lin_drag_v(i,J) = (GV%Z_to_H * wave_drag_scale) * &
- 0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
+ CS%lin_drag_v(i,J) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
enddo ; enddo
deallocate(lin_drag_h)
endif
@@ -4790,7 +4898,12 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
! Estimate the maximum stable barotropic time step.
gtot_estimate = 0.0
- do k=1,GV%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo
+ if (GV%Boussinesq) then
+ do k=1,GV%ke ; gtot_estimate = gtot_estimate + GV%H_to_Z*GV%g_prime(K) ; enddo
+ else
+ H_to_Z = GV%H_to_RZ / CS%Rho_BT_lin
+ do k=1,GV%ke ; gtot_estimate = gtot_estimate + H_to_Z*GV%g_prime(K) ; enddo
+ endif
call set_dtbt(G, GV, US, CS, gtot_est=gtot_estimate, SSH_add=SSH_extra)
if (dtbt_input > 0.0) then
@@ -4957,16 +5070,17 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
if (.not.CS%nonlin_stress) then
Mean_SL = G%Z_ref
+ Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
do j=js,je ; do I=is-1,ie
if (G%mask2dCu(I,j)>0.) then
- CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / ((G%bathyT(i+1,j) + G%bathyT(i,j)) + 2.0*Mean_SL)
+ CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (Z_to_H * ((G%bathyT(i+1,j) + G%bathyT(i,j)) + 2.0*Mean_SL))
else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless
CS%IDatu(I,j) = 0.
endif
enddo ; enddo
do J=js-1,je ; do i=is,ie
if (G%mask2dCv(i,J)>0.) then
- CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / ((G%bathyT(i,j+1) + G%bathyT(i,j)) + 2.0*Mean_SL)
+ CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (Z_to_H * ((G%bathyT(i,j+1) + G%bathyT(i,j)) + 2.0*Mean_SL))
else ! Both neighboring H points are masked out so IDatv(i,J) is meaningless
CS%IDatv(i,J) = 0.
endif
diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90
index 5a098cdf84..75f69dc779 100644
--- a/src/core/MOM_boundary_update.F90
+++ b/src/core/MOM_boundary_update.F90
@@ -156,7 +156,7 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time)
call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, GV, US, h, Time)
if (CS%use_dyed_channel) &
call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, US, Time)
- if (OBC%needs_IO_for_data .or. OBC%add_tide_constituents) &
+ if (OBC%any_needs_IO_for_data .or. OBC%add_tide_constituents) &
call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
end subroutine update_OBC_data
diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90
index 090d1ee0fb..73c6503242 100644
--- a/src/core/MOM_continuity_PPM.F90
+++ b/src/core/MOM_continuity_PPM.F90
@@ -378,9 +378,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are
dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j))
else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif
- if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) &
+ if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)*G%mask2dCu(I,j)) &
du_max_CFL(I) = (dx_W*CFL_dt - u(I,j,k)) / visc_rem(I,k)
- if (du_min_CFL(I) * visc_rem(I,k) < -dx_E*CFL_dt - u(I,j,k)) &
+ if (du_min_CFL(I) * visc_rem(I,k) < -dx_E*CFL_dt - u(I,j,k)*G%mask2dCu(I,j)) &
du_min_CFL(I) = -(dx_E*CFL_dt + u(I,j,k)) / visc_rem(I,k)
enddo ; enddo
endif
@@ -1201,9 +1201,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac
dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j))
dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1))
else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif
- if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) &
+ if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)*G%mask2dCv(i,J)) &
dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k)
- if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)) &
+ if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)*G%mask2dCv(i,J)) &
dv_min_CFL(i) = -(dy_N*CFL_dt + v(i,J,k)) / visc_rem(i,k)
enddo ; enddo
endif
diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90
index bb83d65d44..4bbd03a46a 100644
--- a/src/core/MOM_dynamics_split_RK2.F90
+++ b/src/core/MOM_dynamics_split_RK2.F90
@@ -50,17 +50,19 @@ module MOM_dynamics_split_RK2
use MOM_hor_index, only : hor_index_type
use MOM_hor_visc, only : horizontal_viscosity, hor_visc_CS
use MOM_hor_visc, only : hor_visc_init, hor_visc_end
-use MOM_interface_heights, only : find_eta
+use MOM_interface_heights, only : thickness_to_dz, find_col_avg_SpV
use MOM_lateral_mixing_coeffs, only : VarMix_CS
use MOM_MEKE_types, only : MEKE_type
use MOM_open_boundary, only : ocean_OBC_type, radiation_open_bdry_conds
-use MOM_open_boundary, only : open_boundary_zero_normal_flow
+use MOM_open_boundary, only : open_boundary_zero_normal_flow, open_boundary_query
use MOM_open_boundary, only : open_boundary_test_extern_h, update_OBC_ramp
use MOM_PressureForce, only : PressureForce, PressureForce_CS
use MOM_PressureForce, only : PressureForce_init
use MOM_set_visc, only : set_viscous_ML, set_visc_CS
use MOM_stochastics, only : stochastic_CS
use MOM_thickness_diffuse, only : thickness_diffuse_CS
+use MOM_self_attr_load, only : SAL_CS
+use MOM_self_attr_load, only : SAL_init, SAL_end
use MOM_tidal_forcing, only : tidal_forcing_CS
use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_end
use MOM_unit_scaling, only : unit_scale_type
@@ -165,6 +167,7 @@ module MOM_dynamics_split_RK2
!! end of the timestep have been stored for use in the next
!! predictor step. This is used to accomodate various generations
!! of restart files.
+ logical :: calculate_SAL !< If true, calculate self-attraction and loading.
logical :: use_tides !< If true, tidal forcing is enabled.
logical :: remap_aux !< If true, apply ALE remapping to all of the auxiliary 3-D
!! variables that are needed to reproduce across restarts,
@@ -178,8 +181,7 @@ module MOM_dynamics_split_RK2
!! Euler (1) [nondim]. 0 is often used.
logical :: debug !< If true, write verbose checksums for debugging purposes.
logical :: debug_OBC !< If true, do debugging calls for open boundary conditions.
- logical :: fpmix !< If true, applies profiles of momentum flux magnitude and direction.
-
+ logical :: fpmix = .false. !< If true, applies profiles of momentum flux magnitude and direction.
logical :: module_is_initialized = .false. !< Record whether this module has been initialized.
!>@{ Diagnostic IDs
@@ -241,6 +243,8 @@ module MOM_dynamics_split_RK2
type(set_visc_CS), pointer :: set_visc_CSp => NULL()
!> A pointer to the barotropic stepping control structure
type(barotropic_CS) :: barotropic_CSp
+ !> A pointer to the SAL control structure
+ type(SAL_CS) :: SAL_CSp
!> A pointer to the tidal forcing control structure
type(tidal_forcing_CS) :: tides_CSp
!> A pointer to the ALE control structure.
@@ -331,6 +335,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted thickness [H ~> m or kg m-2].
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Distance between the interfaces around a layer [Z ~> m]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_bc_accel ! The summed zonal baroclinic accelerations
@@ -347,6 +352,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
real, dimension(SZI_(G),SZJ_(G)) :: eta_pred ! The predictor value of the free surface height
! or column mass [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)) :: SpV_avg ! The column averaged specific volume [R-1 ~> m3 kg-1]
real, dimension(SZI_(G),SZJ_(G)) :: deta_dt ! A diagnostic of the time derivative of the free surface
! height or column mass [H T-1 ~> m s-1 or kg m-2 s-1]
@@ -383,7 +389,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1].
h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2].
- real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth from Cvmix
+ real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth from Cvmix [H ~> m or kg m-2]
real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s].
real :: Idt_bc ! Inverse of the baroclinic timestep [T-1 ~> s-1]
logical :: dyn_p_surf
@@ -395,7 +401,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
logical :: showCallTree, sym
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
- integer :: cont_stencil
+ integer :: cont_stencil, obc_stencil
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
@@ -458,19 +464,23 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
!--- begin set up for group halo pass
cont_stencil = continuity_stencil(CS%continuity_CSp)
+ obc_stencil = 2
+ if (associated(CS%OBC)) then
+ if (CS%OBC%oblique_BCs_exist_globally) obc_stencil = 3
+ endif
call cpu_clock_begin(id_clock_pass)
call create_group_pass(CS%pass_eta, eta, G%Domain, halo=1)
call create_group_pass(CS%pass_visc_rem, CS%visc_rem_u, CS%visc_rem_v, G%Domain, &
To_All+SCALAR_PAIR, CGRID_NE, halo=max(1,cont_stencil))
call create_group_pass(CS%pass_uvp, up, vp, G%Domain, halo=max(1,cont_stencil))
call create_group_pass(CS%pass_hp_uv, hp, G%Domain, halo=2)
- call create_group_pass(CS%pass_hp_uv, u_av, v_av, G%Domain, halo=2)
- call create_group_pass(CS%pass_hp_uv, uh(:,:,:), vh(:,:,:), G%Domain, halo=2)
+ call create_group_pass(CS%pass_hp_uv, u_av, v_av, G%Domain, halo=max(2,obc_stencil))
+ call create_group_pass(CS%pass_hp_uv, uh(:,:,:), vh(:,:,:), G%Domain, halo=max(2,obc_stencil))
call create_group_pass(CS%pass_uv, u, v, G%Domain, halo=max(2,cont_stencil))
call create_group_pass(CS%pass_h, h, G%Domain, halo=max(2,cont_stencil))
- call create_group_pass(CS%pass_av_uvh, u_av, v_av, G%Domain, halo=2)
- call create_group_pass(CS%pass_av_uvh, uh(:,:,:), vh(:,:,:), G%Domain, halo=2)
+ call create_group_pass(CS%pass_av_uvh, u_av, v_av, G%Domain, halo=max(2,obc_stencil))
+ call create_group_pass(CS%pass_av_uvh, uh(:,:,:), vh(:,:,:), G%Domain, halo=max(2,obc_stencil))
call cpu_clock_end(id_clock_pass)
!--- end set up for group halo pass
@@ -494,7 +504,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
Use_Stokes_PGF = associated(Waves)
if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF
if (Use_Stokes_PGF) then
- call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves)
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+ call Stokes_PGF(G, GV, US, dz, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves)
! We are adding Stokes_PGF to hydrostatic PGF here. The diag PFu/PFv
! will therefore report the sum total PGF and we avoid other
@@ -581,7 +592,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
if (CS%debug) then
call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s)
endif
- call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(up, vp, h, dz, forces, visc, tv, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp)
call cpu_clock_end(id_clock_vertvisc)
if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)")
@@ -602,6 +614,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
if (.not.BT_cont_BT_thick) &
call btcalc(h, G, GV, CS%barotropic_CSp, OBC=CS%OBC)
call bt_mass_source(h, eta, .true., G, GV, CS%barotropic_CSp)
+
+ SpV_avg(:,:) = 0.0
+ if ((.not.GV%Boussinesq) .and. associated(CS%OBC)) then
+ ! Determine the column average specific volume if it is needed due to the
+ ! use of Flather open boundary conditions in non-Boussinesq mode.
+ if (open_boundary_query(CS%OBC, apply_Flather_OBC=.true.)) &
+ call find_col_avg_SpV(h, SpV_avg, tv, G, GV, US)
+ endif
call cpu_clock_end(id_clock_btcalc)
if (G%nonblocking_updates) &
@@ -631,7 +651,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
! The CS%ADp argument here stores the weights for certain integrated diagnostics.
call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, u_av, v_av, &
CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, US, &
- CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, CS%ADp, CS%OBC, CS%BT_cont, &
+ CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, SpV_avg, CS%ADp, CS%OBC, CS%BT_cont, &
eta_PF_start, taux_bot, tauy_bot, uh_ptr, vh_ptr, u_ptr, v_ptr)
if (showCallTree) call callTree_leave("btstep()")
call cpu_clock_end(id_clock_btstep)
@@ -691,7 +711,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
enddo
endif
- call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, &
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(up, vp, h, dz, forces, visc, tv, dt_pred, G, GV, US, CS%vertvisc_CSp, &
CS%OBC, VarMix)
call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%AD_pred, CS%CDp, G, &
GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves)
@@ -789,7 +810,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
Use_Stokes_PGF = associated(Waves)
if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF
if (Use_Stokes_PGF) then
- call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves)
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+ call Stokes_PGF(G, GV, US, dz, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves)
if (.not.Waves%Passive_Stokes_PGF) then
do k=1,nz
do j=js,je ; do I=Isq,Ieq
@@ -881,7 +903,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
! This is the corrector step call to btstep.
call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, u_av, v_av, &
CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, US, &
- CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, CS%ADp, CS%OBC, CS%BT_cont, &
+ CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, SpV_avg, CS%ADp, CS%OBC, CS%BT_cont, &
eta_PF_start, taux_bot, tauy_bot, uh_ptr, vh_ptr, u_ptr, v_ptr, etaav=eta_av)
if (CS%id_deta_dt>0) then
do j=js,je ; do i=is,ie ; deta_dt(i,j) = (eta_pred(i,j) - eta(i,j))*Idt_bc ; enddo ; enddo
@@ -942,7 +964,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
enddo
endif
- call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, &
CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves)
@@ -1034,8 +1057,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
endif
if (CS%fpmix) then
- if (CS%id_uold > 0) call post_data(CS%id_uold , uold, CS%diag)
- if (CS%id_vold > 0) call post_data(CS%id_vold , vold, CS%diag)
+ if (CS%id_uold > 0) call post_data(CS%id_uold, uold, CS%diag)
+ if (CS%id_vold > 0) call post_data(CS%id_vold, vold, CS%diag)
endif
! The time-averaged free surface height has already been set by the last call to btstep.
@@ -1051,8 +1074,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
if (CS%id_CAv > 0) call post_data(CS%id_CAv, CS%CAv, CS%diag)
! Here the thickness fluxes are offered for time averaging.
- if (CS%id_uh > 0) call post_data(CS%id_uh , uh, CS%diag)
- if (CS%id_vh > 0) call post_data(CS%id_vh , vh, CS%diag)
+ if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag)
+ if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag)
if (CS%id_uav > 0) call post_data(CS%id_uav, u_av, CS%diag)
if (CS%id_vav > 0) call post_data(CS%id_vav, v_av, CS%diag)
if (CS%id_u_BT_accel > 0) call post_data(CS%id_u_BT_accel, CS%u_accel_bt, CS%diag)
@@ -1240,27 +1263,34 @@ end subroutine register_restarts_dyn_split_RK2
!> This subroutine does remapping for the auxiliary restart variables that are used
!! with the split RK2 time stepping scheme.
-subroutine remap_dyn_split_RK2_aux_vars(G, GV, CS, h_old, h_new, ALE_CSp, OBC, dzRegrid)
+subroutine remap_dyn_split_RK2_aux_vars(G, GV, CS, h_old_u, h_old_v, h_new_u, h_new_v, ALE_CSp)
type(ocean_grid_type), intent(inout) :: G !< ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h_old !< Thickness of source grid [H ~> m or kg m-2]
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h_new !< Thickness of destination grid [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h_old_u !< Source grid thickness at zonal
+ !! velocity points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(in) :: h_old_v !< Source grid thickness at meridional
+ !! velocity points [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h_new_u !< Destination grid thickness at zonal
+ !! velocity points [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(in) :: h_new_v !< Destination grid thickness at meridional
+ !! velocity points [H ~> m or kg m-2]
type(ALE_CS), pointer :: ALE_CSp !< ALE control structure to use when remapping
- type(ocean_OBC_type), pointer :: OBC !< OBC control structure to use when remapping
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- optional, intent(in) :: dzRegrid !< Change in interface position [H ~> m or kg m-2]
if (.not.CS%remap_aux) return
if (CS%store_CAu) then
- call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%u_av, CS%v_av, OBC, dzRegrid)
- call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%CAu_pred, CS%CAv_pred, OBC, dzRegrid)
+ call ALE_remap_velocities(ALE_CSp, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, CS%u_av, CS%v_av)
+ call pass_vector(CS%u_av, CS%v_av, G%Domain, complete=.false.)
+ call ALE_remap_velocities(ALE_CSp, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, CS%CAu_pred, CS%CAv_pred)
+ call pass_vector(CS%CAu_pred, CS%CAv_pred, G%Domain, complete=.true.)
endif
- call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%diffu, CS%diffv, OBC, dzRegrid)
+ call ALE_remap_velocities(ALE_CSp, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, CS%diffu, CS%diffv)
end subroutine remap_dyn_split_RK2_aux_vars
@@ -1278,7 +1308,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param
intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
intent(inout) :: v !< merid velocity [L T-1 ~> m s-1]
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) , &
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: h !< layer thickness [H ~> m or kg m-2]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1]
@@ -1344,6 +1374,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param
call log_version(param_file, mdl, version, "")
call get_param(param_file, mdl, "TIDES", CS%use_tides, &
"If true, apply tidal momentum forcing.", default=.false.)
+ call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
+ "If true, calculate self-attraction and loading.", default=CS%use_tides)
call get_param(param_file, mdl, "BE", CS%be, &
"If SPLIT is true, BE determines the relative weighting "//&
"of a 2nd-order Runga-Kutta baroclinic time stepping "//&
@@ -1447,9 +1479,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param
call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp)
cont_stencil = continuity_stencil(CS%continuity_CSp)
call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv)
+ if (CS%calculate_SAL) call SAL_init(G, US, param_file, CS%SAL_CSp)
if (CS%use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp)
call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, &
- CS%tides_CSp)
+ CS%SAL_CSp, CS%tides_CSp)
call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp)
call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, &
ntrunc, CS%vertvisc_CSp)
@@ -1485,7 +1518,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param
call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, &
CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, &
- CS%tides_CSp)
+ CS%SAL_CSp)
if (.not. query_initialized(CS%diffu, "diffu", restart_CS) .or. &
.not. query_initialized(CS%diffv, "diffv", restart_CS)) then
@@ -1781,6 +1814,7 @@ subroutine end_dyn_split_RK2(CS)
deallocate(CS%vertvisc_CSp)
call hor_visc_end(CS%hor_visc)
+ if (CS%calculate_SAL) call SAL_end(CS%SAL_CSp)
if (CS%use_tides) call tidal_forcing_end(CS%tides_CSp)
call CoriolisAdv_end(CS%CoriolisAdv)
diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90
index e2483484a3..f1d3311a89 100644
--- a/src/core/MOM_dynamics_unsplit.F90
+++ b/src/core/MOM_dynamics_unsplit.F90
@@ -79,7 +79,7 @@ module MOM_dynamics_unsplit
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_CS
-use MOM_interface_heights, only : find_eta
+use MOM_interface_heights, only : find_eta, thickness_to_dz
use MOM_lateral_mixing_coeffs, only : VarMix_CS
use MOM_MEKE_types, only : MEKE_type
use MOM_open_boundary, only : ocean_OBC_type
@@ -88,7 +88,8 @@ module MOM_dynamics_unsplit
use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS
use MOM_set_visc, only : set_viscous_ML, set_visc_CS
use MOM_stochastics, only : stochastic_CS
-use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS
+use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_end, tidal_forcing_CS
+use MOM_self_attr_load, only : SAL_init, SAL_end, SAL_CS
use MOM_unit_scaling, only : unit_scale_type
use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS
use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units
@@ -121,6 +122,8 @@ module MOM_dynamics_unsplit
!! and in the calculation of the turbulent mixed layer properties
!! for viscosity. The default should be true, but it is false.
logical :: debug !< If true, write verbose checksums for debugging purposes.
+ logical :: calculate_SAL !< If true, calculate self-attraction and loading.
+ logical :: use_tides !< If true, tidal forcing is enabled.
logical :: module_is_initialized = .false. !< Record whether this module has been initialized.
@@ -154,6 +157,8 @@ module MOM_dynamics_unsplit
type(vertvisc_CS), pointer :: vertvisc_CSp => NULL()
!> A pointer to the set_visc control structure
type(set_visc_CS), pointer :: set_visc_CSp => NULL()
+ !> A pointer to the SAL control structure
+ type(SAL_CS) :: SAL_CSp
!> A pointer to the tidal forcing control structure
type(tidal_forcing_CS) :: tides_CSp
!> A pointer to the ALE control structure.
@@ -225,6 +230,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av, hp ! Predicted or averaged layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Distance between the interfaces around a layer [Z ~> m]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2]
@@ -347,7 +353,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
call disable_averaging(CS%diag)
dt_visc = 0.5*dt ; if (CS%use_correct_dt_visc) dt_visc = dt_pred
- call vertvisc_coef(up, vp, h_av, forces, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call thickness_to_dz(h_av, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(up, vp, h_av, dz, forces, visc, tv, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc(up, vp, h_av, forces, visc, dt_visc, CS%OBC, CS%ADp, CS%CDp, &
G, GV, US, CS%vertvisc_CSp, Waves=Waves)
call cpu_clock_end(id_clock_vertvisc)
@@ -407,7 +414,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
! upp <- upp + dt/2 d/dz visc d/dz upp
call cpu_clock_begin(id_clock_vertvisc)
- call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call thickness_to_dz(hp, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(upp, vpp, hp, dz, forces, visc, tv, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, &
G, GV, US, CS%vertvisc_CSp, Waves=Waves)
call cpu_clock_end(id_clock_vertvisc)
@@ -491,7 +499,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, &
! u <- u + dt d/dz visc d/dz u
call cpu_clock_begin(id_clock_vertvisc)
- call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call thickness_to_dz(h_av, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(u, v, h_av, dz, forces, visc, tv, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, &
G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves)
call cpu_clock_end(id_clock_vertvisc)
@@ -623,7 +632,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS
character(len=48) :: flux_units
! This include declares and sets the variable "version".
# include "version_variable.h"
- logical :: use_tides
integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
@@ -648,8 +656,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS
call get_param(param_file, mdl, "DEBUG", CS%debug, &
"If true, write out verbose debugging data.", &
default=.false., debuggingParam=.true.)
- call get_param(param_file, mdl, "TIDES", use_tides, &
+ call get_param(param_file, mdl, "TIDES", CS%use_tides, &
"If true, apply tidal momentum forcing.", default=.false.)
+ call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
+ "If true, calculate self-attraction and loading.", default=CS%use_tides)
allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0)
allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0)
@@ -666,9 +676,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS
call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp)
cont_stencil = continuity_stencil(CS%continuity_CSp)
call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv)
- if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp)
+ if (CS%calculate_SAL) call SAL_init(G, US, param_file, CS%SAL_CSp)
+ if (CS%use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp)
call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, &
- CS%tides_CSp)
+ CS%SAL_CSp, CS%tides_CSp)
call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc)
call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, &
ntrunc, CS%vertvisc_CSp)
@@ -720,6 +731,9 @@ subroutine end_dyn_unsplit(CS)
DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv)
DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv)
+ if (CS%calculate_SAL) call SAL_end(CS%SAL_CSp)
+ if (CS%use_tides) call tidal_forcing_end(CS%tides_CSp)
+
deallocate(CS)
end subroutine end_dyn_unsplit
diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90
index 2a48255146..ff00bb1d4e 100644
--- a/src/core/MOM_dynamics_unsplit_RK2.F90
+++ b/src/core/MOM_dynamics_unsplit_RK2.F90
@@ -78,6 +78,7 @@ module MOM_dynamics_unsplit_RK2
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_CS
+use MOM_interface_heights, only : thickness_to_dz
use MOM_lateral_mixing_coeffs, only : VarMix_CS
use MOM_MEKE_types, only : MEKE_type
use MOM_open_boundary, only : ocean_OBC_type
@@ -86,7 +87,7 @@ module MOM_dynamics_unsplit_RK2
use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS
use MOM_set_visc, only : set_viscous_ML, set_visc_CS
use MOM_stochastics, only : stochastic_CS
-use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS
+use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_end, tidal_forcing_CS
use MOM_unit_scaling, only : unit_scale_type
use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_init, vertvisc_CS
use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units
@@ -123,6 +124,8 @@ module MOM_dynamics_unsplit_RK2
!! turbulent mixed layer properties for viscosity.
!! The default should be true, but it is false.
logical :: debug !< If true, write verbose checksums for debugging purposes.
+ logical :: calculate_SAL !< If true, calculate self-attraction and loading.
+ logical :: use_tides !< If true, tidal forcing is enabled.
logical :: module_is_initialized = .false. !< Record whether this module has been initialized.
@@ -156,6 +159,8 @@ module MOM_dynamics_unsplit_RK2
type(vertvisc_CS), pointer :: vertvisc_CSp => NULL()
!> A pointer to the set_visc control structure
type(set_visc_CS), pointer :: set_visc_CSp => NULL()
+ !> A pointer to the SAL control structure
+ type(SAL_CS) :: SAL_CSp
!> A pointer to the tidal forcing control structure
type(tidal_forcing_CS) :: tides_CSp
!> A pointer to the ALE control structure.
@@ -236,6 +241,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av ! Averaged layer thicknesses [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Distance between the interfaces around a layer [Z ~> m]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2]
@@ -343,7 +349,8 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
call set_viscous_ML(u_in, v_in, h_av, tv, forces, visc, dt_visc, G, GV, US, CS%set_visc_CSp)
call disable_averaging(CS%diag)
- call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call thickness_to_dz(h_av, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(up, vp, h_av, dz, forces, visc, tv, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, &
G, GV, US, CS%vertvisc_CSp)
call cpu_clock_end(id_clock_vertvisc)
@@ -394,10 +401,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt,
! up[n] <- up* + dt d/dz visc d/dz up
! u[n] <- u*[n] + dt d/dz visc d/dz u[n]
call cpu_clock_begin(id_clock_vertvisc)
- call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call thickness_to_dz(h_av, tv, dz, G, GV, US, halo_size=1)
+ call vertvisc_coef(up, vp, h_av, dz, forces, visc, tv, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, &
G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot)
- call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
+ call vertvisc_coef(u_in, v_in, h_av, dz, forces, visc, tv, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix)
call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,&
G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot)
call cpu_clock_end(id_clock_vertvisc)
@@ -571,7 +579,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag
character(len=48) :: flux_units
! This include declares and sets the variable "version".
# include "version_variable.h"
- logical :: use_tides
integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
@@ -612,8 +619,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag
call get_param(param_file, mdl, "DEBUG", CS%debug, &
"If true, write out verbose debugging data.", &
default=.false., debuggingParam=.true.)
- call get_param(param_file, mdl, "TIDES", use_tides, &
+ call get_param(param_file, mdl, "TIDES", CS%use_tides, &
"If true, apply tidal momentum forcing.", default=.false.)
+ call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
+ "If true, calculate self-attraction and loading.", default=CS%use_tides)
allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0)
allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0)
@@ -630,9 +639,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag
call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp)
cont_stencil = continuity_stencil(CS%continuity_CSp)
call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv)
- if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp)
+ if (CS%calculate_SAL) call SAL_init(G, US, param_file, CS%SAL_CSp)
+ if (CS%use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp)
call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, &
- CS%tides_CSp)
+ CS%SAL_CSp, CS%tides_CSp)
call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc)
call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, &
ntrunc, CS%vertvisc_CSp)
@@ -683,6 +693,9 @@ subroutine end_dyn_unsplit_RK2(CS)
DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv)
DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv)
+ if (CS%calculate_SAL) call SAL_end(CS%SAL_CSp)
+ if (CS%use_tides) call tidal_forcing_end(CS%tides_CSp)
+
deallocate(CS)
end subroutine end_dyn_unsplit_RK2
diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90
index 9cc4261e5f..b8b3174b4a 100644
--- a/src/core/MOM_forcing_type.F90
+++ b/src/core/MOM_forcing_type.F90
@@ -11,10 +11,11 @@ module MOM_forcing_type
use MOM_diag_mediator, only : post_data, register_diag_field, register_scalar_field
use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled
use MOM_diag_mediator, only : enable_averages, disable_averaging
-use MOM_EOS, only : calculate_density_derivs, EOS_domain
+use MOM_EOS, only : calculate_density_derivs, calculate_specific_vol_derivs, EOS_domain
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands
use MOM_spatial_means, only : global_area_integral, global_area_mean
use MOM_spatial_means, only : global_area_mean_u, global_area_mean_v
@@ -28,7 +29,7 @@ module MOM_forcing_type
public extractFluxes1d, extractFluxes2d, optics_type
public MOM_forcing_chksum, MOM_mech_forcing_chksum
-public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d
+public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d, find_ustar
public forcing_accumulate, fluxes_accumulate
public forcing_SinglePointPrint, mech_forcing_diags, forcing_diagnostics
public register_forcing_type_diags, allocate_forcing_type, deallocate_forcing_type
@@ -52,6 +53,12 @@ module MOM_forcing_type
module procedure allocate_mech_forcing_from_ref
end interface allocate_mech_forcing
+!> Determine the friction velocity from a forcing type or a mechanical forcing type.
+interface find_ustar
+ module procedure find_ustar_fluxes
+ module procedure find_ustar_mech_forcing
+end interface find_ustar
+
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
@@ -67,13 +74,16 @@ module MOM_forcing_type
! surface stress components and turbulent velocity scale
real, pointer, dimension(:,:) :: &
- omega_w2x => NULL(), & !< the counter-clockwise angle of the wind stress with respect
+ !omega_w2x => NULL(), & !< the counter-clockwise angle of the wind stress with respect
ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1].
tau_mag => NULL(), & !< Magnitude of the wind stress averaged over tracer cells,
!! including any contributions from sub-gridscale variability
!! or gustiness [R L Z T-2 ~> Pa]
- ustar_gustless => NULL() !< surface friction velocity scale without any
+ ustar_gustless => NULL(), & !< surface friction velocity scale without any
!! any augmentation for gustiness [Z T-1 ~> m s-1].
+ tau_mag_gustless => NULL() !< Magnitude of the wind stress averaged over tracer cells,
+ !! without any augmentation for sub-gridscale variability
+ !! or gustiness [R L Z T-2 ~> Pa]
! surface buoyancy force, used when temperature is not a state variable
real, pointer, dimension(:,:) :: &
@@ -135,8 +145,10 @@ module MOM_forcing_type
real, pointer, dimension(:,:) :: &
salt_flux => NULL(), & !< net salt flux into the ocean [R Z T-1 ~> kgSalt m-2 s-1]
salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler [R Z T-1 ~> kgSalt m-2 s-1]
- salt_flux_added => NULL() !< additional salt flux from restoring or flux adjustment before adjustment
+ salt_flux_added => NULL(), & !< additional salt flux from restoring or flux adjustment before adjustment
!! to net zero [R Z T-1 ~> kgSalt m-2 s-1]
+ salt_left_behind => NULL() !< salt left in ocean at the surface from brine rejection
+ !! [R Z T-1 ~> kgSalt m-2 s-1]
! applied surface pressure from other component models (e.g., atmos, sea ice, land ice)
real, pointer, dimension(:,:) :: p_surf_full => NULL()
@@ -227,8 +239,8 @@ module MOM_forcing_type
tau_mag => NULL(), & !< Magnitude of the wind stress averaged over tracer cells, including any
!! contributions from sub-gridscale variability or gustiness [R L Z T-2 ~> Pa]
ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1].
- net_mass_src => NULL(), & !< The net mass source to the ocean [R Z T-1 ~> kg m-2 s-1]
- omega_w2x => NULL() !< the counter-clockwise angle of the wind stress with respect
+ net_mass_src => NULL() !< The net mass source to the ocean [R Z T-1 ~> kg m-2 s-1]
+ !omega_w2x => NULL() !< the counter-clockwise angle of the wind stress with respect
!! to the horizontal abscissa (x-coordinate) at tracer points [rad].
! applied surface pressure from other component models (e.g., atmos, sea ice, land ice)
@@ -349,6 +361,7 @@ module MOM_forcing_type
integer :: id_saltflux = -1
integer :: id_saltFluxIn = -1
integer :: id_saltFluxAdded = -1
+ integer :: id_saltFluxBehind = -1
integer :: id_total_saltflux = -1
integer :: id_total_saltFluxIn = -1
@@ -365,7 +378,7 @@ module MOM_forcing_type
integer :: id_taux = -1
integer :: id_tauy = -1
integer :: id_ustar = -1
- integer :: id_omega_w2x = -1
+ !integer :: id_omega_w2x = -1
integer :: id_tau_mag = -1
integer :: id_psurf = -1
integer :: id_TKE_tidal = -1
@@ -744,15 +757,15 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
endif
! Salt fluxes
- Net_salt(i) = 0.0
- if (do_NSR) Net_salt_rate(i) = 0.0
+ net_salt(i) = 0.0
+ if (do_NSR) net_salt_rate(i) = 0.0
! Convert salt_flux from kg (salt)/(m^2 * s) to
! Boussinesq: (ppt * m)
! non-Bouss: (g/m^2)
if (associated(fluxes%salt_flux)) then
- Net_salt(i) = (scale * dt * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H
+ net_salt(i) = (scale * dt * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H
!Repeat above code for 'rate' term
- if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H
+ if (do_NSR) net_salt_rate(i) = (scale * 1. * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H
endif
! Diagnostics follow...
@@ -973,18 +986,25 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt
real, dimension(SZI_(G)) :: netEvap ! net FW flux leaving ocean via evaporation
! [H T-1 ~> m s-1 or kg m-2 s-1]
real, dimension(SZI_(G)) :: netHeat ! net temp flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
+ real, dimension(SZI_(G), SZK_(GV)) :: dz ! Layer thicknesses in depth units [Z ~> m]
real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band
! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa]
real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R C-1 ~> kg m-3 degC-1]
real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R S-1 ~> kg m-3 ppt-1]
+ real, dimension(SZI_(G)) :: dSpV_dT ! Partial derivative of specific volume with respect
+ ! to temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ real, dimension(SZI_(G)) :: dSpV_dS ! Partial derivative of specific volume with respect
+ ! to salinity [R-1 S-1 ~> m3 kg-1 ppt-1]
real, dimension(SZI_(G),SZK_(GV)+1) :: netPen ! The net penetrating shortwave radiation at each level
! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
logical :: useRiverHeatContent
logical :: useCalvingHeatContent
- real :: GoRho ! The gravitational acceleration divided by mean density times a
- ! unit conversion factor [L2 H-1 R-1 T-2 ~> m4 kg-1 s-2 or m7 kg-2 s-2]
+ real :: GoRho ! The gravitational acceleration divided by mean density times a
+ ! unit conversion factor [L2 H-1 R-1 T-2 ~> m4 kg-1 s-2 or m7 kg-2 s-2]
+ real :: g_conv ! The gravitational acceleration times the conversion factors from non-Boussinesq
+ ! thickness units to mass per units area [R L2 H-1 T-2 ~> kg m-2 s-2 or m s-2]
real :: H_limit_fluxes ! A depth scale that specifies when the ocean is shallow that
! it is necessary to eliminate fluxes [H ~> m or kg m-2]
integer :: i, k
@@ -994,9 +1014,6 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt
useCalvingHeatContent = .False.
H_limit_fluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H )
- pressure(:) = 0.
- if (associated(tv%p_surf)) then ; do i=G%isc,G%iec ; pressure(i) = tv%p_surf(i,j) ; enddo ; endif
- GoRho = (GV%g_Earth * GV%H_to_Z) / GV%Rho0
! The surface forcing is contained in the fluxes type.
! We aggregate the thermodynamic forcing for a time step into the following:
@@ -1012,13 +1029,10 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt
! Sum over bands and attenuate as a function of depth
! netPen is the netSW as a function of depth
- call sumSWoverBands(G, GV, US, h(:,j,:), optics_nbands(optics), optics, j, 1.0, &
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+ call sumSWoverBands(G, GV, US, h(:,j,:), dz, optics_nbands(optics), optics, j, 1.0, &
H_limit_fluxes, .true., penSWbnd, netPen)
- ! Density derivatives
- call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, &
- tv%eqn_of_state, EOS_domain(G%HI))
-
! Adjust netSalt to reflect dilution effect of FW flux
! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec)
@@ -1029,13 +1043,41 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt
!netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 )
netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1)
- ! Convert to a buoyancy flux, excluding penetrating SW heating
- buoyancyFlux(G%isc:G%iec,1) = - GoRho * ( dRhodS(G%isc:G%iec) * netSalt(G%isc:G%iec) + &
- dRhodT(G%isc:G%iec) * netHeat(G%isc:G%iec) ) ! [L2 T-3 ~> m2 s-3]
- ! We also have a penetrative buoyancy flux associated with penetrative SW
- do k=2, GV%ke+1
- buoyancyFlux(G%isc:G%iec,k) = - GoRho * ( dRhodT(G%isc:G%iec) * netPen(G%isc:G%iec,k) ) ! [L2 T-3 ~> m2 s-3]
- enddo
+ ! Determine the buoyancy flux
+ pressure(:) = 0.
+ if (associated(tv%p_surf)) then ; do i=G%isc,G%iec ; pressure(i) = tv%p_surf(i,j) ; enddo ; endif
+
+ if ((.not.GV%Boussinesq) .and. (.not.GV%semi_Boussinesq)) then
+ g_conv = GV%g_Earth * GV%H_to_RZ
+
+ ! Specific volume derivatives
+ call calculate_specific_vol_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dSpV_dT, dSpV_dS, &
+ tv%eqn_of_state, EOS_domain(G%HI))
+
+ ! Convert to a buoyancy flux [L2 T-3 ~> m2 s-3], first excluding penetrating SW heating
+ do i=G%isc,G%iec
+ buoyancyFlux(i,1) = g_conv * (dSpV_dS(i) * netSalt(i) + dSpV_dT(i) * netHeat(i))
+ enddo
+ ! We also have a penetrative buoyancy flux associated with penetrative SW
+ do k=2,GV%ke+1 ; do i=G%isc,G%iec
+ buoyancyFlux(i,k) = g_conv * ( dSpV_dT(i) * netPen(i,k) ) ! [L2 T-3 ~> m2 s-3]
+ enddo ; enddo
+ else
+ GoRho = (GV%g_Earth * GV%H_to_Z) / GV%Rho0
+
+ ! Density derivatives
+ call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, &
+ tv%eqn_of_state, EOS_domain(G%HI))
+
+ ! Convert to a buoyancy flux [L2 T-3 ~> m2 s-3], excluding penetrating SW heating
+ do i=G%isc,G%iec
+ buoyancyFlux(i,1) = - GoRho * ( dRhodS(i) * netSalt(i) + dRhodT(i) * netHeat(i) )
+ enddo
+ ! We also have a penetrative buoyancy flux associated with penetrative SW
+ do k=2,GV%ke+1 ; do i=G%isc,G%iec
+ buoyancyFlux(i,k) = - GoRho * ( dRhodT(i) * netPen(i,k) ) ! [L2 T-3 ~> m2 s-3]
+ enddo ; enddo
+ endif
end subroutine calculateBuoyancyFlux1d
@@ -1071,6 +1113,139 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv,
end subroutine calculateBuoyancyFlux2d
+!> Determine the friction velocity from the contenxts of a forcing type, perhaps
+!! using the evolving surface density.
+subroutine find_ustar_fluxes(fluxes, tv, U_star, G, GV, US, halo, H_T_units)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(forcing), intent(in) :: fluxes !< Surface fluxes container
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields.
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(out) :: U_star !< The surface friction velocity [Z T-1 ~> m s-1] or
+ !! [H T-1 ~> m s-1 or kg m-2 s-1], depending on H_T_units.
+ integer, optional, intent(in) :: halo !< The extra halo size to fill in, 0 by default
+ logical, optional, intent(in) :: H_T_units !< If present and true, return U_star in units
+ !! of [H T-1 ~> m s-1 or kg m-2 s-1]
+
+ ! Local variables
+ real :: I_rho ! The inverse of the reference density times a ratio of scaling
+ ! factors [Z L-1 R-1 ~> m3 kg-1] or in some semi-Boussinesq cases
+ ! the rescaled reference density [H2 Z-1 L-1 R-1 ~> m3 kg-1 or kg m-3]
+ logical :: Z_T_units ! If true, U_star is returned in units of [Z T-1 ~> m s-1], otherwise it is
+ ! returned in [H T-1 ~> m s-1 or kg m-2 s-1]
+ integer :: i, j, k, is, ie, js, je, hs
+
+ hs = 0 ; if (present(halo)) hs = max(halo, 0)
+ is = G%isc - hs ; ie = G%iec + hs ; js = G%jsc - hs ; je = G%jec + hs
+
+ Z_T_units = .true. ; if (present(H_T_units)) Z_T_units = .not.H_T_units
+
+ if (.not.(associated(fluxes%ustar) .or. associated(fluxes%tau_mag))) &
+ call MOM_error(FATAL, "find_ustar_fluxes requires that either ustar or tau_mag be associated.")
+
+ if (associated(fluxes%ustar) .and. (GV%Boussinesq .or. .not.associated(fluxes%tau_mag))) then
+ if (Z_T_units) then
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = fluxes%ustar(i,j)
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = GV%Z_to_H * fluxes%ustar(i,j)
+ enddo ; enddo
+ endif
+ elseif (allocated(tv%SpV_avg)) then
+ if (tv%valid_SpV_halo < 0) call MOM_error(FATAL, &
+ "find_ustar_fluxes called in non-Boussinesq mode with invalid values of SpV_avg.")
+ if (tv%valid_SpV_halo < hs) call MOM_error(FATAL, &
+ "find_ustar_fluxes called in non-Boussinesq mode with insufficient valid values of SpV_avg.")
+ if (Z_T_units) then
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = sqrt(US%L_to_Z*fluxes%tau_mag(i,j) * tv%SpV_avg(i,j,1))
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = GV%RZ_to_H * sqrt(US%L_to_Z*fluxes%tau_mag(i,j) / tv%SpV_avg(i,j,1))
+ enddo ; enddo
+ endif
+ else
+ I_rho = US%L_to_Z * GV%Z_to_H * GV%RZ_to_H
+ if (Z_T_units) I_rho = US%L_to_Z * GV%H_to_Z * GV%RZ_to_H ! == US%L_to_Z / GV%Rho0
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = sqrt(fluxes%tau_mag(i,j) * I_rho)
+ enddo ; enddo
+ endif
+
+end subroutine find_ustar_fluxes
+
+
+!> Determine the friction velocity from the contenxts of a forcing type, perhaps
+!! using the evolving surface density.
+subroutine find_ustar_mech_forcing(forces, tv, U_star, G, GV, US, halo, H_T_units)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(mech_forcing), intent(in) :: forces !< Surface forces container
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields.
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(out) :: U_star !< The surface friction velocity [Z T-1 ~> m s-1]
+ integer, optional, intent(in) :: halo !< The extra halo size to fill in, 0 by default
+ logical, optional, intent(in) :: H_T_units !< If present and true, return U_star in units
+ !! of [H T-1 ~> m s-1 or kg m-2 s-1]
+
+ ! Local variables
+ real :: I_rho ! The inverse of the reference density times a ratio of scaling
+ ! factors [Z L-1 R-1 ~> m3 kg-1] or in some semi-Boussinesq cases
+ ! the rescaled reference density [H2 Z-1 L-1 R-1 ~> m3 kg-1 or kg m-3]
+ logical :: Z_T_units ! If true, U_star is returned in units of [Z T-1 ~> m s-1], otherwise it is
+ ! returned in [H T-1 ~> m s-1 or kg m-2 s-1]
+ integer :: i, j, k, is, ie, js, je, hs
+
+ hs = 0 ; if (present(halo)) hs = max(halo, 0)
+ is = G%isc - hs ; ie = G%iec + hs ; js = G%jsc - hs ; je = G%jec + hs
+
+ Z_T_units = .true. ; if (present(H_T_units)) Z_T_units = .not.H_T_units
+
+ if (.not.(associated(forces%ustar) .or. associated(forces%tau_mag))) &
+ call MOM_error(FATAL, "find_ustar_mech requires that either ustar or tau_mag be associated.")
+
+ if (associated(forces%ustar) .and. (GV%Boussinesq .or. .not.associated(forces%tau_mag))) then
+ if (Z_T_units) then
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = forces%ustar(i,j)
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = GV%Z_to_H * forces%ustar(i,j)
+ enddo ; enddo
+ endif
+ elseif (allocated(tv%SpV_avg)) then
+ if (tv%valid_SpV_halo < 0) call MOM_error(FATAL, &
+ "find_ustar_mech called in non-Boussinesq mode with invalid values of SpV_avg.")
+ if (tv%valid_SpV_halo < hs) call MOM_error(FATAL, &
+ "find_ustar_mech called in non-Boussinesq mode with insufficient valid values of SpV_avg.")
+ if (Z_T_units) then
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = sqrt(US%L_to_Z*forces%tau_mag(i,j) * tv%SpV_avg(i,j,1))
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = GV%RZ_to_H * sqrt(US%L_to_Z*forces%tau_mag(i,j) / tv%SpV_avg(i,j,1))
+ enddo ; enddo
+ endif
+ else
+ I_rho = US%L_to_Z * GV%Z_to_H * GV%RZ_to_H
+ if (Z_T_units) I_rho = US%L_to_Z * GV%H_to_Z * GV%RZ_to_H ! == US%L_to_Z / GV%Rho0
+ do j=js,je ; do i=is,ie
+ U_star(i,j) = sqrt(forces%tau_mag(i,j) * I_rho)
+ enddo ; enddo
+ endif
+
+end subroutine find_ustar_mech_forcing
+
+
!> Write out chksums for thermodynamic fluxes.
subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift)
character(len=*), intent(in) :: mesg !< message
@@ -1331,8 +1506,8 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles,
'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', &
'm s-1', conversion=US%Z_to_m*US%s_to_T)
- handles%id_omega_w2x = register_diag_field('ocean_model', 'omega_w2x', diag%axesT1, Time, &
- 'Counter-clockwise angle of the wind stress from the horizontal axis.', 'rad')
+ !handles%id_omega_w2x = register_diag_field('ocean_model', 'omega_w2x', diag%axesT1, Time, &
+ ! 'Counter-clockwise angle of the wind stress from the horizontal axis.', 'rad')
if (present(use_berg_fluxes)) then
if (use_berg_fluxes) then
@@ -1925,6 +2100,10 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles,
diag%axesT1,Time,'Salt flux into ocean at surface due to restoring or flux adjustment', &
units='kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s)
+ handles%id_saltFluxBehind = register_diag_field('ocean_model', 'salt_left_behind', &
+ diag%axesT1,Time,'Salt left in ocean at surface due to ice formation', &
+ units='kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s)
+
handles%id_saltFluxGlobalAdj = register_scalar_field('ocean_model', &
'salt_flux_global_restoring_adjustment', Time, diag, &
'Adjustment needed to balance net global salt flux into ocean at surface', &
@@ -1991,7 +2170,7 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, G, wt2)
type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged
!! thermodynamic forcing fields
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
- real, intent(out) :: wt2 !< The relative weight of the new fluxes
+ real, intent(out) :: wt2 !< The relative weight of the new fluxes [nondim]
! This subroutine copies mechancal forcing from flux_tmp to fluxes and
! stores the time-weighted averages of the various buoyancy fluxes in fluxes,
@@ -2009,7 +2188,7 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces)
type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged
!! thermodynamic forcing fields
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
- real, intent(out) :: wt2 !< The relative weight of the new fluxes
+ real, intent(out) :: wt2 !< The relative weight of the new fluxes [nondim]
type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces
! This subroutine copies mechanical forcing from flux_tmp to fluxes and
@@ -2034,34 +2213,55 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces)
wt2 = 1.0 - wt1 ! = flux_tmp%dt_buoy_accum / (fluxes%dt_buoy_accum + flux_tmp%dt_buoy_accum)
fluxes%dt_buoy_accum = fluxes%dt_buoy_accum + flux_tmp%dt_buoy_accum
- ! Copy over the pressure fields and accumulate averages of ustar, either from the forcing
+ ! Copy over the pressure fields and accumulate averages of ustar or tau_mag, either from the forcing
! type or from the temporary fluxes type.
if (present(forces)) then
do j=js,je ; do i=is,ie
fluxes%p_surf(i,j) = forces%p_surf(i,j)
fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j)
+ enddo ; enddo
+ if (associated(fluxes%ustar)) then ; do j=js,je ; do i=is,ie
fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j)
+ enddo ; enddo ; endif
+ if (associated(fluxes%tau_mag)) then ; do j=js,je ; do i=is,ie
fluxes%tau_mag(i,j) = wt1*fluxes%tau_mag(i,j) + wt2*forces%tau_mag(i,j)
- enddo ; enddo
+ enddo ; enddo ; endif
else
do j=js,je ; do i=is,ie
fluxes%p_surf(i,j) = flux_tmp%p_surf(i,j)
fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j)
+ enddo ; enddo
+ if (associated(fluxes%ustar)) then ; do j=js,je ; do i=is,ie
fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j)
+ enddo ; enddo ; endif
+ if (associated(fluxes%tau_mag)) then ; do j=js,je ; do i=is,ie
fluxes%tau_mag(i,j) = wt1*fluxes%tau_mag(i,j) + wt2*flux_tmp%tau_mag(i,j)
- enddo ; enddo
+ enddo ; enddo ; endif
endif
- ! Average the water, heat, and salt fluxes, and ustar.
- do j=js,je ; do i=is,ie
+ ! Average ustar_gustless.
+ if (associated(fluxes%ustar_gustless)) then
if (fluxes%gustless_accum_bug) then
- fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j)
+ do j=js,je ; do i=is,ie
+ fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j)
+ enddo ; enddo
else
- fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j)
+ do j=js,je ; do i=is,ie
+ fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j)
+ enddo ; enddo
endif
+ endif
+ if (associated(fluxes%tau_mag_gustless)) then
+ do j=js,je ; do i=is,ie
+ fluxes%tau_mag_gustless(i,j) = wt1*fluxes%tau_mag_gustless(i,j) + wt2*flux_tmp%tau_mag_gustless(i,j)
+ enddo ; enddo
+ endif
+
+ ! Average the water, heat, and salt fluxes.
+ do j=js,je ; do i=is,ie
fluxes%evap(i,j) = wt1*fluxes%evap(i,j) + wt2*flux_tmp%evap(i,j)
fluxes%lprec(i,j) = wt1*fluxes%lprec(i,j) + wt2*flux_tmp%lprec(i,j)
fluxes%fprec(i,j) = wt1*fluxes%fprec(i,j) + wt2*flux_tmp%fprec(i,j)
@@ -2170,12 +2370,11 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres)
fluxes%ustar(i,j) = forces%ustar(i,j)
enddo ; enddo
endif
-
- if (associated(forces%omega_w2x) .and. associated(fluxes%omega_w2x)) then
- do j=js,je ; do i=is,ie
- fluxes%omega_w2x(i,j) = forces%omega_w2x(i,j)
- enddo ; enddo
- endif
+ !if (associated(forces%omega_w2x) .and. associated(fluxes%omega_w2x)) then
+ ! do j=js,je ; do i=is,ie
+ ! fluxes%omega_w2x(i,j) = forces%omega_w2x(i,j)
+ ! enddo ; enddo
+ !endif
if (associated(forces%tau_mag) .and. associated(fluxes%tau_mag)) then
do j=js,je ; do i=is,ie
fluxes%tau_mag(i,j) = forces%tau_mag(i,j)
@@ -2221,8 +2420,8 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0)
Irho0 = US%L_to_Z / Rho0
- if (associated(forces%taux) .and. associated(forces%tauy) .and. &
- associated(fluxes%ustar_gustless)) then
+ if ( associated(forces%taux) .and. associated(forces%tauy) .and. &
+ (associated(fluxes%ustar_gustless) .or. associated(fluxes%tau_mag_gustless)) ) then
do j=js,je ; do i=is,ie
taux2 = 0.0
if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0.0) &
@@ -2235,11 +2434,16 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0)
G%mask2dCv(i,J) * forces%tauy(i,J)**2) / &
(G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
- if (fluxes%gustless_accum_bug) then
- ! This change is just for computational efficiency, but it is wrapped with another change.
- fluxes%ustar_gustless(i,j) = sqrt(US%L_to_Z * sqrt(taux2 + tauy2) / Rho0)
- else
- fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0)
+ if (associated(fluxes%ustar_gustless)) then
+ if (fluxes%gustless_accum_bug) then
+ ! This change is just for computational efficiency, but it is wrapped with another change.
+ fluxes%ustar_gustless(i,j) = sqrt(US%L_to_Z * sqrt(taux2 + tauy2) / Rho0)
+ else
+ fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0)
+ endif
+ endif
+ if (associated(fluxes%tau_mag_gustless)) then
+ fluxes%tau_mag_gustless(i,j) = sqrt(taux2 + tauy2)
endif
enddo ; enddo
endif
@@ -2312,12 +2516,11 @@ subroutine copy_back_forcing_fields(fluxes, forces, G)
forces%ustar(i,j) = fluxes%ustar(i,j)
enddo ; enddo
endif
-
- if (associated(forces%omega_w2x) .and. associated(fluxes%omega_w2x)) then
- do j=js,je ; do i=is,ie
- forces%omega_w2x(i,j) = fluxes%omega_w2x(i,j)
- enddo ; enddo
- endif
+ !if (associated(forces%omega_w2x) .and. associated(fluxes%omega_w2x)) then
+ ! do j=js,je ; do i=is,ie
+ ! forces%omega_w2x(i,j) = fluxes%omega_w2x(i,j)
+ ! enddo ; enddo
+ !endif
if (associated(forces%tau_mag) .and. associated(fluxes%tau_mag)) then
do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = fluxes%tau_mag(i,j)
@@ -2928,6 +3131,9 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
call post_data(handles%id_total_saltFluxIn, total_transport, diag)
endif
+ if (handles%id_saltFluxBehind > 0 .and. associated(fluxes%salt_left_behind)) &
+ call post_data(handles%id_saltFluxBehind, fluxes%salt_left_behind, diag)
+
if (handles%id_saltFluxGlobalAdj > 0) &
call post_data(handles%id_saltFluxGlobalAdj, fluxes%saltFluxGlobalAdj, diag)
if (handles%id_vPrecGlobalAdj > 0) &
@@ -2966,8 +3172,8 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) &
call post_data(handles%id_ustar, fluxes%ustar, diag)
- if ((handles%id_omega_w2x > 0) .and. associated(fluxes%omega_w2x)) &
- call post_data(handles%id_omega_w2x, fluxes%omega_w2x, diag)
+ !if ((handles%id_omega_w2x > 0) .and. associated(fluxes%omega_w2x)) &
+ ! call post_data(handles%id_omega_w2x, fluxes%omega_w2x, diag)
if ((handles%id_ustar_berg > 0) .and. associated(fluxes%ustar_berg)) &
call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag)
@@ -2997,7 +3203,7 @@ end subroutine forcing_diagnostics
!> Conditionally allocate fields within the forcing type
subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
shelf, iceberg, salt, fix_accum_bug, cfc, waves, &
- shelf_sfc_accumulation, lamult, hevap)
+ shelf_sfc_accumulation, lamult, hevap, tau_mag)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields
logical, optional, intent(in) :: water !< If present and true, allocate water fluxes
@@ -3019,6 +3225,7 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
logical, optional, intent(in) :: hevap !< If present and true, allocate heat content evap.
!! This field must be allocated when enthalpy is provided
!! via coupler.
+ logical, optional, intent(in) :: tau_mag !< If present and true, allocate tau_mag and related fields
! Local variables
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
@@ -3038,6 +3245,10 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
call myAlloc(fluxes%ustar_gustless,isd,ied,jsd,jed, ustar)
call myAlloc(fluxes%tau_mag,isd,ied,jsd,jed, ustar)
+ ! Note that myAlloc can be called safely multiple times for the same pointer.
+ call myAlloc(fluxes%tau_mag,isd,ied,jsd,jed, tau_mag)
+ call myAlloc(fluxes%tau_mag_gustless,isd,ied,jsd,jed, tau_mag)
+
call myAlloc(fluxes%evap,isd,ied,jsd,jed, water)
call myAlloc(fluxes%lprec,isd,ied,jsd,jed, water)
call myAlloc(fluxes%fprec,isd,ied,jsd,jed, water)
@@ -3096,20 +3307,20 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
if (present(fix_accum_bug)) fluxes%gustless_accum_bug = .not.fix_accum_bug
end subroutine allocate_forcing_by_group
-
+!> Allocate elements of a new forcing type based on their status in an existing type.
subroutine allocate_forcing_by_ref(fluxes_ref, G, fluxes)
- type(forcing), intent(in) :: fluxes_ref !< Reference fluxes
- type(ocean_grid_type), intent(in) :: G !< Grid metric of target fluxes
- type(forcing), intent(out) :: fluxes !< Target fluxes
+ type(forcing), intent(in) :: fluxes_ref !< Reference fluxes
+ type(ocean_grid_type), intent(in) :: G !< Grid metric of target fluxes
+ type(forcing), intent(out) :: fluxes !< Target fluxes
- logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, &
- do_iceberg, do_heat_added, do_buoy
+ logical :: do_ustar, do_taumag, do_water, do_heat, do_salt, do_press, do_shelf
+ logical :: do_iceberg, do_heat_added, do_buoy
- call get_forcing_groups(fluxes_ref, do_water, do_heat, do_ustar, do_press, &
+ call get_forcing_groups(fluxes_ref, do_water, do_heat, do_ustar, do_taumag, do_press, &
do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy)
call allocate_forcing_type(G, fluxes, do_water, do_heat, do_ustar, &
- do_press, do_shelf, do_iceberg, do_salt)
+ do_press, do_shelf, do_iceberg, do_salt, tau_mag=do_taumag)
! The following fluxes would typically be allocated by the driver
call myAlloc(fluxes%sw_vis_dir, G%isd, G%ied, G%jsd, G%jed, &
@@ -3148,7 +3359,7 @@ end subroutine allocate_forcing_by_ref
!> Conditionally allocate fields within the mechanical forcing type using
!! control flags.
subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, &
- press, iceberg, waves, num_stk_bands)
+ press, iceberg, waves, num_stk_bands, tau_mag)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(mech_forcing), intent(inout) :: forces !< Forcing fields structure
@@ -3159,6 +3370,7 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, &
logical, optional, intent(in) :: iceberg !< If present and true, allocate forces for icebergs
logical, optional, intent(in) :: waves !< If present and true, allocate wave fields
integer, optional, intent(in) :: num_stk_bands !< Number of Stokes bands to allocate
+ logical, optional, intent(in) :: tau_mag !< If present and true, allocate tau_mag
! Local variables
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
@@ -3171,6 +3383,8 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, &
call myAlloc(forces%ustar,isd,ied,jsd,jed, ustar)
call myAlloc(forces%tau_mag,isd,ied,jsd,jed, ustar)
+ ! Note that myAlloc can be called safely multiple times for the same pointer.
+ call myAlloc(forces%tau_mag,isd,ied,jsd,jed, tau_mag)
call myAlloc(forces%p_surf,isd,ied,jsd,jed, press)
call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press)
@@ -3210,24 +3424,25 @@ subroutine allocate_mech_forcing_from_ref(forces_ref, G, forces)
type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing
type(mech_forcing), intent(out) :: forces !< Mechanical forcing fields
- logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg
+ logical :: do_stress, do_ustar, do_tau_mag, do_shelf, do_press, do_iceberg
! Identify the active fields in the reference forcing
- call get_mech_forcing_groups(forces_ref, do_stress, do_ustar, do_shelf, &
- do_press, do_iceberg)
+ call get_mech_forcing_groups(forces_ref, do_stress, do_ustar, do_tau_mag, do_shelf, &
+ do_press, do_iceberg)
call allocate_mech_forcing(G, forces, do_stress, do_ustar, do_shelf, &
- do_press, do_iceberg)
+ do_press, do_iceberg, tau_mag=do_tau_mag)
end subroutine allocate_mech_forcing_from_ref
!> Return flags indicating which groups of forcings are allocated
-subroutine get_forcing_groups(fluxes, water, heat, ustar, press, shelf, &
+subroutine get_forcing_groups(fluxes, water, heat, ustar, tau_mag, press, shelf, &
iceberg, salt, heat_added, buoy)
type(forcing), intent(in) :: fluxes !< Reference flux fields
logical, intent(out) :: water !< True if fluxes contains water-based fluxes
logical, intent(out) :: heat !< True if fluxes contains heat-based fluxes
- logical, intent(out) :: ustar !< True if fluxes contains ustar fluxes
+ logical, intent(out) :: ustar !< True if fluxes contains ustar
+ logical, intent(out) :: tau_mag !< True if fluxes contains tau_mag
logical, intent(out) :: press !< True if fluxes contains surface pressure
logical, intent(out) :: shelf !< True if fluxes contains ice shelf fields
logical, intent(out) :: iceberg !< True if fluxes contains iceberg fluxes
@@ -3240,6 +3455,7 @@ subroutine get_forcing_groups(fluxes, water, heat, ustar, press, shelf, &
! we handle them here as independent flags.
ustar = associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless)
+ tau_mag = associated(fluxes%tau_mag) .and. associated(fluxes%tau_mag_gustless)
! TODO: Check for all associated fields, but for now just check one as a marker
water = associated(fluxes%evap)
heat = associated(fluxes%seaice_melt_heat)
@@ -3253,10 +3469,11 @@ end subroutine get_forcing_groups
!> Return flags indicating which groups of mechanical forcings are allocated
-subroutine get_mech_forcing_groups(forces, stress, ustar, shelf, press, iceberg)
+subroutine get_mech_forcing_groups(forces, stress, ustar, tau_mag, shelf, press, iceberg)
type(mech_forcing), intent(in) :: forces !< Reference forcing fields
logical, intent(out) :: stress !< True if forces contains wind stress fields
logical, intent(out) :: ustar !< True if forces contains ustar field
+ logical, intent(out) :: tau_mag !< True if forces contains tau_mag field
logical, intent(out) :: shelf !< True if forces contains ice shelf fields
logical, intent(out) :: press !< True if forces contains pressure fields
logical, intent(out) :: iceberg !< True if forces contains iceberg fields
@@ -3264,6 +3481,7 @@ subroutine get_mech_forcing_groups(forces, stress, ustar, shelf, press, iceberg)
stress = associated(forces%taux) &
.and. associated(forces%tauy)
ustar = associated(forces%ustar)
+ tau_mag = associated(forces%tau_mag)
shelf = associated(forces%rigidity_ice_u) &
.and. associated(forces%rigidity_ice_v) &
.and. associated(forces%frac_shelf_u) &
@@ -3294,7 +3512,7 @@ end subroutine myAlloc
subroutine deallocate_forcing_type(fluxes)
type(forcing), intent(inout) :: fluxes !< Forcing fields structure
- if (associated(fluxes%omega_w2x)) deallocate(fluxes%omega_w2x)
+ !if (associated(fluxes%omega_w2x)) deallocate(fluxes%omega_w2x)
if (associated(fluxes%ustar)) deallocate(fluxes%ustar)
if (associated(fluxes%ustar_gustless)) deallocate(fluxes%ustar_gustless)
if (associated(fluxes%tau_mag)) deallocate(fluxes%tau_mag)
@@ -3354,7 +3572,7 @@ end subroutine deallocate_forcing_type
subroutine deallocate_mech_forcing(forces)
type(mech_forcing), intent(inout) :: forces !< Forcing fields structure
- if (associated(forces%omega_w2x)) deallocate(forces%omega_w2x)
+ !if (associated(forces%omega_w2x)) deallocate(forces%omega_w2x)
if (associated(forces%taux)) deallocate(forces%taux)
if (associated(forces%tauy)) deallocate(forces%tauy)
if (associated(forces%ustar)) deallocate(forces%ustar)
@@ -3378,17 +3596,21 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns)
type(forcing), intent(inout) :: fluxes !< Rotated forcing structure
integer, intent(in) :: turns !< Number of quarter turns
- logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, &
+ logical :: do_ustar, do_taumag, do_water, do_heat, do_salt, do_press, do_shelf, &
do_iceberg, do_heat_added, do_buoy
- call get_forcing_groups(fluxes_in, do_water, do_heat, do_ustar, do_press, &
+ call get_forcing_groups(fluxes_in, do_water, do_heat, do_ustar, do_taumag, do_press, &
do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy)
- if (do_ustar) then
+ if (associated(fluxes_in%ustar)) &
call rotate_array(fluxes_in%ustar, turns, fluxes%ustar)
+ if (associated(fluxes_in%ustar_gustless)) &
call rotate_array(fluxes_in%ustar_gustless, turns, fluxes%ustar_gustless)
+
+ if (associated(fluxes_in%tau_mag)) &
call rotate_array(fluxes_in%tau_mag, turns, fluxes%tau_mag)
- endif
+ if (associated(fluxes_in%tau_mag_gustless)) &
+ call rotate_array(fluxes_in%tau_mag_gustless, turns, fluxes%tau_mag_gustless)
if (do_water) then
call rotate_array(fluxes_in%evap, turns, fluxes%evap)
@@ -3509,19 +3731,19 @@ subroutine rotate_mech_forcing(forces_in, turns, forces)
integer, intent(in) :: turns !< Number of quarter-turns
type(mech_forcing), intent(inout) :: forces !< Forcing on the rotated domain
- logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg
+ logical :: do_stress, do_ustar, do_tau_mag, do_shelf, do_press, do_iceberg
- call get_mech_forcing_groups(forces_in, do_stress, do_ustar, do_shelf, &
+ call get_mech_forcing_groups(forces_in, do_stress, do_ustar, do_tau_mag, do_shelf, &
do_press, do_iceberg)
if (do_stress) &
call rotate_vector(forces_in%taux, forces_in%tauy, turns, &
forces%taux, forces%tauy)
- if (do_ustar) then
+ if (associated(forces_in%ustar)) &
call rotate_array(forces_in%ustar, turns, forces%ustar)
+ if (associated(forces_in%tau_mag)) &
call rotate_array(forces_in%tau_mag, turns, forces%tau_mag)
- endif
if (do_shelf) then
call rotate_array_pair( &
@@ -3565,8 +3787,9 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar)
!! or updated from mean tau.
real :: tx_mean, ty_mean ! Mean wind stresses [R L Z T-2 ~> Pa]
+ real :: tau_mag ! The magnitude of the wind stresses [R L Z T-2 ~> Pa]
real :: Irho0 ! Inverse of the mean density rescaled to [Z L-1 R-1 ~> m3 kg-1]
- logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg, tau2ustar
+ logical :: do_stress, do_ustar, do_taumag, do_shelf, do_press, do_iceberg, tau2ustar
integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB
@@ -3576,7 +3799,7 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar)
tau2ustar = .false.
if (present(UpdateUstar)) tau2ustar = UpdateUstar
- call get_mech_forcing_groups(forces, do_stress, do_ustar, do_shelf, &
+ call get_mech_forcing_groups(forces, do_stress, do_ustar, do_taumag, do_shelf, &
do_press, do_iceberg)
if (do_stress) then
@@ -3589,19 +3812,24 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar)
if (G%mask2dCv(i,J) > 0.0) forces%tauy(i,J) = ty_mean
enddo ; enddo
if (tau2ustar) then
- do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
- forces%tau_mag(i,j) = sqrt(tx_mean**2 + ty_mean**2)
- forces%ustar(i,j) = sqrt(forces%tau_mag(i,j) * Irho0)
- endif ; enddo ; enddo
+ tau_mag = sqrt(tx_mean**2 + ty_mean**2)
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
+ forces%tau_mag(i,j) = tau_mag
+ endif ; enddo ; enddo ; endif
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
+ forces%ustar(i,j) = sqrt(tau_mag * Irho0)
+ endif ; enddo ; enddo ; endif
else
- call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T)
- call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa)
+ if (associated(forces%ustar)) &
+ call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T)
+ if (associated(forces%tau_mag)) &
+ call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa)
endif
else
- if (do_ustar) then
+ if (associated(forces%ustar)) &
call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T)
+ if (associated(forces%tau_mag)) &
call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa)
- endif
endif
if (do_shelf) then
@@ -3632,17 +3860,21 @@ subroutine homogenize_forcing(fluxes, G, GV, US)
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, &
- do_iceberg, do_heat_added, do_buoy
+ logical :: do_ustar, do_taumag, do_water, do_heat, do_salt, do_press, do_shelf
+ logical :: do_iceberg, do_heat_added, do_buoy
- call get_forcing_groups(fluxes, do_water, do_heat, do_ustar, do_press, &
+ call get_forcing_groups(fluxes, do_water, do_heat, do_ustar, do_taumag, do_press, &
do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy)
- if (do_ustar) then
+ if (associated(fluxes%ustar)) &
call homogenize_field_t(fluxes%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T)
+ if (associated(fluxes%ustar_gustless)) &
call homogenize_field_t(fluxes%ustar_gustless, G, tmp_scale=US%Z_to_m*US%s_to_T)
+
+ if (associated(fluxes%tau_mag)) &
call homogenize_field_t(fluxes%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa)
- endif
+ if (associated(fluxes%tau_mag_gustless)) &
+ call homogenize_field_t(fluxes%tau_mag_gustless, G, tmp_scale=US%RLZ_T2_to_Pa)
if (do_water) then
call homogenize_field_t(fluxes%evap, G, tmp_scale=US%RZ_T_to_kg_m2s)
diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90
index 2e413e505b..52e37f1a9b 100644
--- a/src/core/MOM_grid.F90
+++ b/src/core/MOM_grid.F90
@@ -15,7 +15,7 @@ module MOM_grid
#include
public MOM_grid_init, MOM_grid_end, set_derived_metrics, set_first_direction
-public isPointInCell, hor_index_type, get_global_grid_size, rescale_grid_bathymetry
+public isPointInCell, hor_index_type, get_global_grid_size
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
@@ -136,14 +136,18 @@ module MOM_grid
IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2].
real, pointer, dimension(:) :: &
- gridLatT => NULL(), & !< The latitude of T points for the purpose of labeling the output axes.
+ gridLatT => NULL(), & !< The latitude of T points for the purpose of labeling the output axes,
+ !! often in units of [degrees_N] or [km] or [m] or [gridpoints].
!! On many grids this is the same as geoLatT.
- gridLatB => NULL() !< The latitude of B points for the purpose of labeling the output axes.
+ gridLatB => NULL() !< The latitude of B points for the purpose of labeling the output axes,
+ !! often in units of [degrees_N] or [km] or [m] or [gridpoints].
!! On many grids this is the same as geoLatBu.
real, pointer, dimension(:) :: &
- gridLonT => NULL(), & !< The longitude of T points for the purpose of labeling the output axes.
+ gridLonT => NULL(), & !< The longitude of T points for the purpose of labeling the output axes,
+ !! often in units of [degrees_E] or [km] or [m] or [gridpoints].
!! On many grids this is the same as geoLonT.
- gridLonB => NULL() !< The longitude of B points for the purpose of labeling the output axes.
+ gridLonB => NULL() !< The longitude of B points for the purpose of labeling the output axes,
+ !! often in units of [degrees_E] or [km] or [m] or [gridpoints].
!! On many grids this is the same as geoLonBu.
character(len=40) :: &
! Except on a Cartesian grid, these are usually some variant of "degrees".
@@ -187,8 +191,8 @@ module MOM_grid
! initialization routines (but not all)
real :: south_lat !< The latitude (or y-coordinate) of the first v-line [degrees_N] or [km] or [m]
real :: west_lon !< The longitude (or x-coordinate) of the first u-line [degrees_E] or [km] or [m]
- real :: len_lat !< The latitudinal (or y-coord) extent of physical domain
- real :: len_lon !< The longitudinal (or x-coord) extent of physical domain
+ real :: len_lat !< The latitudinal (or y-coord) extent of physical domain [degrees_N] or [km] or [m]
+ real :: len_lon !< The longitudinal (or x-coord) extent of physical domain [degrees_E] or [km] or [m]
real :: Rad_Earth !< The radius of the planet [m]
real :: Rad_Earth_L !< The radius of the planet in rescaled units [L ~> m]
real :: max_depth !< The maximum depth of the ocean in depth units [Z ~> m]
@@ -400,40 +404,6 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v
end subroutine MOM_grid_init
-!> rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid,
-!! both rescaling the depths and recording the new internal units.
-subroutine rescale_grid_bathymetry(G, m_in_new_units)
- type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure
- real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth.
- !### It appears that this routine is never called.
-
- ! Local variables
- real :: rescale ! A unit rescaling factor [various combinations of units ~> 1]
- integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
-
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
-
- if (m_in_new_units == 1.0) return
- if (m_in_new_units < 0.0) &
- call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.")
- if (m_in_new_units == 0.0) &
- call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.")
-
- rescale = 1.0 / m_in_new_units
- do j=jsd,jed ; do i=isd,ied
- G%bathyT(i,j) = rescale*G%bathyT(i,j)
- enddo ; enddo
- if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB
- G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j)
- enddo ; enddo ; endif
- if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied
- G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J)
- enddo ; enddo ; endif
- G%max_depth = rescale*G%max_depth
-
-end subroutine rescale_grid_bathymetry
-
!> set_derived_metrics calculates metric terms that are derived from other metrics.
subroutine set_derived_metrics(G, US)
type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure
diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90
index befeb1c2ad..6681034cb9 100644
--- a/src/core/MOM_interface_heights.F90
+++ b/src/core/MOM_interface_heights.F90
@@ -4,13 +4,14 @@ module MOM_interface_heights
! This file is part of MOM6. See LICENSE.md for the license.
use MOM_density_integrals, only : int_specific_vol_dp, avg_specific_vol
+use MOM_debugging, only : hchksum
use MOM_error_handler, only : MOM_error, FATAL
-use MOM_EOS, only : calculate_density, EOS_type, EOS_domain
-use MOM_file_parser, only : log_version
-use MOM_grid, only : ocean_grid_type
-use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : thermo_var_ptrs
-use MOM_verticalGrid, only : verticalGrid_type
+use MOM_EOS, only : calculate_density, average_specific_vol, EOS_type, EOS_domain
+use MOM_file_parser, only : log_version
+use MOM_grid, only : ocean_grid_type
+use MOM_unit_scaling, only : unit_scale_type
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
implicit none ; private
@@ -18,6 +19,7 @@ module MOM_interface_heights
public find_eta, dz_to_thickness, thickness_to_dz, dz_to_thickness_simple
public calc_derived_thermo
+public find_rho_bottom, find_col_avg_SpV
!> Calculates the heights of the free surface or all interfaces from layer thicknesses.
interface find_eta
@@ -64,7 +66,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, dZref)
real :: p(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa]
real :: dz_geo(SZI_(G),SZJ_(G),SZK_(GV)) ! The change in geopotential height
! across a layer [L2 T-2 ~> m2 s-2].
- real :: dilate(SZI_(G)) ! non-dimensional dilation factor
+ real :: dilate(SZI_(G)) ! A non-dimensional dilation factor [nondim]
real :: htot(SZI_(G)) ! total thickness [H ~> m or kg m-2]
real :: I_gEarth ! The inverse of the gravitational acceleration times the
! rescaling factor derived from eta_to_m [T2 Z L-2 ~> s2 m-1]
@@ -262,7 +264,7 @@ end subroutine find_eta_2d
!> Calculate derived thermodynamic quantities for re-use later.
-subroutine calc_derived_thermo(tv, h, G, GV, US, halo)
+subroutine calc_derived_thermo(tv, h, G, GV, US, halo, debug)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -271,13 +273,18 @@ subroutine calc_derived_thermo(tv, h, G, GV, US, halo)
!! which will be set here.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
- integer, optional, intent(in) :: halo !< Width of halo within which to
+ integer, optional, intent(in) :: halo !< Width of halo within which to
!! calculate thicknesses
+ logical, optional, intent(in) :: debug !< If present and true, write debugging checksums
! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: p_t ! Hydrostatic pressure atop a layer [R L2 T-2 ~> Pa]
real, dimension(SZI_(G),SZJ_(G)) :: dp ! Pressure change across a layer [R L2 T-2 ~> Pa]
+ real, dimension(SZK_(GV)) :: SpV_lay ! The specific volume of each layer when no equation of
+ ! state is used [R-1 ~> m3 kg-1]
+ logical :: do_debug ! If true, write checksums for debugging.
integer :: i, j, k, is, ie, js, je, halos, nz
+ do_debug = .false. ; if (present(debug)) do_debug = debug
halos = 0 ; if (present(halo)) halos = max(0,halo)
is = G%isc-halos ; ie = G%iec+halos ; js = G%jsc-halos ; je = G%jec+halos ; nz = GV%ke
@@ -296,10 +303,224 @@ subroutine calc_derived_thermo(tv, h, G, GV, US, halo)
p_t(i,j) = p_t(i,j) + dp(i,j)
enddo ; enddo ; endif
enddo
+ tv%valid_SpV_halo = halos
+
+ if (do_debug) then
+ call hchksum(h, "derived_thermo h", G%HI, haloshift=halos, scale=GV%H_to_MKS)
+ if (associated(tv%p_surf)) call hchksum(tv%p_surf, "derived_thermo p_surf", G%HI, &
+ haloshift=halos, scale=US%RL2_T2_to_Pa)
+ call hchksum(tv%T, "derived_thermo T", G%HI, haloshift=halos, scale=US%C_to_degC)
+ call hchksum(tv%S, "derived_thermo S", G%HI, haloshift=halos, scale=US%S_to_ppt)
+ endif
+ elseif (allocated(tv%Spv_avg)) then
+ do k=1,nz ; SpV_lay(k) = 1.0 / GV%Rlay(k) ; enddo
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ tv%SpV_avg(i,j,k) = SpV_lay(k)
+ enddo ; enddo ; enddo
+ tv%valid_SpV_halo = halos
endif
end subroutine calc_derived_thermo
+
+!> Determine the column average specific volumes.
+subroutine find_col_avg_SpV(h, SpV_avg, tv, G, GV, US, halo_size)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(inout) :: SpV_avg !< Column average specific volume [R-1 ~> m3 kg-1]
+ ! SpV_avg is intent inout to retain excess halo values.
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
+ integer, optional, intent(in) :: halo_size !< width of halo points on which to work
+
+ ! Local variables
+ real :: h_tot(SZI_(G)) ! Sum of the layer thicknesses [H ~> m or kg m-3]
+ real :: SpV_x_h_tot(SZI_(G)) ! Vertical sum of the layer average specific volume times
+ ! the layer thicknesses [H R-1 ~> m4 kg-1 or m]
+ real :: I_rho ! The inverse of the Boussiensq reference density [R-1 ~> m3 kg-1]
+ real :: SpV_lay(SZK_(GV)) ! The inverse of the layer target potential densities [R-1 ~> m3 kg-1]
+ character(len=128) :: mesg ! A string for error messages
+ integer i, j, k, is, ie, js, je, nz, halo
+
+ halo = 0 ; if (present(halo_size)) halo = max(0,halo_size)
+
+ is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
+ nz = GV%ke
+
+ if (GV%Boussinesq) then
+ I_rho = 1.0 / GV%Rho0
+ do j=js,je ; do i=is,ie
+ SpV_avg(i,j) = I_rho
+ enddo ; enddo
+ elseif (.not.allocated(tv%SpV_avg)) then
+ do k=1,nz ; Spv_lay(k) = 1.0 / GV%Rlay(k) ; enddo
+ do j=js,je
+ do i=is,ie ; SpV_x_h_tot(i) = 0.0 ; h_tot(i) = 0.0 ; enddo
+ do k=1,nz ; do i=is,ie
+ h_tot(i) = h_tot(i) + max(h(i,j,k), GV%H_subroundoff)
+ SpV_x_h_tot(i) = SpV_x_h_tot(i) + Spv_lay(k)*max(h(i,j,k), GV%H_subroundoff)
+ enddo ; enddo
+ do i=is,ie ; SpV_avg(i,j) = SpV_x_h_tot(i) / h_tot(i) ; enddo
+ enddo
+ else
+ ! Check that SpV_avg has been set.
+ if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < halo)) then
+ if (tv%valid_SpV_halo < 0) then
+ mesg = "invalid values of SpV_avg."
+ else
+ write(mesg, '("insufficiently large SpV_avg halos of width ", i2, " but ", i2," is needed.")') &
+ tv%valid_SpV_halo, halo
+ endif
+ call MOM_error(FATAL, "find_col_avg_SpV called in fully non-Boussinesq mode with "//trim(mesg))
+ endif
+
+ do j=js,je
+ do i=is,ie ; SpV_x_h_tot(i) = 0.0 ; h_tot(i) = 0.0 ; enddo
+ do k=1,nz ; do i=is,ie
+ h_tot(i) = h_tot(i) + max(h(i,j,k), GV%H_subroundoff)
+ SpV_x_h_tot(i) = SpV_x_h_tot(i) + tv%SpV_avg(i,j,k)*max(h(i,j,k), GV%H_subroundoff)
+ enddo ; enddo
+ do i=is,ie ; SpV_avg(i,j) = SpV_x_h_tot(i) / h_tot(i) ; enddo
+ enddo
+ endif
+
+end subroutine find_col_avg_SpV
+
+
+!> Determine the in situ density averaged over a specified distance from the bottom,
+!! calculating it as the inverse of the mass-weighted average specific volume.
+subroutine find_rho_bottom(h, dz, pres_int, dz_avg, tv, j, G, GV, US, Rho_bot)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: dz !< Height change across layers [Z ~> m]
+ real, dimension(SZI_(G),SZK_(GV)+1), &
+ intent(in) :: pres_int !< Pressure at each interface [R L2 T-2 ~> Pa]
+ real, dimension(SZI_(G)), intent(in) :: dz_avg !< The vertical distance over which to average [Z ~> m]
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
+ integer, intent(in) :: j !< j-index of row to work on
+ real, dimension(SZI_(G)), intent(out) :: Rho_bot !< Near-bottom density [R ~> kg m-3].
+
+ ! Local variables
+ real :: hb(SZI_(G)) ! Running sum of the thickness in the bottom boundary layer [H ~> m or kg m-2]
+ real :: SpV_h_bot(SZI_(G)) ! Running sum of the specific volume times thickness in the bottom
+ ! boundary layer [R-1 H ~> m4 kg-1 or m]
+ real :: dz_bbl_rem(SZI_(G)) ! Vertical extent of the boundary layer that has yet to be accounted
+ ! for [Z ~> m]
+ real :: h_bbl_frac(SZI_(G)) ! Thickness of the fractional layer that makes up the top of the
+ ! boundary layer [H ~> m or kg m-2]
+ real :: T_bbl(SZI_(G)) ! Temperature of the fractional layer that makes up the top of the
+ ! boundary layer [C ~> degC]
+ real :: S_bbl(SZI_(G)) ! Salinity of the fractional layer that makes up the top of the
+ ! boundary layer [S ~> ppt]
+ real :: P_bbl(SZI_(G)) ! Pressure the top of the boundary layer [R L2 T-2 ~> Pa]
+ real :: dp(SZI_(G)) ! Pressure change across the fractional layer that makes up the top
+ ! of the boundary layer [R L2 T-2 ~> Pa]
+ real :: SpV_bbl(SZI_(G)) ! In situ specific volume of the fractional layer that makes up the
+ ! top of the boundary layer [R-1 ~> m3 kg-1]
+ real :: frac_in ! The fraction of a layer that is within the bottom boundary layer [nondim]
+ logical :: do_i(SZI_(G)), do_any
+ logical :: use_EOS
+ integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
+ integer :: i, k, is, ie, nz
+
+ is = G%isc ; ie = G%iec ; nz = GV%ke
+
+ use_EOS = associated(tv%T) .and. associated(tv%S) .and. associated(tv%eqn_of_state)
+
+ if (GV%Boussinesq .or. GV%semi_Boussinesq .or. .not.allocated(tv%SpV_avg)) then
+ do i=is,ie
+ rho_bot(i) = GV%Rho0
+ enddo
+ else
+ ! Check that SpV_avg has been set.
+ if (tv%valid_SpV_halo < 0) call MOM_error(FATAL, &
+ "find_rho_bottom called in fully non-Boussinesq mode with invalid values of SpV_avg.")
+
+ ! Set the bottom density to the inverse of the in situ specific volume averaged over the
+ ! specified distance, with care taken to avoid having compressibility lead to an imprint
+ ! of the layer thicknesses on this density.
+ do i=is,ie
+ hb(i) = 0.0 ; SpV_h_bot(i) = 0.0
+ dz_bbl_rem(i) = G%mask2dT(i,j) * max(0.0, dz_avg(i))
+ do_i(i) = .true.
+ if (G%mask2dT(i,j) <= 0.0) then
+ ! Set acceptable values for calling the equation of state over land.
+ T_bbl(i) = 0.0 ; S_bbl(i) = 0.0 ; dp(i) = 0.0 ; P_bbl(i) = 0.0
+ SpV_bbl(i) = 1.0 ! This value is arbitrary, provided it is non-zero.
+ h_bbl_frac(i) = 0.0
+ do_i(i) = .false.
+ endif
+ enddo
+
+ do k=nz,1,-1
+ do_any = .false.
+ do i=is,ie ; if (do_i(i)) then
+ if (dz(i,k) < dz_bbl_rem(i)) then
+ ! This layer is fully within the averaging depth.
+ SpV_h_bot(i) = SpV_h_bot(i) + h(i,j,k) * tv%SpV_avg(i,j,k)
+ dz_bbl_rem(i) = dz_bbl_rem(i) - dz(i,k)
+ hb(i) = hb(i) + h(i,j,k)
+ do_any = .true.
+ else
+ if (dz(i,k) > 0.0) then
+ frac_in = dz_bbl_rem(i) / dz(i,k)
+ else
+ frac_in = 0.0
+ endif
+ if (use_EOS) then
+ ! Store the properties of this layer to determine the average
+ ! specific volume of the portion that is within the BBL.
+ T_bbl(i) = tv%T(i,j,k) ; S_bbl(i) = tv%S(i,j,k)
+ dp(i) = frac_in * (GV%g_Earth*GV%H_to_RZ * h(i,j,k))
+ P_bbl(i) = pres_int(i,K) + (1.0-frac_in) * (GV%g_Earth*GV%H_to_RZ * h(i,j,k))
+ else
+ SpV_bbl(i) = tv%SpV_avg(i,j,k)
+ endif
+ h_bbl_frac(i) = frac_in * h(i,j,k)
+ dz_bbl_rem(i) = 0.0
+ do_i(i) = .false.
+ endif
+ endif ; enddo
+ if (.not.do_any) exit
+ enddo
+ do i=is,ie ; if (do_i(i)) then
+ ! The nominal bottom boundary layer is thicker than the water column, but layer 1 is
+ ! already included in the averages. These values are set so that the call to find
+ ! the layer-average specific volume will behave sensibly.
+ if (use_EOS) then
+ T_bbl(i) = tv%T(i,j,1) ; S_bbl(i) = tv%S(i,j,1)
+ dp(i) = 0.0
+ P_bbl(i) = pres_int(i,1)
+ else
+ SpV_bbl(i) = tv%SpV_avg(i,j,1)
+ endif
+ h_bbl_frac(i) = 0.0
+ endif ; enddo
+
+ if (use_EOS) then
+ ! Find the average specific volume of the fractional layer atop the BBL.
+ EOSdom(:) = EOS_domain(G%HI)
+ call average_specific_vol(T_bbl, S_bbl, P_bbl, dp, SpV_bbl, tv%eqn_of_state, EOSdom)
+ endif
+
+ do i=is,ie
+ if (hb(i) + h_bbl_frac(i) < GV%H_subroundoff) h_bbl_frac(i) = GV%H_subroundoff
+ rho_bot(i) = G%mask2dT(i,j) * (hb(i) + h_bbl_frac(i)) / (SpV_h_bot(i) + h_bbl_frac(i)*SpV_bbl(i))
+ enddo
+ endif
+
+end subroutine find_rho_bottom
+
+
!> Converts thickness from geometric height units to thickness units, perhaps via an
!! inversion of the integral of the density in pressure using variables stored in
!! the thermo_var_ptrs type when in non-Boussinesq mode.
@@ -336,9 +557,7 @@ subroutine dz_to_thickness_tv(dz, tv, h, G, GV, US, halo_size)
endif
else
do k=1,nz ; do j=js,je ; do i=is,ie
- h(i,j,k) = (GV%Z_to_H*dz(i,j,k)) * (GV%Rlay(k) / GV%Rho0)
- ! Consider revising this to the mathematically equivalent expression:
- ! h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k)
+ h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k)
enddo ; enddo ; enddo
endif
endif
@@ -368,10 +587,15 @@ subroutine dz_to_thickness_EOS(dz, Temp, Saln, EoS, h, G, GV, US, halo_size, p_s
! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
p_top, p_bot ! Pressure at the interfaces above and below a layer [R L2 T-2 ~> Pa]
+ real :: dp(SZI_(G),SZJ_(G)) ! Pressure change across a layer [R L2 T-2 ~> Pa]
real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height across a layer [L2 T-2 ~> m2 s-2]
real :: rho(SZI_(G)) ! The in situ density [R ~> kg m-3]
+ real :: dp_adj ! The amount by which to change the bottom pressure in an
+ ! iteration [R L2 T-2 ~> Pa]
real :: I_gEarth ! Unit conversion factors divided by the gravitational
! acceleration [H T2 R-1 L-2 ~> s2 m2 kg-1 or s2 m-1]
+ logical :: do_more(SZI_(G),SZJ_(G)) ! If true, additional iterations would be beneficial.
+ logical :: do_any ! True if there are points in this layer that need more itertions.
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
integer :: i, j, k, is, ie, js, je, halo, nz
integer :: itt, max_itt
@@ -406,30 +630,58 @@ subroutine dz_to_thickness_EOS(dz, Temp, Saln, EoS, h, G, GV, US, halo_size, p_s
do i=is,ie ; p_top(i,j) = p_bot(i,j) ; enddo
call calculate_density(Temp(:,j,k), Saln(:,j,k), p_top(:,j), rho, &
EoS, EOSdom)
- do i=is,ie
- ! This could be simplified, but it would change answers at roundoff.
- p_bot(i,j) = p_top(i,j) + (GV%g_Earth*GV%H_to_Z) * ((GV%Z_to_H*dz(i,j,k)) * rho(i))
- enddo
+ ! The following two expressions are mathematically equivalent.
+ if (GV%semi_Boussinesq) then
+ do i=is,ie
+ p_bot(i,j) = p_top(i,j) + (GV%g_Earth*GV%H_to_Z) * ((GV%Z_to_H*dz(i,j,k)) * rho(i))
+ dp(i,j) = (GV%g_Earth*GV%H_to_Z) * ((GV%Z_to_H*dz(i,j,k)) * rho(i))
+ enddo
+ else
+ do i=is,ie
+ p_bot(i,j) = p_top(i,j) + rho(i) * (GV%g_Earth * dz(i,j,k))
+ dp(i,j) = rho(i) * (GV%g_Earth * dz(i,j,k))
+ enddo
+ endif
enddo
+ do_more(:,:) = .true.
do itt=1,max_itt
- call int_specific_vol_dp(Temp(:,:,k), Saln(:,:,k), p_top, p_bot, 0.0, G%HI, &
- EoS, US, dz_geo)
+ do_any = .false.
+ call int_specific_vol_dp(Temp(:,:,k), Saln(:,:,k), p_top, p_bot, 0.0, G%HI, EoS, US, dz_geo)
if (itt < max_itt) then ; do j=js,je
- call calculate_density(Temp(:,j,k), Saln(:,j,k), p_bot(:,j), rho, &
- EoS, EOSdom)
+ call calculate_density(Temp(:,j,k), Saln(:,j,k), p_bot(:,j), rho, EoS, EOSdom)
! Use Newton's method to correct the bottom value.
! The hydrostatic equation is sufficiently linear that no bounds-checking is needed.
- do i=is,ie
- p_bot(i,j) = p_bot(i,j) + rho(i) * ((GV%g_Earth*GV%H_to_Z)*(GV%Z_to_H*dz(i,j,k)) - dz_geo(i,j))
- enddo
+ if (GV%semi_Boussinesq) then
+ do i=is,ie
+ dp_adj = rho(i) * ((GV%g_Earth*GV%H_to_Z)*(GV%Z_to_H*dz(i,j,k)) - dz_geo(i,j))
+ p_bot(i,j) = p_bot(i,j) + dp_adj
+ dp(i,j) = dp(i,j) + dp_adj
+ enddo
+ do_any = .true. ! To avoid changing answers, always use the maximum number of itertions.
+ else
+ do i=is,ie ; if (do_more(i,j)) then
+ dp_adj = rho(i) * (GV%g_Earth*dz(i,j,k) - dz_geo(i,j))
+ p_bot(i,j) = p_bot(i,j) + dp_adj
+ dp(i,j) = dp(i,j) + dp_adj
+ ! Check for convergence to roundoff.
+ do_more(i,j) = (abs(dp_adj) > 1.0e-15*dp(i,j))
+ if (do_more(i,j)) do_any = .true.
+ endif ; enddo
+ endif
enddo ; endif
+ if (.not.do_any) exit
enddo
- do j=js,je ; do i=is,ie
- !### This code should be revised to use a dp variable for accuracy.
- h(i,j,k) = (p_bot(i,j) - p_top(i,j)) * I_gEarth
- enddo ; enddo
+ if (GV%semi_Boussinesq) then
+ do j=js,je ; do i=is,ie
+ h(i,j,k) = (p_bot(i,j) - p_top(i,j)) * I_gEarth
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ h(i,j,k) = dp(i,j) * I_gEarth
+ enddo ; enddo
+ endif
enddo
endif
@@ -463,7 +715,7 @@ subroutine dz_to_thickness_simple(dz, h, G, GV, US, halo_size, layer_mode)
layered = .false. ; if (present(layer_mode)) layered = layer_mode
is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke
- if (GV%Boussinesq .or. (.not.layered)) then
+ if (GV%Boussinesq) then
do k=1,nz ; do j=js,je ; do i=is,ie
h(i,j,k) = GV%Z_to_H * dz(i,j,k)
enddo ; enddo ; enddo
@@ -471,6 +723,10 @@ subroutine dz_to_thickness_simple(dz, h, G, GV, US, halo_size, layer_mode)
do k=1,nz ; do j=js,je ; do i=is,ie
h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k)
enddo ; enddo ; enddo
+ else
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ h(i,j,k) = (US%Z_to_m * GV%m_to_H) * dz(i,j,k)
+ enddo ; enddo ; enddo
endif
end subroutine dz_to_thickness_simple
@@ -493,12 +749,23 @@ subroutine thickness_to_dz_3d(h, tv, dz, G, GV, US, halo_size)
integer, optional, intent(in) :: halo_size !< Width of halo within which to
!! calculate thicknesses
! Local variables
+ character(len=128) :: mesg ! A string for error messages
integer :: i, j, k, is, ie, js, je, halo, nz
halo = 0 ; if (present(halo_size)) halo = max(0,halo_size)
is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke
if ((.not.GV%Boussinesq) .and. allocated(tv%SpV_avg)) then
+ if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < halo)) then
+ if (tv%valid_SpV_halo < 0) then
+ mesg = "invalid values of SpV_avg."
+ else
+ write(mesg, '("insufficiently large SpV_avg halos of width ", i2, " but ", i2," is needed.")') &
+ tv%valid_SpV_halo, halo
+ endif
+ call MOM_error(FATAL, "thickness_to_dz called in fully non-Boussinesq mode with "//trim(mesg))
+ endif
+
do k=1,nz ; do j=js,je ; do i=is,ie
dz(i,j,k) = GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)
enddo ; enddo ; enddo
@@ -529,12 +796,23 @@ subroutine thickness_to_dz_jslice(h, tv, dz, j, G, GV, halo_size)
integer, optional, intent(in) :: halo_size !< Width of halo within which to
!! calculate thicknesses
! Local variables
+ character(len=128) :: mesg ! A string for error messages
integer :: i, k, is, ie, halo, nz
halo = 0 ; if (present(halo_size)) halo = max(0,halo_size)
is = G%isc-halo ; ie = G%iec+halo ; nz = GV%ke
if ((.not.GV%Boussinesq) .and. allocated(tv%SpV_avg)) then
+ if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < halo)) then
+ if (tv%valid_SpV_halo < 0) then
+ mesg = "invalid values of SpV_avg."
+ else
+ write(mesg, '("insufficiently large SpV_avg halos of width ", i2, " but ", i2," is needed.")') &
+ tv%valid_SpV_halo, halo
+ endif
+ call MOM_error(FATAL, "thickness_to_dz called in fully non-Boussinesq mode with "//trim(mesg))
+ endif
+
do k=1,nz ; do i=is,ie
dz(i,k) = GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)
enddo ; enddo
diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90
index 07dd19b0a6..5aa78cb87a 100644
--- a/src/core/MOM_isopycnal_slopes.F90
+++ b/src/core/MOM_isopycnal_slopes.F90
@@ -4,6 +4,7 @@ module MOM_isopycnal_slopes
! This file is part of MOM6. See LICENSE.md for the license.
use MOM_debugging, only : hchksum, uvchksum
+use MOM_error_handler, only : MOM_error, FATAL
use MOM_grid, only : ocean_grid_type
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
@@ -36,8 +37,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface heights [Z ~> m]
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
- real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity
- !! times a smoothing timescale [Z2 ~> m2].
+ real, intent(in) :: dt_kappa_smooth !< A smoothing vertical
+ !! diffusivity times a smoothing
+ !! timescale [H Z ~> m2 or kg m-1]
logical, intent(in) :: use_stanley !< turn on stanley param in slope
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-dir [Z L-1 ~> nondim]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-dir [Z L-1 ~> nondim]
@@ -80,10 +82,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
real, dimension(SZIB_(G)) :: &
T_u, & ! Temperature on the interface at the u-point [C ~> degC].
S_u, & ! Salinity on the interface at the u-point [S ~> ppt].
+ GxSpV_u, & ! Gravitiational acceleration times the specific volume at an interface
+ ! at the u-points [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]
pres_u ! Pressure on the interface at the u-point [R L2 T-2 ~> Pa].
real, dimension(SZI_(G)) :: &
T_v, & ! Temperature on the interface at the v-point [C ~> degC].
S_v, & ! Salinity on the interface at the v-point [S ~> ppt].
+ GxSpV_v, & ! Gravitiational acceleration times the specific volume at an interface
+ ! at the v-points [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]
pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa].
real, dimension(SZI_(G)) :: &
T_h, & ! Temperature on the interface at the h-point [C ~> degC].
@@ -142,7 +148,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2
- dz_neglect = GV%H_subroundoff * GV%H_to_Z
+ dz_neglect = GV%dZ_subroundoff
local_open_u_BC = .false.
local_open_v_BC = .false.
@@ -195,9 +201,20 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
if (use_EOS) then
if (present(halo)) then
- call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, halo+1)
+ call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, US, halo+1)
else
- call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, 1)
+ call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, US, 1)
+ endif
+ endif
+
+ if ((use_EOS .and. allocated(tv%SpV_avg) .and. (tv%valid_SpV_halo < 1)) .and. &
+ (present_N2_u .or. present(dzSxN) .or. present_N2_v .or. present(dzSyN))) then
+ if (tv%valid_SpV_halo < 0) then
+ call MOM_error(FATAL, "calc_isoneutral_slopes called in fully non-Boussinesq mode "//&
+ "with invalid values of SpV_avg.")
+ else
+ call MOM_error(FATAL, "calc_isoneutral_slopes called in fully non-Boussinesq mode "//&
+ "with insufficiently large SpV_avg halos of width 0 but 1 is needed.")
endif
endif
@@ -226,7 +243,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
!$OMP local_open_u_BC,dzu,OBC,use_stanley) &
!$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, &
!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, &
- !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, &
+ !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h,GxSpV_u, &
!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, &
!$OMP drdx,mag_grad2,slope,l_seg)
do j=js,je ; do K=nz,2,-1
@@ -244,6 +261,18 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
enddo
call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, &
tv%eqn_of_state, EOSdom_u)
+ if (present_N2_u .or. (present(dzSxN))) then
+ if (allocated(tv%SpV_avg)) then
+ do I=is-1,ie
+ GxSpV_u(I) = GV%g_Earth * 0.25* ((tv%SpV_avg(i,j,k) + tv%SpV_avg(i+1,j,k)) + &
+ (tv%SpV_avg(i,j,k-1) + tv%SpV_avg(i+1,j,k-1)))
+ enddo
+ else
+ do I=is-1,ie
+ GxSpV_u(I) = G_Rho0
+ enddo
+ endif
+ endif
endif
if (use_stanley) then
@@ -307,7 +336,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
! drdz = ((hg2L/haL) * drdkL/dzaL + (hg2R/haR) * drdkR/dzaR) / &
! ((hg2L/haL) + (hg2R/haR))
! This is the gradient of density along geopotentials.
- if (present_N2_u) N2_u(I,j,K) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2]
+ if (present_N2_u) then
+ N2_u(I,j,K) = GxSpV_u(I) * drdz * G%mask2dCu(I,j) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2]
+ endif
if (use_EOS) then
drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - &
@@ -341,9 +372,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
slope = slope * max(g%mask2dT(i,j),g%mask2dT(i+1,j))
endif
slope_x(I,j,K) = slope
- if (present(dzSxN)) dzSxN(I,j,K) = sqrt( G_Rho0 * max(0., wtL * ( dzaL * drdkL ) &
- + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N
- * abs(slope) * G%mask2dCu(I,j) ! x-direction contribution to S^2
+ if (present(dzSxN)) &
+ dzSxN(I,j,K) = sqrt( GxSpV_u(I) * max(0., wtL * ( dzaL * drdkL ) &
+ + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N
+ * abs(slope) * G%mask2dCu(I,j) ! x-direction contribution to S^2
enddo ! I
enddo ; enddo ! end of j-loop
@@ -355,7 +387,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
!$OMP dzv,local_open_v_BC,OBC,use_stanley) &
!$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, &
!$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, &
- !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, &
+ !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h,GxSpV_v, &
!$OMP drho_dT_dT_hr,pres_hr,T_hr,S_hr, &
!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, &
!$OMP drdy,mag_grad2,slope,l_seg)
@@ -373,7 +405,21 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
enddo
call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, &
tv%eqn_of_state, EOSdom_v)
+
+ if ((present_N2_v) .or. (present(dzSyN))) then
+ if (allocated(tv%SpV_avg)) then
+ do i=is,ie
+ GxSpV_v(i) = GV%g_Earth * 0.25* ((tv%SpV_avg(i,j,k) + tv%SpV_avg(i,j+1,k)) + &
+ (tv%SpV_avg(i,j,k-1) + tv%SpV_avg(i,j+1,k-1)))
+ enddo
+ else
+ do i=is,ie
+ GxSpV_v(i) = G_Rho0
+ enddo
+ endif
+ endif
endif
+
if (use_stanley) then
do i=is,ie
pres_h(i) = pres(i,j,K)
@@ -441,7 +487,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
! drdz = ((hg2L/haL) * drdkL/dzaL + (hg2R/haR) * drdkR/dzaR) / &
! ((hg2L/haL) + (hg2R/haR))
! This is the gradient of density along geopotentials.
- if (present_N2_v) N2_v(i,J,K) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2]
+ if (present_N2_v) N2_v(i,J,K) = GxSpV_v(i) * drdz * G%mask2dCv(i,J) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2]
if (use_EOS) then
drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - &
@@ -477,9 +523,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
slope = slope * max(g%mask2dT(i,j),g%mask2dT(i,j+1))
endif
slope_y(i,J,K) = slope
- if (present(dzSyN)) dzSyN(i,J,K) = sqrt( G_Rho0 * max(0., wtL * ( dzaL * drdkL ) &
- + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N
- * abs(slope) * G%mask2dCv(i,J) ! x-direction contribution to S^2
+ if (present(dzSyN)) &
+ dzSyN(i,J,K) = sqrt( GxSpV_v(i) * max(0., wtL * ( dzaL * drdkL ) &
+ + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N
+ * abs(slope) * G%mask2dCv(i,J) ! x-direction contribution to S^2
enddo ! i
enddo ; enddo ! end of j-loop
@@ -488,14 +535,15 @@ end subroutine calc_isoneutral_slopes
!> Returns tracer arrays (nominally T and S) with massless layers filled with
!! sensible values, by diffusing vertically with a small but constant diffusivity.
-subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, larger_h_denom)
+subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, US, halo_here, larger_h_denom)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T_in !< Input temperature [C ~> degC]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S_in !< Input salinity [S ~> ppt]
real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing
- !! times a smoothing timescale [Z2 ~> m2].
+ !! times a smoothing timescale [H Z ~> m2 or kg m-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T_f !< Filled temperature [C ~> degC]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S_f !< Filled salinity [S ~> ppt]
integer, optional, intent(in) :: halo_here !< Number of halo points to work on,
@@ -525,10 +573,15 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar
is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke
h_neglect = GV%H_subroundoff
- kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2
+ ! The use of the fixed rescaling factor in the next line avoids an extra call to thickness_to_dz()
+ ! and the use of an extra 3-d array of vertical distnaces across layers (dz). This would be more
+ ! physically consistent, but it would also be more expensive, and given that this routine applies
+ ! a small (but arbitrary) amount of mixing to clean up the properties of nearly massless layers,
+ ! the added expense is hard to justify.
+ kap_dt_x2 = (2.0*kappa_dt) * (US%Z_to_m*GV%m_to_H) ! Usually the latter term is GV%Z_to_H.
h0 = h_neglect
if (present(larger_h_denom)) then
- if (larger_h_denom) h0 = 1.0e-16*sqrt(kappa_dt)*GV%Z_to_H
+ if (larger_h_denom) h0 = 1.0e-16*sqrt(0.5*kap_dt_x2)
endif
if (kap_dt_x2 <= 0.0) then
diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90
index ba8b8ce818..7bfb6479b2 100644
--- a/src/core/MOM_open_boundary.F90
+++ b/src/core/MOM_open_boundary.F90
@@ -7,27 +7,30 @@ module MOM_open_boundary
use MOM_array_transform, only : allocate_rotated_array
use MOM_coms, only : sum_across_PEs, Set_PElist, Get_PElist, PE_here, num_PEs
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
+use MOM_debugging, only : hchksum, uvchksum
use MOM_diag_mediator, only : diag_ctrl, time_type
use MOM_domains, only : pass_var, pass_vector
+use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
use MOM_domains, only : To_All, EAST_FACE, NORTH_FACE, SCALAR_PAIR, CGRID_NE, CORNER
+use MOM_dyn_horgrid, only : dyn_horgrid_type
use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, NOTE, is_root_pe
use MOM_file_parser, only : get_param, log_version, param_file_type, log_param
use MOM_grid, only : ocean_grid_type, hor_index_type
-use MOM_dyn_horgrid, only : dyn_horgrid_type
+use MOM_interface_heights, only : thickness_to_dz
+use MOM_interpolate, only : init_external_field, time_interp_external, time_interp_external_init
+use MOM_interpolate, only : external_field
use MOM_io, only : slasher, field_size, SINGLE_FILE
use MOM_io, only : vardesc, query_vardesc, var_desc
+use MOM_obsolete_params, only : obsolete_logical, obsolete_int, obsolete_real, obsolete_char
+use MOM_regridding, only : regridding_CS
+use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme, remapping_CS
+use MOM_remapping, only : initialize_remapping, remapping_core_h, end_remapping
use MOM_restart, only : register_restart_field, register_restart_pair
use MOM_restart, only : query_initialized, MOM_restart_CS
-use MOM_obsolete_params, only : obsolete_logical, obsolete_int, obsolete_real, obsolete_char
-use MOM_string_functions, only : extract_word, remove_spaces, uppercase
+use MOM_string_functions, only : extract_word, remove_spaces, uppercase, lowercase
use MOM_tidal_forcing, only : astro_longitudes, astro_longitudes_init, eq_phase, nodal_fu, tidal_frequency
use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-)
use MOM_tracer_registry, only : tracer_type, tracer_registry_type, tracer_name_lookup
-use MOM_interpolate, only : init_external_field, time_interp_external, time_interp_external_init
-use MOM_interpolate, only : external_field
-use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme, remapping_CS
-use MOM_remapping, only : initialize_remapping, remapping_core_h, end_remapping
-use MOM_regridding, only : regridding_CS
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
@@ -117,6 +120,8 @@ module MOM_open_boundary
real :: scale !< A scaling factor for converting the units of input
!! data, like [S ppt-1 ~> 1] for salinity.
logical :: is_initialized !< reservoir values have been set when True
+ integer :: ntr_index = -1 !< index of segment tracer in the global tracer registry
+ integer :: fd_index = -1 !< index of segment tracer in the input fields
end type OBC_segment_tracer_type
!> Registry type for tracers on segments
@@ -189,6 +194,7 @@ module MOM_open_boundary
real, allocatable :: Cg(:,:) !< The external gravity wave speed [L T-1 ~> m s-1]
!! at OBC-points.
real, allocatable :: Htot(:,:) !< The total column thickness [H ~> m or kg m-2] at OBC-points.
+ real, allocatable :: dZtot(:,:) !< The total column vertical extent [Z ~> m] at OBC-points.
real, allocatable :: h(:,:,:) !< The cell thickness [H ~> m or kg m-2] at OBC-points.
real, allocatable :: normal_vel(:,:,:) !< The layer velocity normal to the OB
!! segment [L T-1 ~> m s-1].
@@ -200,8 +206,8 @@ module MOM_open_boundary
!! segment [H L2 T-1 ~> m3 s-1].
real, allocatable :: normal_vel_bt(:,:) !< The barotropic velocity normal to
!! the OB segment [L T-1 ~> m s-1].
- real, allocatable :: eta(:,:) !< The sea-surface elevation along the
- !! segment [H ~> m or kg m-2].
+ real, allocatable :: SSH(:,:) !< The sea-surface elevation along the
+ !! segment [Z ~> m].
real, allocatable :: grad_normal(:,:,:) !< The gradient of the normal flow along the
!! segment times the grid spacing [L T-1 ~> m s-1],
!! with the first index being the corner-point index
@@ -276,7 +282,9 @@ module MOM_open_boundary
logical :: update_OBC = .false. !< Is OBC data time-dependent
logical :: update_OBC_seg_data = .false. !< Is it the time for OBC segment data update for fields that
!! require less frequent update
- logical :: needs_IO_for_data = .false. !< Is any i/o needed for OBCs
+ logical :: needs_IO_for_data = .false. !< Is any i/o needed for OBCs on the current PE
+ logical :: any_needs_IO_for_data = .false. !< Is any i/o needed for OBCs globally
+ logical :: some_need_no_IO_for_data = .false. !< Are there any PEs with OBCs that do not need i/o.
logical :: zero_vorticity = .false. !< If True, sets relative vorticity to zero on open boundaries.
logical :: freeslip_vorticity = .false. !< If True, sets normal gradient of tangential velocity to zero
!! in the relative vorticity on open boundaries.
@@ -352,7 +360,7 @@ module MOM_open_boundary
real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc]
logical :: debug !< If true, write verbose checksums for debugging purposes.
real :: silly_h !< A silly value of thickness outside of the domain that can be used to test
- !! the independence of the OBCs to this external data [H ~> m or kg m-2].
+ !! the independence of the OBCs to this external data [Z ~> m].
real :: silly_u !< A silly value of velocity outside of the domain that can be used to test
!! the independence of the OBCs to this external data [L T-1 ~> m s-1].
logical :: ramp = .false. !< If True, ramp from zero to the external values for SSH.
@@ -366,6 +374,7 @@ module MOM_open_boundary
!! for remapping. Values below 20190101 recover the remapping
!! answers from 2018, while higher values use more robust
!! forms of the same remapping expressions.
+ type(group_pass_type) :: pass_oblique !< Structure for group halo pass
end type ocean_OBC_type
!> Control structure for open boundaries that read from files.
@@ -417,16 +426,12 @@ subroutine open_boundary_config(G, US, param_file, OBC)
! Local variables
integer :: l ! For looping over segments
- logical :: debug_OBC, mask_outside, reentrant_x, reentrant_y
+ logical :: debug, debug_OBC, mask_outside, reentrant_x, reentrant_y
character(len=15) :: segment_param_str ! The run-time parameter name for each segment
character(len=1024) :: segment_str ! The contents (rhs) for parameter "segment_param_str"
character(len=200) :: config1 ! String for OBC_USER_CONFIG
real :: Lscale_in, Lscale_out ! parameters controlling tracer values at the boundaries [L ~> m]
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions for remapping
- ! that recover the answers from the end of 2018. Otherwise, use more
- ! robust and accurate forms of mathematically equivalent expressions.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
logical :: check_reconstruction, check_remapping, force_bounds_in_subcell
character(len=64) :: remappingScheme
! This include declares and sets the variable "version".
@@ -523,22 +528,22 @@ subroutine open_boundary_config(G, US, param_file, OBC)
OBC%add_tide_constituents = .false.
endif
- call get_param(param_file, mdl, "DEBUG", OBC%debug, default=.false.)
- call get_param(param_file, mdl, "DEBUG_OBC", debug_OBC, default=.false.)
- if (debug_OBC .or. OBC%debug) &
- call log_param(param_file, mdl, "DEBUG_OBC", debug_OBC, &
+ call get_param(param_file, mdl, "DEBUG", debug, default=.false.)
+ ! This extra get_param call is to enable logging if either DEBUG or DEBUG_OBC are true.
+ call get_param(param_file, mdl, "DEBUG_OBC", debug_OBC, default=debug)
+ call get_param(param_file, mdl, "DEBUG_OBC", OBC%debug, &
"If true, do additional calls to help debug the performance "//&
- "of the open boundary condition code.", default=.false., &
- debuggingParam=.true.)
+ "of the open boundary condition code.", &
+ default=debug, do_not_log=.not.(debug_OBC.or.debug), debuggingParam=.true.)
call get_param(param_file, mdl, "OBC_SILLY_THICK", OBC%silly_h, &
"A silly value of thicknesses used outside of open boundary "//&
"conditions for debugging.", units="m", default=0.0, scale=US%m_to_Z, &
- do_not_log=.not.debug_OBC, debuggingParam=.true.)
+ do_not_log=.not.OBC%debug, debuggingParam=.true.)
call get_param(param_file, mdl, "OBC_SILLY_VEL", OBC%silly_u, &
"A silly value of velocities used outside of open boundary "//&
"conditions for debugging.", units="m/s", default=0.0, scale=US%m_s_to_L_T, &
- do_not_log=.not.debug_OBC, debuggingParam=.true.)
+ do_not_log=.not.OBC%debug, debuggingParam=.true.)
reentrant_x = .false.
call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, default=.true.)
reentrant_y = .false.
@@ -676,23 +681,12 @@ subroutine open_boundary_config(G, US, param_file, OBC)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", OBC%remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date)
allocate(OBC%remap_CS)
call initialize_remapping(OBC%remap_CS, remappingScheme, boundary_extrapolation = .false., &
@@ -749,6 +743,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF)
integer, dimension(1) :: single_pelist
type(external_tracers_segments_props), pointer :: obgc_segments_props_list =>NULL()
!will be able to dynamically switch between sub-sampling refined grid data or model grid
+ integer :: IO_needs(3) ! Sums to determine global OBC data use and update patterns.
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
@@ -859,6 +854,8 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF)
! if (siz(4) == 1) segment%values_needed = .false.
if (segment%on_pe) then
if (OBC%brushcutter_mode .and. (modulo(siz(1),2) == 0 .or. modulo(siz(2),2) == 0)) then
+ write(mesg,'("Brushcutter mode sizes ", I6, I6))') siz(1), siz(2)
+ call MOM_error(WARNING, mesg // " " // trim(filename) // " " // trim(fieldname))
call MOM_error(FATAL,'segment data are not on the supergrid')
endif
siz2(1)=1
@@ -1058,6 +1055,15 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF)
call Set_PElist(saved_pelist)
+ ! Determine global IO data requirement patterns.
+ IO_needs(1) = 0 ; if (OBC%needs_IO_for_data) IO_needs(1) = 1
+ IO_needs(2) = 0 ; if (OBC%update_OBC) IO_needs(2) = 1
+ IO_needs(3) = 0 ; if (.not.OBC%needs_IO_for_data) IO_needs(3) = 1
+ call sum_across_PES(IO_needs, 3)
+ OBC%any_needs_IO_for_data = (IO_needs(1) > 0)
+ OBC%update_OBC = (IO_needs(2) > 0)
+ OBC%some_need_no_IO_for_data = (IO_needs(3) > 0)
+
end subroutine initialize_segment_data
!> Return an appropriate dimensional scaling factor for input data based on an OBC segment data
@@ -1079,8 +1085,8 @@ real function scale_factor_from_name(name, GV, US, Tr_Reg)
case ('Vamp') ; scale_factor_from_name = US%m_s_to_L_T
case ('DVDX') ; scale_factor_from_name = US%T_to_s
case ('DUDY') ; scale_factor_from_name = US%T_to_s
- case ('SSH') ; scale_factor_from_name = GV%m_to_H
- case ('SSHamp') ; scale_factor_from_name = GV%m_to_H
+ case ('SSH') ; scale_factor_from_name = US%m_to_Z
+ case ('SSHamp') ; scale_factor_from_name = US%m_to_Z
case default ; scale_factor_from_name = 1.0
end select
@@ -1884,9 +1890,13 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS)
if (OBC%radiation_BCs_exist_globally) call pass_vector(OBC%rx_normal, OBC%ry_normal, G%Domain, &
To_All+Scalar_Pair)
if (OBC%oblique_BCs_exist_globally) then
- call pass_vector(OBC%rx_oblique_u, OBC%ry_oblique_v, G%Domain, To_All+Scalar_Pair)
- call pass_vector(OBC%ry_oblique_u, OBC%rx_oblique_v, G%Domain, To_All+Scalar_Pair)
- call pass_vector(OBC%cff_normal_u, OBC%cff_normal_v, G%Domain, To_All+Scalar_Pair)
+! call pass_vector(OBC%rx_oblique_u, OBC%ry_oblique_v, G%Domain, To_All+Scalar_Pair)
+! call pass_vector(OBC%ry_oblique_u, OBC%rx_oblique_v, G%Domain, To_All+Scalar_Pair)
+! call pass_vector(OBC%cff_normal_u, OBC%cff_normal_v, G%Domain, To_All+Scalar_Pair)
+ call create_group_pass(OBC%pass_oblique, OBC%rx_oblique_u, OBC%ry_oblique_v, G%Domain, To_All+Scalar_Pair)
+ call create_group_pass(OBC%pass_oblique, OBC%ry_oblique_u, OBC%rx_oblique_v, G%Domain, To_All+Scalar_Pair)
+ call create_group_pass(OBC%pass_oblique, OBC%cff_normal_u, OBC%cff_normal_v, G%Domain, To_All+Scalar_Pair)
+ call do_group_pass(OBC%pass_oblique, G%Domain)
endif
if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then
do m=1,OBC%ntr
@@ -1922,7 +1932,7 @@ logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, a
OBC%Flather_v_BCs_exist_globally
if (present(apply_nudged_OBC)) open_boundary_query = OBC%nudged_u_BCs_exist_globally .or. &
OBC%nudged_v_BCs_exist_globally
- if (present(needs_ext_seg_data)) open_boundary_query = OBC%needs_IO_for_data
+ if (present(needs_ext_seg_data)) open_boundary_query = OBC%any_needs_IO_for_data
end function open_boundary_query
@@ -2216,6 +2226,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
type(OBC_segment_type), pointer :: segment => NULL()
integer :: i, j, k, is, ie, js, je, m, nz, n
integer :: is_obc, ie_obc, js_obc, je_obc
+ logical :: sym
+ character(len=3) :: var_num
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -3290,6 +3302,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
call pass_vector(u_new, v_new, G%Domain, clock=id_clock_pass)
+ if (OBC%debug) then
+ sym = G%Domain%symmetric
+ if (OBC%radiation_BCs_exist_globally) then
+ call uvchksum("radiation_OBCs: OBC%r[xy]_normal", OBC%rx_normal, OBC%ry_normal, G%HI, &
+ haloshift=0, symmetric=sym, scale=1.0)
+ endif
+ if (OBC%oblique_BCs_exist_globally) then
+ call uvchksum("radiation_OBCs: OBC%r[xy]_oblique_[uv]", OBC%rx_oblique_u, OBC%ry_oblique_v, G%HI, &
+ haloshift=0, symmetric=sym, scale=1.0/US%L_T_to_m_s**2)
+ call uvchksum("radiation_OBCs: OBC%r[yx]_oblique_[uv]", OBC%ry_oblique_u, OBC%rx_oblique_v, G%HI, &
+ haloshift=0, symmetric=sym, scale=1.0/US%L_T_to_m_s**2)
+ call uvchksum("radiation_OBCs: OBC%cff_normal_[uv]", OBC%cff_normal_u, OBC%cff_normal_v, G%HI, &
+ haloshift=0, symmetric=sym, scale=1.0/US%L_T_to_m_s**2)
+ endif
+ if (OBC%ntr == 0) return
+ if (.not. allocated (OBC%tres_x) .or. .not. allocated (OBC%tres_y)) return
+ do m=1,OBC%ntr
+ write(var_num,'(I3.3)') m
+ call uvchksum("radiation_OBCs: OBC%tres_[xy]_"//var_num, OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%HI, &
+ haloshift=0, symmetric=sym, scale=1.0)
+ enddo
+ endif
+
end subroutine radiation_open_bdry_conds
!> Applies OBC values stored in segments to 3d u,v fields
@@ -3595,8 +3630,9 @@ subroutine allocate_OBC_segment_data(OBC, segment)
! If these are just Flather, change update_OBC_segment_data accordingly
allocate(segment%Cg(IsdB:IedB,jsd:jed), source=0.0)
allocate(segment%Htot(IsdB:IedB,jsd:jed), source=0.0)
+ allocate(segment%dZtot(IsdB:IedB,jsd:jed), source=0.0)
allocate(segment%h(IsdB:IedB,jsd:jed,OBC%ke), source=0.0)
- allocate(segment%eta(IsdB:IedB,jsd:jed), source=0.0)
+ allocate(segment%SSH(IsdB:IedB,jsd:jed), source=0.0)
if (segment%radiation) &
allocate(segment%rx_norm_rad(IsdB:IedB,jsd:jed,OBC%ke), source=0.0)
allocate(segment%normal_vel(IsdB:IedB,jsd:jed,OBC%ke), source=0.0)
@@ -3630,8 +3666,9 @@ subroutine allocate_OBC_segment_data(OBC, segment)
! If these are just Flather, change update_OBC_segment_data accordingly
allocate(segment%Cg(isd:ied,JsdB:JedB), source=0.0)
allocate(segment%Htot(isd:ied,JsdB:JedB), source=0.0)
+ allocate(segment%dZtot(isd:ied,JsdB:JedB), source=0.0)
allocate(segment%h(isd:ied,JsdB:JedB,OBC%ke), source=0.0)
- allocate(segment%eta(isd:ied,JsdB:JedB), source=0.0)
+ allocate(segment%SSH(isd:ied,JsdB:JedB), source=0.0)
if (segment%radiation) &
allocate(segment%ry_norm_rad(isd:ied,JsdB:JedB,OBC%ke), source=0.0)
allocate(segment%normal_vel(isd:ied,JsdB:JedB,OBC%ke), source=0.0)
@@ -3671,8 +3708,9 @@ subroutine deallocate_OBC_segment_data(segment)
if (allocated(segment%Cg)) deallocate(segment%Cg)
if (allocated(segment%Htot)) deallocate(segment%Htot)
+ if (allocated(segment%dZtot)) deallocate(segment%dZtot)
if (allocated(segment%h)) deallocate(segment%h)
- if (allocated(segment%eta)) deallocate(segment%eta)
+ if (allocated(segment%SSH)) deallocate(segment%SSH)
if (allocated(segment%rx_norm_rad)) deallocate(segment%rx_norm_rad)
if (allocated(segment%ry_norm_rad)) deallocate(segment%ry_norm_rad)
if (allocated(segment%rx_norm_obl)) deallocate(segment%rx_norm_obl)
@@ -3753,7 +3791,7 @@ subroutine open_boundary_test_extern_h(G, GV, OBC, h)
if (.not. associated(OBC)) return
- silly_h = GV%Z_to_H*OBC%silly_h
+ silly_h = GV%Z_to_H * OBC%silly_h
do n = 1, OBC%number_of_segments
do k = 1, GV%ke
@@ -3804,6 +3842,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
integer :: ni_buf, nj_buf ! Number of filled values in tmp_buffer
integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain
integer :: ishift, jshift ! offsets for staggered locations
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Distance between the interfaces around a layer [Z ~> m]
real, dimension(:,:,:), allocatable, target :: tmp_buffer ! A buffer for input data [various units]
real, dimension(:), allocatable :: h_stack ! Thicknesses at corner points [H ~> m or kg m-2]
integer :: is_obc2, js_obc2
@@ -3812,7 +3851,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
real :: net_H_int ! Total thickness of the incoming flow in the model [H ~> m or kg m-2]
real :: scl_fac ! A scaling factor to compensate for differences in total thicknesses [nondim]
real :: tidal_vel ! Interpolated tidal velocity at the OBC points [L T-1 ~> m s-1]
- real :: tidal_elev ! Interpolated tidal elevation at the OBC points [H ~> m or kg m-2]
+ real :: tidal_elev ! Interpolated tidal elevation at the OBC points [Z ~> m]
real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1]
integer :: turns ! Number of index quarter turns
real :: time_delta ! Time since tidal reference date [T ~> s]
@@ -3837,6 +3876,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
h_neglect = GV%kg_m2_to_H * 1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H * 1.0e-10
endif
+ if (OBC%number_of_segments >= 1) then
+ call thickness_to_dz(h, tv, dz, G, GV, US)
+ call pass_var(dz, G%Domain)
+ endif
+
do n = 1, OBC%number_of_segments
segment => OBC%segment(n)
@@ -3869,11 +3913,13 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
I=segment%HI%IsdB
do j=segment%HI%jsd,segment%HI%jed
segment%Htot(I,j) = 0.0
+ segment%dZtot(I,j) = 0.0
do k=1,GV%ke
segment%h(I,j,k) = h(i+ishift,j,k)
segment%Htot(I,j) = segment%Htot(I,j) + segment%h(I,j,k)
+ segment%dZtot(I,j) = segment%dZtot(I,j) + dz(i+ishift,j,k)
enddo
- segment%Cg(I,j) = sqrt(GV%g_prime(1)*segment%Htot(I,j)*GV%H_to_Z)
+ segment%Cg(I,j) = sqrt(GV%g_prime(1) * segment%dZtot(I,j))
enddo
else! (segment%direction == OBC_DIRECTION_N .or. segment%direction == OBC_DIRECTION_S)
allocate(normal_trans_bt(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB), source=0.0)
@@ -3881,11 +3927,13 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
J=segment%HI%JsdB
do i=segment%HI%isd,segment%HI%ied
segment%Htot(i,J) = 0.0
+ segment%dZtot(i,J) = 0.0
do k=1,GV%ke
segment%h(i,J,k) = h(i,j+jshift,k)
segment%Htot(i,J) = segment%Htot(i,J) + segment%h(i,J,k)
+ segment%dZtot(i,J) = segment%dZtot(i,J) + dz(i,j+jshift,k)
enddo
- segment%Cg(i,J) = sqrt(GV%g_prime(1)*segment%Htot(i,J)*GV%H_to_Z)
+ segment%Cg(i,J) = sqrt(GV%g_prime(1) * segment%dZtot(i,J))
enddo
endif
@@ -4396,7 +4444,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
+ (OBC%tide_eq_phases(c) + OBC%tide_un(c)))
enddo
endif
- segment%eta(i,j) = OBC%ramp_value * (segment%field(m)%buffer_dst(i,j,1) + tidal_elev)
+ segment%SSH(i,j) = OBC%ramp_value * (segment%field(m)%buffer_dst(i,j,1) + tidal_elev)
enddo
enddo
else
@@ -4410,7 +4458,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
+ (OBC%tide_eq_phases(c) + OBC%tide_un(c)))
enddo
endif
- segment%eta(i,j) = (segment%field(m)%buffer_dst(i,j,1) + tidal_elev)
+ segment%SSH(i,j) = (segment%field(m)%buffer_dst(i,j,1) + tidal_elev)
enddo
enddo
endif
@@ -4635,8 +4683,8 @@ end subroutine segment_tracer_registry_init
!> Register a tracer array that is active on an OBC segment, potentially also specifying how the
!! tracer inflow values are specified.
-subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
- OBC_scalar, OBC_array, scale)
+subroutine register_segment_tracer(tr_ptr, ntr_index, param_file, GV, segment, &
+ OBC_scalar, OBC_array, scale, fd_index)
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
type(tracer_type), target :: tr_ptr !< A target that can be used to set a pointer to the
!! stored value of tr. This target must be
@@ -4645,6 +4693,7 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
!! but it also means that any updates to this
!! structure in the calling module will be
!! available subsequently to the tracer registry.
+ integer, intent(in) :: ntr_index !< index of segment tracer in the global tracer registry
type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values
type(OBC_segment_type), intent(inout) :: segment !< current segment data structure
real, optional, intent(in) :: OBC_scalar !< If present, use scalar value for segment tracer
@@ -4655,6 +4704,7 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
real, optional, intent(in) :: scale !< A scaling factor that should be used with any
!! data that is read in, to convert it to the internal
!! units of this tracer.
+ integer, optional, intent(in) :: fd_index !< index of segment tracer in the input field
! Local variables
real :: rescale ! A multiplicative correction to the scaling factor.
@@ -4678,6 +4728,8 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
segment%tr_Reg%Tr(ntseg)%Tr => tr_ptr
segment%tr_Reg%Tr(ntseg)%name = tr_ptr%name
+ segment%tr_Reg%Tr(ntseg)%ntr_index = ntr_index
+ if (present(fd_index)) segment%tr_Reg%Tr(ntseg)%fd_index = fd_index
segment%tr_Reg%Tr(ntseg)%scale = 1.0
if (present(scale)) then
@@ -4740,7 +4792,7 @@ subroutine register_temp_salt_segments(GV, US, OBC, tr_Reg, param_file)
type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values
! Local variables
- integer :: n
+ integer :: n, ntr_id
character(len=32) :: name
type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
type(tracer_type), pointer :: tr_ptr => NULL()
@@ -4755,12 +4807,12 @@ subroutine register_temp_salt_segments(GV, US, OBC, tr_Reg, param_file)
call MOM_error(FATAL,"register_temp_salt_segments: tracer array was previously allocated")
name = 'temp'
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
- call register_segment_tracer(tr_ptr, param_file, GV, segment, &
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
+ call register_segment_tracer(tr_ptr, ntr_id, param_file, GV, segment, &
OBC_array=segment%temp_segment_data_exists, scale=US%degC_to_C)
name = 'salt'
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
- call register_segment_tracer(tr_ptr, param_file, GV, segment, &
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
+ call register_segment_tracer(tr_ptr, ntr_id, param_file, GV, segment, &
OBC_array=segment%salt_segment_data_exists, scale=US%ppt_to_S)
enddo
@@ -4813,8 +4865,8 @@ subroutine register_obgc_segments(GV, OBC, tr_Reg, param_file, tr_name)
type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values
character(len=*), intent(in) :: tr_name!< Tracer name
! Local variables
- integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, nz, nf
- integer :: i, j, k, n
+ integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, nz, nf, ntr_id, fd_id
+ integer :: i, j, k, n, m
type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list
type(tracer_type), pointer :: tr_ptr => NULL()
@@ -4823,8 +4875,13 @@ subroutine register_obgc_segments(GV, OBC, tr_Reg, param_file, tr_name)
do n=1, OBC%number_of_segments
segment=>OBC%segment(n)
if (.not. segment%on_pe) cycle
- call tracer_name_lookup(tr_Reg, tr_ptr, tr_name)
- call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.True.)
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, tr_name)
+ ! get the obgc field index
+ fd_id = -1
+ do m=1,segment%num_fields
+ if (lowercase(segment%field(m)%name) == lowercase(tr_name)) fd_id = m
+ enddo
+ call register_segment_tracer(tr_ptr, ntr_id, param_file, GV, segment, OBC_array=.True., fd_index=fd_id)
enddo
end subroutine register_obgc_segments
@@ -5324,8 +5381,9 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
real :: fac1 ! The denominator of the expression for tracer updates [nondim]
real :: I_scale ! The inverse of the scaling factor for the tracers.
! For salinity the units would be [ppt S-1 ~> 1]
- integer :: i, j, k, m, n, ntr, nz
+ integer :: i, j, k, m, n, ntr, nz, ntr_id, fd_id
integer :: ishift, idir, jshift, jdir
+ real :: resrv_lfac_out, resrv_lfac_in
real :: b_in, b_out ! The 0 and 1 switch for tracer reservoirs
! 1 if the length scale of reservoir is zero [nondim]
real :: a_in, a_out ! The 0 and 1(-1) switch for reservoir source weights
@@ -5353,7 +5411,16 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
! Can keep this or take it out, either way
if (G%mask2dT(I+ishift,j) == 0.0) cycle
! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep
- do m=1,ntr
+ do m=1,segment%tr_Reg%ntseg
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
+ fd_id = segment%tr_reg%Tr(m)%fd_index
+ if(fd_id == -1) then
+ resrv_lfac_out = 1.0
+ resrv_lfac_in = 1.0
+ else
+ resrv_lfac_out = segment%field(fd_id)%resrv_lfac_out
+ resrv_lfac_in = segment%field(fd_id)%resrv_lfac_in
+ endif
I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale
if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz
! Calculate weights. Both a and u_L are nodim. Adding them together has no meaning.
@@ -5362,14 +5429,14 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
! When InvLscale_in is 0 and inflow, only nudged data is applied to reservoirs
a_out = b_out * max(0.0, sign(1.0, idir*uhr(I,j,k)))
a_in = b_in * min(0.0, sign(1.0, idir*uhr(I,j,k)))
- u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out*segment%field(m)%resrv_lfac_out / &
+ u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out*resrv_lfac_out / &
((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j)))
- u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in*segment%field(m)%resrv_lfac_in / &
+ u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in*resrv_lfac_in / &
((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j)))
fac1 = (1.0 - (a_out - a_in)) + ((u_L_out + a_out) - (u_L_in + a_in))
segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1) * &
((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(I,j,k)+ &
- ((u_L_out+a_out)*Reg%Tr(m)%t(I+ishift,j,k) - &
+ ((u_L_out+a_out)*Reg%Tr(ntr_id)%t(I+ishift,j,k) - &
(u_L_in+a_in)*segment%tr_Reg%Tr(m)%t(I,j,k)))
if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k)
enddo ; endif
@@ -5388,20 +5455,28 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg)
! Can keep this or take it out, either way
if (G%mask2dT(i,j+jshift) == 0.0) cycle
! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep
- do m=1,ntr
+ do m=1,segment%tr_Reg%ntseg
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
+ fd_id = segment%tr_reg%Tr(m)%fd_index
+ if(fd_id == -1) then
+ resrv_lfac_out = 1.0
+ resrv_lfac_in = 1.0
+ else
+ resrv_lfac_out = segment%field(fd_id)%resrv_lfac_out
+ resrv_lfac_in = segment%field(fd_id)%resrv_lfac_in
+ endif
I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale
if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz
a_out = b_out * max(0.0, sign(1.0, jdir*vhr(i,J,k)))
a_in = b_in * min(0.0, sign(1.0, jdir*vhr(i,J,k)))
- v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out*segment%field(m)%resrv_lfac_out / &
+ v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out*resrv_lfac_out / &
((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J)))
- v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in*segment%field(m)%resrv_lfac_in / &
+ v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in*resrv_lfac_in / &
((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J)))
- fac1 = 1.0 + (v_L_out-v_L_in)
fac1 = (1.0 - (a_out - a_in)) + ((v_L_out + a_out) - (v_L_in + a_in))
segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1) * &
((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(i,J,k) + &
- ((v_L_out+a_out)*Reg%Tr(m)%t(i,J+jshift,k) - &
+ ((v_L_out+a_out)*Reg%Tr(ntr_id)%t(i,J+jshift,k) - &
(v_L_in+a_in)*segment%tr_Reg%Tr(m)%t(i,J,k)))
if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k)
enddo ; endif
@@ -5586,6 +5661,11 @@ subroutine remap_OBC_fields(G, GV, h_old, h_new, OBC, PCM_cell)
enddo
endif
enddo ; endif ; endif
+ if (OBC%radiation_BCs_exist_globally) call pass_vector(OBC%rx_normal, OBC%ry_normal, G%Domain, &
+ To_All+Scalar_Pair)
+ if (OBC%oblique_BCs_exist_globally) then
+ call do_group_pass(OBC%pass_oblique, G%Domain)
+ endif
end subroutine remap_OBC_fields
@@ -5638,8 +5718,8 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld)
! The normal slope at the boundary is zero by a
! previous call to open_boundary_impose_normal_slope
do k=nz+1,1,-1
- if (-eta(i,j,k) > segment%Htot(i,j)*GV%H_to_Z + hTolerance) then
- eta(i,j,k) = -segment%Htot(i,j)*GV%H_to_Z
+ if (-eta(i,j,k) > segment%dZtot(i,j) + hTolerance) then
+ eta(i,j,k) = -segment%dZtot(i,j)
contractions = contractions + 1
endif
enddo
@@ -5657,10 +5737,10 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld)
! The whole column is dilated to accommodate deeper topography than
! the bathymetry would indicate.
- if (-eta(i,j,nz+1) < (segment%Htot(i,j) * GV%H_to_Z) - hTolerance) then
+ if (-eta(i,j,nz+1) < segment%dZtot(i,j) - hTolerance) then
dilations = dilations + 1
! expand bottom-most cell only
- eta(i,j,nz+1) = -(segment%Htot(i,j) * GV%H_to_Z)
+ eta(i,j,nz+1) = -segment%dZtot(i,j)
segment%field(fld)%dz_src(i,j,nz)= eta(i,j,nz)-eta(i,j,nz+1)
! if (eta(i,j,1) <= eta(i,j,nz+1)) then
! do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo
@@ -5755,6 +5835,8 @@ subroutine rotate_OBC_config(OBC_in, G_in, OBC, G, turns)
OBC%brushcutter_mode = OBC_in%brushcutter_mode
OBC%update_OBC = OBC_in%update_OBC
OBC%needs_IO_for_data = OBC_in%needs_IO_for_data
+ OBC%any_needs_IO_for_data = OBC_in%any_needs_IO_for_data
+ OBC%some_need_no_IO_for_data = OBC_in%some_need_no_IO_for_data
OBC%ntr = OBC_in%ntr
diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90
index ebe3907469..e212581993 100644
--- a/src/core/MOM_porous_barriers.F90
+++ b/src/core/MOM_porous_barriers.F90
@@ -80,7 +80,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt)
logical, dimension(SZIB_(G),SZJB_(G)) :: do_I ! Booleans for calculation at u or v points
! updated while moving up layers
real :: A_layer ! Integral of fractional open width from bottom to current layer [Z ~> m]
- real :: h_min ! ! The minimum layer thickness [Z ~> m]
+ real :: dz_min ! The minimum layer thickness [Z ~> m]
real :: dmask ! The depth below which porous barrier is not applied [Z ~> m]
integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq
@@ -100,7 +100,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt)
call calc_eta_at_uv(eta_u, eta_v, CS%eta_interp, dmask, h, tv, G, GV, US)
- h_min = GV%Angstrom_H * GV%H_to_Z
+ dz_min = GV%Angstrom_Z
! u-points
do j=js,je ; do I=Isq,Ieq ; do_I(I,j) = .False. ; enddo ; enddo
@@ -125,7 +125,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt)
do k=nk,1,-1 ; do j=js,je ; do I=Isq,Ieq ; if (do_I(I,j)) then
call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), &
eta_u(I,j,K), A_layer, do_I(I,j))
- if (eta_u(I,j,K) - (eta_u(I,j,K+1)+h_min) > 0.0) then
+ if (eta_u(I,j,K) - (eta_u(I,j,K+1)+dz_min) > 0.0) then
pbv%por_face_areaU(I,j,k) = min(1.0, (A_layer - A_layer_prev(I,j)) / (eta_u(I,j,K) - eta_u(I,j,K+1)))
else
pbv%por_face_areaU(I,j,k) = 0.0 ! use calc_por_interface() might be a better choice
@@ -157,7 +157,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt)
do k=nk,1,-1 ; do J=Jsq,Jeq ; do i=is,ie ; if (do_I(i,J)) then
call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), &
eta_v(i,J,K), A_layer, do_I(i,J))
- if (eta_v(i,J,K) - (eta_v(i,J,K+1)+h_min) > 0.0) then
+ if (eta_v(i,J,K) - (eta_v(i,J,K+1)+dz_min) > 0.0) then
pbv%por_face_areaV(i,J,k) = min(1.0, (A_layer - A_layer_prev(i,J)) / (eta_v(i,J,K) - eta_v(i,J,K+1)))
else
pbv%por_face_areaV(i,J,k) = 0.0 ! use calc_por_interface() might be a better choice
@@ -286,7 +286,7 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt)
! local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Layer interface heights [Z ~> m].
- real :: h_neglect ! Negligible thicknesses [Z ~> m]
+ real :: dz_neglect ! A negligible height difference [Z ~> m]
integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq
is = G%isc; ie = G%iec; js = G%jsc; je = G%jec; nk = GV%ke
@@ -295,7 +295,7 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt)
! currently no treatment for using optional find_eta arguments if present
call find_eta(h, tv, G, GV, US, eta, halo_size=1)
- h_neglect = GV%H_subroundoff * GV%H_to_Z
+ dz_neglect = GV%dZ_subroundoff
do K=1,nk+1
do j=js,je ; do I=Isq,Ieq ; eta_u(I,j,K) = dmask ; enddo ; enddo
@@ -333,10 +333,10 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt)
case (ETA_INTERP_HARM) ! Harmonic mean
do K=1,nk+1
do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then
- eta_u(I,j,K) = 2.0 * (eta(i,j,K) * eta(i+1,j,K)) / (eta(i,j,K) + eta(i+1,j,K) + h_neglect)
+ eta_u(I,j,K) = 2.0 * (eta(i,j,K) * eta(i+1,j,K)) / (eta(i,j,K) + eta(i+1,j,K) + dz_neglect)
endif ; enddo ; enddo
do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then
- eta_v(i,J,K) = 2.0 * (eta(i,j,K) * eta(i,j+1,K)) / (eta(i,j,K) + eta(i,j+1,K) + h_neglect)
+ eta_v(i,J,K) = 2.0 * (eta(i,j,K) * eta(i,j+1,K)) / (eta(i,j,K) + eta(i,j+1,K) + dz_neglect)
endif ; enddo ; enddo
enddo
case default
@@ -414,12 +414,13 @@ subroutine calc_por_interface(D_min, D_max, D_avg, eta_layer, w_layer, do_next)
endif
end subroutine calc_por_interface
-subroutine porous_barriers_init(Time, US, param_file, diag, CS)
- type(porous_barrier_CS), intent(inout) :: CS !< Module control structure
- type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse
+subroutine porous_barriers_init(Time, GV, US, param_file, diag, CS)
type(time_type), intent(in) :: Time !< Current model time
- type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse
+ type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure
+ type(porous_barrier_CS), intent(inout) :: CS !< Module control structure
! local variables
character(len=40) :: mdl = "MOM_porous_barriers" ! This module's name.
@@ -439,7 +440,9 @@ subroutine porous_barriers_init(Time, US, param_file, diag, CS)
call get_param(param_file, mdl, "PORBAR_ANSWER_DATE", CS%answer_date, &
"The vintage of the porous barrier weight function calculations. Values below "//&
"20220806 recover the old answers in which the layer averaged weights are not "//&
- "strictly limited by an upper-bound of 1.0 .", default=default_answer_date)
+ "strictly limited by an upper-bound of 1.0 .", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.)
call get_param(param_file, mdl, "PORBAR_MASKING_DEPTH", CS%mask_depth, &
"If the effective average depth at the velocity cell is shallower than this "//&
diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90
index deb878e99c..2bd742be6d 100644
--- a/src/core/MOM_stoch_eos.F90
+++ b/src/core/MOM_stoch_eos.F90
@@ -40,7 +40,7 @@ module MOM_stoch_eos
real :: stanley_coeff !< Coefficient correlating the temperature gradient
!! and SGS T variance [nondim]; if <0, turn off scheme in all codes
real :: stanley_a !< a in exp(aX) in stochastic coefficient [nondim]
- real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1]
+ real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
!>@{ Diagnostic IDs
integer :: id_stoch_eos = -1, id_stoch_phi = -1, id_tvar_sgs = -1
@@ -51,9 +51,10 @@ module MOM_stoch_eos
contains
!> Initializes MOM_stoch_eos module, returning a logical indicating whether this module will be used.
-logical function MOM_stoch_eos_init(Time, G, US, param_file, diag, CS, restart_CS)
+logical function MOM_stoch_eos_init(Time, G, GV, US, param_file, diag, CS, restart_CS)
type(time_type), intent(in) :: Time !< Time for stochastic process
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse
type(diag_ctrl), target, intent(inout) :: diag !< Structure used to control diagnostics
@@ -80,7 +81,7 @@ logical function MOM_stoch_eos_init(Time, G, US, param_file, diag, CS, restart_C
call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", CS%kappa_smooth, &
"A diapycnal diffusivity that is used to interpolate "//&
"more sensible values of T & S into thin layers.", &
- units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s, &
+ units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T, &
do_not_log=(CS%stanley_coeff<0.0))
! Don't run anything if STANLEY_COEFF < 0
@@ -193,9 +194,10 @@ subroutine post_stoch_EOS_diags(CS, tv, diag)
end subroutine post_stoch_EOS_diags
!> Computes a parameterization of the SGS temperature variance
-subroutine MOM_calc_varT(G, GV, h, tv, CS, dt)
+subroutine MOM_calc_varT(G, GV, US, h, tv, CS, dt)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
intent(in) :: h !< Layer thickness [H ~> m]
type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure
@@ -219,7 +221,7 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt)
! extreme gradients along layers which are vanished against topography. It is
! still a poor approximation in the interior when coordinates are strongly tilted.
if (.not. associated(tv%varT)) allocate(tv%varT(G%isd:G%ied, G%jsd:G%jed, GV%ke), source=0.0)
- call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.)
+ call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, US, halo_here=1, larger_h_denom=.true.)
do k=1,G%ke
do j=G%jsc,G%jec
diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90
index 4ad26ed362..0eab1a5b17 100644
--- a/src/core/MOM_variables.F90
+++ b/src/core/MOM_variables.F90
@@ -93,6 +93,8 @@ module MOM_variables
real :: min_salinity !< The minimum value of salinity when BOUND_SALINITY=True [S ~> ppt].
real, allocatable, dimension(:,:,:) :: SpV_avg
!< The layer averaged in situ specific volume [R-1 ~> m3 kg-1].
+ integer :: valid_SpV_halo = -1 !< If positive, the valid halo size for SpV_avg, or if negative
+ !! SpV_avg is not currently set.
! These arrays are accumulated fluxes for communication with other components.
real, dimension(:,:), pointer :: frazil => NULL()
@@ -230,12 +232,12 @@ module MOM_variables
real, allocatable, dimension(:,:) :: &
bbl_thick_u, & !< The bottom boundary layer thickness at the u-points [Z ~> m].
bbl_thick_v, & !< The bottom boundary layer thickness at the v-points [Z ~> m].
- kv_bbl_u, & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1].
- kv_bbl_v, & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1].
- ustar_BBL, & !< The turbulence velocity in the bottom boundary layer at h points [Z T-1 ~> m s-1].
+ kv_bbl_u, & !< The bottom boundary layer viscosity at the u-points [H Z T-1 ~> m2 s-1 or Pa s]
+ kv_bbl_v, & !< The bottom boundary layer viscosity at the v-points [H Z T-1 ~> m2 s-1 or Pa s]
+ ustar_BBL, & !< The turbulence velocity in the bottom boundary layer at
+ !! h points [H T-1 ~> m s-1 or kg m-2 s-1].
TKE_BBL, & !< A term related to the bottom boundary layer source of turbulent kinetic
- !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed
- !! to [R Z3 T-3 ~> W m-2].
+ !! energy, currently in [H Z2 T-3 ~> m3 s-3 or W m-2].
taux_shelf, & !< The zonal stresses on the ocean under shelves [R Z L T-2 ~> Pa].
tauy_shelf !< The meridional stresses on the ocean under shelves [R Z L T-2 ~> Pa].
real, allocatable, dimension(:,:) :: tbl_thick_shelf_u
@@ -243,9 +245,11 @@ module MOM_variables
real, allocatable, dimension(:,:) :: tbl_thick_shelf_v
!< Thickness of the viscous top boundary layer under ice shelves at v-points [Z ~> m].
real, allocatable, dimension(:,:) :: kv_tbl_shelf_u
- !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 T-1 ~> m2 s-1].
+ !< Viscosity in the viscous top boundary layer under ice shelves at
+ !! u-points [H Z T-1 ~> m2 s-1 or Pa s]
real, allocatable, dimension(:,:) :: kv_tbl_shelf_v
- !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 T-1 ~> m2 s-1].
+ !< Viscosity in the viscous top boundary layer under ice shelves at
+ !! v-points [H Z T-1 ~> m2 s-1 or Pa s]
real, allocatable, dimension(:,:) :: nkml_visc_u
!< The number of layers in the viscous surface mixed layer at u-points [nondim].
!! This is not an integer because there may be fractional layers, and it is stored in
@@ -254,24 +258,24 @@ module MOM_variables
real, allocatable, dimension(:,:) :: nkml_visc_v
!< The number of layers in the viscous surface mixed layer at v-points [nondim].
real, allocatable, dimension(:,:,:) :: &
- Ray_u, & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1].
- Ray_v !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1].
+ Ray_u, & !< The Rayleigh drag velocity to be applied to each layer at u-points [H T-1 ~> m s-1 or Pa s m-1].
+ Ray_v !< The Rayleigh drag velocity to be applied to each layer at v-points [H T-1 ~> m s-1 or Pa s m-1].
! The following elements are pointers so they can be used as targets for pointers in the restart registry.
real, pointer, dimension(:,:) :: MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m].
real, pointer, dimension(:,:) :: sfc_buoy_flx => NULL() !< Surface buoyancy flux (derived) [Z2 T-3 ~> m2 s-3].
real, pointer, dimension(:,:,:) :: Kd_shear => NULL()
!< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers
- !! in tracer columns [Z2 T-1 ~> m2 s-1].
+ !! in tracer columns [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, pointer, dimension(:,:,:) :: Kv_shear => NULL()
!< The shear-driven turbulent vertical viscosity at the interfaces between layers
- !! in tracer columns [Z2 T-1 ~> m2 s-1].
+ !! in tracer columns [H Z T-1 ~> m2 s-1 or Pa s]
real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL()
!< The shear-driven turbulent vertical viscosity at the interfaces between layers in
- !! corner columns [Z2 T-1 ~> m2 s-1].
+ !! corner columns [H Z T-1 ~> m2 s-1 or Pa s]
real, pointer, dimension(:,:,:) :: Kv_slow => NULL()
!< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal,
- !! background, convection etc) [Z2 T-1 ~> m2 s-1].
+ !! background, convection etc) [H Z T-1 ~> m2 s-1 or Pa s]
real, pointer, dimension(:,:,:) :: TKE_turb => NULL()
!< The turbulent kinetic energy per unit mass at the interfaces [Z2 T-2 ~> m2 s-2].
!! This may be at the tracer or corner points
diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90
index 5e9b5c476c..b0b9fa9fcd 100644
--- a/src/core/MOM_verticalGrid.F90
+++ b/src/core/MOM_verticalGrid.F90
@@ -138,8 +138,12 @@ subroutine verticalGridInit( param_file, GV, US )
default=.true., do_not_log=GV%Boussinesq)
if (GV%Boussinesq) GV%semi_Boussinesq = .true.
call get_param(param_file, mdl, "RHO_KV_CONVERT", Rho_Kv, &
- "The density used to convert input kinematic viscosities into dynamic "//&
- "viscosities in non-BOUSSINESQ mode, and similarly for vertical diffusivities.", &
+ "The density used to convert input vertical distances into thickesses in "//&
+ "non-BOUSSINESQ mode, and to convert kinematic viscosities into dynamic "//&
+ "viscosities and similarly for vertical diffusivities. GV%m_to_H is set "//&
+ "using this value, whereas GV%Z_to_H is set using RHO_0. The default is "//&
+ "RHO_0, but this can be set separately to demonstrate the independence of the "//&
+ "non-Boussinesq solutions of the value of RHO_0.", &
units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
do_not_log=GV%Boussinesq)
call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_Z, &
@@ -186,18 +190,22 @@ subroutine verticalGridInit( param_file, GV, US )
GV%m_to_H = 1.0 / GV%H_to_m
GV%H_to_MKS = GV%H_to_m
GV%m2_s_to_HZ_T = GV%m_to_H * US%m_to_Z * US%T_to_s
+
+ GV%H_to_Z = GV%H_to_m * US%m_to_Z
+ GV%Z_to_H = US%Z_to_m * GV%m_to_H
else
GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2
- GV%m_to_H = US%R_to_kg_m3*GV%Rho0 * GV%kg_m2_to_H
- GV%H_to_m = GV%H_to_kg_m2 / (US%R_to_kg_m3*GV%Rho0)
+ ! GV%m_to_H = US%R_to_kg_m3*GV%Rho0 * GV%kg_m2_to_H
+ GV%m_to_H = US%R_to_kg_m3*rho_Kv * GV%kg_m2_to_H
GV%H_to_MKS = GV%H_to_kg_m2
GV%m2_s_to_HZ_T = US%R_to_kg_m3*rho_Kv * GV%kg_m2_to_H * US%m_to_Z * US%T_to_s
- endif
+ GV%H_to_m = 1.0 / GV%m_to_H
- GV%H_to_Z = GV%H_to_m * US%m_to_Z
- GV%Z_to_H = US%Z_to_m * GV%m_to_H
+ GV%H_to_Z = US%m_to_Z * ( GV%H_to_kg_m2 / (US%R_to_kg_m3*GV%Rho0) )
+ GV%Z_to_H = US%Z_to_m * ( US%R_to_kg_m3*GV%Rho0 * GV%kg_m2_to_H )
+ endif
- GV%Angstrom_H = GV%Z_to_H * GV%Angstrom_Z
+ GV%Angstrom_H = (US%Z_to_m * GV%m_to_H) * GV%Angstrom_Z
GV%Angstrom_m = US%Z_to_m * GV%Angstrom_Z
GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H, GV%m_to_H*1e-17)
diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90
index d53b2e6636..e9c1092ed7 100644
--- a/src/diagnostics/MOM_PointAccel.F90
+++ b/src/diagnostics/MOM_PointAccel.F90
@@ -83,7 +83,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st
real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]
real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), &
- optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1].
+ optional, intent(in) :: a !< The layer coupling coefficients from vertvisc
+ !! [H T-1 ~> m s-1 or Pa s m-1]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
optional, intent(in) :: hv !< The layer thicknesses at velocity grid points,
!! from vertvisc [H ~> m or kg m-2].
@@ -223,8 +224,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st
(vel_scale*ADp%du_other(I,j,k)) ; enddo
endif
if (present(a)) then
- write(file,'(/,"a: ",ES10.3," ")', advance='no') US%Z_to_m*a(I,j,ks)*dt
- do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(I,j,K)*dt) ; enddo
+ write(file,'(/,"a: ",ES10.3," ")', advance='no') h_scale*a(I,j,ks)*dt
+ do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (h_scale*a(I,j,K)*dt) ; enddo
endif
if (present(hv)) then
write(file,'(/,"hvel: ")', advance='no')
@@ -422,7 +423,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st
real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]
real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), &
- optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1].
+ optional, intent(in) :: a !< The layer coupling coefficients from vertvisc
+ !! [H T-1 ~> m s-1 or Pa s m-1]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
optional, intent(in) :: hv !< The layer thicknesses at velocity grid points,
!! from vertvisc [H ~> m or kg m-2].
@@ -566,8 +568,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st
(vel_scale*ADp%dv_other(i,J,k)) ; enddo
endif
if (present(a)) then
- write(file,'(/,"a: ",ES10.3," ")', advance='no') US%Z_to_m*a(i,J,ks)*dt
- do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(i,J,K)*dt) ; enddo
+ write(file,'(/,"a: ",ES10.3," ")', advance='no') h_scale*a(i,J,ks)*dt
+ do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (h_scale*a(i,J,K)*dt) ; enddo
endif
if (present(hv)) then
write(file,'(/,"hvel: ")', advance='no')
diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90
index cf8b042c14..aeb25bc351 100644
--- a/src/diagnostics/MOM_diagnostics.F90
+++ b/src/diagnostics/MOM_diagnostics.F90
@@ -56,7 +56,7 @@ module MOM_diagnostics
!! monotonic for the purposes of calculating the equivalent
!! barotropic wave speed [nondim].
real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of
- !! calculating the equivalent barotropic wave speed [Z ~> m].
+ !! calculating the equivalent barotropic wave speed [H ~> m or kg m-2].
type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
!! regulate the timing of diagnostic output.
@@ -957,9 +957,9 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
real :: KE_term(SZI_(G),SZJ_(G),SZK_(GV)) ! A term in the kinetic energy budget
! [H L2 T-3 ~> m3 s-3 or W m-2]
real :: KE_u(SZIB_(G),SZJ_(G)) ! The area integral of a KE term in a layer at u-points
- ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3]
+ ! [H L4 T-3 ~> m5 s-3 or W]
real :: KE_v(SZI_(G),SZJB_(G)) ! The area integral of a KE term in a layer at v-points
- ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3]
+ ! [H L4 T-3 ~> m5 s-3 or W]
real :: KE_h(SZI_(G),SZJ_(G)) ! A KE term contribution at tracer points
! [H L2 T-3 ~> m3 s-3 or W m-2]
@@ -984,7 +984,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_dKEdt > 0) then
- ! Calculate the time derivative of the layer KE [H L2 T-3 ~> m3 s-3].
+ ! Calculate the time derivative of the layer KE [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * CS%du_dt(I,j,k)
@@ -1006,7 +1006,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_PE_to_KE > 0) then
- ! Calculate the potential energy to KE term [H L2 T-3 ~> m3 s-3].
+ ! Calculate the potential energy to KE term [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%PFu(I,j,k)
@@ -1025,7 +1025,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_BT > 0) then
- ! Calculate the barotropic contribution to KE term [H L2 T-3 ~> m3 s-3].
+ ! Calculate the barotropic contribution to KE term [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%u_accel_bt(I,j,k)
@@ -1044,7 +1044,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_Coradv > 0) then
- ! Calculate the KE source from the combined Coriolis and advection terms [H L2 T-3 ~> m3 s-3].
+ ! Calculate the KE source from the combined Coriolis and advection terms [H L2 T-3 ~> m3 s-3 or W m-2].
! The Coriolis source should be zero, but is not due to truncation errors. There should be
! near-cancellation of the global integral of this spurious Coriolis source.
do k=1,nz
@@ -1069,7 +1069,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_adv > 0) then
- ! Calculate the KE source from along-layer advection [H L2 T-3 ~> m3 s-3].
+ ! Calculate the KE source from along-layer advection [H L2 T-3 ~> m3 s-3 or W m-2].
! NOTE: All terms in KE_adv are multiplied by -1, which can easily produce
! negative zeros and may signal a reproducibility issue over land.
! We resolve this by re-initializing and only evaluating over water points.
@@ -1098,7 +1098,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_visc > 0) then
- ! Calculate the KE source from vertical viscosity [H L2 T-3 ~> m3 s-3].
+ ! Calculate the KE source from vertical viscosity [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc(I,j,k)
@@ -1117,7 +1117,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_visc_gl90 > 0) then
- ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3].
+ ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc_gl90(I,j,k)
@@ -1136,7 +1136,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_stress > 0) then
- ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3].
+ ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_str(I,j,k)
@@ -1155,7 +1155,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_horvisc > 0) then
- ! Calculate the KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3].
+ ! Calculate the KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%diffu(I,j,k)
@@ -1174,7 +1174,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
endif
if (CS%id_KE_dia > 0) then
- ! Calculate the KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3].
+ ! Calculate the KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3 or W m-2].
do k=1,nz
do j=js,je ; do I=Isq,Ieq
KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_dia(I,j,k)
@@ -1572,12 +1572,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag
character(len=48) :: thickness_units, flux_units
logical :: use_temperature, adiabatic
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use
! for remapping. Values below 20190101 recover the remapping
! answers from 2018, while higher values use more robust
! forms of the same remapping expressions.
- logical :: remap_answers_2018
CS%initialized = .true.
@@ -1594,7 +1592,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag
call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_DEPTH", CS%mono_N2_depth, &
"The depth below which N2 is limited as monotonic for the "// &
"purposes of calculating the equivalent barotropic wave speed.", &
- units='m', scale=US%m_to_Z, default=-1.)
+ units='m', scale=GV%m_to_H, default=-1.)
call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_TOL", wave_speed_tol, &
"The fractional tolerance for finding the wave speeds.", &
units="nondim", default=0.001)
@@ -1608,23 +1606,13 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701)
call get_param(param_file, mdl, "SPLIT", split, default=.true., do_not_log=.true.)
diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90
index d6a337b08a..4a50abbb14 100644
--- a/src/diagnostics/MOM_obsolete_params.F90
+++ b/src/diagnostics/MOM_obsolete_params.F90
@@ -113,6 +113,44 @@ subroutine find_obsolete_params(param_file)
call obsolete_logical(param_file, "SMOOTH_RI", hint="Instead use N_SMOOTH_RI.")
+ call obsolete_logical(param_file, "TIDE_USE_SAL_SCALAR", hint="Use SAL_SCALAR_APPROX instead.")
+ call obsolete_logical(param_file, "TIDAL_SAL_SHT", hint="Use SAL_HARMONICS instead.")
+ call obsolete_int(param_file, "TIDAL_SAL_SHT_DEGREE", hint="Use SAL_HARMONICS_DEGREE instead.")
+ call obsolete_real(param_file, "RHO_E", hint="Use RHO_SOLID_EARTH instead.")
+ call obsolete_logical(param_file, "DEFAULT_2018_ANSWERS", hint="Instead use DEFAULT_ANSWER_DATE.")
+
+ call obsolete_logical(param_file, "SURFACE_FORCING_2018_ANSWERS", &
+ hint="Instead use SURFACE_FORCING_ANSWER_DATE.")
+ call obsolete_logical(param_file, "WIND_GYRES_2018_ANSWERS", &
+ hint="Instead use WIND_GYRES_ANSWER_DATE.")
+
+ call obsolete_logical(param_file, "BAROTROPIC_2018_ANSWERS", &
+ hint="Instead use BAROTROPIC_ANSWER_DATE.")
+ call obsolete_logical(param_file, "EPBL_2018_ANSWERS", hint="Instead use EPBL_ANSWER_DATE.")
+ call obsolete_logical(param_file, "HOR_REGRID_2018_ANSWERS", &
+ hint="Instead use HOR_REGRID_ANSWER_DATE.")
+ call obsolete_logical(param_file, "HOR_VISC_2018_ANSWERS", &
+ hint="Instead use HOR_VISC_ANSWER_DATE.")
+ call obsolete_logical(param_file, "IDL_HURR_2018_ANSWERS", &
+ hint="Instead use IDL_HURR_ANSWER_DATE.")
+ call obsolete_logical(param_file, "MEKE_GEOMETRIC_2018_ANSWERS", &
+ hint="Instead use MEKE_GEOMETRIC_ANSWER_DATE.")
+ call obsolete_logical(param_file, "ODA_2018_ANSWERS", hint="Instead use ODA_ANSWER_DATE.")
+ call obsolete_logical(param_file, "OPTICS_2018_ANSWERS", hint="Instead use OPTICS_ANSWER_DATE.")
+ call obsolete_logical(param_file, "REGULARIZE_LAYERS_2018_ANSWERS", &
+ hint="Instead use REGULARIZE_LAYERS_ANSWER_DATE.")
+ call obsolete_logical(param_file, "REMAPPING_2018_ANSWERS", &
+ hint="Instead use REMAPPING_ANSWER_DATE.")
+ call obsolete_logical(param_file, "SET_DIFF_2018_ANSWERS", &
+ hint="Instead use SET_DIFF_ANSWER_DATE.")
+ call obsolete_logical(param_file, "SET_VISC_2018_ANSWERS", &
+ hint="Instead use SET_VISC_ANSWER_DATE.")
+ call obsolete_logical(param_file, "SURFACE_2018_ANSWERS", hint="Instead use SURFACE_ANSWER_DATE.")
+ call obsolete_logical(param_file, "TIDAL_MIXING_2018_ANSWERS", &
+ hint="Instead use TIDAL_MIXING_ANSWER_DATE.")
+ call obsolete_logical(param_file, "VERT_FRICTION_2018_ANSWERS", &
+ hint="Instead use VERT_FRICTION_ANSWER_DATE.")
+
! Write the file version number to the model log.
call log_version(param_file, mdl, version)
diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90
index fd957d0a44..fb95b79a91 100644
--- a/src/diagnostics/MOM_sum_output.F90
+++ b/src/diagnostics/MOM_sum_output.F90
@@ -8,7 +8,7 @@ module MOM_sum_output
use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum
use MOM_coms, only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP
use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs
-use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg
+use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_forcing_type, only : forcing
use MOM_grid, only : ocean_grid_type
@@ -510,24 +510,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci
do k=1,nz ; vol_lay(k) = (US%m_to_L**2*GV%H_to_Z/GV%H_to_kg_m2)*mass_lay(k) ; enddo
else
tmp1(:,:,:) = 0.0
- if (CS%do_APE_calc) then
- do k=1,nz ; do j=js,je ; do i=is,ie
- tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j)
- enddo ; enddo ; enddo
- mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP)
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j)
+ enddo ; enddo ; enddo
+ mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP)
+ if (CS%do_APE_calc) then
call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref)
do k=1,nz ; do j=js,je ; do i=is,ie
tmp1(i,j,k) = US%Z_to_m*US%L_to_m**2*(eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j)
enddo ; enddo ; enddo
vol_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=vol_lay)
do k=1,nz ; vol_lay(k) = US%m_to_Z*US%m_to_L**2 * vol_lay(k) ; enddo
- else
- do k=1,nz ; do j=js,je ; do i=is,ie
- tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j)
- enddo ; enddo ; enddo
- mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP)
- do k=1,nz ; vol_lay(k) = US%m_to_Z*US%m_to_L**2*US%kg_m3_to_R * (mass_lay(k) / GV%Rho0) ; enddo
endif
endif ! Boussinesq
@@ -643,7 +637,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci
if (GV%Boussinesq) then
do j=js,je ; do i=is,ie
hbelow = 0.0
- do k=nz,1,-1
+ do K=nz,1,-1
hbelow = hbelow + h(i,j,k) * GV%H_to_Z
hint = Z_0APE(K) + (hbelow - (G%bathyT(i,j) + G%Z_ref))
hbot = Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref)
@@ -652,14 +646,28 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci
(hint * hint - hbot * hbot)
enddo
enddo ; enddo
- else
+ elseif (GV%semi_Boussinesq) then
do j=js,je ; do i=is,ie
- do k=nz,1,-1
+ do K=nz,1,-1
hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs.
hbot = max(Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref), 0.0)
PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * &
- (hint * hint - hbot * hbot)
+ (hint * hint - hbot * hbot)
+ enddo
+ enddo ; enddo
+ else
+ do j=js,je ; do i=is,ie
+ do K=nz,2,-1
+ hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs.
+ hbot = max(Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref), 0.0)
+ PE_pt(i,j,K) = (0.25 * PE_scale_factor * areaTm(i,j) * &
+ ((GV%Rlay(k)+GV%Rlay(k-1))*GV%g_prime(K))) * &
+ (hint * hint - hbot * hbot)
enddo
+ hint = Z_0APE(1) + eta(i,j,1) ! eta and H_0 have opposite signs.
+ hbot = max(Z_0APE(1) - (G%bathyT(i,j) + G%Z_ref), 0.0)
+ PE_pt(i,j,1) = (0.5 * PE_scale_factor * areaTm(i,j) * (GV%Rlay(1)*GV%g_prime(1))) * &
+ (hint * hint - hbot * hbot)
enddo ; enddo
endif
@@ -1077,7 +1085,7 @@ subroutine depth_list_setup(G, GV, US, DL, CS)
valid_DL_read = .true. ! Otherwise there would have been a fatal error.
endif
else
- if (is_root_pe()) call MOM_error(WARNING, "depth_list_setup: "// &
+ if (is_root_pe()) call MOM_error(NOTE, "depth_list_setup: "// &
trim(CS%depth_list_file)//" does not exist. Creating a new file.")
valid_DL_read = .false.
endif
diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90
index bb1b381c15..59dbfc184e 100644
--- a/src/diagnostics/MOM_wave_speed.F90
+++ b/src/diagnostics/MOM_wave_speed.F90
@@ -7,11 +7,12 @@ module MOM_wave_speed
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_file_parser, only : log_version
use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h, interpolate_column
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
-use MOM_EOS, only : calculate_density_derivs
+use MOM_EOS, only : calculate_density_derivs, calculate_specific_vol_derivs
implicit none ; private
@@ -38,7 +39,8 @@ module MOM_wave_speed
!! wave speed [nondim]. This parameter controls the default behavior of
!! wave_speed() which can be overridden by optional arguments.
real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of
- !! calculating the equivalent barotropic wave speed [Z ~> m].
+ !! calculating the equivalent barotropic wave speed [H ~> m or kg m-2].
+ !! If this parameter is negative, this limiting does not occur.
!! This parameter controls the default behavior of wave_speed() which
!! can be overridden by optional arguments.
real :: min_speed2 = 0. !< The minimum mode 1 internal wave speed squared [L2 T-2 ~> m2 s-2]
@@ -61,7 +63,7 @@ module MOM_wave_speed
contains
!> Calculates the wave speed of the first baroclinic mode.
-subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_N2_column_fraction, &
+subroutine wave_speed(h, tv, G, GV, US, cg1, CS, halo_size, use_ebt_mode, mono_N2_column_fraction, &
mono_N2_depth, modal_structure)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -71,8 +73,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed [L T-1 ~> m s-1]
type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct
- logical, optional, intent(in) :: full_halos !< If true, do the calculation
- !! over the entire computational domain.
+ integer, optional, intent(in) :: halo_size !< Width of halo within which to
+ !! calculate wave speeds
logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent
!! barotropic mode instead of the first baroclinic mode.
real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction
@@ -80,7 +82,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
!! for the purposes of calculating vertical modal structure [nondim].
real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as
!! monotonic for the purposes of calculating vertical
- !! modal structure [Z ~> m].
+ !! modal structure [H ~> m or kg m-2].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
optional, intent(out) :: modal_structure !< Normalized model structure [nondim]
@@ -88,27 +90,28 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
real, dimension(SZK_(GV)+1) :: &
dRho_dT, & ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
dRho_dS, & ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]
+ dSpV_dT, & ! Partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ dSpV_dS, & ! Partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]
pres, & ! Interface pressure [R L2 T-2 ~> Pa]
T_int, & ! Temperature interpolated to interfaces [C ~> degC]
S_int, & ! Salinity interpolated to interfaces [S ~> ppt]
- H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m]
- H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m]
- gprime ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2].
+ H_top, & ! The distance of each filtered interface from the ocean surface [H ~> m or kg m-2]
+ H_bot, & ! The distance of each filtered interface from the bottom [H ~> m or kg m-2]
+ gprime ! The reduced gravity across each interface [L2 H-1 T-2 ~> m s-2 or m4 s-1 kg-1].
real, dimension(SZK_(GV)) :: &
Igl, Igu ! The inverse of the reduced gravity across an interface times
! the thickness of the layer below (Igl) or above (Igu) it, in [T2 L-2 ~> s2 m-2].
real, dimension(SZK_(GV),SZI_(G)) :: &
- Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m]
+ Hf, & ! Layer thicknesses after very thin layers are combined [H ~> m or kg m-2]
Tf, & ! Layer temperatures after very thin layers are combined [C ~> degC]
Sf, & ! Layer salinities after very thin layers are combined [S ~> ppt]
Rf ! Layer densities after very thin layers are combined [R ~> kg m-3]
real, dimension(SZK_(GV)) :: &
- Hc, & ! A column of layer thicknesses after convective instabilities are removed [Z ~> m]
+ Hc, & ! A column of layer thicknesses after convective instabilities are removed [H ~> m or kg m-2]
Tc, & ! A column of layer temperatures after convective instabilities are removed [C ~> degC]
Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt]
- Rc, & ! A column of layer densities after convective instabilities are removed [R ~> kg m-3]
- Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2]
- real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m]
+ Rc ! A column of layer densities after convective instabilities are removed [R ~> kg m-3]
+ real :: I_Htot ! The inverse of the total filtered thicknesses [H-1 ~> m-1 or m2 kg-1]
real :: det, ddet ! Determinant of the eigen system and its derivative with lam. Because the
! units of the eigenvalue change with the number of layers and because of the
! dynamic rescaling that is used to keep det in a numerically representable range,
@@ -117,18 +120,21 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
real :: lam ! The eigenvalue [T2 L-2 ~> s2 m-2]
real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2]
real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s2 m-2]
- real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1]
+ real :: H_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]
real, dimension(SZI_(G)) :: &
- htot, hmin, & ! Thicknesses [Z ~> m]
- H_here, & ! A thickness [Z ~> m]
- HxT_here, & ! A layer integrated temperature [C Z ~> degC m]
- HxS_here, & ! A layer integrated salinity [S Z ~> ppt m]
- HxR_here ! A layer integrated density [R Z ~> kg m-2]
+ htot, hmin, & ! Thicknesses [H ~> m or kg m-2]
+ H_here, & ! A thickness [H ~> m or kg m-2]
+ HxT_here, & ! A layer integrated temperature [C H ~> degC m or degC kg m-2]
+ HxS_here, & ! A layer integrated salinity [S H ~> ppt m or ppt kg m-2]
+ HxR_here ! A layer integrated density [R H ~> kg m-2 or kg2 m-5]
real :: speed2_tot ! overestimate of the mode-1 speed squared [L2 T-2 ~> m2 s-2]
real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2]
- real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1]
- real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2]
- real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1].
+ real :: cg1_est ! An initial estimate of the squared first mode speed [L2 T-2 ~> m2 s-2]
+ real :: I_Hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m2 kg-1]
+ real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R H ~> kg m-2 or kg2 m-5]
+ real :: dSpVxh_sum ! The sum of specific volume differences across interfaces times
+ ! thicknesses [R-1 H ~> m4 kg-1 or m], negative for stable stratification.
+ real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2].
real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and
! its derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim].
! The exact value should not matter for the final result if it is an even power of 2.
@@ -147,31 +153,35 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
! with each iteration. Because of all of the dynamic rescaling of the determinant
! between rows, its units are not easily interpretable, but the ratio of det/ddet
! always has units of [T2 L-2 ~> s2 m-2]
- logical :: use_EOS ! If true, density is calculated from T & S using an equation of state.
+ logical :: use_EOS ! If true, density or specific volume is calculated from T & S using an equation of state.
+ logical :: nonBous ! If true, do not make the Boussinesq approximation.
logical :: better_est ! If true, use an improved estimate of the first mode internal wave speed.
logical :: merge ! If true, merge the current layer with the one above.
integer :: kc ! The number of layers in the column after merging
- integer :: i, j, k, k2, itt, is, ie, js, je, nz
- real :: hw ! The mean of the adjacent layer thicknesses [Z ~> m]
- real :: sum_hc ! The sum of the layer thicknesses [Z ~> m]
- real :: gp ! A limited local copy of gprime [L2 Z-1 T-2 ~> m s-2]
- real :: N2min ! A minimum buoyancy frequency, including a slope rescaling factor [L2 Z-2 T-2 ~> s-2]
+ integer :: i, j, k, k2, itt, is, ie, js, je, nz, halo
+ real :: hw ! The mean of the adjacent layer thicknesses [H ~> m or kg m-2]
+ real :: sum_hc ! The sum of the layer thicknesses [H ~> m or kg m-2]
+ real :: gp ! A limited local copy of gprime [L2 H-1 T-2 ~> m s-2 or m4 s-1 kg-1]
+ real :: N2min ! A minimum buoyancy frequency, including a slope rescaling factor [L2 H-2 T-2 ~> s-2 or m6 kg-2 s-2]
+ logical :: below_mono_N2_frac ! True if an interface is below the fractional depth where N2 should not increase.
+ logical :: below_mono_N2_depth ! True if an interface is below the absolute depth where N2 should not increase.
logical :: l_use_ebt_mode, calc_modal_structure
real :: l_mono_N2_column_fraction ! A local value of mono_N2_column_fraction [nondim]
- real :: l_mono_N2_depth ! A local value of mono_N2_column_depth [Z ~> m]
+ real :: l_mono_N2_depth ! A local value of mono_N2_column_depth [H ~> m or kg m-2]
real :: mode_struct(SZK_(GV)) ! The mode structure [nondim], but it is also temporarily
! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6.
real :: ms_min, ms_max ! The minimum and maximum mode structure values returned from tdma6 [L2 T-2 ~> m2 s-2]
real :: ms_sq ! The sum of the square of the values returned from tdma6 [L4 T-4 ~> m4 s-4]
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ; halo = 0
if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed / wave_speed: "// &
"Module must be initialized before it is used.")
- if (present(full_halos)) then ; if (full_halos) then
- is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed
- endif ; endif
+ if (present(halo_size)) then
+ halo = halo_size
+ is = G%isc - halo ; ie = G%iec + halo ; js = G%jsc - halo ; je = G%jec + halo
+ endif
l_use_ebt_mode = CS%use_ebt_mode
if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode
@@ -187,9 +197,10 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
enddo ; enddo ; enddo
endif
- g_Rho0 = GV%g_Earth / GV%Rho0
- ! Simplifying the following could change answers at roundoff.
- Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth)
+ g_Rho0 = GV%g_Earth*GV%H_to_Z / GV%Rho0
+ H_to_pres = GV%H_to_RZ * GV%g_Earth
+ ! Note that g_Rho0 = H_to_pres / GV%Rho0**2
+ nonBous = .not.(GV%Boussinesq .or. GV%semi_Boussinesq)
use_EOS = associated(tv%eqn_of_state)
better_est = CS%better_cg1_est
@@ -213,24 +224,17 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results.
min_h_frac = tol_Hfrac / real(nz)
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,tv,&
-!$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, &
-!$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, &
-!$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale, &
-!$OMP better_est,cg1_min2,tol_merge,tol_solve,c2_scale) &
-!$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, &
-!$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT,drho_dS, &
-!$OMP drxh_sum,kc,Hc,Hc_H,Tc,Sc,I_Hnew,gprime,&
-!$OMP Rc,speed2_tot,Igl,Igu,lam0,lam,lam_it,dlam, &
-!$OMP mode_struct,sum_hc,N2min,gp,hw, &
-!$OMP ms_min,ms_max,ms_sq,H_top,H_bot,I_Htot,merge, &
-!$OMP det,ddet,det_it,ddet_it)
+ !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,tv,use_EOS,nonBous, &
+ !$OMP CS,min_h_frac,calc_modal_structure,l_use_ebt_mode, &
+ !$OMP modal_structure,l_mono_N2_column_fraction,l_mono_N2_depth, &
+ !$OMP H_to_pres,cg1,g_Rho0,rescale,I_rescale,cg1_min2, &
+ !$OMP better_est,tol_solve,tol_merge,c2_scale)
do j=js,je
! First merge very thin layers with the one above (or below if they are
! at the top). This also transposes the row order so that columns can
! be worked upon one at a time.
do i=is,ie ; htot(i) = 0.0 ; enddo
- do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo
+ do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo
do i=is,ie
hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0
@@ -238,20 +242,20 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
enddo
if (use_EOS) then
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k) > hmin(i))) then
Hf(kf(i),i) = H_here(i)
Tf(kf(i),i) = HxT_here(i) / H_here(i)
Sf(kf(i),i) = HxS_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*GV%H_to_Z
- HxT_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k)
- HxS_here(i) = (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k)
+ H_here(i) = h(i,j,k)
+ HxT_here(i) = h(i,j,k) * tv%T(i,j,k)
+ HxS_here(i) = h(i,j,k) * tv%S(i,j,k)
else
- H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
- HxT_here(i) = HxT_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%T(i,j,k)
- HxS_here(i) = HxS_here(i) + (h(i,j,k) * GV%H_to_Z) * tv%S(i,j,k)
+ H_here(i) = H_here(i) + h(i,j,k)
+ HxT_here(i) = HxT_here(i) + h(i,j,k) * tv%T(i,j,k)
+ HxS_here(i) = HxS_here(i) + h(i,j,k) * tv%S(i,j,k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -259,18 +263,18 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
Tf(kf(i),i) = HxT_here(i) / H_here(i)
Sf(kf(i),i) = HxS_here(i) / H_here(i)
endif ; enddo
- else
+ else ! .not. (use_EOS)
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k) > hmin(i))) then
Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*GV%H_to_Z
- HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
+ H_here(i) = h(i,j,k)
+ HxR_here(i) = h(i,j,k)*GV%Rlay(k)
else
- H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
- HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
+ H_here(i) = H_here(i) + h(i,j,k)
+ HxR_here(i) = HxR_here(i) + h(i,j,k)*GV%Rlay(k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
@@ -283,16 +287,21 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
if (use_EOS) then
pres(1) = 0.0 ; H_top(1) = 0.0
do K=2,kf(i)
- pres(K) = pres(K-1) + Z_to_pres*Hf(k-1,i)
+ pres(K) = pres(K-1) + H_to_pres*Hf(k-1,i)
T_int(K) = 0.5*(Tf(k,i)+Tf(k-1,i))
S_int(K) = 0.5*(Sf(k,i)+Sf(k-1,i))
H_top(K) = H_top(K-1) + Hf(k-1,i)
enddo
- call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, &
- tv%eqn_of_state, (/2,kf(i)/) )
+ if (nonBous) then
+ call calculate_specific_vol_derivs(T_int, S_int, pres, dSpV_dT, dSpV_dS, &
+ tv%eqn_of_state, (/2,kf(i)/) )
+ else
+ call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, &
+ tv%eqn_of_state, (/2,kf(i)/) )
+ endif
! Sum the reduced gravities to find out how small a density difference is negligibly small.
- drxh_sum = 0.0
+ drxh_sum = 0.0 ; dSpVxh_sum = 0.0
if (better_est) then
! This is an estimate that is correct for the non-EBT mode for 2 or 3 layers, or for
! clusters of massless layers at interfaces that can be grouped into 2 or 3 layers.
@@ -301,44 +310,81 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
if (H_top(kf(i)) > 0.0) then
I_Htot = 1.0 / (H_top(kf(i)) + Hf(kf(i),i)) ! = 1.0 / (H_top(K) + H_bot(K)) for all K.
H_bot(kf(i)+1) = 0.0
- do K=kf(i),2,-1
- H_bot(K) = H_bot(K+1) + Hf(k,i)
- drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
- max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
- enddo
+ if (nonBous) then
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ dSpVxh_sum = dSpVxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
+ min(0.0, dSpV_dT(K)*(Tf(k,i)-Tf(k-1,i)) + dSpV_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ else
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
+ max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ endif
endif
else
! This estimate is problematic in that it goes like 1/nz for a large number of layers,
! but it is an overestimate (as desired) for a small number of layers, by at a factor
! of (H1+H2)**2/(H1*H2) >= 4 for two thick layers.
- do K=2,kf(i)
- drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * &
- max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
- enddo
+ if (nonBous) then
+ do K=2,kf(i)
+ dSpVxh_sum = dSpVxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * &
+ min(0.0, dSpV_dT(K)*(Tf(k,i)-Tf(k-1,i)) + dSpV_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ else
+ do K=2,kf(i)
+ drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * &
+ max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ endif
endif
- else
- drxh_sum = 0.0
+ else ! .not. (use_EOS)
+ drxh_sum = 0.0 ; dSpVxh_sum = 0.0
if (better_est) then
H_top(1) = 0.0
do K=2,kf(i) ; H_top(K) = H_top(K-1) + Hf(k-1,i) ; enddo
if (H_top(kf(i)) > 0.0) then
I_Htot = 1.0 / (H_top(kf(i)) + Hf(kf(i),i)) ! = 1.0 / (H_top(K) + H_bot(K)) for all K.
H_bot(kf(i)+1) = 0.0
- do K=kf(i),2,-1
- H_bot(K) = H_bot(K+1) + Hf(k,i)
- drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * max(0.0,Rf(k,i)-Rf(k-1,i))
- enddo
+ if (nonBous) then
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ dSpVxh_sum = dSpVxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
+ min(0.0, (Rf(k-1,i)-Rf(k,i)) / (Rf(k,i)*Rf(k-1,i)))
+ enddo
+ else
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * max(0.0,Rf(k,i)-Rf(k-1,i))
+ enddo
+ endif
endif
else
- do K=2,kf(i)
- drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * max(0.0,Rf(k,i)-Rf(k-1,i))
- enddo
+ if (nonBous) then
+ do K=2,kf(i)
+ dSpVxh_sum = dSpVxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * &
+ min(0.0, (Rf(k-1,i)-Rf(k,i)) / (Rf(k,i)*Rf(k-1,i)))
+ enddo
+ else
+ do K=2,kf(i)
+ drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * max(0.0,Rf(k,i)-Rf(k-1,i))
+ enddo
+ endif
endif
+ endif ! use_EOS
+
+ if (nonBous) then
+ ! Note that dSpVxh_sum is negative for stable stratification.
+ cg1_est = H_to_pres * abs(dSpVxh_sum)
+ else
+ cg1_est = g_Rho0 * drxh_sum
endif
! Find gprime across each internal interface, taking care of convective instabilities by
! merging layers. If the estimated wave speed is too small, simply return zero.
- if (g_Rho0 * drxh_sum <= cg1_min2) then
+ if (cg1_est <= cg1_min2) then
cg1(i,j) = 0.0
if (present(modal_structure)) modal_structure(i,j,:) = 0.
else
@@ -349,9 +395,15 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
kc = 1
Hc(1) = Hf(1,i) ; Tc(1) = Tf(1,i) ; Sc(1) = Sf(1,i)
do k=2,kf(i)
- if (better_est) then
+ if (better_est .and. nonBous) then
+ merge = ((dSpV_dT(K)*(Tc(kc)-Tf(k,i)) + dSpV_dS(K)*(Sc(kc)-Sf(k,i))) * &
+ ((Hc(kc) * Hf(k,i))*I_Htot) < abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (better_est) then
merge = ((drho_dT(K)*(Tf(k,i)-Tc(kc)) + drho_dS(K)*(Sf(k,i)-Sc(kc))) * &
((Hc(kc) * Hf(k,i))*I_Htot) < 2.0 * tol_merge*drxh_sum)
+ elseif (nonBous) then
+ merge = ((dSpV_dT(K)*(Tc(kc)-Tf(k,i)) + dSpV_dS(K)*(Sc(kc)-Sf(k,i))) * &
+ (Hc(kc) + Hf(k,i)) < abs(2.0 * tol_merge * dSpVxh_sum))
else
merge = ((drho_dT(K)*(Tf(k,i)-Tc(kc)) + drho_dS(K)*(Sf(k,i)-Sc(kc))) * &
(Hc(kc) + Hf(k,i)) < 2.0 * tol_merge*drxh_sum)
@@ -366,9 +418,15 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
! that the tolerance is a factor of two larger, to avoid limit how
! far back we go.
do K2=kc,2,-1
- if (better_est) then
+ if (better_est .and. nonBous) then
+ merge = ( (dSpV_dT(K2)*(Tc(k2-1)-Tc(k2)) + dSpV_dS(K2)*(Sc(k2-1)-Sc(k2))) * &
+ ((Hc(k2) * Hc(k2-1))*I_Htot) < abs(tol_merge * dSpVxh_sum) )
+ elseif (better_est) then
merge = ((drho_dT(K2)*(Tc(k2)-Tc(k2-1)) + drho_dS(K2)*(Sc(k2)-Sc(k2-1))) * &
((Hc(k2) * Hc(k2-1))*I_Htot) < tol_merge*drxh_sum)
+ elseif (nonBous) then
+ merge = ( (dSpV_dT(K2)*(Tc(k2-1)-Tc(k2)) + dSpV_dS(K2)*(Sc(k2-1)-Sc(k2))) * &
+ (Hc(k2) + Hc(k2-1)) < abs(tol_merge * dSpVxh_sum) )
else
merge = ((drho_dT(K2)*(Tc(k2)-Tc(k2-1)) + drho_dS(K2)*(Sc(k2)-Sc(k2-1))) * &
(Hc(k2) + Hc(k2-1)) < tol_merge*drxh_sum)
@@ -385,20 +443,36 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
else
! Add a new layer to the column.
kc = kc + 1
- drho_dS(Kc) = drho_dS(K) ; drho_dT(Kc) = drho_dT(K)
+ if (nonBous) then
+ dSpV_dS(Kc) = dSpV_dS(K) ; dSpV_dT(Kc) = dSpV_dT(K)
+ else
+ drho_dS(Kc) = drho_dS(K) ; drho_dT(Kc) = drho_dT(K)
+ endif
Tc(kc) = Tf(k,i) ; Sc(kc) = Sf(k,i) ; Hc(kc) = Hf(k,i)
endif
enddo
! At this point there are kc layers and the gprimes should be positive.
- do K=2,kc ! Revisit this if non-Boussinesq.
- gprime(K) = g_Rho0 * (drho_dT(K)*(Tc(k)-Tc(k-1)) + drho_dS(K)*(Sc(k)-Sc(k-1)))
- enddo
- else ! .not.use_EOS
+ if (nonBous) then
+ do K=2,kc
+ gprime(K) = H_to_pres * (dSpV_dT(K)*(Tc(k-1)-Tc(k)) + dSpV_dS(K)*(Sc(k-1)-Sc(k)))
+ enddo
+ else
+ do K=2,kc
+ gprime(K) = g_Rho0 * (drho_dT(K)*(Tc(k)-Tc(k-1)) + drho_dS(K)*(Sc(k)-Sc(k-1)))
+ enddo
+ endif
+ else ! .not. (use_EOS)
! Do the same with density directly...
kc = 1
Hc(1) = Hf(1,i) ; Rc(1) = Rf(1,i)
do k=2,kf(i)
- if (better_est) then
+ if (nonBous .and. better_est) then
+ merge = ((Rf(k,i) - Rc(kc)) * ((Hc(kc) * Hf(k,i))*I_Htot) < &
+ (Rc(kc)*Rf(k,i)) * abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (nonBous) then
+ merge = ((Rf(k,i) - Rc(kc)) * (Hc(kc) + Hf(k,i)) < &
+ (Rc(kc)*Rf(k,i)) * abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (better_est) then
merge = ((Rf(k,i) - Rc(kc)) * ((Hc(kc) * Hf(k,i))*I_Htot) < 2.0*tol_merge*drxh_sum)
else
merge = ((Rf(k,i) - Rc(kc)) * (Hc(kc) + Hf(k,i)) < 2.0*tol_merge*drxh_sum)
@@ -411,7 +485,13 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
! that the tolerance is a factor of two larger, to avoid limit how
! far back we go.
do k2=kc,2,-1
- if (better_est) then
+ if (nonBous .and. better_est) then
+ merge = ((Rc(k2) - Rc(k2-1)) * ((Hc(kc) * Hf(k,i))*I_Htot) < &
+ (Rc(k2-1)*Rc(k2)) * abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (nonBous) then
+ merge = ((Rc(k2) - Rc(k2-1)) * (Hc(kc) + Hf(k,i)) < &
+ (Rc(k2-1)*Rc(k2)) * abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (better_est) then
merge = ((Rc(k2)-Rc(k2-1)) * ((Hc(k2) * Hc(k2-1))*I_Htot) < tol_merge*drxh_sum)
else
merge = ((Rc(k2)-Rc(k2-1)) * (Hc(k2)+Hc(k2-1)) < tol_merge*drxh_sum)
@@ -430,9 +510,15 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
endif
enddo
! At this point there are kc layers and the gprimes should be positive.
- do K=2,kc ! Revisit this if non-Boussinesq.
- gprime(K) = g_Rho0 * (Rc(k)-Rc(k-1))
- enddo
+ if (nonBous) then
+ do K=2,kc
+ gprime(K) = H_to_pres * (Rc(k) - Rc(k-1)) / (Rc(k) * Rc(k-1))
+ enddo
+ else
+ do K=2,kc
+ gprime(K) = g_Rho0 * (Rc(k)-Rc(k-1))
+ enddo
+ endif
endif ! use_EOS
! Sum the contributions from all of the interfaces to give an over-estimate
@@ -451,24 +537,38 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
Igu(1) = 0. ! Neumann condition for pressure modes
sum_hc = Hc(1)
N2min = gprime(2)/Hc(1)
+
+ below_mono_N2_frac = .false.
+ below_mono_N2_depth = .false.
do k=2,kc
hw = 0.5*(Hc(k-1)+Hc(k))
gp = gprime(K)
+
if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then
- !### Change to: if ( ((htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) .or. & ) )
- if ( (((G%bathyT(i,j)+G%Z_ref) - sum_hc < l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref)) .or. &
- ((l_mono_N2_depth >= 0.) .and. (sum_hc > l_mono_N2_depth))) .and. &
- (gp > N2min*hw) ) then
- ! Filters out regions where N2 increases with depth but only in a lower fraction
+ ! Determine whether N2 estimates should not be allowed to increase with depth.
+ if (l_mono_N2_column_fraction>0.) then
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ below_mono_N2_frac = ((G%bathyT(i,j)+G%Z_ref) - GV%H_to_Z*sum_hc < &
+ l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref))
+ else
+ below_mono_N2_frac = (htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i))
+ endif
+ endif
+ if (l_mono_N2_depth >= 0.) below_mono_N2_depth = (sum_hc > l_mono_N2_depth)
+
+ if ( (gp > N2min*hw) .and. (below_mono_N2_frac .or. below_mono_N2_depth) ) then
+ ! Filters out regions where N2 increases with depth, but only in a lower fraction
! of the water column or below a certain depth.
gp = N2min * hw
else
N2min = gp / hw
endif
endif
+
Igu(k) = 1.0/(gp*Hc(k))
Igl(k-1) = 1.0/(gp*Hc(k-1))
sum_hc = sum_hc + Hc(k)
+
if (better_est) then
! Estimate that the ebt_mode is sqrt(2) times the speed of the flat bottom modes.
speed2_tot = speed2_tot + 2.0 * gprime(K)*((H_top(K) * H_bot(K)) * I_Htot)
@@ -572,17 +672,13 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_
else
mode_struct(1:kc)=0.
endif
- ! Note that remapping_core_h requires that the same units be used
- ! for both the source and target grid thicknesses, here [H ~> m or kg m-2].
- do k = 1,kc
- Hc_H(k) = GV%Z_to_H * Hc(k)
- enddo
+
if (CS%remap_answer_date < 20190101) then
- call remapping_core_h(CS%remapping_CS, kc, Hc_H(:), mode_struct, &
+ call remapping_core_h(CS%remapping_CS, kc, Hc(:), mode_struct, &
nz, h(i,j,:), modal_structure(i,j,:), &
1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H)
else
- call remapping_core_h(CS%remapping_CS, kc, Hc_H(:), mode_struct, &
+ call remapping_core_h(CS%remapping_CS, kc, Hc(:), mode_struct, &
nz, h(i,j,:), modal_structure(i,j,:), &
GV%H_subroundoff, GV%H_subroundoff)
endif
@@ -652,7 +748,7 @@ end subroutine tdma6
!> Calculates the wave speeds for the first few barolinic modes.
subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_struct_max, u_struct_bot, Nb, int_w2, &
- int_U2, int_N2w2, full_halos)
+ int_U2, int_N2w2, halo_size)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -660,50 +756,56 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
integer, intent(in) :: nmodes !< Number of modes
type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1,nmodes),intent(out) :: w_struct !< Wave Vertical profile [nondim]
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV),nmodes),intent(out) :: u_struct !< Wave Horizontal profile [Z-1 ~> m-1]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1,nmodes),intent(out) :: w_struct !< Wave vertical velocity profile [nondim]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV),nmodes),intent(out) :: u_struct !< Wave horizontal velocity profile
+ !! [Z-1 ~> m-1]
real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1]
- real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: u_struct_max !< Maximum of wave horizontal profile
- !! [Z-1 ~> m-1]
+ real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: u_struct_max !< Maximum of wave horizontal velocity
+ !! profile [Z-1 ~> m-1]
real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: u_struct_bot !< Bottom value of wave horizontal
- !! profile [Z-1 ~> m-1]
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Nb !< Bottom value of Brunt Vaissalla freqency
+ !! velocity profile [Z-1 ~> m-1]
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Nb !< Bottom value of buoyancy freqency
!! [T-1 ~> s-1]
- real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_w2 !< depth-integrated
- !! vertical profile squared [Z ~> m]
- real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_U2 !< depth-integrated
- !! horizontal profile squared [Z-1 ~> m-1]
- real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_N2w2 !< depth-integrated Brunt Vaissalla
- !! frequency times vertical
- !! profile squared [Z T-2 ~> m s-2]
- logical, optional, intent(in) :: full_halos !< If true, do the calculation
- !! over the entire data domain.
+ real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_w2 !< depth-integrated vertical velocity
+ !! profile squared [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_U2 !< depth-integrated horizontal velocity
+ !! profile squared [H Z-2 ~> m-1 or kg m-4]
+ real, dimension(SZI_(G),SZJ_(G),nmodes), intent(out) :: int_N2w2 !< depth-integrated buoyancy frequency
+ !! times vertical velocity profile
+ !! squared [H T-2 ~> m s-2 or kg m-2 s-2]
+ integer, optional, intent(in) :: halo_size !< Width of halo within which to
+ !! calculate wave speeds
! Local variables
real, dimension(SZK_(GV)+1) :: &
dRho_dT, & ! Partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
dRho_dS, & ! Partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]
+ dSpV_dT, & ! Partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ dSpV_dS, & ! Partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]
pres, & ! Interface pressure [R L2 T-2 ~> Pa]
T_int, & ! Temperature interpolated to interfaces [C ~> degC]
S_int, & ! Salinity interpolated to interfaces [S ~> ppt]
- H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m]
- H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m]
- gprime, & ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2].
- N2 ! The Brunt Vaissalla freqency squared [T-2 ~> s-2]
+ H_top, & ! The distance of each filtered interface from the ocean surface [H ~> m or kg m-2]
+ H_bot, & ! The distance of each filtered interface from the bottom [H ~> m or kg m-2]
+ gprime, & ! The reduced gravity across each interface [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
+ N2 ! The buoyancy freqency squared [T-2 ~> s-2]
real, dimension(SZK_(GV),SZI_(G)) :: &
- Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m]
+ Hf, & ! Layer thicknesses after very thin layers are combined [H ~> m or kg m-2]
+ dzf, & ! Layer vertical extents after very thin layers are combined [Z ~> m]
Tf, & ! Layer temperatures after very thin layers are combined [C ~> degC]
Sf, & ! Layer salinities after very thin layers are combined [S ~> ppt]
Rf ! Layer densities after very thin layers are combined [R ~> kg m-3]
+ real, dimension(SZI_(G),SZK_(GV)) :: &
+ dz_2d ! Height change across layers [Z ~> m]
real, dimension(SZK_(GV)) :: &
Igl, Igu, & ! The inverse of the reduced gravity across an interface times
! the thickness of the layer below (Igl) or above (Igu) it, in [T2 L-2 ~> s2 m-2].
- Hc, & ! A column of layer thicknesses after convective instabilities are removed [Z ~> m]
+ Hc, & ! A column of layer thicknesses after convective instabilities are removed [H ~> m or kg m-2]
+ dzc, & ! A column of layer vertical extents after convective instabilities are removed [Z ~> m]
Tc, & ! A column of layer temperatures after convective instabilities are removed [C ~> degC]
Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt]
- Rc, & ! A column of layer densities after convective instabilities are removed [R ~> kg m-3]
- Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2]
- real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m]
+ Rc ! A column of layer densities after convective instabilities are removed [R ~> kg m-3]
+ real :: I_Htot ! The inverse of the total filtered thicknesses [H-1 ~> m-1 or m2 kg-1]
real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and its
! derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim].
! The exact value should not matter for the final result if it is an even power of 2.
@@ -734,20 +836,24 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
xbl, xbr ! lam guesses bracketing a zero-crossing (root) [T2 L-2 ~> s2 m-2]
integer :: numint ! number of widows (intervals) in root searching range
integer :: nrootsfound ! number of extra roots found (not including 1st root)
- real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1]
+ real :: H_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]
real, dimension(SZI_(G)) :: &
- htot, hmin, & ! Thicknesses [Z ~> m]
- H_here, & ! A thickness [Z ~> m]
- HxT_here, & ! A layer integrated temperature [C Z ~> degC m]
- HxS_here, & ! A layer integrated salinity [S Z ~> ppt m]
- HxR_here ! A layer integrated density [R Z ~> kg m-2]
+ htot, hmin, & ! Thicknesses [H ~> m or kg m-2]
+ H_here, & ! A layer thickness [H ~> m or kg m-2]
+ dz_here, & ! A layer vertical extent [Z ~> m]
+ HxT_here, & ! A layer integrated temperature [C H ~> degC m or degC kg m-2]
+ HxS_here, & ! A layer integrated salinity [S H ~> ppt m or ppt kg m-2]
+ HxR_here ! A layer integrated density [R H ~> kg m-2 or kg2 m-5]
real :: speed2_tot ! overestimate of the mode-1 speed squared [L2 T-2 ~> m2 s-2]
real :: speed2_min ! minimum mode speed (squared) to consider in root searching [L2 T-2 ~> m2 s-2]
real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2]
+ real :: cg1_est ! An initial estimate of the squared first mode speed [L2 T-2 ~> m2 s-2]
real, parameter :: reduct_factor = 0.5 ! A factor used in setting speed2_min [nondim]
- real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1]
- real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2]
- real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1].
+ real :: I_Hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m2 kg-1]
+ real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R H ~> kg m-2 or kg2 m-5]
+ real :: dSpVxh_sum ! The sum of specific volume differences across interfaces times
+ ! thicknesses [R-1 H ~> m4 kg-1 or m], negative for stable stratification.
+ real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 pr m7 s-2 kg-1].
real :: tol_Hfrac ! Layers that together are smaller than this fraction of
! the total water column can be merged for efficiency [nondim].
real :: min_h_frac ! tol_Hfrac divided by the total number of layers [nondim].
@@ -756,7 +862,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
! when deciding to merge layers in the calculation [nondim]
integer :: kf(SZI_(G)) ! The number of active layers after filtering.
integer, parameter :: max_itt = 30
- logical :: use_EOS ! If true, density is calculated from T & S using the equation of state.
+ logical :: use_EOS ! If true, density or specific volume is calculated from T & S using the equation of state.
+ logical :: nonBous ! If true, do not make the Boussinesq approximation.
logical :: better_est ! If true, use an improved estimate of the first mode internal wave speed.
logical :: merge ! If true, merge the current layer with the one above.
integer :: nsub ! number of subintervals used for root finding
@@ -766,36 +873,38 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
logical :: sub_rootfound ! if true, subdivision has located root
integer :: kc ! The number of layers in the column after merging
integer :: sub, sub_it
- integer :: i, j, k, k2, itt, is, ie, js, je, nz, iint, m
+ integer :: i, j, k, k2, itt, is, ie, js, je, nz, iint, m, halo
real, dimension(SZK_(GV)+1) :: modal_structure !< Normalized model structure [nondim]
real, dimension(SZK_(GV)) :: modal_structure_fder !< Normalized model structure [Z-1 ~> m-1]
real :: mode_struct(SZK_(GV)+1) ! The mode structure [nondim], but it is also temporarily
! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6.
- real :: mode_struct_fder(SZK_(GV)) ! The mode structure 1st derivative [nondim], but it is also temporarily
- ! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6.
+ real :: mode_struct_fder(SZK_(GV)) ! The mode structure 1st derivative [Z-1 ~> m-1], but it is also temporarily
+ ! in units of [Z-1 L2 T-2 ~> m s-2] after it is modified inside of tdma6.
real :: mode_struct_sq(SZK_(GV)+1) ! The square of mode structure [nondim]
real :: mode_struct_fder_sq(SZK_(GV)) ! The square of mode structure 1st derivative [Z-2 ~> m-2]
real :: ms_min, ms_max ! The minimum and maximum mode structure values returned from tdma6 [L2 T-2 ~> m2 s-2]
real :: ms_sq ! The sum of the square of the values returned from tdma6 [L4 T-4 ~> m4 s-4]
- real :: w2avg ! A total for renormalization
- real, parameter :: a_int = 0.5 ! Integral total for normalization
- real :: renorm ! Normalization factor
+ real :: w2avg ! A total for renormalization [H L4 T-4 ~> m5 s-4 or kg m2 s-4]
+ real, parameter :: a_int = 0.5 ! Integral total for normalization [nondim]
+ real :: renorm ! Normalization factor [T2 L-2 ~> s2 m-2]
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ; halo = 0
if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed / wave_speeds: "// &
"Module must be initialized before it is used.")
- if (present(full_halos)) then ; if (full_halos) then
- is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed
- endif ; endif
+ if (present(halo_size)) then
+ halo = halo_size
+ is = G%isc - halo ; ie = G%iec + halo ; js = G%jsc - halo ; je = G%jec + halo
+ endif
- g_Rho0 = GV%g_Earth / GV%Rho0
- ! Simplifying the following could change answers at roundoff.
- Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth)
+ g_Rho0 = GV%g_Earth * GV%H_to_Z / GV%Rho0
+ H_to_pres = GV%H_to_RZ * GV%g_Earth
+ nonBous = .not.(GV%Boussinesq .or. GV%semi_Boussinesq)
use_EOS = associated(tv%eqn_of_state)
+
if (CS%c1_thresh < 0.0) &
call MOM_error(FATAL, "INTERNAL_WAVE_CG1_THRESH must be set to a non-negative "//&
"value via wave_speed_init for wave_speeds to be used.")
@@ -823,59 +932,69 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
w_struct(:,:,:,:) = 0.0
min_h_frac = tol_Hfrac / real(nz)
- !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,CS,min_h_frac,use_EOS, &
- !$OMP Z_to_pres,tv,cn,g_Rho0,nmodes,cg1_min2,better_est, &
- !$OMP tol_solve,tol_merge,c2_scale)
+ !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,CS,use_EOS,nonBous, &
+ !$OMP min_h_frac,H_to_pres,tv,cn,g_Rho0,nmodes,cg1_min2, &
+ !$OMP better_est,tol_solve,tol_merge,c2_scale)
do j=js,je
! First merge very thin layers with the one above (or below if they are
! at the top). This also transposes the row order so that columns can
! be worked upon one at a time.
do i=is,ie ; htot(i) = 0.0 ; enddo
- do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo
+ do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo
+
+ call thickness_to_dz(h, tv, dz_2d, j, G, GV, halo_size=halo)
do i=is,ie
- hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0
+ hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 ; dz_here(i) = 0.0
HxT_here(i) = 0.0 ; HxS_here(i) = 0.0 ; HxR_here(i) = 0.0
enddo
if (use_EOS) then
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k) > hmin(i))) then
Hf(kf(i),i) = H_here(i)
+ dzf(kf(i),i) = dz_here(i)
Tf(kf(i),i) = HxT_here(i) / H_here(i)
Sf(kf(i),i) = HxS_here(i) / H_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*GV%H_to_Z
- HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*tv%T(i,j,k)
- HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*tv%S(i,j,k)
+ H_here(i) = h(i,j,k)
+ dz_here(i) = dz_2d(i,k)
+ HxT_here(i) = h(i,j,k)*tv%T(i,j,k)
+ HxS_here(i) = h(i,j,k)*tv%S(i,j,k)
else
- H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
- HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*tv%T(i,j,k)
- HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*tv%S(i,j,k)
+ H_here(i) = H_here(i) + h(i,j,k)
+ dz_here(i) = dz_here(i) + dz_2d(i,k)
+ HxT_here(i) = HxT_here(i) + h(i,j,k)*tv%T(i,j,k)
+ HxS_here(i) = HxS_here(i) + h(i,j,k)*tv%S(i,j,k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
Hf(kf(i),i) = H_here(i)
+ dzf(kf(i),i) = dz_here(i)
Tf(kf(i),i) = HxT_here(i) / H_here(i)
Sf(kf(i),i) = HxS_here(i) / H_here(i)
endif ; enddo
- else
+ else ! .not. (use_EOS)
do k=1,nz ; do i=is,ie
- if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then
+ if ((H_here(i) > hmin(i)) .and. (h(i,j,k) > hmin(i))) then
Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i)
+ dzf(kf(i),i) = dz_here(i)
kf(i) = kf(i) + 1
! Start a new layer
- H_here(i) = h(i,j,k)*GV%H_to_Z
- HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
+ H_here(i) = h(i,j,k)
+ dz_here(i) = dz_2d(i,k)
+ HxR_here(i) = h(i,j,k)*GV%Rlay(k)
else
- H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z
- HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k)
+ H_here(i) = H_here(i) + h(i,j,k)
+ dz_here(i) = dz_here(i) + dz_2d(i,k)
+ HxR_here(i) = HxR_here(i) + h(i,j,k)*GV%Rlay(k)
endif
enddo ; enddo
do i=is,ie ; if (H_here(i) > 0.0) then
Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i)
+ dzf(kf(i),i) = dz_here(i)
endif ; enddo
endif
@@ -885,16 +1004,21 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
if (use_EOS) then
pres(1) = 0.0 ; H_top(1) = 0.0
do K=2,kf(i)
- pres(K) = pres(K-1) + Z_to_pres*Hf(k-1,i)
+ pres(K) = pres(K-1) + H_to_pres*Hf(k-1,i)
T_int(K) = 0.5*(Tf(k,i)+Tf(k-1,i))
S_int(K) = 0.5*(Sf(k,i)+Sf(k-1,i))
H_top(K) = H_top(K-1) + Hf(k-1,i)
enddo
- call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, &
- tv%eqn_of_state, (/2,kf(i)/) )
+ if (nonBous) then
+ call calculate_specific_vol_derivs(T_int, S_int, pres, dSpV_dT, dSpV_dS, &
+ tv%eqn_of_state, (/2,kf(i)/) )
+ else
+ call calculate_density_derivs(T_int, S_int, pres, drho_dT, drho_dS, &
+ tv%eqn_of_state, (/2,kf(i)/) )
+ endif
! Sum the reduced gravities to find out how small a density difference is negligibly small.
- drxh_sum = 0.0
+ drxh_sum = 0.0 ; dSpVxh_sum = 0.0
if (better_est) then
! This is an estimate that is correct for the non-EBT mode for 2 or 3 layers, or for
! clusters of massless layers at interfaces that can be grouped into 2 or 3 layers.
@@ -903,33 +1027,57 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
if (H_top(kf(i)) > 0.0) then
I_Htot = 1.0 / (H_top(kf(i)) + Hf(kf(i),i)) ! = 1.0 / (H_top(K) + H_bot(K)) for all K.
H_bot(kf(i)+1) = 0.0
- do K=kf(i),2,-1
- H_bot(K) = H_bot(K+1) + Hf(k,i)
- drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
- max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
- enddo
+ if (nonBous) then
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ dSpVxh_sum = dSpVxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
+ min(0.0, dSpV_dT(K)*(Tf(k,i)-Tf(k-1,i)) + dSpV_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ else
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
+ max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ endif
endif
else
! This estimate is problematic in that it goes like 1/nz for a large number of layers,
! but it is an overestimate (as desired) for a small number of layers, by at a factor
! of (H1+H2)**2/(H1*H2) >= 4 for two thick layers.
- do K=2,kf(i)
- drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * &
- max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
- enddo
+ if (nonBous) then
+ do K=2,kf(i)
+ dSpVxh_sum = dSpVxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * &
+ min(0.0, dSpV_dT(K)*(Tf(k,i)-Tf(k-1,i)) + dSpV_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ else
+ do K=2,kf(i)
+ drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * &
+ max(0.0, drho_dT(K)*(Tf(k,i)-Tf(k-1,i)) + drho_dS(K)*(Sf(k,i)-Sf(k-1,i)))
+ enddo
+ endif
endif
- else
- drxh_sum = 0.0
+ cg1_est = g_Rho0 * drxh_sum
+ else ! Not use_EOS
+ drxh_sum = 0.0 ; dSpVxh_sum = 0.0
if (better_est) then
H_top(1) = 0.0
do K=2,kf(i) ; H_top(K) = H_top(K-1) + Hf(k-1,i) ; enddo
if (H_top(kf(i)) > 0.0) then
I_Htot = 1.0 / (H_top(kf(i)) + Hf(kf(i),i)) ! = 1.0 / (H_top(K) + H_bot(K)) for all K.
H_bot(kf(i)+1) = 0.0
- do K=kf(i),2,-1
- H_bot(K) = H_bot(K+1) + Hf(k,i)
- drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * max(0.0,Rf(k,i)-Rf(k-1,i))
- enddo
+ if (nonBous) then
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ dSpVxh_sum = dSpVxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * &
+ min(0.0, (Rf(k-1,i)-Rf(k,i)) / (Rf(k,i)*Rf(k-1,i)))
+ enddo
+ else
+ do K=kf(i),2,-1
+ H_bot(K) = H_bot(K+1) + Hf(k,i)
+ drxh_sum = drxh_sum + ((H_top(K) * H_bot(K)) * I_Htot) * max(0.0,Rf(k,i)-Rf(k-1,i))
+ enddo
+ endif
endif
else
do K=2,kf(i)
@@ -938,19 +1086,32 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
endif
endif
+ if (nonBous) then
+ ! Note that dSpVxh_sum is negative for stable stratification.
+ cg1_est = H_to_pres * abs(dSpVxh_sum)
+ else
+ cg1_est = g_Rho0 * drxh_sum
+ endif
+
! Find gprime across each internal interface, taking care of convective
! instabilities by merging layers.
- if (g_Rho0 * drxh_sum > cg1_min2) then
+ if (cg1_est > cg1_min2) then
! Merge layers to eliminate convective instabilities or exceedingly
! small reduced gravities. Merging layers reduces the estimated wave speed by
! (rho(2)-rho(1))*h(1)*h(2) / H_tot.
if (use_EOS) then
kc = 1
- Hc(1) = Hf(1,i) ; Tc(1) = Tf(1,i) ; Sc(1) = Sf(1,i)
+ Hc(1) = Hf(1,i) ; dzc(1) = dzf(1,i) ; Tc(1) = Tf(1,i) ; Sc(1) = Sf(1,i)
do k=2,kf(i)
- if (better_est) then
+ if (better_est .and. nonBous) then
+ merge = ((dSpV_dT(K)*(Tc(kc)-Tf(k,i)) + dSpV_dS(K)*(Sc(kc)-Sf(k,i))) * &
+ ((Hc(kc) * Hf(k,i))*I_Htot) < abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (better_est) then
merge = ((drho_dT(K)*(Tf(k,i)-Tc(kc)) + drho_dS(K)*(Sf(k,i)-Sc(kc))) * &
((Hc(kc) * Hf(k,i))*I_Htot) < 2.0 * tol_merge*drxh_sum)
+ elseif (nonBous) then
+ merge = ((dSpV_dT(K)*(Tc(kc)-Tf(k,i)) + dSpV_dS(K)*(Sc(kc)-Sf(k,i))) * &
+ (Hc(kc) + Hf(k,i)) < abs(2.0 * tol_merge * dSpVxh_sum))
else
merge = ((drho_dT(K)*(Tf(k,i)-Tc(kc)) + drho_dS(K)*(Sf(k,i)-Sc(kc))) * &
(Hc(kc) + Hf(k,i)) < 2.0 * tol_merge*drxh_sum)
@@ -960,14 +1121,21 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
I_Hnew = 1.0 / (Hc(kc) + Hf(k,i))
Tc(kc) = (Hc(kc)*Tc(kc) + Hf(k,i)*Tf(k,i)) * I_Hnew
Sc(kc) = (Hc(kc)*Sc(kc) + Hf(k,i)*Sf(k,i)) * I_Hnew
- Hc(kc) = (Hc(kc) + Hf(k,i))
+ Hc(kc) = Hc(kc) + Hf(k,i)
+ dzc(kc) = dzc(kc) + dzf(k,i)
! Backtrack to remove any convective instabilities above... Note
! that the tolerance is a factor of two larger, to avoid limit how
! far back we go.
do K2=kc,2,-1
- if (better_est) then
+ if (better_est .and. nonBous) then
+ merge = ( (dSpV_dT(K2)*(Tc(k2-1)-Tc(k2)) + dSpV_dS(K2)*(Sc(k2-1)-Sc(k2))) * &
+ ((Hc(k2) * Hc(k2-1))*I_Htot) < abs(tol_merge * dSpVxh_sum) )
+ elseif (better_est) then
merge = ((drho_dT(K2)*(Tc(k2)-Tc(k2-1)) + drho_dS(K2)*(Sc(k2)-Sc(k2-1))) * &
((Hc(k2) * Hc(k2-1))*I_Htot) < tol_merge*drxh_sum)
+ elseif (nonBous) then
+ merge = ( (dSpV_dT(K2)*(Tc(k2-1)-Tc(k2)) + dSpV_dS(K2)*(Sc(k2-1)-Sc(k2))) * &
+ (Hc(k2) + Hc(k2-1)) < abs(tol_merge * dSpVxh_sum) )
else
merge = ((drho_dT(K2)*(Tc(k2)-Tc(k2-1)) + drho_dS(K2)*(Sc(k2)-Sc(k2-1))) * &
(Hc(k2) + Hc(k2-1)) < tol_merge*drxh_sum)
@@ -977,35 +1145,53 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
I_Hnew = 1.0 / (Hc(kc) + Hc(kc-1))
Tc(kc-1) = (Hc(kc)*Tc(kc) + Hc(kc-1)*Tc(kc-1)) * I_Hnew
Sc(kc-1) = (Hc(kc)*Sc(kc) + Hc(kc-1)*Sc(kc-1)) * I_Hnew
- Hc(kc-1) = (Hc(kc) + Hc(kc-1))
+ Hc(kc-1) = Hc(kc) + Hc(kc-1)
+ dzc(kc-1) = dzc(kc) + dzc(kc-1)
kc = kc - 1
else ; exit ; endif
enddo
else
! Add a new layer to the column.
kc = kc + 1
- drho_dS(Kc) = drho_dS(K) ; drho_dT(Kc) = drho_dT(K)
- Tc(kc) = Tf(k,i) ; Sc(kc) = Sf(k,i) ; Hc(kc) = Hf(k,i)
+ if (nonBous) then
+ dSpV_dS(Kc) = dSpV_dS(K) ; dSpV_dT(Kc) = dSpV_dT(K)
+ else
+ drho_dS(Kc) = drho_dS(K) ; drho_dT(Kc) = drho_dT(K)
+ endif
+ Tc(kc) = Tf(k,i) ; Sc(kc) = Sf(k,i) ; Hc(kc) = Hf(k,i) ; dzc(kc) = dzf(k,i)
endif
enddo
! At this point there are kc layers and the gprimes should be positive.
- do K=2,kc ! Revisit this if non-Boussinesq.
- gprime(K) = g_Rho0 * (drho_dT(K)*(Tc(k)-Tc(k-1)) + drho_dS(K)*(Sc(k)-Sc(k-1)))
- enddo
- else ! .not.use_EOS
+ if (nonBous) then
+ do K=2,kc
+ gprime(K) = H_to_pres * (dSpV_dT(K)*(Tc(k-1)-Tc(k)) + dSpV_dS(K)*(Sc(k-1)-Sc(k)))
+ enddo
+ else
+ do K=2,kc
+ gprime(K) = g_Rho0 * (drho_dT(K)*(Tc(k)-Tc(k-1)) + drho_dS(K)*(Sc(k)-Sc(k-1)))
+ enddo
+ endif
+ else ! .not. (use_EOS)
! Do the same with density directly...
kc = 1
- Hc(1) = Hf(1,i) ; Rc(1) = Rf(1,i)
+ Hc(1) = Hf(1,i) ; dzc(1) = dzf(1,i) ; Rc(1) = Rf(1,i)
do k=2,kf(i)
- if (better_est) then
- merge = ((Rf(k,i) - Rc(kc)) * ((Hc(kc) * Hf(k,i))*I_Htot) < 2.0 * tol_merge*drxh_sum)
+ if (nonBous .and. better_est) then
+ merge = ((Rf(k,i) - Rc(kc)) * ((Hc(kc) * Hf(k,i))*I_Htot) < &
+ (Rc(kc)*Rf(k,i)) * abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (nonBous) then
+ merge = ((Rf(k,i) - Rc(kc)) * (Hc(kc) + Hf(k,i)) < &
+ (Rc(kc)*Rf(k,i)) * abs(2.0 * tol_merge * dSpVxh_sum))
+ elseif (better_est) then
+ merge = ((Rf(k,i) - Rc(kc)) * ((Hc(kc) * Hf(k,i))*I_Htot) < 2.0*tol_merge*drxh_sum)
else
merge = ((Rf(k,i) - Rc(kc)) * (Hc(kc) + Hf(k,i)) < 2.0*tol_merge*drxh_sum)
endif
if (merge) then
! Merge this layer with the one above and backtrack.
Rc(kc) = (Hc(kc)*Rc(kc) + Hf(k,i)*Rf(k,i)) / (Hc(kc) + Hf(k,i))
- Hc(kc) = (Hc(kc) + Hf(k,i))
+ Hc(kc) = Hc(kc) + Hf(k,i)
+ dzc(kc) = dzc(kc) + dzf(k,i)
! Backtrack to remove any convective instabilities above... Note
! that the tolerance is a factor of two larger, to avoid limit how
! far back we go.
@@ -1018,20 +1204,27 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
if (merge) then
! Merge the two bottommost layers. At this point kc = k2.
Rc(kc-1) = (Hc(kc)*Rc(kc) + Hc(kc-1)*Rc(kc-1)) / (Hc(kc) + Hc(kc-1))
- Hc(kc-1) = (Hc(kc) + Hc(kc-1))
+ Hc(kc-1) = Hc(kc) + Hc(kc-1)
+ dzc(kc-1) = dzc(kc) + dzc(kc-1)
kc = kc - 1
else ; exit ; endif
enddo
else
! Add a new layer to the column.
kc = kc + 1
- Rc(kc) = Rf(k,i) ; Hc(kc) = Hf(k,i)
+ Rc(kc) = Rf(k,i) ; Hc(kc) = Hf(k,i) ; dzc(kc) = dzf(k,i)
endif
enddo
! At this point there are kc layers and the gprimes should be positive.
- do K=2,kc ! Revisit this if non-Boussinesq.
- gprime(K) = g_Rho0 * (Rc(k)-Rc(k-1))
- enddo
+ if (nonBous) then
+ do K=2,kc
+ gprime(K) = H_to_pres * (Rc(k) - Rc(k-1)) / (Rc(k) * Rc(k-1))
+ enddo
+ else
+ do K=2,kc
+ gprime(K) = g_Rho0 * (Rc(k)-Rc(k-1))
+ enddo
+ endif
endif ! use_EOS
!-----------------NOW FIND WAVE SPEEDS---------------------------------------
@@ -1056,8 +1249,13 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
N2(:) = 0.
do K=2,kc
- Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1))
- N2(K) = US%L_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1)))
+ Igl(K) = 1.0 / (gprime(K)*Hc(k)) ; Igu(K) = 1.0 / (gprime(K)*Hc(k-1))
+ if (nonBous) then
+ N2(K) = 2.0*US%L_to_Z**2*gprime(K) * (Hc(k) + Hc(k-1)) / & ! Units are [T-2 ~> s-2]
+ (dzc(k) + dzc(k-1))**2
+ else
+ N2(K) = 2.0*US%L_to_Z**2*GV%Z_to_H*gprime(K) / (dzc(k) + dzc(k-1)) ! Units are [T-2 ~> s-2]
+ endif
if (better_est) then
speed2_tot = speed2_tot + gprime(K)*((H_top(K) * H_bot(K)) * I_Htot)
else
@@ -1106,12 +1304,11 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
! renormalization of the integral of the profile
w2avg = 0.0
do k=1,kc
- w2avg = w2avg + 0.5*(mode_struct(K)**2+mode_struct(K+1)**2)*Hc(k) ![Z L4 T-4]
+ w2avg = w2avg + 0.5*(mode_struct(K)**2+mode_struct(K+1)**2)*Hc(k) ! [H L4 T-4]
enddo
- renorm = sqrt(htot(i)*a_int/w2avg) ![L-2 T-2]
+ renorm = sqrt(htot(i)*a_int/w2avg) ! [T2 L-2]
do K=1,kc+1 ; mode_struct(K) = renorm * mode_struct(K) ; enddo
! after renorm, mode_struct is again [nondim]
-
if (abs(dlam) < tol_solve*lam_1) exit
enddo
@@ -1124,7 +1321,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
! vertical derivative of w at interfaces lives on the layer points
do k=1,kc
- mode_struct_fder(k) = (mode_struct(k) - mode_struct(k+1)) / Hc(k)
+ mode_struct_fder(k) = (mode_struct(k) - mode_struct(k+1)) / dzc(k)
enddo
! boundary condition for derivative is no-gradient
@@ -1156,18 +1353,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
mode_struct_sq(K+1)*N2(K+1)) * Hc(k)
enddo
- ! Note that remapping_core_h requires that the same units be used
- ! for both the source and target grid thicknesses, here [H ~> m or kg m-2].
- do k = 1,kc
- Hc_H(k) = GV%Z_to_H * Hc(k)
- enddo
-
! for w (diag) interpolate onto all interfaces
- call interpolate_column(kc, Hc_H(1:kc), mode_struct(1:kc+1), &
+ call interpolate_column(kc, Hc(1:kc), mode_struct(1:kc+1), &
nz, h(i,j,:), modal_structure(:), .false.)
! for u (remap) onto all layers
- call remapping_core_h(CS%remapping_CS, kc, Hc_H(1:kc), mode_struct_fder(1:kc), &
+ call remapping_core_h(CS%remapping_CS, kc, Hc(1:kc), mode_struct_fder(1:kc), &
nz, h(i,j,:), modal_structure_fder(:), &
GV%H_subroundoff, GV%H_subroundoff)
@@ -1306,7 +1497,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
! derivative of vertical profile (i.e. dw/dz) is evaluated at the layer point
do k=1,kc
- mode_struct_fder(k) = (mode_struct(k) - mode_struct(k+1)) / Hc(k)
+ mode_struct_fder(k) = (mode_struct(k) - mode_struct(k+1)) / dzc(k)
enddo
! boundary condition for 1st derivative is no-gradient
@@ -1338,18 +1529,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s
mode_struct_sq(K+1)*N2(K+1)) * Hc(k)
enddo
- ! Note that remapping_core_h requires that the same units be used
- ! for both the source and target grid thicknesses, here [H ~> m or kg m-2].
- do k = 1,kc
- Hc_H(k) = GV%Z_to_H * Hc(k)
- enddo
-
! for w (diag) interpolate onto all interfaces
- call interpolate_column(kc, Hc_H(1:kc), mode_struct(1:kc+1), &
+ call interpolate_column(kc, Hc(1:kc), mode_struct(1:kc+1), &
nz, h(i,j,:), modal_structure(:), .false.)
! for u (remap) onto all layers
- call remapping_core_h(CS%remapping_CS, kc, Hc_H(1:kc), mode_struct_fder(1:kc), &
+ call remapping_core_h(CS%remapping_CS, kc, Hc(1:kc), mode_struct_fder(1:kc), &
nz, h(i,j,:), modal_structure_fder(:), &
GV%H_subroundoff, GV%H_subroundoff)
@@ -1436,7 +1621,7 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de
!! calculating the vertical modal structure [nondim].
real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited
!! as monotonic for the purposes of calculating the
- !! vertical modal structure [Z ~> m].
+ !! vertical modal structure [H ~> m or kg m-2].
logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions
!! that recover the remapping answers from 2018. Otherwise
!! use more robust but mathematically equivalent expressions.
@@ -1465,7 +1650,8 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de
call log_version(mdl, version)
call wave_speed_set_param(CS, use_ebt_mode=use_ebt_mode, mono_N2_column_fraction=mono_N2_column_fraction, &
- better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol, &
+ mono_N2_depth=mono_N2_depth, better_speed_est=better_speed_est, &
+ min_speed=min_speed, wave_speed_tol=wave_speed_tol, &
remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date, &
c1_thresh=c1_thresh)
@@ -1487,7 +1673,7 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_
!! calculating the vertical modal structure [nondim].
real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited
!! as monotonic for the purposes of calculating the
- !! vertical modal structure [Z ~> m].
+ !! vertical modal structure [H ~> m or kg m-2].
logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions
!! that recover the remapping answers from 2018. Otherwise
!! use more robust but mathematically equivalent expressions.
diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90
index c68dc7b661..2087cd86e5 100644
--- a/src/equation_of_state/MOM_EOS.F90
+++ b/src/equation_of_state/MOM_EOS.F90
@@ -84,6 +84,7 @@ module MOM_EOS
public gsw_sp_from_sr
public gsw_pt_from_ct
public query_compressible
+public get_EOS_name
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
@@ -181,6 +182,10 @@ module MOM_EOS
integer, parameter, public :: EOS_ROQUET_RHO = 7 !< A named integer specifying an equation of state
integer, parameter, public :: EOS_ROQUET_SPV = 8 !< A named integer specifying an equation of state
integer, parameter, public :: EOS_JACKETT06 = 9 !< A named integer specifying an equation of state
+!> A list of all the available EOS
+integer, dimension(9), public :: list_of_EOS = (/ EOS_LINEAR, EOS_UNESCO, &
+ EOS_WRIGHT, EOS_WRIGHT_FULL, EOS_WRIGHT_REDUCED, &
+ EOS_TEOS10, EOS_ROQUET_RHO, EOS_ROQUET_SPV, EOS_JACKETT06 /)
character*(12), parameter :: EOS_LINEAR_STRING = "LINEAR" !< A string for specifying the equation of state
character*(12), parameter :: EOS_UNESCO_STRING = "UNESCO" !< A string for specifying the equation of state
@@ -1679,6 +1684,36 @@ logical function query_compressible(EOS)
query_compressible = EOS%compressible
end function query_compressible
+!> Returns the string identifying the equation of state with enumeration "id"
+function get_EOS_name(id) result (eos_name)
+ integer, optional, intent(in) :: id !< Enumerated ID
+ character(:), allocatable :: eos_name !< The name of the EOS
+
+ select case (id)
+ case (EOS_LINEAR)
+ eos_name = EOS_LINEAR_STRING
+ case (EOS_UNESCO)
+ eos_name = EOS_UNESCO_STRING
+ case (EOS_WRIGHT)
+ eos_name = EOS_WRIGHT_STRING
+ case (EOS_WRIGHT_REDUCED)
+ eos_name = EOS_WRIGHT_RED_STRING
+ case (EOS_WRIGHT_FULL)
+ eos_name = EOS_WRIGHT_FULL_STRING
+ case (EOS_TEOS10)
+ eos_name = EOS_TEOS10_STRING
+ case (EOS_ROQUET_RHO)
+ eos_name = EOS_ROQUET_RHO_STRING
+ case (EOS_ROQUET_SPV)
+ eos_name = EOS_ROQUET_SPV_STRING
+ case (EOS_JACKETT06)
+ eos_name = EOS_JACKETT06_STRING
+ case default
+ call MOM_error(FATAL, "get_EOS_name: something went wrong internally - enumeration is not valid.")
+ end select
+
+end function get_EOS_name
+
!> Initializes EOS_type by allocating and reading parameters. The scaling factors in
!! US are stored in EOS for later use.
subroutine EOS_init(param_file, EOS, US)
@@ -2249,7 +2284,11 @@ logical function EOS_unit_tests(verbose)
if (verbose .and. fail) call MOM_error(WARNING, "TEOS_POLY TFr has failed some self-consistency tests.")
EOS_unit_tests = EOS_unit_tests .or. fail
- if (verbose .and. .not.EOS_unit_tests) call MOM_mesg("All EOS consistency tests have passed.")
+ if (EOS_unit_tests) then
+ call MOM_error(WARNING, "EOS_unit_tests: One or more EOS tests have failed!")
+ else
+ if (verbose) call MOM_mesg("EOS_unit_tests: All EOS consistency tests have passed.")
+ endif
end function EOS_unit_tests
diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90
index 092b12a2d2..2c71a93e42 100644
--- a/src/framework/MOM_diag_mediator.F90
+++ b/src/framework/MOM_diag_mediator.F90
@@ -3144,15 +3144,11 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir)
! Local variables
integer :: ios, i, new_unit
logical :: opened, new_file
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the remapping answers from 2018. If false, use more
- ! robust forms of the same remapping expressions.
integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use
! for remapping. Values below 20190101 recover the remapping
! answers from 2018, while higher values use more robust
! forms of the same remapping expressions.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
character(len=8) :: this_pe
character(len=240) :: doc_file, doc_file_dflt, doc_path
character(len=240), allocatable :: diag_coords(:)
@@ -3182,23 +3178,13 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701)
call get_param(param_file, mdl, 'USE_GRID_SPACE_DIAGNOSTIC_AXES', diag_cs%grid_space_axes, &
'If true, use a grid index coordinate convention for diagnostic axes. ',&
default=.false.)
@@ -3553,37 +3539,45 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager)
enddo
call diag_grid_storage_end(diag_cs%diag_grid_temp)
- deallocate(diag_cs%mask3dTL)
- deallocate(diag_cs%mask3dBL)
- deallocate(diag_cs%mask3dCuL)
- deallocate(diag_cs%mask3dCvL)
- deallocate(diag_cs%mask3dTi)
- deallocate(diag_cs%mask3dBi)
- deallocate(diag_cs%mask3dCui)
- deallocate(diag_cs%mask3dCvi)
+ if (associated(diag_cs%mask3dTL)) deallocate(diag_cs%mask3dTL)
+ if (associated(diag_cs%mask3dBL)) deallocate(diag_cs%mask3dBL)
+ if (associated(diag_cs%mask3dCuL)) deallocate(diag_cs%mask3dCuL)
+ if (associated(diag_cs%mask3dCvL)) deallocate(diag_cs%mask3dCvL)
+ if (associated(diag_cs%mask3dTi)) deallocate(diag_cs%mask3dTi)
+ if (associated(diag_cs%mask3dBi)) deallocate(diag_cs%mask3dBi)
+ if (associated(diag_cs%mask3dCui)) deallocate(diag_cs%mask3dCui)
+ if (associated(diag_cs%mask3dCvi)) deallocate(diag_cs%mask3dCvi)
do dl=2,MAX_DSAMP_LEV
- deallocate(diag_cs%dsamp(dl)%mask2dT)
- deallocate(diag_cs%dsamp(dl)%mask2dBu)
- deallocate(diag_cs%dsamp(dl)%mask2dCu)
- deallocate(diag_cs%dsamp(dl)%mask2dCv)
- deallocate(diag_cs%dsamp(dl)%mask3dTL)
- deallocate(diag_cs%dsamp(dl)%mask3dBL)
- deallocate(diag_cs%dsamp(dl)%mask3dCuL)
- deallocate(diag_cs%dsamp(dl)%mask3dCvL)
- deallocate(diag_cs%dsamp(dl)%mask3dTi)
- deallocate(diag_cs%dsamp(dl)%mask3dBi)
- deallocate(diag_cs%dsamp(dl)%mask3dCui)
- deallocate(diag_cs%dsamp(dl)%mask3dCvi)
+ if (associated(diag_cs%dsamp(dl)%mask2dT)) deallocate(diag_cs%dsamp(dl)%mask2dT)
+ if (associated(diag_cs%dsamp(dl)%mask2dBu)) deallocate(diag_cs%dsamp(dl)%mask2dBu)
+ if (associated(diag_cs%dsamp(dl)%mask2dCu)) deallocate(diag_cs%dsamp(dl)%mask2dCu)
+ if (associated(diag_cs%dsamp(dl)%mask2dCv)) deallocate(diag_cs%dsamp(dl)%mask2dCv)
+ if (associated(diag_cs%dsamp(dl)%mask3dTL)) deallocate(diag_cs%dsamp(dl)%mask3dTL)
+ if (associated(diag_cs%dsamp(dl)%mask3dBL)) deallocate(diag_cs%dsamp(dl)%mask3dBL)
+ if (associated(diag_cs%dsamp(dl)%mask3dCuL)) deallocate(diag_cs%dsamp(dl)%mask3dCuL)
+ if (associated(diag_cs%dsamp(dl)%mask3dCvL)) deallocate(diag_cs%dsamp(dl)%mask3dCvL)
+ if (associated(diag_cs%dsamp(dl)%mask3dTi)) deallocate(diag_cs%dsamp(dl)%mask3dTi)
+ if (associated(diag_cs%dsamp(dl)%mask3dBi)) deallocate(diag_cs%dsamp(dl)%mask3dBi)
+ if (associated(diag_cs%dsamp(dl)%mask3dCui)) deallocate(diag_cs%dsamp(dl)%mask3dCui)
+ if (associated(diag_cs%dsamp(dl)%mask3dCvi)) deallocate(diag_cs%dsamp(dl)%mask3dCvi)
do i=1,diag_cs%num_diag_coords
- deallocate(diag_cs%dsamp(dl)%remap_axesTL(i)%dsamp(dl)%mask3d)
- deallocate(diag_cs%dsamp(dl)%remap_axesCuL(i)%dsamp(dl)%mask3d)
- deallocate(diag_cs%dsamp(dl)%remap_axesCvL(i)%dsamp(dl)%mask3d)
- deallocate(diag_cs%dsamp(dl)%remap_axesBL(i)%dsamp(dl)%mask3d)
- deallocate(diag_cs%dsamp(dl)%remap_axesTi(i)%dsamp(dl)%mask3d)
- deallocate(diag_cs%dsamp(dl)%remap_axesCui(i)%dsamp(dl)%mask3d)
- deallocate(diag_cs%dsamp(dl)%remap_axesCvi(i)%dsamp(dl)%mask3d)
- deallocate(diag_cs%dsamp(dl)%remap_axesBi(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesTL(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesTL(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesCuL(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesCuL(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesCvL(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesCvL(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesBL(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesBL(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesTi(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesTi(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesCui(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesCui(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesCvi(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesCvi(i)%dsamp(dl)%mask3d)
+ if (associated(diag_cs%dsamp(dl)%remap_axesBi(i)%dsamp(dl)%mask3d)) &
+ deallocate(diag_cs%dsamp(dl)%remap_axesBi(i)%dsamp(dl)%mask3d)
enddo
enddo
diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90
index f2c3225025..22226d3b85 100644
--- a/src/framework/MOM_domains.F90
+++ b/src/framework/MOM_domains.F90
@@ -65,7 +65,7 @@ module MOM_domains
!! properties of the domain type.
subroutine MOM_domains_init(MOM_dom, US, param_file, symmetric, static_memory, &
NIHALO, NJHALO, NIGLOBAL, NJGLOBAL, NIPROC, NJPROC, &
- min_halo, domain_name, include_name, param_suffix)
+ min_halo, domain_name, include_name, param_suffix, MOM_dom_unmasked)
type(MOM_domain_type), pointer :: MOM_dom !< A pointer to the MOM_domain_type
!! being defined here.
type(unit_scale_type), pointer :: US !< A dimensional unit scaling type
@@ -99,10 +99,13 @@ subroutine MOM_domains_init(MOM_dom, US, param_file, symmetric, static_memory, &
!! "MOM_memory.h" if missing.
character(len=*), optional, intent(in) :: param_suffix !< A suffix to apply to
!! layout-specific parameters.
+ type(MOM_domain_type), pointer, optional :: MOM_dom_unmasked !< Unmasked MOM domain instance.
+ !! Set to null if masking is not enabled.
! Local variables
integer, dimension(2) :: layout ! The number of logical processors in the i- and j- directions
integer, dimension(2) :: auto_layout ! The layout determined by the auto masking routine
+ integer, dimension(2) :: layout_unmasked ! A temporary layout for unmasked domain
integer, dimension(2) :: io_layout ! The layout of logical processors for input and output
!$ integer :: ocean_nthreads ! Number of openMP threads
!$ logical :: ocean_omp_hyper_thread ! If true use openMP hyper-threads
@@ -429,6 +432,16 @@ subroutine MOM_domains_init(MOM_dom, US, param_file, symmetric, static_memory, &
"to be the same as the layout.", default=1, layoutParam=.true.)
endif
+ ! Create an unmasked domain if requested. This is used for writing out unmasked ocean geometry.
+ if (present(MOM_dom_unmasked) .and. mask_table_exists) then
+ call MOM_define_layout(n_global, PEs_used, layout_unmasked)
+ call create_MOM_domain(MOM_dom_unmasked, n_global, n_halo, reentrant, tripolar_N, layout_unmasked, &
+ domain_name=domain_name, symmetric=symmetric, thin_halos=thin_halos, &
+ nonblocking=nonblocking)
+ else
+ MOM_dom_unmasked => null()
+ endif
+
call create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, layout, &
io_layout=io_layout, domain_name=domain_name, mask_table=mask_table, &
symmetric=symmetric, thin_halos=thin_halos, nonblocking=nonblocking)
diff --git a/src/framework/MOM_error_handler.F90 b/src/framework/MOM_error_handler.F90
index d61e82b32c..b113050572 100644
--- a/src/framework/MOM_error_handler.F90
+++ b/src/framework/MOM_error_handler.F90
@@ -10,6 +10,11 @@ module MOM_error_handler
use posix, only : sigjmp_buf, siglongjmp
use posix, only : sleep
+! MOM_error_infra does not provide stderr . We only use stderr in this module
+! *IF* FMS has not been initialized. Further, stderr is only used internally and
+! not made public. Other modules should obtain stderr from MOM_io.
+use iso_fortran_env, only : stderr=>error_unit
+
implicit none ; private
! These routines are found in this module.
@@ -20,7 +25,7 @@ module MOM_error_handler
public :: is_root_pe, stdlog, stdout
!> Integer parameters encoding the severity of an error message
public :: NOTE, WARNING, FATAL
-public :: disable_fatal_errors, enable_fatal_errors
+public :: disable_fatal_errors, enable_fatal_errors, set_skip_mpi
integer :: verbosity = 6
!< Verbosity level:
@@ -58,6 +63,11 @@ module MOM_error_handler
!< The default signal handler used before signal() setup (usually SIG_DFT)
type(sigjmp_buf) :: prior_env
!< Buffer containing the program state to be recovered by longjmp
+logical :: skip_mpi_dep = .false.
+ !< If true, bypass any calls that require FMS (MPI) to have been initialized.
+ !! Use s/r set_skip_mpi() to change this flag. By default, set_skip_mpi() does not
+ !! need to be called and this flag is false so that FMS (and MPI) should be
+ !! initialized.
contains
@@ -72,11 +82,15 @@ subroutine MOM_mesg(message, verb, all_print)
integer :: verb_msg
logical :: write_msg
- write_msg = is_root_pe()
+ if (skip_mpi_dep) then
+ write_msg = .true.
+ else
+ write_msg = is_root_pe()
+ endif
if (present(all_print)) write_msg = write_msg .or. all_print
verb_msg = 2 ; if (present(verb)) verb_msg = verb
- if (write_msg .and. (verbosity >= verb_msg)) call MOM_err(NOTE, message)
+ if (write_msg .and. (verbosity >= verb_msg)) call loc_MOM_err(NOTE, message)
end subroutine MOM_mesg
@@ -121,6 +135,14 @@ subroutine enable_fatal_errors()
dummy => signal(sig, prior_handler)
end subroutine enable_fatal_errors
+!> Enable/disable skipping MPI dependent behaviors
+subroutine set_skip_mpi(skip)
+ logical, intent(in) :: skip !< State to assign
+
+ skip_mpi_dep = skip
+
+end subroutine set_skip_mpi
+
!> This provides a convenient interface for writing an error message
!! with run-time filter based on a verbosity and the severity of the error.
subroutine MOM_error(level, message, all_print)
@@ -128,19 +150,21 @@ subroutine MOM_error(level, message, all_print)
character(len=*), intent(in) :: message !< A message to write out
logical, optional, intent(in) :: all_print !< If present and true, any PEs are
!! able to write this message.
- ! This provides a convenient interface for writing an error message
- ! with run-time filter based on a verbosity.
logical :: write_msg
integer :: rc
- write_msg = is_root_pe()
+ if (skip_mpi_dep) then
+ write_msg = .true.
+ else
+ write_msg = is_root_pe()
+ endif
if (present(all_print)) write_msg = write_msg .or. all_print
select case (level)
case (NOTE)
- if (write_msg.and.verbosity>=2) call MOM_err(NOTE, message)
+ if (write_msg.and.verbosity>=2) call loc_MOM_err(NOTE, message)
case (WARNING)
- if (write_msg.and.verbosity>=1) call MOM_err(WARNING, message)
+ if (write_msg.and.verbosity>=1) call loc_MOM_err(WARNING, message)
case (FATAL)
if (ignore_fatal) then
print *, "(FATAL): " // message
@@ -151,12 +175,33 @@ subroutine MOM_error(level, message, all_print)
! In practice, the signal will take control before sleep() completes.
rc = sleep(3)
endif
- if (verbosity>=0) call MOM_err(FATAL, message)
+ if (verbosity>=0) call loc_MOM_err(FATAL, message)
case default
- call MOM_err(level, message)
+ call loc_MOM_err(level, message)
end select
end subroutine MOM_error
+!> A private routine through which all error/warning/note messages are written
+!! by this module.
+subroutine loc_MOM_err(level, message)
+ integer, intent(in) :: level !< The severity level of this message
+ character(len=*), intent(in) :: message !< A message to write out
+
+ if (.not. skip_mpi_dep) then
+ call MOM_err(level, message)
+ else
+ ! FMS (and therefore MPI) have not been initialized
+ write(stdout(),'(a)') trim(message) ! Send message to stdout
+ select case (level)
+ case (WARNING)
+ write(stderr,'("WARNING ",a)') trim(message) ! Additionally send message to stderr
+ case (FATAL)
+ write(stderr,'("ERROR: ",a)') trim(message) ! Additionally send message to stderr
+ end select
+ endif
+
+end subroutine loc_MOM_err
+
!> This subroutine sets the level of verbosity filtering MOM error messages
subroutine MOM_set_verbosity(verb)
integer, intent(in) :: verb !< A level of verbosity to set
@@ -202,10 +247,10 @@ subroutine callTree_enter(mesg,n)
nAsString = ''
if (present(n)) then
write(nAsString(1:8),'(i8)') n
- call MOM_err(NOTE, 'callTree: '// &
+ call loc_MOM_err(NOTE, 'callTree: '// &
repeat(' ',callTreeIndentLevel-1)//'loop '//trim(mesg)//trim(nAsString))
else
- call MOM_err(NOTE, 'callTree: '// &
+ call loc_MOM_err(NOTE, 'callTree: '// &
repeat(' ',callTreeIndentLevel-1)//'---> '//trim(mesg))
endif
endif
@@ -217,7 +262,7 @@ subroutine callTree_leave(mesg)
if (callTreeIndentLevel<1) write(0,*) 'callTree_leave: error callTreeIndentLevel=',callTreeIndentLevel,trim(mesg)
callTreeIndentLevel = callTreeIndentLevel - 1
if (verbosity<6) return
- if (is_root_pe()) call MOM_err(NOTE, 'callTree: '// &
+ if (is_root_pe()) call loc_MOM_err(NOTE, 'callTree: '// &
repeat(' ',callTreeIndentLevel)//'<--- '//trim(mesg))
end subroutine callTree_leave
@@ -233,10 +278,10 @@ subroutine callTree_waypoint(mesg,n)
nAsString = ''
if (present(n)) then
write(nAsString(1:8),'(i8)') n
- call MOM_err(NOTE, 'callTree: '// &
+ call loc_MOM_err(NOTE, 'callTree: '// &
repeat(' ',callTreeIndentLevel)//'loop '//trim(mesg)//trim(nAsString))
else
- call MOM_err(NOTE, 'callTree: '// &
+ call loc_MOM_err(NOTE, 'callTree: '// &
repeat(' ',callTreeIndentLevel)//'o '//trim(mesg))
endif
endif
diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90
index c92753be1e..944ccfdf07 100644
--- a/src/framework/MOM_file_parser.F90
+++ b/src/framework/MOM_file_parser.F90
@@ -154,28 +154,34 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir, ens
! Check that this file has not already been opened
if (CS%nfiles > 0) then
reopened_file = .false.
- inquire(file=trim(filename), number=iounit)
- if (iounit /= -1) then
- do i = 1, CS%nfiles
- if (CS%iounit(i) == iounit) then
- call assert(trim(CS%filename(1)) == trim(filename), &
- "open_param_file: internal inconsistency! "//trim(filename)// &
- " is registered as open but has the wrong unit number!")
- call MOM_error(WARNING, &
- "open_param_file: file "//trim(filename)// &
- " has already been opened. This should NOT happen!"// &
- " Did you specify the same file twice in a namelist?")
- reopened_file = .true.
- endif ! unit numbers
- enddo ! i
+
+ if (is_root_pe()) then
+ inquire(file=trim(filename), number=iounit)
+ if (iounit /= -1) then
+ do i = 1, CS%nfiles
+ if (CS%iounit(i) == iounit) then
+ call assert(trim(CS%filename(1)) == trim(filename), &
+ "open_param_file: internal inconsistency! "//trim(filename)// &
+ " is registered as open but has the wrong unit number!")
+ call MOM_error(WARNING, &
+ "open_param_file: file "//trim(filename)// &
+ " has already been opened. This should NOT happen!"// &
+ " Did you specify the same file twice in a namelist?")
+ reopened_file = .true.
+ endif ! unit numbers
+ enddo ! i
+ endif
endif
+
if (any_across_PEs(reopened_file)) return
endif
! Check that the file exists to readstdlog
- inquire(file=trim(filename), exist=file_exists)
- if (.not.file_exists) call MOM_error(FATAL, &
- "open_param_file: Input file '"// trim(filename)//"' does not exist.")
+ if (is_root_pe()) then
+ inquire(file=trim(filename), exist=file_exists)
+ if (.not.file_exists) call MOM_error(FATAL, &
+ "open_param_file: Input file '"// trim(filename)//"' does not exist.")
+ endif
Netcdf_file = .false.
if (strlen > 3) then
diff --git a/src/framework/MOM_get_input.F90 b/src/framework/MOM_get_input.F90
index 4c643a5442..6ecc3ef3f9 100644
--- a/src/framework/MOM_get_input.F90
+++ b/src/framework/MOM_get_input.F90
@@ -11,6 +11,7 @@ module MOM_get_input
use MOM_file_parser, only : open_param_file, param_file_type
use MOM_io, only : file_exists, close_file, slasher, ensembler
use MOM_io, only : open_namelist_file, check_nml_error
+use posix, only : mkdir, stat, stat_buf
implicit none ; private
@@ -54,6 +55,8 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename,
character(len=240) :: output_dir
integer :: unit, io, ierr, valid_param_files
+ type(stat_buf) :: buf
+
namelist /MOM_input_nml/ output_directory, input_filename, parameter_filename, &
restart_input_dir, restart_output_dir
@@ -73,6 +76,7 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename,
endif
! Read namelist parameters
+ ! NOTE: Every rank is reading MOM_input_nml
ierr=1 ; do while (ierr /= 0)
read(unit, nml=MOM_input_nml, iostat=io, end=10)
ierr = check_nml_error(io, 'MOM_input_nml')
@@ -92,6 +96,15 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename,
dirs%restart_input_dir = slasher(ensembler(restart_input_dir))
dirs%input_filename = ensembler(input_filename)
endif
+
+ ! Create the RESTART directory if absent
+ if (is_root_PE()) then
+ if (stat(trim(dirs%restart_output_dir), buf) == -1) then
+ ierr = mkdir(trim(dirs%restart_output_dir), int(o'700'))
+ if (ierr == -1) &
+ call MOM_error(FATAL, 'Restart directory could not be created.')
+ endif
+ endif
endif
! Open run-time parameter file(s)
diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90
index 220a7d6bcf..27d244b226 100644
--- a/src/framework/MOM_io.F90
+++ b/src/framework/MOM_io.F90
@@ -148,6 +148,20 @@ module MOM_io
module procedure read_attribute_int32, read_attribute_int64
end interface read_attribute
+!> Type that stores information that can be used to create a non-decomposed axis.
+type :: axis_info
+ character(len=32) :: name = "" !< The name of this axis for use in files
+ character(len=256) :: longname = "" !< A longer name describing this axis
+ character(len=48) :: units = "" !< The units of the axis labels
+ character(len=8) :: cartesian = "N" !< A variable indicating which direction
+ !! this axis corresponds with. Valid values
+ !! include 'X', 'Y', 'Z', 'T', and 'N' for none.
+ integer :: sense = 0 !< This is 1 for axes whose values increase upward, or -1
+ !! if they increase downward. The default, 0, is ignored.
+ integer :: ax_size = 0 !< The number of elements in this axis
+ real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis [arbitrary]
+end type axis_info
+
!> Type for describing a 3-d variable for output
type, public :: vardesc
character(len=64) :: name !< Variable name in a NetCDF file
@@ -165,22 +179,9 @@ module MOM_io
character(len=32) :: dim_names(5) !< The names in the file of the axes for this variable
integer :: position = -1 !< An integer encoding the horizontal position, it may
!! CENTER, CORNER, EAST_FACE, NORTH_FACE, or 0.
+ type(axis_info) :: extra_axes(5) !< dimensions other than space-time
end type vardesc
-!> Type that stores information that can be used to create a non-decomposed axis.
-type :: axis_info ; private
- character(len=32) :: name = "" !< The name of this axis for use in files
- character(len=256) :: longname = "" !< A longer name describing this axis
- character(len=48) :: units = "" !< The units of the axis labels
- character(len=8) :: cartesian = "N" !< A variable indicating which direction
- !! this axis corresponds with. Valid values
- !! include 'X', 'Y', 'Z', 'T', and 'N' for none.
- integer :: sense = 0 !< This is 1 for axes whose values increase upward, or -1
- !! if they increase downward. The default, 0, is ignored.
- integer :: ax_size = 0 !< The number of elements in this axis
- real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis [arbitrary]
-end type axis_info
-
!> Type that stores for a global file attribute
type :: attribute_info ; private
character(len=:), allocatable :: name !< The name of this attribute
@@ -271,7 +272,8 @@ subroutine create_MOM_file(IO_handle, filename, vars, novars, fields, &
!! required if the new file uses any
!! vertical grid axes.
integer(kind=int64), optional, intent(in) :: checksums(:,:) !< checksums of vars
- type(axis_info), optional, intent(in) :: extra_axes(:) !< Types with information about
+ type(axis_info), dimension(:), &
+ optional, intent(in) :: extra_axes !< Types with information about
!! some axes that might be used in this file
type(attribute_info), optional, intent(in) :: global_atts(:) !< Global attributes to
!! write to this file
@@ -1751,7 +1753,8 @@ end subroutine verify_variable_units
!! have default values that are empty strings or are appropriate for a 3-d
!! tracer field at the tracer cell centers.
function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, &
- cmor_units, cmor_longname, conversion, caller, position, dim_names, fixed) result(vd)
+ cmor_units, cmor_longname, conversion, caller, position, dim_names, &
+ extra_axes, fixed) result(vd)
character(len=*), intent(in) :: name !< variable name
character(len=*), optional, intent(in) :: units !< variable units
character(len=*), optional, intent(in) :: longname !< variable long name
@@ -1772,6 +1775,8 @@ function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_na
!! NORTH_FACE, and 0 for no horizontal dimensions.
character(len=*), dimension(:), &
optional, intent(in) :: dim_names !< The names of the dimensions of this variable
+ type(axis_info), dimension(:), &
+ optional, intent(in) :: extra_axes !< dimensions other than space-time
logical, optional, intent(in) :: fixed !< If true, this does not evolve with time
type(vardesc) :: vd !< vardesc type that is created
@@ -1795,7 +1800,8 @@ function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_na
call modify_vardesc(vd, units=units, longname=longname, hor_grid=hor_grid, &
z_grid=z_grid, t_grid=t_grid, position=position, dim_names=dim_names, &
cmor_field_name=cmor_field_name, cmor_units=cmor_units, &
- cmor_longname=cmor_longname, conversion=conversion, caller=cllr)
+ cmor_longname=cmor_longname, conversion=conversion, caller=cllr, &
+ extra_axes=extra_axes)
end function var_desc
@@ -1803,7 +1809,8 @@ end function var_desc
!> This routine modifies the named elements of a vardesc type.
!! All arguments are optional, except the vardesc type to be modified.
subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
- cmor_field_name, cmor_units, cmor_longname, conversion, caller, position, dim_names)
+ cmor_field_name, cmor_units, cmor_longname, conversion, caller, position, dim_names, &
+ extra_axes)
type(vardesc), intent(inout) :: vd !< vardesc type that is modified
character(len=*), optional, intent(in) :: name !< name of variable
character(len=*), optional, intent(in) :: units !< units of variable
@@ -1825,6 +1832,8 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
!! NORTH_FACE, and 0 for no horizontal dimensions.
character(len=*), dimension(:), &
optional, intent(in) :: dim_names !< The names of the dimensions of this variable
+ type(axis_info), dimension(:), &
+ optional, intent(in) :: extra_axes !< dimensions other than space-time
character(len=120) :: cllr
integer :: n
@@ -1877,6 +1886,12 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
endif ; enddo
endif
+ if (present(extra_axes)) then
+ do n=1,size(extra_axes) ; if (len_trim(extra_axes(n)%name) > 0) then
+ vd%extra_axes(n) = extra_axes(n)
+ endif ; enddo
+ endif
+
end subroutine modify_vardesc
integer function position_from_horgrid(hor_grid)
@@ -2020,7 +2035,7 @@ end function cmor_long_std
!> This routine queries vardesc
subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
cmor_field_name, cmor_units, cmor_longname, conversion, caller, &
- position, dim_names)
+ extra_axes, position, dim_names)
type(vardesc), intent(in) :: vd !< vardesc type that is queried
character(len=*), optional, intent(out) :: name !< name of variable
character(len=*), optional, intent(out) :: units !< units of variable
@@ -2035,6 +2050,8 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
!! convert from intensive to extensive
!! [various] or [a A-1 ~> 1]
character(len=*), optional, intent(in) :: caller !< calling routine?
+ type(axis_info), dimension(5), &
+ optional, intent(out) :: extra_axes !< dimensions other than space-time
integer, optional, intent(out) :: position !< A coded integer indicating the horizontal position
!! of this variable if it has such dimensions.
!! Valid values include CORNER, CENTER, EAST_FACE
@@ -2043,7 +2060,8 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
optional, intent(out) :: dim_names !< The names of the dimensions of this variable
integer :: n
- character(len=120) :: cllr
+ integer, parameter :: nmax_extraaxes = 5
+ character(len=120) :: cllr, varname
cllr = "mod_vardesc"
if (present(caller)) cllr = trim(caller)
@@ -2076,6 +2094,19 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
enddo
endif
+ if (present(extra_axes)) then
+ ! save_restart expects 5 extra axes (can be empty)
+ do n=1, nmax_extraaxes
+ if (vd%extra_axes(n)%ax_size>=1) then
+ extra_axes(n) = vd%extra_axes(n)
+ else
+ ! return an empty axis
+ write(varname,"('dummy',i1.1)") n
+ call set_axis_info(extra_axes(n), name=trim(varname), ax_size=1)
+ endif
+ enddo
+ endif
+
end subroutine query_vardesc
diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90
index 75051c32ba..188cfbb2ec 100644
--- a/src/framework/MOM_restart.F90
+++ b/src/framework/MOM_restart.F90
@@ -14,6 +14,7 @@ module MOM_restart
use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc, get_filename_appendix
use MOM_io, only : MULTIPLE, READONLY_FILE, SINGLE_FILE
use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE
+use MOM_io, only : axis_info, get_axis_info
use MOM_string_functions, only : lowercase
use MOM_time_manager, only : time_type, time_type_to_real, real_to_time
use MOM_time_manager, only : days_in_month, get_date, set_date
@@ -26,6 +27,7 @@ module MOM_restart
public restart_registry_lock, restart_init_end, vardesc
public restart_files_exist, determine_is_new_run, is_new_run
public register_restart_field_as_obsolete, register_restart_pair
+public lock_check
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
@@ -445,7 +447,7 @@ end subroutine register_restart_pair_ptr4d
!> Register a 4-d field for restarts, providing the metadata as individual arguments
subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units, conversion, &
- hor_grid, z_grid, t_grid)
+ hor_grid, z_grid, t_grid, extra_axes)
real, dimension(:,:,:,:), &
target, intent(in) :: f_ptr !< A pointer to the field to be read or written
!! in arbitrary rescaled units [A ~> a]
@@ -460,8 +462,26 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units
character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent
character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent
character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent
+ type(axis_info), dimension(:), &
+ optional, intent(in) :: extra_axes !< dimensions other than space-time
type(vardesc) :: vd
+ character(len=32), dimension(:), allocatable :: dim_names
+ integer :: n, n_extradims
+
+ ! first 2 dimensions in dim_names are reserved for i,j
+ ! so extra_dimensions are shifted to index 3.
+ ! this is designed not to break the behavior in SIS2
+ ! (see register_restart_field_4d in SIS_restart.F90)
+ if (present(extra_axes)) then
+ n_extradims = size(extra_axes)
+ allocate(dim_names(n_extradims+2))
+ dim_names(1) = ""
+ dim_names(2) = ""
+ do n=3,n_extradims+2
+ dim_names(n) = extra_axes(n-2)%name
+ enddo
+ endif
if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // &
"register_restart_field_4d: Module must be initialized before "//&
@@ -469,8 +489,13 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units
call lock_check(CS, name=name)
- vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
- z_grid=z_grid, t_grid=t_grid)
+ if (present(extra_axes)) then
+ vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
+ z_grid=z_grid, t_grid=t_grid, dim_names=dim_names, extra_axes=extra_axes)
+ else
+ vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
+ z_grid=z_grid, t_grid=t_grid)
+ endif
call register_restart_field_ptr4d(f_ptr, vd, mandatory, CS, conversion)
@@ -478,7 +503,7 @@ end subroutine register_restart_field_4d
!> Register a 3-d field for restarts, providing the metadata as individual arguments
subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units, conversion, &
- hor_grid, z_grid, t_grid)
+ hor_grid, z_grid, t_grid, extra_axes)
real, dimension(:,:,:), &
target, intent(in) :: f_ptr !< A pointer to the field to be read or written
!! in arbitrary rescaled units [A ~> a]
@@ -493,8 +518,26 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units
character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent
character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent
character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent
+ type(axis_info), dimension(:), &
+ optional, intent(in) :: extra_axes !< dimensions other than space-time
type(vardesc) :: vd
+ character(len=32), dimension(:), allocatable :: dim_names
+ integer :: n, n_extradims
+
+ ! first 2 dimensions in dim_names are reserved for i,j
+ ! so extra_dimensions are shifted to index 3.
+ ! this is designed not to break the behavior in SIS2
+ ! (see register_restart_field_4d in SIS_restart.F90)
+ if (present(extra_axes)) then
+ n_extradims = size(extra_axes)
+ allocate(dim_names(n_extradims+2))
+ dim_names(1) = ""
+ dim_names(2) = ""
+ do n=3,n_extradims+2
+ dim_names(n) = extra_axes(n-2)%name
+ enddo
+ endif
if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart: " // &
"register_restart_field_3d: Module must be initialized before "//&
@@ -502,8 +545,13 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units
call lock_check(CS, name=name)
- vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
- z_grid=z_grid, t_grid=t_grid)
+ if (present(extra_axes)) then
+ vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
+ z_grid=z_grid, t_grid=t_grid, dim_names=dim_names, extra_axes=extra_axes)
+ else
+ vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, &
+ z_grid=z_grid, t_grid=t_grid)
+ endif
call register_restart_field_ptr3d(f_ptr, vd, mandatory, CS, conversion)
@@ -612,7 +660,7 @@ end subroutine register_restart_field_0d
!> query_initialized_name determines whether a named field has been successfully
-!! read from a restart file or has otherwise been recored as being initialzed.
+!! read from a restart file or has otherwise been recorded as being initialized.
function query_initialized_name(name, CS) result(query_initialized)
character(len=*), intent(in) :: name !< The name of the field that is being queried
type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct
@@ -1223,7 +1271,7 @@ subroutine only_read_restart_pair_3d(a_ptr, b_ptr, a_name, b_name, G, CS, &
end subroutine only_read_restart_pair_3d
-!> Return an indicationof whether the named variable is the restart files, and provie the full path
+!> Return an indication of whether the named variable is in the restart files, and provide the full path
!! to the restart file in which a variable is found.
function find_var_in_restart_files(varname, G, CS, file_path, filename, directory, is_global) result (found)
character(len=*), intent(in) :: varname !< The variable name to be used in the restart file
@@ -1309,7 +1357,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_
integer :: start_var, next_var ! The starting variables of the
! current and next files.
type(MOM_infra_file) :: IO_handle ! The I/O handle of the open fileset
- integer :: m, nz
+ integer :: m, nz, na
integer :: num_files ! The number of restart files that will be used.
integer :: seconds, days, year, month, hour, minute
character(len=8) :: hor_grid, z_grid, t_grid ! Variable grid info.
@@ -1320,9 +1368,13 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_
integer(kind=8) :: check_val(CS%max_fields,1)
integer :: isL, ieL, jsL, jeL, pos
integer :: turns
+ integer, parameter :: nmax_extradims = 5
+ type(axis_info), dimension(:), allocatable :: extra_axes
turns = CS%turns
+ allocate (extra_axes(nmax_extradims))
+
if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // &
"save_restart: Module must be initialized before it is used.")
@@ -1361,8 +1413,14 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_
do m=start_var,CS%novars
call query_vardesc(CS%restart_field(m)%vars, hor_grid=hor_grid, &
- z_grid=z_grid, t_grid=t_grid, caller="save_restart")
+ z_grid=z_grid, t_grid=t_grid, caller="save_restart", &
+ extra_axes=extra_axes)
+
var_sz = get_variable_byte_size(hor_grid, z_grid, t_grid, G, nz)
+ ! factor in size of extra axes, or multiply by 1
+ do na=1,nmax_extradims
+ var_sz = var_sz*extra_axes(na)%ax_size
+ enddo
if ((m==start_var) .OR. (size_in_file < max_file_size-var_sz)) then
size_in_file = size_in_file + var_sz
@@ -1445,10 +1503,10 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_
if (CS%parallel_restartfiles) then
call create_MOM_file(IO_handle, trim(restartpath), vars, next_var-start_var, &
- fields, MULTIPLE, G=G, GV=GV, checksums=check_val)
+ fields, MULTIPLE, G=G, GV=GV, checksums=check_val, extra_axes=extra_axes)
else
call create_MOM_file(IO_handle, trim(restartpath), vars, next_var-start_var, &
- fields, SINGLE_FILE, G=G, GV=GV, checksums=check_val)
+ fields, SINGLE_FILE, G=G, GV=GV, checksums=check_val, extra_axes=extra_axes)
endif
do m=start_var,next_var-1
@@ -1650,7 +1708,7 @@ subroutine restore_state(filename, directory, day, G, CS)
elseif (associated(CS%var_ptr4d(m)%p)) then ! Read a 4d array.
if (pos /= 0) then
call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, &
- G%Domain, timelevel=1, position=pos, scale=scale)
+ G%Domain, timelevel=1, position=pos, scale=scale, global_file=unit_is_global(n))
else ! This array is not domain-decomposed. This variant may be under-tested.
call MOM_error(FATAL, &
"MOM_restart does not support 4-d arrays without domain decomposition.")
diff --git a/src/framework/posix.F90 b/src/framework/posix.F90
index 213ff4656d..fffb619cba 100644
--- a/src/framework/posix.F90
+++ b/src/framework/posix.F90
@@ -13,6 +13,16 @@ module posix
implicit none
+!> Container for file metadata from stat
+!!
+!! NOTE: This is currently just a placeholder containing fields, such as size,
+!! uid, mode, etc. A readable Fortran type may be used in the future.
+type, bind(c) :: stat_buf
+ private
+ character(kind=c_char) :: state(SIZEOF_STAT_BUF)
+ !< Byte array containing file metadata
+end type stat_buf
+
!> Container for the jump point buffer created by setjmp().
!!
!! The buffer typically contains the current register values, stack pointers,
@@ -52,6 +62,34 @@ function chmod_posix(path, mode) result(rc) bind(c, name="chmod")
!< Function return code
end function chmod_posix
+ !> C interface to POSIX mkdir()
+ !! Users should use the Fortran-defined mkdir() function.
+ function mkdir_posix(path, mode) result(rc) bind(c, name="mkdir")
+ ! #include
+ ! int mkdir(const char *path, mode_t mode);
+ import :: c_char, c_int
+
+ character(kind=c_char), dimension(*), intent(in) :: path
+ !< Zero-delimited file path
+ integer(kind=c_int), value, intent(in) :: mode
+ !< File permission to be assigned to file.
+ integer(kind=c_int) :: rc
+ !< Function return code
+ end function mkdir_posix
+
+ !> C interface to POSIX stat()
+ !! Users should use the Fortran-defined stat() function.
+ function stat_posix(path, buf) result(rc) bind(c, name="stat")
+ import :: c_char, stat_buf, c_int
+
+ character(kind=c_char), dimension(*), intent(in) :: path
+ !< Pathname of a POSIX file
+ type(stat_buf), intent(in) :: buf
+ !< Information describing the file if it exists
+ integer(kind=c_int) :: rc
+ !< Function return code
+ end function
+
!> C interface to POSIX signal()
!! Users should use the Fortran-defined signal() function.
function signal_posix(sig, func) result(handle) bind(c, name="signal")
@@ -240,6 +278,44 @@ function chmod(path, mode) result(rc)
rc = int(rc_c)
end function chmod
+!> Create a file directory
+!!
+!! This creates a new directory named `path` with permissons set by `mode`.
+!! If successful, it returns zero. Otherwise, it returns -1.
+function mkdir(path, mode) result(rc)
+ character(len=*), intent(in) :: path
+ integer, intent(in) :: mode
+ integer :: rc
+
+ integer(kind=c_int) :: mode_c
+ integer(kind=c_int) :: rc_c
+
+ mode_c = int(mode, kind=c_int)
+ rc_c = mkdir_posix(path//c_null_char, mode_c)
+ rc = int(rc_c)
+end function mkdir
+
+!> Get file status
+!!
+!! This obtains information about the named file and writes it to buf.
+!! If found, it returns zero. Otherwise, it returns -1.
+function stat(path, buf) result(rc)
+ character(len=*), intent(in) :: path
+ !< Pathname of file to be inspected
+ type(stat_buf), intent(out) :: buf
+ !< Buffer containing information about the file if it exists
+ ! NOTE: Currently the contents of buf are not readable, but we could move
+ ! the contents into a readable Fortran type.
+ integer :: rc
+ !< Function return code
+
+ integer(kind=c_int) :: rc_c
+
+ rc_c = stat_posix(path//c_null_char, buf)
+
+ rc = int(rc_c)
+end function stat
+
!> Create a signal handler `handle` to be called when `sig` is detected.
!!
!! If successful, the previous handler for `sig` is returned. Otherwise,
@@ -359,6 +435,9 @@ function setjmp_missing(env) result(rc) bind(c)
print '(a)', 'ERROR: setjmp() is not implemented in this build.'
print '(a)', 'Recompile with autoconf or -DSETJMP_NAME=\"\".'
error stop
+
+ ! NOTE: compilers may expect a return value, even if it is unreachable
+ rc = -1
end function setjmp_missing
!> Placeholder function for a missing or unconfigured longjmp
@@ -386,7 +465,7 @@ function sigsetjmp_missing(env, savesigs) result(rc) bind(c)
print '(a)', 'Recompile with autoconf or -DSIGSETJMP_NAME=\"\".'
error stop
- ! NOTE: Compilers may expect a return value, even if it is unreachable
+ ! NOTE: compilers may expect a return value, even if it is unreachable
rc = -1
end function sigsetjmp_missing
diff --git a/src/framework/posix.h b/src/framework/posix.h
index f7cea0fec9..c4b09e1285 100644
--- a/src/framework/posix.h
+++ b/src/framework/posix.h
@@ -1,6 +1,12 @@
#ifndef MOM6_POSIX_H_
#define MOM6_POSIX_H_
+! STAT_BUF_SIZE should be set to sizeof(stat).
+! The default value is based on glibc 2.28.
+#ifndef SIZEOF_STAT_BUF
+#define SIZEOF_STAT_BUF 144
+#endif
+
! JMP_BUF_SIZE should be set to sizeof(jmp_buf).
! If unset, then use a typical glibc value (25 long ints)
#ifndef SIZEOF_JMP_BUF
diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90
index b5ed3f91cf..eab178280c 100644
--- a/src/ice_shelf/MOM_ice_shelf.F90
+++ b/src/ice_shelf/MOM_ice_shelf.F90
@@ -48,9 +48,9 @@ module MOM_ice_shelf
use MOM_get_input, only : directories, Get_MOM_input
use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_TFreeze, EOS_domain
use MOM_EOS, only : EOS_type, EOS_init
-use MOM_ice_shelf_dynamics, only : ice_shelf_dyn_CS, update_ice_shelf
+use MOM_ice_shelf_dynamics, only : ice_shelf_dyn_CS, update_ice_shelf, write_ice_shelf_energy
use MOM_ice_shelf_dynamics, only : register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn
-use MOM_ice_shelf_dynamics, only : ice_shelf_min_thickness_calve
+use MOM_ice_shelf_dynamics, only : ice_shelf_min_thickness_calve, change_in_draft
use MOM_ice_shelf_dynamics, only : ice_time_step_CFL, ice_shelf_dyn_end
use MOM_ice_shelf_initialize, only : initialize_ice_thickness
!MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary
@@ -162,6 +162,8 @@ module MOM_ice_shelf
type(EOS_type) :: eqn_of_state !< Type that indicates the equation of state to use.
logical :: active_shelf_dynamics !< True if the ice shelf mass changes as a result
!! the dynamic ice-shelf model.
+ logical :: shelf_mass_is_dynamic !< True if ice shelf mass changes over time. If true, ice
+ !! shelf dynamics will be initialized
logical :: data_override_shelf_fluxes !< True if the ice shelf surface mass fluxes can be
!! written using the data_override feature (only for MOSAIC grids)
logical :: override_shelf_movement !< If true, user code specifies the shelf movement
@@ -175,6 +177,8 @@ module MOM_ice_shelf
logical :: const_gamma !< If true, gamma_T is specified by the user.
logical :: constant_sea_level !< if true, apply an evaporative, heat and salt
!! fluxes. It will avoid large increase in sea level.
+ logical :: constant_sea_level_misomip !< If true, constant_sea_level fluxes are applied only over
+ !! the surface sponge cells from the ISOMIP/MISOMIP configuration
real :: min_ocean_mass_float !< The minimum ocean mass per unit area before the ice
!! shelf is considered to float when constant_sea_level
!! is used [R Z ~> kg m-2]
@@ -185,12 +189,20 @@ module MOM_ice_shelf
!! salinity [C S-1 ~> degC ppt-1]
real :: dTFr_dp !< Partial derivative of freezing temperature with
!! pressure [C T2 R-1 L-2 ~> degC Pa-1]
+ real :: Zeta_N !< The stability constant xi_N = 0.052 from Holland & Jenkins '99
+ !! divided by the von Karman constant VK. Was 1/8.
+ real :: Vk !< Von Karman's constant - dimensionless
+ real :: Rc !< critical flux Richardson number.
+ logical :: buoy_flux_itt_bug !< If true, fixes buoyancy iteration bug
+ logical :: salt_flux_itt_bug !< If true, fixes salt iteration bug
+ real :: buoy_flux_itt_threshold !< Buoyancy iteration threshold for convergence
+
!>@{ Diagnostic handles
integer :: id_melt = -1, id_exch_vel_s = -1, id_exch_vel_t = -1, &
id_tfreeze = -1, id_tfl_shelf = -1, &
id_thermal_driving = -1, id_haline_driving = -1, &
id_u_ml = -1, id_v_ml = -1, id_sbdry = -1, &
- id_h_shelf = -1, id_h_mask = -1, &
+ id_h_shelf = -1, id_dhdt_shelf, id_h_mask = -1, &
id_surf_elev = -1, id_bathym = -1, &
id_area_shelf_h = -1, &
id_ustar_shelf = -1, id_shelf_mass = -1, id_mass_flux = -1, &
@@ -261,10 +273,11 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
!! interface, positive for melting and negative for freezing [S ~> ppt].
!! This is computed as part of the ISOMIP diagnostics.
real :: time_step !< Length of time over which these fluxes will be applied [T ~> s].
- real, parameter :: VK = 0.40 !< Von Karman's constant - dimensionless
- real :: ZETA_N = 0.052 !> The fraction of the boundary layer over which the
- !! viscosity is linearly increasing [nondim]. (Was 1/8. Why?)
- real, parameter :: RC = 0.20 ! critical flux Richardson number.
+ real :: Itime_step !< Inverse of the length of time over which these fluxes will be applied [T-1 ~> s-1]
+ real :: VK !< Von Karman's constant - dimensionless
+ real :: ZETA_N !< This is the stability constant xi_N = 0.052 from Holland & Jenkins '99
+ !! divided by the von Karman constant VK. Was 1/8. [nondim]
+ real :: RC !< critical flux Richardson number.
real :: I_ZETA_N !< The inverse of ZETA_N [nondim].
real :: I_LF !< The inverse of the latent heat of fusion [Q-1 ~> kg J-1].
real :: I_VK !< The inverse of the Von Karman constant [nondim].
@@ -346,6 +359,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
endif
! useful parameters
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ied = G%ied ; jed = G%jed
+ ZETA_N = CS%Zeta_N
+ VK = CS%Vk
+ RC = CS%Rc
I_ZETA_N = 1.0 / ZETA_N
I_LF = 1.0 / CS%Lat_fusion
SC = CS%kv_molec/CS%kd_molec_salt
@@ -527,7 +543,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
if (wB_flux < 0.0) then
! The buoyancy flux is stabilizing and will reduce the turbulent
! fluxes, and iteration is required.
- n_star_term = (ZETA_N/RC) * (hBL_neut * VK) / (ustar_h)**3
+ n_star_term = (ZETA_N * hBL_neut * VK) / (RC * ustar_h**3)
do it3 = 1,30
! n_star <= 1.0 is the ratio of working boundary layer thickness
! to the neutral thickness.
@@ -558,13 +574,15 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
wT_flux = dT_ustar * I_Gam_T
wB_flux_new = dB_dS * (dS_ustar * I_Gam_S) + dB_dT * wT_flux
- ! Find the root where wB_flux_new = wB_flux. Make the 1.0e-4 below into a parameter?
- if (abs(wB_flux_new - wB_flux) < 1.0e-4*(abs(wB_flux_new) + abs(wB_flux))) exit
+ ! Find the root where wB_flux_new = wB_flux.
+ if (abs(wB_flux_new - wB_flux) < CS%buoy_flux_itt_threshold*(abs(wB_flux_new) + abs(wB_flux))) exit
dDwB_dwB_in = dG_dwB * (dB_dS * (dS_ustar * I_Gam_S**2) + &
dB_dT * (dT_ustar * I_Gam_T**2)) - 1.0
! This is Newton's method without any bounds. Should bounds be needed?
wB_flux_new = wB_flux - (wB_flux_new - wB_flux) / dDwB_dwB_in
+ ! Update wB_flux
+ if (CS%buoy_flux_itt_bug) wB_flux = wB_flux_new
enddo !it3
endif
@@ -637,7 +655,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
Sbdry(i,j) = Sbdry_it
endif ! Sb_min_set
- Sbdry(i,j) = Sbdry_it
+ if (.not.CS%salt_flux_itt_bug) Sbdry(i,j) = Sbdry_it
+
endif ! CS%find_salt_root
enddo !it1
@@ -735,6 +754,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
! Melting has been computed, now is time to update thickness and mass with dynamic ice shelf
if (CS%active_shelf_dynamics) then
+
+ ISS%dhdt_shelf(:,:) = ISS%h_shelf(:,:)
+
call change_thickness_using_melt(ISS, G, US, time_step, fluxes, CS%density_ice, CS%debug)
if (CS%debug) then
@@ -751,25 +773,29 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
scale=US%RZ_to_kg_m2)
endif
- endif
-
- if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0)
-
- call add_shelf_flux(G, US, CS, sfc_state, fluxes)
-
- ! now the thermodynamic data is passed on... time to update the ice dynamic quantities
-
- if (CS%active_shelf_dynamics) then
update_ice_vel = .false.
- coupled_GL = (CS%GL_couple .and. .not.CS%solo_ice_sheet)
+ coupled_GL = (CS%GL_couple .and. .not. CS%solo_ice_sheet)
! advect the ice shelf, and advance the front. Calving will be in here somewhere as well..
! when we decide on how to do it
call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, &
sfc_state%ocean_mass, coupled_GL)
+ Itime_step = 1./time_step
+ do j=js,je ; do i=is,ie
+ ISS%dhdt_shelf(i,j) = (ISS%h_shelf(i,j) - ISS%dhdt_shelf(i,j))*Itime_step
+ enddo; enddo
endif
+ if (CS%shelf_mass_is_dynamic) &
+ call write_ice_shelf_energy(CS%dCS, G, US, ISS%mass_shelf, Time, &
+ time_step=real_to_time(US%T_to_s*time_step) )
+
+ if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0)
+
+ ! pass on the updated ice sheet geometry (for pressure on ocean) and thermodynamic data
+ call add_shelf_flux(G, US, CS, sfc_state, fluxes, time_step)
+
call enable_averages(time_step, Time, CS%diag)
if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, ISS%mass_shelf, CS%diag)
if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag)
@@ -788,6 +814,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS)
if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, exch_vel_t, CS%diag)
if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, exch_vel_s, CS%diag)
if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf, ISS%h_shelf, CS%diag)
+ if (CS%id_dhdt_shelf > 0) call post_data(CS%id_dhdt_shelf, ISS%dhdt_shelf, CS%diag)
if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag)
call disable_averaging(CS%diag)
@@ -840,13 +867,13 @@ subroutine change_thickness_using_melt(ISS, G, US, time_step, fluxes, density_ic
ISS%hmask(i,j) = 0.0
ISS%area_shelf_h(i,j) = 0.0
endif
- ISS%mass_shelf(i,j) = ISS%h_shelf(i,j) * density_ice
+ ISS%mass_shelf(i,j) = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) * G%IareaT(i,j) * density_ice
endif
enddo ; enddo
- call pass_var(ISS%area_shelf_h, G%domain)
- call pass_var(ISS%h_shelf, G%domain)
- call pass_var(ISS%hmask, G%domain)
+ call pass_var(ISS%area_shelf_h, G%domain, complete=.false.)
+ call pass_var(ISS%h_shelf, G%domain, complete=.false.)
+ call pass_var(ISS%hmask, G%domain, complete=.false.)
call pass_var(ISS%mass_shelf, G%domain)
end subroutine change_thickness_using_melt
@@ -998,13 +1025,13 @@ subroutine add_shelf_pressure(Ocn_grid, US, CS, fluxes)
end subroutine add_shelf_pressure
!> Updates surface fluxes that are influenced by sub-ice-shelf melting
-subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes)
+subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes, time_step)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(ice_shelf_CS), pointer :: CS !< This module's control structure.
type(surface), intent(inout) :: sfc_state !< Surface ocean state
type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated.
-
+ real, intent(in) :: time_step !< Time step over which fluxes are applied
! local variables
real :: frac_shelf !< The fractional area covered by the ice shelf [nondim].
real :: frac_open !< The fractional area of the ocean that is not covered by the ice shelf [nondim].
@@ -1025,6 +1052,8 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes)
!! at at previous time (Time-dt)
real, dimension(SZDI_(G),SZDJ_(G)) :: last_area_shelf_h !< Ice shelf area [L2 ~> m2]
!! at at previous time (Time-dt)
+ real, dimension(SZDI_(G),SZDJ_(G)) :: delta_draft !< change in ice shelf draft thickness [L ~> m]
+ !! since previous time (Time-dt)
type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe
!! the ice-shelf state
@@ -1151,22 +1180,38 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes)
else! first time step
delta_mass_shelf = 0.0
endif
- else ! ice shelf mass does not change
- delta_mass_shelf = 0.0
+ else
+ if (CS%active_shelf_dynamics) then ! change in ice_shelf draft
+ do j=js,je ; do i=is,ie
+ last_h_shelf(i,j) = ISS%h_shelf(i,j) - time_step * ISS%dhdt_shelf(i,j)
+ enddo ; enddo
+ call change_in_draft(CS%dCS, G, last_h_shelf, ISS%h_shelf, delta_draft)
+
+ !this currently assumes area_shelf_h is constant over the time step
+ delta_mass_shelf = global_area_integral(delta_draft, G, tmp_scale=US%RZ_to_kg_m2, &
+ area=ISS%area_shelf_h) &
+ * CS%Rho_ocn / CS%time_step
+ else ! ice shelf mass does not change
+ delta_mass_shelf = 0.0
+ endif
endif
- ! average total melt flux over sponge area
+ ! average total melt flux over sponge area (ISOMIP/MISOMIP only) or open ocean (general case)
do j=js,je ; do i=is,ie
- if ((G%mask2dT(i,j) > 0.0) .AND. (ISS%area_shelf_h(i,j) * G%IareaT(i,j) < 1.0)) then
- ! Uncomment this for some ISOMIP cases:
- ! .AND. (G%geoLonT(i,j) >= 790.0) .AND. (G%geoLonT(i,j) <= 800.0)) then
+ if (CS%constant_sea_level_misomip) then !for ismip/misomip only
+ if (G%geoLonT(i,j) >= 790.0) then
+ bal_frac(i,j) = max(1.0 - ISS%area_shelf_h(i,j) * G%IareaT(i,j), 0.0)
+ else
+ bal_frac(i,j) = 0.0
+ endif
+ elseif ((G%mask2dT(i,j) > 0.0) .and. (ISS%area_shelf_h(i,j) * G%IareaT(i,j) < 1.0)) then !general case
bal_frac(i,j) = max(1.0 - ISS%area_shelf_h(i,j) * G%IareaT(i,j), 0.0)
else
bal_frac(i,j) = 0.0
endif
enddo ; enddo
- balancing_area = global_area_integral(bal_frac, G)
+ balancing_area = global_area_integral(bal_frac, G, area=G%areaT)
if (balancing_area > 0.0) then
balancing_flux = ( global_area_integral(ISS%water_flux, G, tmp_scale=US%RZ_T_to_kg_m2s, &
area=ISS%area_shelf_h) + &
@@ -1197,14 +1242,16 @@ end subroutine add_shelf_flux
!> Initializes shelf model data, parameters and diagnostics
-subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, &
- fluxes_in, sfc_state_in, Time_in, solo_ice_sheet_in)
+subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, directory, forces_in, &
+ fluxes_in, sfc_state_in, solo_ice_sheet_in)
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure
type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time
type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure
type(MOM_diag_ctrl), pointer :: diag !< This is a pointer to the MOM diag CS
!! which will be discarded
+ type(time_type), intent(in) :: Time_init !< The time at initialization.
+ character(len=*), intent(in) :: directory !< The directory where the energy file goes.
type(mech_forcing), optional, target, intent(inout) :: forces_in !< A structure with the driving mechanical forces
type(forcing), optional, target, intent(inout) :: fluxes_in !< A structure containing pointers to any
@@ -1212,7 +1259,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
type(surface), target, optional, intent(inout) :: sfc_state_in !< A structure containing fields that
!! describe the surface state of the ocean. The
!! intent is only inout to allow for halo updates.
- type(time_type), optional, intent(in) :: Time_in !< The time at initialization.
logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether
!! a solo ice-sheet driver.
@@ -1234,7 +1280,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name.
integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq
integer :: wd_halos(2)
- logical :: read_TideAmp, shelf_mass_is_dynamic, debug
+ logical :: read_TideAmp, debug
logical :: global_indexing
character(len=240) :: Tideamp_file ! Input file names
character(len=80) :: tideamp_var ! Input file variable names
@@ -1349,7 +1395,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
CS%solo_ice_sheet = .false.
if (present(solo_ice_sheet_in)) CS%solo_ice_sheet = solo_ice_sheet_in
- if (present(Time_in)) Time = Time_in
+ !if (present(Time_in)) Time = Time_in
CS%override_shelf_movement = .false. ; CS%active_shelf_dynamics = .false.
@@ -1359,10 +1405,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
call get_param(param_file, mdl, "DEBUG_IS", CS%debug, &
"If true, write verbose debugging messages for the ice shelf.", &
default=debug)
- call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, &
+ call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", CS%shelf_mass_is_dynamic, &
"If true, the ice sheet mass can evolve with time.", &
default=.false.)
- if (shelf_mass_is_dynamic) then
+ if (CS%shelf_mass_is_dynamic) then
call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", CS%override_shelf_movement, &
"If true, user provided code specifies the ice-shelf "//&
"movement instead of the dynamic ice model.", default=.false.)
@@ -1381,6 +1427,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
"will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", &
default=.false., do_not_log=CS%GL_regularize)
if (CS%GL_regularize) CS%GL_couple = .false.
+ if (CS%solo_ice_sheet) CS%GL_couple = .false.
endif
call get_param(param_file, mdl, "SHELF_THERMO", CS%isthermo, &
@@ -1408,6 +1455,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
"ISOMIP+ experiments (Ocean3 and Ocean4). "//&
"IMPORTANT: it is not currently possible to do "//&
"prefect restarts using this flag.", default=.false.)
+ call get_param(param_file, mdl, "CONST_SEA_LEVEL_MISOMIP", CS%constant_sea_level_misomip, &
+ "If true, constant_sea_level fluxes are applied only over "//&
+ "the surface sponge cells from the ISOMIP/MISOMIP configuration", default=.false.)
call get_param(param_file, mdl, "MIN_OCEAN_FLOAT_THICK", dz_ocean_min_float, &
"The minimum ocean thickness above which the ice shelf is considered to be "//&
"floating when CONST_SEA_LEVEL = True.", &
@@ -1514,7 +1564,24 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
call get_param(param_file, mdl, "READ_TIDEAMP", read_TIDEAMP, &
"If true, read a file (given by TIDEAMP_FILE) containing "//&
"the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.)
-
+ call get_param(param_file, mdl, "ICE_SHELF_LINEAR_SHELF_FRAC", CS%Zeta_N, &
+ "Ratio of HJ99 stability constant xi_N (ratio of maximum "//&
+ "mixing length to planetary boundary layer depth in "//&
+ "neutrally stable conditions) to the von Karman constant", &
+ units="nondim", default=0.13)
+ call get_param(param_file, mdl, "ICE_SHELF_VK_CNST", CS%Vk, &
+ "Von Karman constant.", &
+ units="nondim", default=0.40)
+ call get_param(param_file, mdl, "ICE_SHELF_RC", CS%Rc, &
+ "Critical flux Richardson number for ice melt ", &
+ units="nondim", default=0.20)
+ call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_BUG", CS%buoy_flux_itt_bug, &
+ "Bug fix of buoyancy iteration", default=.true.)
+ call get_param(param_file, mdl, "ICE_SHELF_SALT_FLUX_ITT_BUG", CS%salt_flux_itt_bug, &
+ "Bug fix of salt iteration", default=.true.)
+ call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_THRESHOLD", CS%buoy_flux_itt_threshold, &
+ "Convergence criterion of Newton's method for ice shelf "//&
+ "buoyancy iteration.", units="nondim", default=1.0e-4)
if (PRESENT(sfc_state_in)) then
allocate(sfc_state)
@@ -1629,7 +1696,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
! next make sure mass is consistent with thickness
do j=G%jsd,G%jed ; do i=G%isd,G%ied
- if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then
+ if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2) .or. (ISS%hmask(i,j)==3)) then
ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice
endif
enddo ; enddo
@@ -1696,7 +1763,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
CS%rotate_index, CS%turns)
! next make sure mass is consistent with thickness
do j=G%jsd,G%jed ; do i=G%isd,G%ied
- if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then
+ if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2) .or. (ISS%hmask(i,j) == 3)) then
ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice
endif
enddo ; enddo
@@ -1722,10 +1789,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
id_clock_pass = cpu_clock_id(' Ice shelf halo updates', grain=CLOCK_ROUTINE)
call cpu_clock_begin(id_clock_pass)
- call pass_var(ISS%area_shelf_h, G%domain)
- call pass_var(ISS%h_shelf, G%domain)
- call pass_var(ISS%mass_shelf, G%domain)
- call pass_var(ISS%hmask, G%domain)
+ call pass_var(ISS%area_shelf_h, G%domain, complete=.false.)
+ call pass_var(ISS%h_shelf, G%domain, complete=.false.)
+ call pass_var(ISS%mass_shelf, G%domain, complete=.false.)
+ call pass_var(ISS%hmask, G%domain, complete=.false.)
call pass_var(G%bathyT, G%domain)
call cpu_clock_end(id_clock_pass)
@@ -1746,8 +1813,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
ISS%water_flux(:,:) = 0.0
endif
- if (shelf_mass_is_dynamic) &
- call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, US, CS%diag, new_sim, solo_ice_sheet_in)
+ if (CS%shelf_mass_is_dynamic) &
+ call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, US, CS%diag, new_sim, &
+ Time_init, directory, solo_ice_sheet_in)
call fix_restart_unit_scaling(US, unscaled=.true.)
@@ -1769,6 +1837,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in,
'mass of shelf', 'kg/m^2', conversion=US%RZ_to_kg_m2)
CS%id_h_shelf = register_diag_field('ice_shelf_model', 'h_shelf', CS%diag%axesT1, CS%Time, &
'ice shelf thickness', 'm', conversion=US%Z_to_m)
+ CS%id_dhdt_shelf = register_diag_field('ice_shelf_model', 'dhdt_shelf', CS%diag%axesT1, CS%Time, &
+ 'change in ice shelf thickness over time', 'm s-1', conversion=US%Z_to_m*US%s_to_T)
CS%id_mass_flux = register_diag_field('ice_shelf_model', 'mass_flux', CS%diag%axesT1,&
CS%Time, 'Total mass flux of freshwater across the ice-ocean interface.', &
'kg/s', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2)
@@ -1838,10 +1908,12 @@ subroutine initialize_ice_shelf_fluxes(CS, ocn_grid, US, fluxes_in)
! when SHELF_THERMO = True. These fluxes are necessary if one wants to
! use either ENERGETICS_SFC_PBL (ALE mode) or BULKMIXEDLAYER (layer mode).
call allocate_forcing_type(CS%Grid_in, fluxes_in, ustar=.true., shelf=.true., &
- press=.true., water=CS%isthermo, heat=CS%isthermo, shelf_sfc_accumulation = CS%active_shelf_dynamics)
+ press=.true., water=CS%isthermo, heat=CS%isthermo, shelf_sfc_accumulation=CS%active_shelf_dynamics, &
+ tau_mag=.true.)
else
call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes in solo mode.")
- call allocate_forcing_type(CS%Grid_in, fluxes_in, ustar=.true., shelf=.true., press=.true.)
+ call allocate_forcing_type(CS%Grid_in, fluxes_in, ustar=.true., shelf=.true., &
+ press=.true., shelf_sfc_accumulation = CS%active_shelf_dynamics, tau_mag=.true.)
endif
if (CS%rotate_index) then
allocate(fluxes)
@@ -1872,7 +1944,7 @@ subroutine initialize_ice_shelf_forces(CS, ocn_grid, US, forces_in)
type(mech_forcing), pointer :: forces => NULL()
call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating forces.")
- call allocate_mech_forcing(CS%Grid_in, forces_in, ustar=.true., shelf=.true., press=.true.)
+ call allocate_mech_forcing(CS%Grid_in, forces_in, ustar=.true., shelf=.true., press=.true., tau_mag=.true.)
if (CS%rotate_index) then
allocate(forces)
call allocate_mech_forcing(forces_in, CS%Grid, forces)
@@ -1999,7 +2071,7 @@ subroutine change_thickness_using_precip(CS, ISS, G, US, fluxes, time_step, Time
do j=G%jsc,G%jec ; do i=G%isc,G%iec
if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then
- if (-fluxes%shelf_sfc_mass_flux(i,j) * time_step < ISS%h_shelf(i,j)) then
+ if (-fluxes%shelf_sfc_mass_flux(i,j) * time_step * I_rho_ice < ISS%h_shelf(i,j)) then
ISS%h_shelf(i,j) = ISS%h_shelf(i,j) + fluxes%shelf_sfc_mass_flux(i,j) * time_step * I_rho_ice
else
! the ice is about to ablate, so set thickness, area, and mask to zero
@@ -2008,7 +2080,7 @@ subroutine change_thickness_using_precip(CS, ISS, G, US, fluxes, time_step, Time
ISS%hmask(i,j) = 0.0
ISS%area_shelf_h(i,j) = 0.0
endif
- ISS%mass_shelf(i,j) = ISS%h_shelf(i,j) * CS%density_ice
+ ISS%mass_shelf(i,j) = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) * G%IareaT(i,j) * CS%density_ice
endif
enddo ; enddo
@@ -2068,10 +2140,10 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time)
CS%min_thickness_simple_calve, halo=0)
endif
- call pass_var(ISS%area_shelf_h, G%domain)
- call pass_var(ISS%h_shelf, G%domain)
- call pass_var(ISS%hmask, G%domain)
- call pass_var(ISS%mass_shelf, G%domain)
+ call pass_var(ISS%area_shelf_h, G%domain, complete=.false.)
+ call pass_var(ISS%h_shelf, G%domain, complete=.false.)
+ call pass_var(ISS%hmask, G%domain, complete=.false.)
+ call pass_var(ISS%mass_shelf, G%domain, complete=.true.)
end subroutine update_shelf_mass
@@ -2146,13 +2218,14 @@ subroutine ice_shelf_end(CS)
end subroutine ice_shelf_end
!> This routine is for stepping a stand-alone ice shelf model without an ocean.
-subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in)
+subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in, fluxes_in)
type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure
type(time_type), intent(in) :: time_interval !< The time interval for this update [s].
integer, intent(inout) :: nsteps !< The running number of ice shelf steps.
type(time_type), intent(inout) :: Time !< The current model time
real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step [T ~> s].
-
+ type(forcing), optional, target, intent(inout) :: fluxes_in !< A structure containing pointers to any
+ !! possible thermodynamic or mass-flux forcing fields.
type(ocean_grid_type), pointer :: G => NULL() ! A pointer to the ocean's grid structure
type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing
! various unit conversion factors
@@ -2160,19 +2233,23 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in
!! the ice-shelf state
real :: remaining_time ! The remaining time in this call [T ~> s]
real :: time_step ! The internal time step during this call [T ~> s]
+ real :: full_time_step ! The external time step (sum of internal time steps) during this call [T ~> s]
+ real :: Ifull_time_step ! The inverse of the external time step [T-1 ~> s-1]
real :: min_time_step ! The minimal required timestep that would indicate a fatal problem [T ~> s]
character(len=240) :: mesg
logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities.
logical :: coupled_GL ! If true the grounding line position is determined based on
! coupled ice-ocean dynamics.
- integer :: is, iec, js, jec
+ integer :: is, ie, js, je, i, j
G => CS%grid
US => CS%US
ISS => CS%ISS
- is = G%isc ; iec = G%iec ; js = G%jsc ; jec = G%jec
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
remaining_time = US%s_to_T*time_type_to_real(time_interval)
+ full_time_step = remaining_time
+ Ifull_time_step = 1./full_time_step
if (present (min_time_step_in)) then
min_time_step = min_time_step_in
@@ -2183,6 +2260,8 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in
write (mesg,*) "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/(365. * 86400.)
call MOM_mesg("solo_step_ice_shelf: "//mesg, 5)
+ ISS%dhdt_shelf(:,:) = ISS%h_shelf(:,:)
+
do while (remaining_time > 0.0)
nsteps = nsteps+1
@@ -2196,6 +2275,8 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in
call MOM_mesg("solo_step_ice_shelf: "//mesg, 5)
endif
+ call change_thickness_using_precip(CS, ISS, G, US, fluxes_in, time_step, Time)
+
remaining_time = remaining_time - time_step
! If the last mini-timestep is a day or less, we cannot expect velocities to change by much.
@@ -2205,13 +2286,20 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in
call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, must_update_vel=update_ice_vel)
- call enable_averages(time_step, Time, CS%diag)
+ enddo
+
+ call write_ice_shelf_energy(CS%dCS, G, US, ISS%mass_shelf, Time, &
+ time_step=real_to_time(US%T_to_s*time_step) )
+ do j=js,je ; do i=is,ie
+ ISS%dhdt_shelf(i,j) = (ISS%h_shelf(i,j) - ISS%dhdt_shelf(i,j)) * Ifull_time_step
+ enddo; enddo
+
+ call enable_averages(full_time_step, Time, CS%diag)
if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag)
if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf, ISS%h_shelf, CS%diag)
+ if (CS%id_dhdt_shelf > 0) call post_data(CS%id_dhdt_shelf, ISS%dhdt_shelf, CS%diag)
if (CS%id_h_mask > 0) call post_data(CS%id_h_mask, ISS%hmask, CS%diag)
- call disable_averaging(CS%diag)
-
- enddo
+ call disable_averaging(CS%diag)
end subroutine solo_step_ice_shelf
diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90
index 9b584ae0f9..312fa43fe9 100644
--- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90
+++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90
@@ -16,12 +16,16 @@ module MOM_ice_shelf_dynamics
use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type
use MOM_grid, only : MOM_grid_init, ocean_grid_type
use MOM_io, only : file_exists, slasher, MOM_read_data
+use MOM_io, only : open_ASCII_file, get_filename_appendix
+use MOM_io, only : APPEND_FILE, WRITEONLY_FILE
use MOM_restart, only : register_restart_field, MOM_restart_CS
-use MOM_time_manager, only : time_type, set_time
+use MOM_time_manager, only : time_type, get_time, set_time, time_type_to_real, operator(>)
+use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/)
+use MOM_time_manager, only : operator(/=), operator(<=), operator(>=), operator(<)
use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init
!MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary
use MOM_ice_shelf_state, only : ice_shelf_state
-use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs
+use MOM_coms, only : reproducing_sum, max_across_PEs, min_across_PEs
use MOM_checksums, only : hchksum, qchksum
use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel,initialize_ice_flow_from_file
use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_from_file,initialize_ice_C_basal_friction
@@ -31,7 +35,7 @@ module MOM_ice_shelf_dynamics
#include
public register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn, update_ice_shelf
-public ice_time_step_CFL, ice_shelf_dyn_end
+public ice_time_step_CFL, ice_shelf_dyn_end, change_in_draft, write_ice_shelf_energy
public shelf_advance_front, ice_shelf_min_thickness_calve, calve_to_mask
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
@@ -54,11 +58,14 @@ module MOM_ice_shelf_dynamics
!! not vertices. Will represent boundary conditions on computational boundary
!! (or permanent boundary between fast-moving and near-stagnant ice
!! FOR NOW: 1=interior bdry, 0=no-flow boundary, 2=stress bdry condition,
- !! 3=inhomogeneous Dirichlet boundary, 4=flux boundary: at these faces a flux
- !! will be specified which will override velocities; a homogeneous velocity
- !! condition will be specified (this seems to give the solver less difficulty)
+ !! 3=inhomogeneous Dirichlet boundary for u and v, 4=flux boundary: at these
+ !! faces a flux will be specified which will override velocities; a homogeneous
+ !! velocity condition will be specified (this seems to give the solver less
+ !! difficulty) 5=inhomogenous Dirichlet boundary for u only. 6=inhomogenous
+ !! Dirichlet boundary for v only
real, pointer, dimension(:,:) :: v_face_mask => NULL() !< A mask for velocity boundary conditions on the C-grid
- !! v-face, with valued defined similarly to u_face_mask.
+ !! v-face, with valued defined similarly to u_face_mask, but 5 is Dirichlet for v
+ !! and 6 is Dirichlet for u
real, pointer, dimension(:,:) :: u_face_mask_bdry => NULL() !< A duplicate copy of u_face_mask?
real, pointer, dimension(:,:) :: v_face_mask_bdry => NULL() !< A duplicate copy of v_face_mask?
real, pointer, dimension(:,:) :: u_flux_bdry_val => NULL() !< The ice volume flux per unit face length into the cell
@@ -79,6 +86,7 @@ module MOM_ice_shelf_dynamics
real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice.
real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity (Pa s),
!! in [R L2 T-1 ~> kg m-1 s-1].
+ real, pointer, dimension(:,:,:) :: Ee => NULL() !< Glen's effective strain-rate ** (1-n)/(n)
real, pointer, dimension(:,:) :: AGlen_visc => NULL() !< Ice-stiffness parameter in Glen's law ice viscosity,
!! often in [Pa-3 s-1] if n_Glen is 3.
real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m].
@@ -94,11 +102,12 @@ module MOM_ice_shelf_dynamics
!! the same as G%bathyT+Z_ref, when below sea-level.
!! Sign convention: positive below sea-level, negative above.
- real, pointer, dimension(:,:) :: basal_traction => NULL() !< The area integrated nonlinear part of "linearized"
- !! basal stress (Pa) [R L2 T-2 ~> Pa].
+ real, pointer, dimension(:,:) :: basal_traction => NULL() !< The area-integrated taub_beta field
+ !! (m2 Pa s m-1, or kg s-1) related to the nonlinear part
+ !! of "linearized" basal stress (Pa) [R L3 T-1 ~> kg s-1]
!! The exact form depends on basal law exponent and/or whether flow is "hybridized" a la Goldberg 2011
real, pointer, dimension(:,:) :: C_basal_friction => NULL()!< Coefficient in sliding law tau_b = C u^(n_basal_fric),
- !! units= Pa (m yr-1)-(n_basal_fric)
+ !! units= Pa (m s-1)^(n_basal_fric)
real, pointer, dimension(:,:) :: OD_rt => NULL() !< A running total for calculating OD_av [Z ~> m].
real, pointer, dimension(:,:) :: ground_frac_rt => NULL() !< A running total for calculating ground_frac.
real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth [Z ~> m].
@@ -118,6 +127,7 @@ module MOM_ice_shelf_dynamics
real :: g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2].
real :: density_ice !< A typical density of ice [R ~> kg m-3].
+ logical :: advect_shelf !< If true (default), advect ice shelf and evolve thickness
character(len=40) :: ice_viscosity_compute !< Specifies whether the ice viscosity is computed internally
!! according to Glen's flow law; is constant (for debugging purposes)
!! or using observed strain rates and read from a file
@@ -139,6 +149,10 @@ module MOM_ice_shelf_dynamics
real :: n_glen !< Nonlinearity exponent in Glen's Law [nondim]
real :: eps_glen_min !< Min. strain rate to avoid infinite Glen's law viscosity, [T-1 ~> s-1].
real :: n_basal_fric !< Exponent in sliding law tau_b = C u^(m_slide) [nondim]
+ logical :: CoulombFriction !< Use Coulomb friction law (Schoof 2005, Gagliardini et al 2007)
+ real :: CF_MinN !< Minimum Coulomb friction effective pressure [R L2 T-2 ~> Pa]
+ real :: CF_PostPeak !< Coulomb friction post peak exponent [nondim]
+ real :: CF_Max !< Coulomb friction maximum coefficient [nondim]
real :: density_ocean_avg !< A typical ocean density [R ~> kg m-3]. This does not affect ocean
!! circulation or thermodynamics. It is used to estimate the
!! gravitational driving force at the shelf front (until we think of
@@ -155,6 +169,28 @@ module MOM_ice_shelf_dynamics
integer :: cg_max_iterations !< The maximum number of iterations that can be used in the CG solver
integer :: nonlin_solve_err_mode !< 1: exit vel solve based on nonlin residual
!! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol) where | | is infty-norm
+ !! 3: exit based on change of norm
+
+ ! for write_ice_shelf_energy
+ type(time_type) :: energysavedays !< The interval between writing the energies
+ !! and other integral quantities of the run.
+ type(time_type) :: energysavedays_geometric !< The starting interval for computing a geometric
+ !! progression of time deltas between calls to
+ !! write_energy. This interval will increase by a factor of 2.
+ !! after each call to write_energy.
+ logical :: energysave_geometric !< Logical to control whether calls to write_energy should
+ !! follow a geometric progression
+ type(time_type) :: write_energy_time !< The next time to write to the energy file.
+ type(time_type) :: geometric_end_time !< Time at which to stop the geometric progression
+ !! of calls to write_energy and revert to the standard
+ !! energysavedays interval
+ real :: timeunit !< The length of the units for the time axis and certain input parameters
+ !! including ENERGYSAVEDAYS [s].
+ type(time_type) :: Start_time !< The start time of the simulation.
+ ! Start_time is set in MOM_initialization.F90
+ integer :: prev_IS_energy_calls = 0 !< The number of times write_ice_shelf_energy has been called.
+ integer :: IS_fileenergy_ascii !< The unit number of the ascii version of the energy file.
+ character(len=200) :: IS_energyfile !< The name of the ice sheet energy file with path.
! ids for outputting intermediate thickness in advection subroutine (debugging)
!integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1
@@ -265,23 +301,24 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS)
call get_param(param_file, mdl, "MISSING_SHELF_TEMPERATURE", T_shelf_missing, &
"An ice shelf temperature to use where there is no ice shelf.",&
units="degC", default=-10.0, scale=US%degC_to_C, do_not_log=.true.)
- allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB), source=0.0 )
- allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 )
- allocate( CS%t_shelf(isd:ied,jsd:jed), source=T_shelf_missing ) ! [C ~> degC]
- allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 )
- allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3 s-1]
- allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) ! [R L2 T-2 ~> Pa]
- allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding]
- allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 )
- allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 )
- allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB), source=0.0 )
- allocate( CS%taudy_shelf(IsdB:IedB,JsdB:JedB), source=0.0 )
- allocate( CS%bed_elev(isd:ied,jsd:jed) ) ; CS%bed_elev(:,:) = G%bathyT(:,:) + G%Z_ref
- allocate( CS%u_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0 )
- allocate( CS%v_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0 )
- allocate( CS%u_face_mask_bdry(IsdB:IedB,JsdB:JedB), source=-2.0 )
- allocate( CS%v_face_mask_bdry(IsdB:iedB,JsdB:JedB), source=-2.0 )
- allocate( CS%h_bdry_val(isd:ied,jsd:jed), source=0.0 )
+ allocate(CS%u_shelf(IsdB:IedB,JsdB:JedB), source=0.0)
+ allocate(CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0)
+ allocate(CS%t_shelf(isd:ied,jsd:jed), source=T_shelf_missing) ! [C ~> degC]
+ allocate(CS%ice_visc(isd:ied,jsd:jed), source=0.0)
+ allocate(CS%Ee(isd:ied,jsd:jed,4), source=0.0)
+ allocate(CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25) ! [Pa-3 s-1]
+ allocate(CS%basal_traction(isd:ied,jsd:jed), source=0.0) ! [R L3 T-1 ~> kg s-1]
+ allocate(CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10) ! [Pa (m-1 s)^n_sliding]
+ allocate(CS%OD_av(isd:ied,jsd:jed), source=0.0)
+ allocate(CS%ground_frac(isd:ied,jsd:jed), source=0.0)
+ allocate(CS%taudx_shelf(IsdB:IedB,JsdB:JedB), source=0.0)
+ allocate(CS%taudy_shelf(IsdB:IedB,JsdB:JedB), source=0.0)
+ allocate(CS%bed_elev(isd:ied,jsd:jed), source=0.0)
+ allocate(CS%u_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0)
+ allocate(CS%v_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0)
+ allocate(CS%u_face_mask_bdry(IsdB:IedB,JsdB:JedB), source=-2.0)
+ allocate(CS%v_face_mask_bdry(IsdB:iedB,JsdB:JedB), source=-2.0)
+ allocate(CS%h_bdry_val(isd:ied,jsd:jed), source=0.0)
! additional restarts for ice shelf state
call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, &
"ice sheet/shelf u-velocity", &
@@ -310,12 +347,15 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS)
"ice-stiffness parameter", "Pa-3 s-1")
call register_restart_field(CS%h_bdry_val, "h_bdry_val", .false., restart_CS, &
"ice thickness at the boundary", "m", conversion=US%Z_to_m)
+ call register_restart_field(CS%bed_elev, "bed elevation", .true., restart_CS, &
+ "bed elevation", "m", conversion=US%Z_to_m)
endif
end subroutine register_ice_shelf_dyn_restarts
!> Initializes shelf model data, parameters and diagnostics
-subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_sim, solo_ice_sheet_in)
+subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_sim, &
+ Input_start_time, directory, solo_ice_sheet_in)
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time
type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe
@@ -326,6 +366,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output.
logical, intent(in) :: new_sim !< If true this is a new simulation, otherwise
!! has been started from a restart file.
+ type(time_type), intent(in) :: Input_start_time !< The start time of the simulation.
+ character(len=*), intent(in) :: directory !< The directory where the ice sheet energy file goes.
logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether
!! a solo ice-sheet driver.
@@ -340,6 +382,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics
logical :: debug
integer :: i, j, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters
+ character(len=200) :: IS_energyfile ! The name of the energy file.
+ character(len=32) :: filename_appendix = '' ! FMS appendix to filename for ensemble runs
Isdq = G%isdB ; Iedq = G%iedB ; Jsdq = G%jsdB ; Jedq = G%jedB
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -388,6 +432,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
"will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", &
default=.false., do_not_log=CS%GL_regularize)
if (CS%GL_regularize) CS%GL_couple = .false.
+ if (present(solo_ice_sheet_in)) then
+ if (solo_ice_sheet_in) CS%GL_couple = .false.
+ endif
if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, &
"GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used")
call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, &
@@ -414,6 +461,19 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_fric, &
"Exponent in sliding law \tau_b = C u^(n_basal_fric)", &
units="none", fail_if_missing=.true.)
+ call get_param(param_file, mdl, "USE_COULOMB_FRICTION", CS%CoulombFriction, &
+ "Use Coulomb Friction Law", &
+ units="none", default=.false., fail_if_missing=.false.)
+ call get_param(param_file, mdl, "CF_MinN", CS%CF_MinN, &
+ "Minimum Coulomb friction effective pressure", &
+ units="Pa", default=1.0, scale=US%Pa_to_RL2_T2, fail_if_missing=.false.)
+ call get_param(param_file, mdl, "CF_PostPeak", CS%CF_PostPeak, &
+ "Coulomb friction post peak exponent", &
+ units="none", default=1.0, fail_if_missing=.false.)
+ call get_param(param_file, mdl, "CF_Max", CS%CF_Max, &
+ "Coulomb friction maximum coefficient", &
+ units="none", default=0.5, fail_if_missing=.false.)
+
call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, &
"A typical density of ice.", units="kg m-3", default=917.0, scale=US%kg_m3_to_R)
call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, &
@@ -428,7 +488,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
units="m", default=1.e-3, scale=US%m_to_Z)
call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, &
"Choose whether nonlin error in vel solve is based on nonlinear "//&
- "residual (1) or relative change since last iteration (2)", default=1)
+ "residual (1), relative change since last iteration (2), or change in norm (3)", default=1)
call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, &
"Specify whether to advance shelf front (and calve).", &
@@ -436,8 +496,12 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, &
"If true, do not allow an ice shelf where prohibited by a mask.", &
default=.false.)
+ call get_param(param_file, mdl, "ADVECT_SHELF", CS%advect_shelf, &
+ "If true, advect ice shelf and evolve thickness", &
+ default=.true.)
call get_param(param_file, mdl, "ICE_VISCOSITY_COMPUTE", CS%ice_viscosity_compute, &
- "If MODEL, compute ice viscosity internally, if OBS read from a file,"//&
+ "If MODEL, compute ice viscosity internally at cell centers, if OBS read from a file,"//&
+ "If MODEL_QUADRATURE, compute at quadrature points (4 per element),"//&
"if CONSTANT a constant value (for debugging).", &
default="MODEL")
@@ -452,6 +516,43 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
"Min thickness rule for the VERY simple calving law",&
units="m", default=0.0, scale=US%m_to_Z)
+ !for write_ice_shelf_energy
+ ! Note that the units of CS%Timeunit are the MKS units of [s].
+ call get_param(param_file, mdl, "TIMEUNIT", CS%Timeunit, &
+ "The time unit in seconds a number of input fields", &
+ units="s", default=86400.0)
+ if (CS%Timeunit < 0.0) CS%Timeunit = 86400.0
+ call get_param(param_file, mdl, "ENERGYSAVEDAYS",CS%energysavedays, &
+ "The interval in units of TIMEUNIT between saves of the "//&
+ "energies of the run and other globally summed diagnostics.",&
+ default=set_time(0,days=1), timeunit=CS%Timeunit)
+ call get_param(param_file, mdl, "ENERGYSAVEDAYS_GEOMETRIC",CS%energysavedays_geometric, &
+ "The starting interval in units of TIMEUNIT for the first call "//&
+ "to save the energies of the run and other globally summed diagnostics. "//&
+ "The interval increases by a factor of 2. after each call to write_ice_shelf_energy.",&
+ default=set_time(seconds=0), timeunit=CS%Timeunit)
+ if ((time_type_to_real(CS%energysavedays_geometric) > 0.) .and. &
+ (CS%energysavedays_geometric < CS%energysavedays)) then
+ CS%energysave_geometric = .true.
+ else
+ CS%energysave_geometric = .false.
+ endif
+ CS%Start_time = Input_start_time
+ call get_param(param_file, mdl, "ICE_SHELF_ENERGYFILE", IS_energyfile, &
+ "The file to use to write the energies and globally "//&
+ "summed diagnostics.", default="ice_shelf.stats")
+ !query fms_io if there is a filename_appendix (for ensemble runs)
+ call get_filename_appendix(filename_appendix)
+ if (len_trim(filename_appendix) > 0) then
+ IS_energyfile = trim(IS_energyfile) //'.'//trim(filename_appendix)
+ endif
+
+ CS%IS_energyfile = trim(slasher(directory))//trim(IS_energyfile)
+ call log_param(param_file, mdl, "output_path/ENERGYFILE", CS%IS_energyfile)
+#ifdef STATSLABEL
+ CS%IS_energyfile = trim(CS%IS_energyfile)//"."//trim(adjustl(STATSLABEL))
+#endif
+
! Allocate memory in the ice shelf dynamics control structure that was not
! previously allocated for registration for restarts.
@@ -489,27 +590,52 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
! right hand side have not been set up yet.
if (.not. G%symmetric) then
do j=G%jsd,G%jed ; do i=G%isd,G%ied
- if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(CS%u_face_mask(I-1,j) == 3)) then
- CS%u_shelf(I-1,J-1) = CS%u_bdry_val(I-1,J-1)
- CS%u_shelf(I-1,J) = CS%u_bdry_val(I-1,J)
- CS%v_shelf(I-1,J-1) = CS%v_bdry_val(I-1,J-1)
- CS%v_shelf(I-1,J) = CS%v_bdry_val(I-1,J)
+ if ((i+G%idg_offset) == (G%domain%nihalo+1)) then
+ if (CS%u_face_mask(I-1,j) == 3) then
+ CS%u_shelf(I-1,J-1) = CS%u_bdry_val(I-1,J-1)
+ CS%u_shelf(I-1,J) = CS%u_bdry_val(I-1,J)
+ CS%v_shelf(I-1,J-1) = CS%v_bdry_val(I-1,J-1)
+ CS%v_shelf(I-1,J) = CS%v_bdry_val(I-1,J)
+ elseif (CS%u_face_mask(I-1,j) == 5) then
+ CS%u_shelf(I-1,J-1) = CS%u_bdry_val(I-1,J-1)
+ CS%u_shelf(I-1,J) = CS%u_bdry_val(I-1,J)
+ elseif (CS%u_face_mask(I-1,j) == 6) then
+ CS%v_shelf(I-1,J-1) = CS%v_bdry_val(I-1,J-1)
+ CS%v_shelf(I-1,J) = CS%v_bdry_val(I-1,J)
+ endif
endif
- if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,J-1) == 3)) then
- CS%u_shelf(I-1,J-1) = CS%u_bdry_val(I-1,J-1)
- CS%u_shelf(I,J-1) = CS%u_bdry_val(I,J-1)
- CS%v_shelf(I-1,J-1) = CS%v_bdry_val(I-1,J-1)
- CS%v_shelf(I,J-1) = CS%v_bdry_val(I,J-1)
+ if ((j+G%jdg_offset) == (G%domain%njhalo+1)) then
+ if (CS%v_face_mask(i,J-1) == 3) then
+ CS%v_shelf(I-1,J-1) = CS%v_bdry_val(I-1,J-1)
+ CS%v_shelf(I,J-1) = CS%v_bdry_val(I,J-1)
+ CS%u_shelf(I-1,J-1) = CS%u_bdry_val(I-1,J-1)
+ CS%u_shelf(I,J-1) = CS%u_bdry_val(I,J-1)
+ elseif (CS%v_face_mask(i,J-1) == 5) then
+ CS%v_shelf(I-1,J-1) = CS%v_bdry_val(I-1,J-1)
+ CS%v_shelf(I,J-1) = CS%v_bdry_val(I,J-1)
+ elseif (CS%v_face_mask(i,J-1) == 6) then
+ CS%u_shelf(I-1,J-1) = CS%u_bdry_val(I-1,J-1)
+ CS%u_shelf(I,J-1) = CS%u_bdry_val(I,J-1)
+ endif
endif
enddo ; enddo
endif
- call pass_var(CS%OD_av,G%domain)
- call pass_var(CS%ground_frac,G%domain)
- call pass_var(CS%ice_visc,G%domain)
- call pass_var(CS%basal_traction, G%domain)
- call pass_var(CS%AGlen_visc, G%domain)
- call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE)
+ call pass_var(CS%OD_av,G%domain, complete=.false.)
+ call pass_var(CS%ground_frac,G%domain, complete=.false.)
+ call pass_var(CS%ice_visc,G%domain, complete=.false.)
+ call pass_var(CS%basal_traction, G%domain, complete=.false.)
+ call pass_var(CS%AGlen_visc, G%domain, complete=.false.)
+ call pass_var(CS%bed_elev, G%domain, complete=.false.)
+ call pass_var(CS%C_basal_friction, G%domain, complete=.false.)
+ call pass_var(CS%h_bdry_val, G%domain, complete=.false.)
+ call pass_var(CS%thickness_bdry_val, G%domain, complete=.true.)
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") call pass_var(CS%Ee,G%domain)
+
+ call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE, complete=.false.)
+ call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE, complete=.false.)
+ call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE, complete=.true.)
+ call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask)
endif
if (active_shelf_dynamics) then
@@ -541,27 +667,28 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
! initialize basal friction coefficients
if (new_sim) then
call initialize_ice_C_basal_friction(CS%C_basal_friction, G, US, param_file)
- call pass_var(CS%C_basal_friction, G%domain)
+ call pass_var(CS%C_basal_friction, G%domain, complete=.false.)
! initialize ice-stiffness AGlen
call initialize_ice_AGlen(CS%AGlen_visc, G, US, param_file)
- call pass_var(CS%AGlen_visc, G%domain)
+ call pass_var(CS%AGlen_visc, G%domain, complete=.false.)
!initialize boundary conditions
call initialize_ice_shelf_boundary_from_file(CS%u_face_mask_bdry, CS%v_face_mask_bdry, &
CS%u_bdry_val, CS%v_bdry_val, CS%umask, CS%vmask, CS%h_bdry_val, &
CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, US, param_file )
- call pass_var(ISS%hmask, G%domain)
- call pass_var(CS%h_bdry_val, G%domain)
- call pass_var(CS%thickness_bdry_val, G%domain)
- call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE)
- call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE)
+ call pass_var(ISS%hmask, G%domain, complete=.false.)
+ call pass_var(CS%h_bdry_val, G%domain, complete=.false.)
+ call pass_var(CS%thickness_bdry_val, G%domain, complete=.true.)
+ call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE, complete=.false.)
+ call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE, complete=.false.)
!initialize ice flow characteristic (velocities, bed elevation under the grounded part, etc) from file
call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf, CS%ground_frac, &
G, US, param_file)
- call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE)
- call pass_var(CS%bed_elev, G%domain,CENTER)
+ call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE, complete=.true.)
+ call pass_var(CS%ground_frac, G%domain, complete=.false.)
+ call pass_var(CS%bed_elev, G%domain, complete=.true.)
call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask)
endif
! Register diagnostics.
@@ -585,13 +712,14 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_
CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, &
'vi-viscosity', 'Pa m s', conversion=US%RL2_T2_to_Pa*US%Z_to_m*US%T_to_s) !vertically integrated viscosity
CS%id_taub = register_diag_field('ice_shelf_model','taub_beta',CS%diag%axesT1, Time, &
- 'taub', 'MPa', conversion=1e-6*US%RL2_T2_to_Pa)
+ 'taub', 'MPa s m-1', conversion=1e-6*US%RL2_T2_to_Pa/(365.0*86400.0*US%L_T_to_m_s))
CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, &
'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m)
endif
call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.")
- call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:))
- call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time)
+ if (new_sim) then
+ call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:))
+ endif
end subroutine initialize_ice_shelf_dyn
@@ -645,7 +773,7 @@ function ice_time_step_CFL(CS, ISS, G)
min_dt = 5.0e17*G%US%s_to_T ! The starting maximum is roughly the lifetime of the universe.
min_vel = (1.0e-12/(365.0*86400.0)) * G%US%m_s_to_L_T
- do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0 .or. ISS%hmask(i,j)==3) then
dt_local = 2.0*G%areaT(i,j) / &
((G%dyCu(I,j) * max(abs(CS%u_shelf(I,J) + CS%u_shelf(I,j-1)), min_vel) + &
G%dyCu(I-1,j)* max(abs(CS%u_shelf(I-1,J)+ CS%u_shelf(I-1,j-1)), min_vel)) + &
@@ -680,7 +808,8 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled
real, dimension(SZDIB_(G),SZDJB_(G)) :: taud_x, taud_y ! Pa]
real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc !< area-averaged vertically integrated ice viscosity
!! [R L2 Z T-1 ~> Pa s m]
- real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr !< area-averaged basal traction [R L2 T-2 ~> Pa]
+ real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr !< area-averaged taub_beta field related to basal traction,
+ !! [R L1 T-1 ~> Pa s m-1]
integer :: iters
logical :: update_ice_vel, coupled_GL
@@ -690,7 +819,9 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled
coupled_GL = .false.
if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding
!
- call ice_shelf_advect(CS, ISS, G, time_step, Time)
+ if (CS%advect_shelf) then
+ call ice_shelf_advect(CS, ISS, G, time_step, Time)
+ endif
CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step
if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true.
@@ -698,6 +829,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled
call update_OD_ffrac(CS, G, US, ocean_mass, update_ice_vel)
elseif (update_ice_vel) then
call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:))
+ CS%GL_couple=.false.
endif
@@ -707,24 +839,28 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled
! call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time)
- if (update_ice_vel) then
+ if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) then
call enable_averages(CS%elapsed_velocity_time, Time, CS%diag)
if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag)
if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag)
if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag)
! if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf, CS%t_shelf, CS%diag)
if (CS%id_taudx_shelf > 0) then
- taud_x(:,:) = CS%taudx_shelf(:,:)*G%IareaT(:,:)
+ taud_x(:,:) = CS%taudx_shelf(:,:)*G%IareaBu(:,:)
call post_data(CS%id_taudx_shelf, taud_x, CS%diag)
endif
if (CS%id_taudy_shelf > 0) then
- taud_y(:,:) = CS%taudy_shelf(:,:)*G%IareaT(:,:)
+ taud_y(:,:) = CS%taudy_shelf(:,:)*G%IareaBu(:,:)
call post_data(CS%id_taudy_shelf, taud_y, CS%diag)
endif
if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac, CS%diag)
if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag)
if (CS%id_visc_shelf > 0) then
ice_visc(:,:) = CS%ice_visc(:,:)*G%IareaT(:,:)
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") then
+ ice_visc(:,:) = ice_visc(:,:) * &
+ 0.25 * (CS%Ee(:,:,1) + CS%Ee(:,:,2) + CS%Ee(:,:,3) + CS%Ee(:,:,4))
+ endif
call post_data(CS%id_visc_shelf, ice_visc, CS%diag)
endif
if (CS%id_taub > 0) then
@@ -745,6 +881,138 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled
end subroutine update_ice_shelf
+!> Writes the total ice shelf kinetic energy and mass to an ascii file
+subroutine write_ice_shelf_energy(CS, G, US, mass, day, time_step)
+ type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure
+ type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf.
+ type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors
+ real, dimension(SZDI_(G),SZDJ_(G)), &
+ intent(in) :: mass !< The mass per unit area of the ice shelf
+ !! or sheet [R Z ~> kg m-2]
+ type(time_type), intent(in) :: day !< The current model time.
+ type(time_type), optional, intent(in) :: time_step !< The current time step
+ ! Local variables
+ type(time_type) :: dt ! A time_type version of the timestep.
+ real, dimension(SZDI_(G),SZDJ_(G)) :: tmp1 ! A temporary array used in reproducing sums [various]
+ real :: KE_tot, mass_tot, KE_scale_factor, mass_scale_factor
+ integer :: is, ie, js, je, isr, ier, jsr, jer, i, j
+ character(len=32) :: mesg_intro, time_units, day_str, n_str, date_str
+ integer :: start_of_day, num_days
+ real :: reday ! Time in units given by CS%Timeunit, but often [days]
+
+ ! write_energy_time is the next integral multiple of energysavedays.
+ if (present(time_step)) then
+ dt = time_step
+ else
+ dt = set_time(seconds=2)
+ endif
+
+ !CS%prev_IS_energy_calls tracks the ice sheet step, which is outputted in the energy file.
+ if (CS%prev_IS_energy_calls == 0) then
+ if (CS%energysave_geometric) then
+ if (CS%energysavedays_geometric < CS%energysavedays) then
+ CS%write_energy_time = day + CS%energysavedays_geometric
+ CS%geometric_end_time = CS%Start_time + CS%energysavedays * &
+ (1 + (day - CS%Start_time) / CS%energysavedays)
+ else
+ CS%write_energy_time = CS%Start_time + CS%energysavedays * &
+ (1 + (day - CS%Start_time) / CS%energysavedays)
+ endif
+ else
+ CS%write_energy_time = CS%Start_time + CS%energysavedays * &
+ (1 + (day - CS%Start_time) / CS%energysavedays)
+ endif
+ elseif (day + (dt/2) <= CS%write_energy_time) then
+ CS%prev_IS_energy_calls = CS%prev_IS_energy_calls + 1
+ return ! Do not write this step
+ else ! Determine the next write time before proceeding
+ if (CS%energysave_geometric) then
+ if (CS%write_energy_time + CS%energysavedays_geometric >= &
+ CS%geometric_end_time) then
+ CS%write_energy_time = CS%geometric_end_time
+ CS%energysave_geometric = .false. ! stop geometric progression
+ else
+ CS%write_energy_time = CS%write_energy_time + CS%energysavedays_geometric
+ endif
+ CS%energysavedays_geometric = CS%energysavedays_geometric*2
+ else
+ CS%write_energy_time = CS%write_energy_time + CS%energysavedays
+ endif
+ endif
+
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ isr = is - (G%isd-1) ; ier = ie - (G%isd-1) ; jsr = js - (G%jsd-1) ; jer = je - (G%jsd-1)
+
+ !calculate KE using cell-centered ice shelf velocity
+ tmp1(:,:)=0.0
+ KE_scale_factor = US%L_to_m**2 * US%RZ_to_kg_m2 * US%L_T_to_m_s**2
+ do j=js,je ; do i=is,ie
+ tmp1(i,j) = KE_scale_factor * 0.03125 * G%areaT(i,j) * mass(i,j) * &
+ ((CS%u_shelf(I-1,J-1)+CS%u_shelf(I,J-1)+CS%u_shelf(I,J)+CS%u_shelf(I,J-1))**2 + &
+ (CS%v_shelf(I-1,J-1)+CS%v_shelf(I,J-1)+CS%v_shelf(I,J)+CS%v_shelf(I,J-1))**2)
+ enddo; enddo
+
+ KE_tot = reproducing_sum(tmp1, isr, ier, jsr, jer)
+
+ !calculate mass
+ tmp1(:,:)=0.0
+ mass_scale_factor = US%L_to_m**2 * US%RZ_to_kg_m2
+ do j=js,je ; do i=is,ie
+ tmp1(i,j) = mass_scale_factor * mass(i,j) * G%areaT(i,j)
+ enddo; enddo
+
+ mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer)
+
+ if (is_root_pe()) then ! Only the root PE actually writes anything.
+ if (day > CS%Start_time) then
+ call open_ASCII_file(CS%IS_fileenergy_ascii, trim(CS%IS_energyfile), action=APPEND_FILE)
+ else
+ call open_ASCII_file(CS%IS_fileenergy_ascii, trim(CS%IS_energyfile), action=WRITEONLY_FILE)
+ if (abs(CS%timeunit - 86400.0) < 1.0) then
+ write(CS%IS_fileenergy_ascii,'(" Step,",7x,"Day,"8x,"Energy/Mass,",13x,"Total Mass")')
+ write(CS%IS_fileenergy_ascii,'(12x,"[days]",10x,"[m2 s-2]",17x,"[kg]")')
+ else
+ if ((CS%timeunit >= 0.99) .and. (CS%timeunit < 1.01)) then
+ time_units = " [seconds] "
+ elseif ((CS%timeunit >= 3599.0) .and. (CS%timeunit < 3601.0)) then
+ time_units = " [hours] "
+ elseif ((CS%timeunit >= 86399.0) .and. (CS%timeunit < 86401.0)) then
+ time_units = " [days] "
+ elseif ((CS%timeunit >= 3.0e7) .and. (CS%timeunit < 3.2e7)) then
+ time_units = " [years] "
+ else
+ write(time_units,'(9x,"[",es8.2," s] ")') CS%timeunit
+ endif
+
+ write(CS%IS_fileenergy_ascii,'(" Step,",7x,"Time,"7x,"Energy/Mass,",13x,"Total Mass")')
+ write(CS%IS_fileenergy_ascii,'(A25,3x,"[m2 s-2]",17x,"[kg]")') time_units
+ endif
+ endif
+
+ call get_time(day, start_of_day, num_days)
+
+ if (abs(CS%timeunit - 86400.0) < 1.0) then
+ reday = REAL(num_days)+ (REAL(start_of_day)/86400.0)
+ else
+ reday = REAL(num_days)*(86400.0/CS%timeunit) + REAL(start_of_day)/abs(CS%timeunit)
+ endif
+
+ if (reday < 1.0e8) then ; write(day_str, '(F12.3)') reday
+ elseif (reday < 1.0e11) then ; write(day_str, '(F15.3)') reday
+ else ; write(day_str, '(ES15.9)') reday ; endif
+
+ if (CS%prev_IS_energy_calls < 1000000) then ; write(n_str, '(I6)') CS%prev_IS_energy_calls
+ elseif (CS%prev_IS_energy_calls < 10000000) then ; write(n_str, '(I7)') CS%prev_IS_energy_calls
+ elseif (CS%prev_IS_energy_calls < 100000000) then ; write(n_str, '(I8)') CS%prev_IS_energy_calls
+ else ; write(n_str, '(I10)') CS%prev_IS_energy_calls ; endif
+
+ write(CS%IS_fileenergy_ascii,'(A,",",A,", En ",ES22.16,", M ",ES11.5)') &
+ trim(n_str), trim(day_str), KE_tot/mass_tot, mass_tot
+ endif
+
+ CS%prev_IS_energy_calls = CS%prev_IS_energy_calls + 1
+end subroutine write_ice_shelf_energy
+
!> This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once.
!! Additionally, it will update the volume of ice in partially-filled cells, and update
!! hmask accordingly
@@ -823,6 +1091,15 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time)
endif
endif
+ do j=jsc,jec; do i=isc,iec
+ ISS%mass_shelf(i,j) = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) * G%IareaT(i,j) * CS%density_ice
+ enddo; enddo
+
+ call pass_var(ISS%mass_shelf, G%domain, complete=.false.)
+ call pass_var(ISS%h_shelf, G%domain, complete=.false.)
+ call pass_var(ISS%area_shelf_h, G%domain, complete=.false.)
+ call pass_var(ISS%hmask, G%domain, complete=.true.)
+
!call enable_averages(time_step, Time, CS%diag)
!if (CS%id_h_after_adv > 0) call post_data(CS%id_h_after_adv, ISS%h_shelf, CS%diag)
!call disable_averaging(CS%diag)
@@ -852,22 +1129,24 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
intent(out) :: taudx !< Driving x-stress at q-points [R L3 Z T-2 ~> kg m s-2]
real, dimension(SZDIB_(G),SZDJB_(G)), &
intent(out) :: taudy !< Driving y-stress at q-points [R L3 Z T-2 ~> kg m s-2]
- real, dimension(SZDIB_(G),SZDJB_(G)) :: u_bdry_cont ! Boundary u-stress contribution [R L3 Z T-2 ~> kg m s-2]
- real, dimension(SZDIB_(G),SZDJB_(G)) :: v_bdry_cont ! Boundary v-stress contribution [R L3 Z T-2 ~> kg m s-2]
+ !real, dimension(SZDIB_(G),SZDJB_(G)) :: u_bdry_cont ! Boundary u-stress contribution [R L3 Z T-2 ~> kg m s-2]
+ !real, dimension(SZDIB_(G),SZDJB_(G)) :: v_bdry_cont ! Boundary v-stress contribution [R L3 Z T-2 ~> kg m s-2]
real, dimension(SZDIB_(G),SZDJB_(G)) :: Au, Av ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2]
real, dimension(SZDIB_(G),SZDJB_(G)) :: u_last, v_last ! Previous velocities [L T-1 ~> m s-1]
real, dimension(SZDIB_(G),SZDJB_(G)) :: H_node ! Ice shelf thickness at corners [Z ~> m].
- real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond ! An array indicating where the ice
- ! shelf is floating: 0 if floating, 1 if not.
+ real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond ! If GL_regularize=true, an array indicating where the ice
+ ! shelf is floating: 0 if floating, 1 if not
+ real, dimension(SZDIB_(G),SZDJB_(G)) :: Normvec ! Used for convergence
character(len=160) :: mesg ! The text of an error message
integer :: conv_flag, i, j, k,l, iter
integer :: isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, nodefloat, nsub
- real :: err_max, err_tempu, err_tempv, err_init, max_vel, tempu, tempv
+ real :: err_max, err_tempu, err_tempv, err_init, max_vel, tempu, tempv, Norm, PrevNorm
real :: rhoi_rhow ! The density of ice divided by a typical water density [nondim]
real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian
! quadrature points surrounding the cell vertices [L-1 ~> m-1].
real, pointer, dimension(:,:,:,:,:,:) :: Phisub => NULL() ! Quadrature structure weights at subgridscale
! locations for finite element calculations [nondim]
+ integer :: Is_sum, Js_sum, Ie_sum, Je_sum ! Loop bounds for global sums or arrays starting at 1.
! for GL interpolation
nsub = CS%n_sub_regularize
@@ -877,23 +1156,23 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
rhoi_rhow = CS%density_ice / CS%density_ocean_avg
taudx(:,:) = 0.0 ; taudy(:,:) = 0.0
- u_bdry_cont(:,:) = 0.0 ; v_bdry_cont(:,:) = 0.0
+ !u_bdry_cont(:,:) = 0.0 ; v_bdry_cont(:,:) = 0.0
Au(:,:) = 0.0 ; Av(:,:) = 0.0
! need to make these conditional on GL interpolation
float_cond(:,:) = 0.0 ; H_node(:,:) = 0.0
- CS%ground_frac(:,:) = 0.0
+ !CS%ground_frac(:,:) = 0.0
allocate(Phisub(nsub,nsub,2,2,2,2), source=0.0)
- do j=G%jsc,G%jec
- do i=G%isc,G%iec
+ if (.not. CS%GL_couple) then
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) > 0) then
- float_cond(i,j) = 1.0
+ if (CS%GL_regularize) float_cond(i,j) = 1.0
CS%ground_frac(i,j) = 1.0
CS%OD_av(i,j) =0.0
endif
- enddo
- enddo
+ enddo ; enddo
+ endif
call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av)
call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE)
@@ -912,7 +1191,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
nodefloat = 0
do l=0,1 ; do k=0,1
- if ((ISS%hmask(i,j) == 1) .and. &
+ if ((ISS%hmask(i,j) == 1 .or. ISS%hmask(i,j)==3) .and. &
(rhoi_rhow * H_node(i-1+k,j-1+l) - CS%bed_elev(i,j) <= 0)) then
nodefloat = nodefloat + 1
endif
@@ -923,7 +1202,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
endif
enddo ; enddo
- call pass_var(float_cond, G%Domain)
+ call pass_var(float_cond, G%Domain, complete=.false.)
call bilinear_shape_functions_subgrid(Phisub, nsub)
@@ -937,40 +1216,66 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
enddo ; enddo
call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf)
- call pass_var(CS%ice_visc, G%domain)
+ call pass_var(CS%ice_visc, G%domain, complete=.false.)
call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf)
- call pass_var(CS%basal_traction, G%domain)
+ call pass_var(CS%basal_traction, G%domain, complete=.true.)
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") call pass_var(CS%Ee,G%domain)
! This makes sure basal stress is only applied when it is supposed to be
- do j=G%jsd,G%jed ; do i=G%isd,G%ied
-! CS%basal_traction(i,j) = CS%basal_traction(i,j) * CS%ground_frac(i,j)
- CS%basal_traction(i,j) = CS%basal_traction(i,j) * float_cond(i,j)
- enddo ; enddo
+ if (CS%GL_regularize) then
+ do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ CS%basal_traction(i,j) = CS%basal_traction(i,j) * float_cond(i,j)
+ enddo ; enddo
+ else
+ do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ CS%basal_traction(i,j) = CS%basal_traction(i,j) * CS%ground_frac(i,j)
+ enddo ; enddo
+ endif
- call apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, CS%ice_visc, &
- CS%basal_traction, float_cond, rhoi_rhow, u_bdry_cont, v_bdry_cont)
+ if (CS%nonlin_solve_err_mode == 1) then
+ ! call apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, CS%ice_visc, &
+ ! CS%basal_traction, float_cond, rhoi_rhow, u_bdry_cont, v_bdry_cont)
- Au(:,:) = 0.0 ; Av(:,:) = 0.0
+ Au(:,:) = 0.0 ; Av(:,:) = 0.0
- call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, &
- CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, &
- G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow)
- call pass_vector(Au,Av,G%domain,TO_ALL,BGRID_NE)
+ call CG_action(CS, Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, &
+ CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, &
+ G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow)
+ call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE)
- if (CS%nonlin_solve_err_mode == 1) then
err_init = 0 ; err_tempu = 0 ; err_tempv = 0
do J=G%IscB,G%JecB ; do I=G%IscB,G%IecB
if (CS%umask(I,J) == 1) then
- err_tempu = ABS(Au(I,J) + u_bdry_cont(I,J) - taudx(I,J))
+ !err_tempu = ABS(Au(I,J) + u_bdry_cont(I,J) - taudx(I,J))
+ err_tempu = ABS(Au(I,J) - taudx(I,J))
if (err_tempu >= err_init) err_init = err_tempu
endif
if (CS%vmask(I,J) == 1) then
- err_tempv = ABS(Av(I,J) + v_bdry_cont(I,J) - taudy(I,J))
+ !err_tempv = ABS(Av(I,J) + v_bdry_cont(I,J) - taudy(I,J))
+ err_tempv = ABS(Av(I,J) - taudy(I,J))
if (err_tempv >= err_init) err_init = err_tempv
endif
enddo ; enddo
call max_across_PEs(err_init)
+ elseif (CS%nonlin_solve_err_mode == 3) then
+ Normvec=0.0
+ ! Determine the loop limits for sums, bearing in mind that the arrays will be starting at 1.
+ Is_sum = G%isc + (1-G%IsdB)
+ Ie_sum = G%iecB + (1-G%IsdB)
+ ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant.
+ if (G%isc+G%idg_offset==G%isg) Is_sum = G%IscB + (1-G%IsdB)
+
+ Js_sum = G%jsc + (1-G%JsdB)
+ Je_sum = G%jecB + (1-G%JsdB)
+ ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant.
+ if (G%jsc+G%jdg_offset==G%jsg) Js_sum = G%JscB + (1-G%JsdB)
+ do J=G%jscB,G%jecB ; do I=G%iscB,G%iecB
+ if (CS%umask(I,J) == 1) Normvec(I,J) = Normvec(I,J) + u_shlf(I,J)*u_shlf(I,J)
+ if (CS%vmask(I,J) == 1) Normvec(I,J) = Normvec(I,J) + v_shlf(I,J)*v_shlf(I,J)
+ enddo; enddo
+ Norm = reproducing_sum( Normvec, Is_sum, Ie_sum, Js_sum, Je_sum )
+ Norm = sqrt(Norm)
endif
u_last(:,:) = u_shlf(:,:) ; v_last(:,:) = v_shlf(:,:)
@@ -991,38 +1296,47 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
call MOM_mesg(mesg, 5)
call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf)
- call pass_var(CS%ice_visc, G%domain)
+ call pass_var(CS%ice_visc, G%domain, complete=.false.)
call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf)
- call pass_var(CS%basal_traction, G%domain)
- ! makes sure basal stress is only applied when it is supposed to be
+ call pass_var(CS%basal_traction, G%domain, complete=.true.)
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") call pass_var(CS%Ee,G%domain)
- do j=G%jsd,G%jed ; do i=G%isd,G%ied
-! CS%basal_traction(i,j) = CS%basal_traction(i,j) * CS%ground_frac(i,j)
- CS%basal_traction(i,j) = CS%basal_traction(i,j) * float_cond(i,j)
- enddo ; enddo
+ ! makes sure basal stress is only applied when it is supposed to be
+ if (CS%GL_regularize) then
+ do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ CS%basal_traction(i,j) = CS%basal_traction(i,j) * float_cond(i,j)
+ enddo ; enddo
+ else
+ do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ CS%basal_traction(i,j) = CS%basal_traction(i,j) * CS%ground_frac(i,j)
+ enddo ; enddo
+ endif
- u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0
+ if (CS%nonlin_solve_err_mode == 1) then
+ !u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0
- call apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, CS%ice_visc, &
- CS%basal_traction, float_cond, rhoi_rhow, u_bdry_cont, v_bdry_cont)
+ ! call apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, CS%ice_visc, &
+ ! CS%basal_traction, float_cond, rhoi_rhow, u_bdry_cont, v_bdry_cont)
- Au(:,:) = 0 ; Av(:,:) = 0
+ Au(:,:) = 0 ; Av(:,:) = 0
- call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, &
- CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, &
- G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow)
+ call CG_action(CS, Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, &
+ CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, &
+ G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow)
- err_max = 0
+ call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE)
- if (CS%nonlin_solve_err_mode == 1) then
+ err_max = 0
do J=G%jscB,G%jecB ; do I=G%jscB,G%iecB
if (CS%umask(I,J) == 1) then
- err_tempu = ABS(Au(I,J) + u_bdry_cont(I,J) - taudx(I,J))
+ !err_tempu = ABS(Au(I,J) + u_bdry_cont(I,J) - taudx(I,J))
+ err_tempu = ABS(Au(I,J) - taudx(I,J))
if (err_tempu >= err_max) err_max = err_tempu
endif
if (CS%vmask(I,J) == 1) then
- err_tempv = ABS(Av(I,J) + v_bdry_cont(I,J) - taudy(I,J))
+ !err_tempv = ABS(Av(I,J) + v_bdry_cont(I,J) - taudy(I,J))
+ err_tempv = ABS(Av(I,J) - taudy(I,J))
if (err_tempv >= err_max) err_max = err_tempv
endif
enddo ; enddo
@@ -1031,7 +1345,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
elseif (CS%nonlin_solve_err_mode == 2) then
- max_vel = 0 ; tempu = 0 ; tempv = 0
+ err_max=0. ; max_vel = 0 ; tempu = 0 ; tempv = 0 ; err_tempu = 0
do J=G%jscB,G%jecB ; do I=G%iscB,G%iecB
if (CS%umask(I,J) == 1) then
err_tempu = ABS(u_last(I,J)-u_shlf(I,J))
@@ -1054,6 +1368,16 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i
call max_across_PEs(max_vel)
call max_across_PEs(err_max)
err_init = max_vel
+
+ elseif (CS%nonlin_solve_err_mode == 3) then
+ PrevNorm=Norm; Norm=0.0; Normvec=0.0
+ do J=G%jscB,G%jecB ; do I=G%iscB,G%iecB
+ if (CS%umask(I,J) == 1) Normvec(I,J) = Normvec(I,J) + u_shlf(I,J)*u_shlf(I,J)
+ if (CS%vmask(I,J) == 1) Normvec(I,J) = Normvec(I,J) + v_shlf(I,J)*v_shlf(I,J)
+ enddo; enddo
+ Norm = reproducing_sum( Normvec, Is_sum, Ie_sum, Js_sum, Je_sum )
+ Norm = sqrt(Norm)
+ err_max=2.*abs(Norm-PrevNorm); err_init=Norm+PrevNorm
endif
write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init
@@ -1093,8 +1417,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
intent(in) :: H_node !< The ice shelf thickness at nodal (corner)
!! points [Z ~> m].
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(in) :: float_cond !< An array indicating where the ice
- !! shelf is floating: 0 if floating, 1 if not.
+ intent(in) :: float_cond !< If GL_regularize=true, an array indicating where the ice
+ !! shelf is floating: 0 if floating, 1 if not
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(in) :: hmask !< A mask indicating which tracer points are
!! partly or fully covered by an ice-shelf
@@ -1124,10 +1448,10 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
Zu_old, Zv_old, & ! Previous values of Zu and Zv [L T-1 ~> m s-1]
DIAGu, DIAGv, & ! Diagonals with units like Ru/Zu [R L2 Z T-1 ~> kg s-1]
RHSu, RHSv, & ! Right hand side of the stress balance [R L3 Z T-2 ~> m kg s-2]
- ubd, vbd, & ! Boundary stress contributions [R L3 Z T-2 ~> kg m s-2]
Au, Av, & ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2]
Du, Dv, & ! Velocity changes [L T-1 ~> m s-1]
- sum_vec, sum_vec_2
+ sum_vec, sum_vec_2 !, &
+ !ubd, vbd ! Boundary stress contributions [R L3 Z T-2 ~> kg m s-2]
real :: beta_k, dot_p1, resid0, cg_halo
real :: alpha_k ! A scaling factor for iterative corrections [nondim]
real :: resid_scale ! A scaling factor for redimensionalizing the global residuals [m2 L-2 ~> 1]
@@ -1149,7 +1473,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
Zu(:,:) = 0 ; Zv(:,:) = 0 ; DIAGu(:,:) = 0 ; DIAGv(:,:) = 0
Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 ; RHSu(:,:) = 0 ; RHSv(:,:) = 0
- Du(:,:) = 0 ; Dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0
+ Du(:,:) = 0 ; Dv(:,:) = 0 !; ubd(:,:) = 0 ; vbd(:,:) = 0
dot_p1 = 0
! Determine the loop limits for sums, bearing in mind that the arrays will be starting at 1.
@@ -1163,24 +1487,24 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant.
if (G%jsc+G%jdg_offset==G%jsg) Js_sum = G%JscB + (1-G%JsdB)
- call apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, CS%ice_visc, &
- CS%basal_traction, float_cond, rhoi_rhow, ubd, vbd)
+ !call apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, CS%ice_visc, &
+ ! CS%basal_traction, float_cond, rhoi_rhow, ubd, vbd)
- RHSu(:,:) = taudx(:,:) - ubd(:,:)
- RHSv(:,:) = taudy(:,:) - vbd(:,:)
+ RHSu(:,:) = taudx(:,:) !- ubd(:,:)
+ RHSv(:,:) = taudy(:,:) !- vbd(:,:)
- call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE)
+ call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE, complete=.false.)
call matrix_diagonal(CS, G, US, float_cond, H_node, CS%ice_visc, CS%basal_traction, &
hmask, rhoi_rhow, Phisub, DIAGu, DIAGv)
- call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE)
+ call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE, complete=.false.)
- call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, hmask, &
+ call CG_action(CS, Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, hmask, &
H_node, CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, &
G, US, isc-1, iec+1, jsc-1, jec+1, rhoi_rhow)
- call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE)
+ call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE, complete=.true.)
Ru(:,:) = (RHSu(:,:) - Au(:,:))
Rv(:,:) = (RHSv(:,:) - Av(:,:))
@@ -1225,12 +1549,12 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
! the computational domain - this is their state in the initial iteration
- is = isc - cg_halo ; ie = iecq + cg_halo
+ is = iscq - cg_halo ; ie = iecq + cg_halo
js = jscq - cg_halo ; je = jecq + cg_halo
Au(:,:) = 0 ; Av(:,:) = 0
- call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, &
+ call CG_action(CS, Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, &
H_node, CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, &
G, US, is, ie, js, je, rhoi_rhow)
@@ -1242,12 +1566,12 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
do j=jscq,jecq ; do i=iscq,iecq
if (CS%umask(I,J) == 1) then
- sum_vec(I,J) = resid_scale * Zu(I,J) * Ru(I,J)
- sum_vec_2(I,J) = resid_scale * Du(I,J) * Au(I,J)
+ sum_vec(I,J) = resid_scale * (Zu(I,J) * Ru(I,J))
+ sum_vec_2(I,J) = resid_scale * (Du(I,J) * Au(I,J))
endif
if (CS%vmask(I,J) == 1) then
- sum_vec(I,J) = sum_vec(I,J) + resid_scale * Zv(I,J) * Rv(I,J)
- sum_vec_2(I,J) = sum_vec_2(I,J) + resid_scale * Dv(I,J) * Av(I,J)
+ sum_vec(I,J) = sum_vec(I,J) + resid_scale * (Zv(I,J) * Rv(I,J))
+ sum_vec_2(I,J) = sum_vec_2(I,J) + resid_scale * (Dv(I,J) * Av(I,J))
endif
enddo ; enddo
@@ -1297,12 +1621,12 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
do j=jscq,jecq ; do i=iscq,iecq
if (CS%umask(I,J) == 1) then
- sum_vec(I,J) = resid_scale * Zu(I,J) * Ru(I,J)
- sum_vec_2(I,J) = resid_scale * Zu_old(I,J) * Ru_old(I,J)
+ sum_vec(I,J) = resid_scale * (Zu(I,J) * Ru(I,J))
+ sum_vec_2(I,J) = resid_scale * (Zu_old(I,J) * Ru_old(I,J))
endif
if (CS%vmask(I,J) == 1) then
- sum_vec(I,J) = sum_vec(I,J) + resid_scale * Zv(I,J) * Rv(I,J)
- sum_vec_2(I,J) = sum_vec_2(I,J) + resid_scale * Zv_old(I,J) * Rv_old(I,J)
+ sum_vec(I,J) = sum_vec(I,J) + resid_scale * (Zv(I,J) * Rv(I,J))
+ sum_vec_2(I,J) = sum_vec_2(I,J) + resid_scale * (Zv_old(I,J) * Rv_old(I,J))
endif
enddo ; enddo
@@ -1340,9 +1664,9 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H
if (cg_halo == 0) then
! pass vectors
- call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE)
- call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE)
- call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE)
+ call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE, complete=.false.)
+ call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE, complete=.false.)
+ call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE, complete=.true.)
cg_halo = 3
endif
@@ -1409,7 +1733,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, LB, time_step, hmask, h0, h_after
do j=jsh,jeh ; do I=ish-1,ieh
if (CS%u_face_mask(I,j) == 4.) then ! The flux itself is a specified boundary condition.
uh_ice(I,j) = time_step * G%dyCu(I,j) * CS%u_flux_bdry_val(I,j)
- elseif ((hmask(i,j) == 1) .or. (hmask(i+1,j) == 1)) then
+ elseif ((hmask(i,j) == 1 .or. hmask(i,j) == 3) .or. (hmask(i+1,j) == 1 .or. hmask(i+1,j) == 3)) then
u_face = 0.5 * (CS%u_shelf(I,J-1) + CS%u_shelf(I,J))
h_face = 0.0 ! This will apply when the source cell is iceless or not fully ice covered.
@@ -1488,8 +1812,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, LB, time_step, hmask, h0, h_after
do J=jsh-1,jeh ; do i=ish,ieh
if (CS%v_face_mask(i,J) == 4.) then ! The flux itself is a specified boundary condition.
vh_ice(i,J) = time_step * G%dxCv(i,J) * CS%v_flux_bdry_val(i,J)
- elseif ((hmask(i,j) == 1) .or. (hmask(i,j+1) == 1)) then
-
+ elseif ((hmask(i,j) == 1 .or. hmask(i,j) == 3) .or. (hmask(i,j+1) == 1 .or. hmask(i,j+1) == 3)) then
v_face = 0.5 * (CS%v_shelf(I-1,J) + CS%v_shelf(I,J))
h_face = 0.0 ! This will apply when the source cell is iceless or not fully ice covered.
@@ -1621,14 +1944,14 @@ subroutine shelf_advance_front(CS, ISS, G, hmask, uh_ice, vh_ice)
do j=jsc-1,jec+1
- if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. &
- ((j+j_off) >= G%domain%njhalo+1)) then
+ if (((j+j_off) <= G%domain%njglobal) .AND. &
+ ((j+j_off) >= 1)) then
do i=isc-1,iec+1
- if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. &
- ((i+i_off) >= G%domain%nihalo+1)) then
- ! first get reference thickness by averaging over cells that are fluxing into this cell
+ if (((i+i_off) <= G%domain%niglobal) .AND. &
+ ((i+i_off) >= 1)) then
+ ! first get reference thickness by averaging over cells that are fluxing into this cell
n_flux = 0
h_reference = 0.0
tot_flux = 0.0
@@ -1636,7 +1959,8 @@ subroutine shelf_advance_front(CS, ISS, G, hmask, uh_ice, vh_ice)
do k=1,2
if (flux_enter(i,j,k) > 0) then
n_flux = n_flux + 1
- h_reference = h_reference + ISS%h_shelf(i+2*k-3,j)
+ h_reference = h_reference + flux_enter(i,j,k) * ISS%h_shelf(i+2*k-3,j)
+ !h_reference = h_reference + ISS%h_shelf(i+2*k-3,j)
tot_flux = tot_flux + flux_enter(i,j,k)
flux_enter(i,j,k) = 0.0
endif
@@ -1645,7 +1969,8 @@ subroutine shelf_advance_front(CS, ISS, G, hmask, uh_ice, vh_ice)
do k=1,2
if (flux_enter(i,j,k+2) > 0) then
n_flux = n_flux + 1
- h_reference = h_reference + ISS%h_shelf(i,j+2*k-3)
+ h_reference = h_reference + flux_enter(i,j,k+2) * ISS%h_shelf(i,j+2*k-3)
+ !h_reference = h_reference + ISS%h_shelf(i,j+2*k-3)
tot_flux = tot_flux + flux_enter(i,j,k+2)
flux_enter(i,j,k+2) = 0.0
endif
@@ -1653,11 +1978,12 @@ subroutine shelf_advance_front(CS, ISS, G, hmask, uh_ice, vh_ice)
if (n_flux > 0) then
dxdyh = G%areaT(i,j)
- h_reference = h_reference / real(n_flux)
+ h_reference = h_reference / tot_flux
+ !h_reference = h_reference / real(n_flux)
partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux
if ((partial_vol / G%areaT(i,j)) == h_reference) then ! cell is exactly covered, no overflow
- ISS%hmask(i,j) = 1
+ if (ISS%hmask(i,j).ne.3) ISS%hmask(i,j) = 1
ISS%h_shelf(i,j) = h_reference
ISS%area_shelf_h(i,j) = G%areaT(i,j)
elseif ((partial_vol / G%areaT(i,j)) < h_reference) then
@@ -1667,7 +1993,7 @@ subroutine shelf_advance_front(CS, ISS, G, hmask, uh_ice, vh_ice)
ISS%h_shelf(i,j) = h_reference
else
- ISS%hmask(i,j) = 1
+ if (ISS%hmask(i,j).ne.3) ISS%hmask(i,j) = 1
ISS%area_shelf_h(i,j) = G%areaT(i,j)
!h_temp(i,j) = h_reference
partial_vol = partial_vol - h_reference * G%areaT(i,j)
@@ -1778,6 +2104,7 @@ subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask)
end subroutine calve_to_mask
+!> Calculate driving stress using cell-centered bed elevation and ice thickness
subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure
type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe
@@ -1803,10 +2130,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
! "average" ocean depth -- and is needed to find surface elevation
! (it is assumed that base_ice = bed + OD)
- real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation [Z ~> m].
- BASE ! basal elevation of shelf/stream [Z ~> m].
- real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian
- ! quadrature points surrounding the cell vertices [L-1 ~> m-1].
+ real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S ! surface elevation [Z ~> m].
real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3]
real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> nondim]
@@ -1837,26 +2161,26 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
rhoi_rhow = rho/rhow
! prelim - go through and calculate S
- ! or is this faster?
- BASE(:,:) = -CS%bed_elev(:,:) + OD(:,:)
- S(:,:) = -CS%bed_elev(:,:) + ISS%h_shelf(:,:)
- ! check whether the ice is floating or grounded
-
- do j=jsc-G%domain%njhalo,jec+G%domain%njhalo
- do i=isc-G%domain%nihalo,iec+G%domain%nihalo
- if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then
- S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j)
- else
- S(i,j) = ISS%h_shelf(i,j)-CS%bed_elev(i,j)
- endif
+ if (CS%GL_couple) then
+ do j=jsc-G%domain%njhalo,jec+G%domain%njhalo
+ do i=isc-G%domain%nihalo,iec+G%domain%nihalo
+ S(i,j) = -CS%bed_elev(i,j) + (OD(i,j) + ISS%h_shelf(i,j))
+ enddo
enddo
- enddo
+ else
+ ! check whether the ice is floating or grounded
+ do j=jsc-G%domain%njhalo,jec+G%domain%njhalo
+ do i=isc-G%domain%nihalo,iec+G%domain%nihalo
+ if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then
+ S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j)
+ else
+ S(i,j) = ISS%h_shelf(i,j)-CS%bed_elev(i,j)
+ endif
+ enddo
+ enddo
+ endif
call pass_var(S, G%domain)
- allocate(Phi(1:8,1:4,isd:ied,jsd:jed), source=0.0)
- do j=jscq,jecq ; do i=iscq,iecq
- call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j))
- enddo ; enddo
do j=jsc-1,jec+1
do i=isc-1,iec+1
@@ -1867,30 +2191,31 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
dyh = G%dyT(i,j)
Dx=dxh
Dy=dyh
- if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell
+ if (ISS%hmask(i,j) == 1 .or. ISS%hmask(i,j) == 3) then
+ ! we are inside the global computational bdry, at an ice-filled cell
! calculate sx
- if ((i+i_off) == gisc) then ! at left computational bdry
- if (ISS%hmask(i+1,j) == 1) then
+ if ((i+i_off) == gisc) then ! at west computational bdry
+ if (ISS%hmask(i+1,j) == 1 .or. ISS%hmask(i+1,j) == 3) then
sx = (S(i+1,j)-S(i,j))/dxh
else
sx = 0
endif
elseif ((i+i_off) == giec) then ! at east computational bdry
- if (ISS%hmask(i-1,j) == 1) then
+ if (ISS%hmask(i-1,j) == 1 .or. ISS%hmask(i-1,j) == 3) then
sx = (S(i,j)-S(i-1,j))/dxh
else
sx = 0
endif
else ! interior
- if (ISS%hmask(i+1,j) == 1) then
+ if (ISS%hmask(i+1,j) == 1 .or. ISS%hmask(i+1,j) == 3) then
cnt = cnt+1
Dx =dxh+ G%dxT(i+1,j)
sx = S(i+1,j)
else
sx = S(i,j)
endif
- if (ISS%hmask(i-1,j) == 1) then
+ if (ISS%hmask(i-1,j) == 1 .or. ISS%hmask(i-1,j) == 3) then
cnt = cnt+1
Dx =dxh+ G%dxT(i-1,j)
sx = sx - S(i-1,j)
@@ -1908,26 +2233,26 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
! calculate sy, similarly
if ((j+j_off) == gjsc) then ! at south computational bdry
- if (ISS%hmask(i,j+1) == 1) then
+ if (ISS%hmask(i,j+1) == 1 .or. ISS%hmask(i,j+1) == 3) then
sy = (S(i,j+1)-S(i,j))/dyh
else
sy = 0
endif
- elseif ((j+j_off) == gjec) then ! at nprth computational bdry
- if (ISS%hmask(i,j-1) == 1) then
+ elseif ((j+j_off) == gjec) then ! at north computational bdry
+ if (ISS%hmask(i,j-1) == 1 .or. ISS%hmask(i,j-1) == 3) then
sy = (S(i,j)-S(i,j-1))/dyh
else
sy = 0
endif
else ! interior
- if (ISS%hmask(i,j+1) == 1) then
+ if (ISS%hmask(i,j+1) == 1 .or. ISS%hmask(i,j+1) == 3) then
cnt = cnt+1
Dy =dyh+ G%dyT(i,j+1)
sy = S(i,j+1)
else
sy = S(i,j)
endif
- if (ISS%hmask(i,j-1) == 1) then
+ if (ISS%hmask(i,j-1) == 1 .or. ISS%hmask(i,j-1) == 3) then
cnt = cnt+1
sy = sy - S(i,j-1)
Dy =dyh+ G%dyT(i,j-1)
@@ -1942,32 +2267,34 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
endif
! SW vertex
- if (ISS%hmask(I-1,J-1) == 1) then
+ !if (ISS%hmask(I-1,J-1) == 1) then
taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j)
taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j)
- endif
+ !endif
! SE vertex
- if (ISS%hmask(I,J-1) == 1) then
+ !if (ISS%hmask(I,J-1) == 1) then
taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j)
taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j)
- endif
+ !endif
! NW vertex
- if (ISS%hmask(I-1,J) == 1) then
+ !if (ISS%hmask(I-1,J) == 1) then
taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j)
taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j)
- endif
+ !endif
! NE vertex
- if (ISS%hmask(I,J) == 1) then
+ !if (ISS%hmask(I,J) == 1) then
taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j)
taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j)
- endif
+ !endif
+
+ !Stress (Neumann) boundary conditions
if (CS%ground_frac(i,j) == 1) then
neumann_val = (.5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2))
else
neumann_val = (.5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2)
endif
-
- if ((CS%u_face_mask_bdry(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then
+ if ((CS%u_face_mask_bdry(I-1,j) == 2) .OR. &
+ ((ISS%hmask(i-1,j) == 0 .OR. ISS%hmask(i-1,j) == 2) .AND. (i+i_off .ne. gisc))) then
! left face of the cell is at a stress boundary
! the depth-integrated longitudinal stress is equal to the difference of depth-integrated
! pressure on either side of the face
@@ -1981,19 +2308,22 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
taudx(I-1,J) = taudx(I-1,J) - .5 * dyh * neumann_val
endif
- if ((CS%u_face_mask_bdry(I,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then
+ if ((CS%u_face_mask_bdry(I,j) == 2) .OR. &
+ ((ISS%hmask(i+1,j) == 0 .OR. ISS%hmask(i+1,j) == 2) .and. (i+i_off .ne. giec))) then
! east face of the cell is at a stress boundary
taudx(I,J-1) = taudx(I,J-1) + .5 * dyh * neumann_val
taudx(I,J) = taudx(I,J) + .5 * dyh * neumann_val
endif
- if ((CS%v_face_mask_bdry(i,J-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then
+ if ((CS%v_face_mask_bdry(i,J-1) == 2) .OR. &
+ ((ISS%hmask(i,j-1) == 0 .OR. ISS%hmask(i,j-1) == 2) .and. (j+j_off .ne. gjsc))) then
! south face of the cell is at a stress boundary
taudy(I-1,J-1) = taudy(I-1,J-1) - .5 * dxh * neumann_val
taudy(I,J-1) = taudy(I,J-1) - .5 * dxh * neumann_val
endif
- if ((CS%v_face_mask_bdry(i,J) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then
+ if ((CS%v_face_mask_bdry(i,J) == 2) .OR. &
+ ((ISS%hmask(i,j+1) == 0 .OR. ISS%hmask(i,j+1) == 2) .and. (j+j_off .ne. gjec))) then
! north face of the cell is at a stress boundary
taudy(I-1,J) = taudy(I-1,J) + .5 * dxh * neumann_val
taudy(I,J) = taudy(I,J) + .5 * dxh * neumann_val
@@ -2003,9 +2333,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD)
enddo
enddo
- deallocate(Phi)
end subroutine calc_shelf_driving_stress
+! Not used? Seems to be only set up to work for a specific test case with u_face_mask==3
subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim)
type(ice_shelf_dyn_CS),intent(inout) :: CS !< A pointer to the ice shelf control structure
type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf.
@@ -2075,9 +2405,10 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new
end subroutine init_boundary_values
-subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmask, H_node, &
+subroutine CG_action(CS, uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmask, H_node, &
ice_visc, float_cond, bathyT, basal_trac, G, US, is, ie, js, je, dens_ratio)
+ type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure
type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf.
real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), &
intent(inout) :: uret !< The retarding stresses working at u-points [R L3 Z T-2 ~> kg m s-2].
@@ -2110,14 +2441,14 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas
!! flow law [R L4 Z T-1 ~> kg m2 s-1]. The exact form
!! and units depend on the basal law exponent.
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(in) :: float_cond !< An array indicating where the ice
- !! shelf is floating: 0 if floating, 1 if not.
+ intent(in) :: float_cond !< If GL_regularize=true, an array indicating where the ice
+ !! shelf is floating: 0 if floating, 1 if not
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points
!! relative to sea-level [Z ~> m].
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(in) :: basal_trac !< A field related to the nonlinear part of the
- !! "linearized" basal stress [R Z T-1 ~> kg m-2 s-1].
+ intent(in) :: basal_trac !< Area-integrated taub_beta field related to the nonlinear
+ !! part of the "linearized" basal stress [R L3 T-1 ~> kg s-1].
real, intent(in) :: dens_ratio !< The density of ice divided by the density
!! of seawater, nondimensional
@@ -2151,22 +2482,25 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas
integer :: iq, jq, iphi, jphi, i, j, ilq, jlq, Itgt, Jtgt
real, dimension(2) :: xquad
real, dimension(2,2) :: Ucell, Vcell, Hcell, Usub, Vsub
+ real :: Ee
xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3))
- do j=js,je ; do i=is,ie ; if (hmask(i,j) == 1) then
+ Ee=1.0
+
+ do j=js,je ; do i=is,ie ; if (hmask(i,j) == 1 .or. hmask(i,j)==3) then
do iq=1,2 ; do jq=1,2
- uq = u_shlf(I-1,J-1) * xquad(3-iq) * xquad(3-jq) + &
- u_shlf(I,J-1) * xquad(iq) * xquad(3-jq) + &
- u_shlf(I-1,J) * xquad(3-iq) * xquad(jq) + &
- u_shlf(I,J) * xquad(iq) * xquad(jq)
+ uq = u_shlf(I-1,J-1) * (xquad(3-iq) * xquad(3-jq)) + &
+ u_shlf(I,J-1) * (xquad(iq) * xquad(3-jq)) + &
+ u_shlf(I-1,J) * (xquad(3-iq) * xquad(jq)) + &
+ u_shlf(I,J) * (xquad(iq) * xquad(jq))
- vq = v_shlf(I-1,J-1) * xquad(3-iq) * xquad(3-jq) + &
- v_shlf(I,J-1) * xquad(iq) * xquad(3-jq) + &
- v_shlf(I-1,J) * xquad(3-iq) * xquad(jq) + &
- v_shlf(I,J) * xquad(iq) * xquad(jq)
+ vq = v_shlf(I-1,J-1) * (xquad(3-iq) * xquad(3-jq)) + &
+ v_shlf(I,J-1) * (xquad(iq) * xquad(3-jq)) + &
+ v_shlf(I-1,J) * (xquad(3-iq) * xquad(jq)) + &
+ v_shlf(I,J) * (xquad(iq) * xquad(jq))
ux = u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + &
u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j) + &
@@ -2183,16 +2517,18 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas
u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + &
u_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)
- vy = v_shlf(I-1,j-1) * Phi(2,2*(jq-1)+iq,i,j) + &
+ vy = v_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq,i,j) + &
v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j) + &
v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + &
v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") Ee = CS%Ee(i,j,2*(jq-1)+iq)
+
do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; ;Jtgt = J-2+jphi
- if (umask(Itgt,Jtgt) == 1) uret(Itgt,Jtgt) = uret(Itgt,Jtgt) + 0.25 * ice_visc(i,j) * &
+ if (umask(Itgt,Jtgt) == 1) uret(Itgt,Jtgt) = uret(Itgt,Jtgt) + 0.25 * Ee * ice_visc(i,j) * &
((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq,i,j) + &
(uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq,i,j))
- if (vmask(Itgt,Jtgt) == 1) vret(Itgt,Jtgt) = vret(Itgt,Jtgt) + 0.25 * ice_visc(i,j) * &
+ if (vmask(Itgt,Jtgt) == 1) vret(Itgt,Jtgt) = vret(Itgt,Jtgt) + 0.25 * Ee * ice_visc(i,j) * &
((uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq,i,j) + &
(4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq,i,j))
@@ -2200,9 +2536,9 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas
ilq = 1 ; if (iq == iphi) ilq = 2
jlq = 1 ; if (jq == jphi) jlq = 2
if (umask(Itgt,Jtgt) == 1) uret(Itgt,Jtgt) = uret(Itgt,Jtgt) + &
- 0.25 * basal_trac(i,j) * uq * xquad(ilq) * xquad(jlq)
+ 0.25 * basal_trac(i,j) * uq * (xquad(ilq) * xquad(jlq))
if (vmask(Itgt,Jtgt) == 1) vret(Itgt,Jtgt) = vret(Itgt,Jtgt) + &
- 0.25 * basal_trac(i,j) * vq * xquad(ilq) * xquad(jlq)
+ 0.25 * basal_trac(i,j) * vq * (xquad(ilq) * xquad(jlq))
endif
enddo ; enddo
enddo ; enddo
@@ -2276,8 +2612,8 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac,
type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf.
type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(in) :: float_cond !< An array indicating where the ice
- !! shelf is floating: 0 if floating, 1 if not.
+ intent(in) :: float_cond !< If GL_regularize=true, an array indicating where the ice
+ !! shelf is floating: 0 if floating, 1 if not
real, dimension(SZDIB_(G),SZDJB_(G)), &
intent(in) :: H_node !< The ice shelf thickness at nodal
!! (corner) points [Z ~> m].
@@ -2286,8 +2622,8 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac,
!! flow law [R L4 Z T-1 ~> kg m2 s-1]. The exact form
!! and units depend on the basal law exponent.
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(in) :: basal_trac !< A field related to the nonlinear part of the
- !! "linearized" basal stress [R Z T-1 ~> kg m-2 s-1].
+ intent(in) :: basal_trac !< Area-integrated taub_beta field related to the nonlinear
+ !! part of the "linearized" basal stress [R L3 T-1 ~> kg s-1].
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(in) :: hmask !< A mask indicating which tracer points are
@@ -2312,58 +2648,67 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac,
real, dimension(2) :: xquad
real, dimension(2,2) :: Hcell, sub_ground
integer :: i, j, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq, Itgt, Jtgt
+ real :: Ee
isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec
xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3))
- do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then
+ Ee=1.0
+
+ do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1 .or. hmask(i,j)==3) then
call bilinear_shape_fn_grid(G, i, j, Phi)
! Phi(2*i-1,j) gives d(Phi_i)/dx at quadrature point j
! Phi(2*i,j) gives d(Phi_i)/dy at quadrature point j
- do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi
- ilq = 1 ; if (iq == iphi) ilq = 2
- jlq = 1 ; if (jq == jphi) jlq = 2
+ do iq=1,2 ; do jq=1,2
- if (CS%umask(Itgt,Jtgt) == 1) then
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") Ee = CS%Ee(i,j,2*(jq-1)+iq)
+ do iphi=1,2 ; do jphi=1,2
- ux = Phi(2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq)
- uy = Phi(2*(2*(jphi-1)+iphi), 2*(jq-1)+iq)
- vx = 0.
- vy = 0.
+ Itgt = I-2+iphi ; Jtgt = J-2+jphi
+ ilq = 1 ; if (iq == iphi) ilq = 2
+ jlq = 1 ; if (jq == jphi) jlq = 2
+
+ if (CS%umask(Itgt,Jtgt) == 1) then
- u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + &
- 0.25 * ice_visc(i,j) * ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
- (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
+ ux = Phi(2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq)
+ uy = Phi(2*(2*(jphi-1)+iphi), 2*(jq-1)+iq)
+ vx = 0.
+ vy = 0.
- if (float_cond(i,j) == 0) then
- uq = xquad(ilq) * xquad(jlq)
u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + &
- 0.25 * basal_trac(i,j) * uq * xquad(ilq) * xquad(jlq)
- endif
- endif
+ 0.25 * Ee * ice_visc(i,j) * ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
+ (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
- if (CS%vmask(Itgt,Jtgt) == 1) then
+ if (float_cond(i,j) == 0) then
+ uq = xquad(ilq) * xquad(jlq)
+ u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + &
+ 0.25 * basal_trac(i,j) * uq * (xquad(ilq) * xquad(jlq))
+ endif
+ endif
- vx = Phi(2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq)
- vy = Phi(2*(2*(jphi-1)+iphi), 2*(jq-1)+iq)
- ux = 0.
- uy = 0.
+ if (CS%vmask(Itgt,Jtgt) == 1) then
- v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + &
- 0.25 * ice_visc(i,j) * ((uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
- (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
+ vx = Phi(2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq)
+ vy = Phi(2*(2*(jphi-1)+iphi), 2*(jq-1)+iq)
+ ux = 0.
+ uy = 0.
- if (float_cond(i,j) == 0) then
- vq = xquad(ilq) * xquad(jlq)
v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + &
- 0.25 * basal_trac(i,j) * vq * xquad(ilq) * xquad(jlq)
+ 0.25 * Ee * ice_visc(i,j) * ((uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
+ (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
+
+ if (float_cond(i,j) == 0) then
+ vq = xquad(ilq) * xquad(jlq)
+ v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + &
+ 0.25 * basal_trac(i,j) * vq * (xquad(ilq) * xquad(jlq))
+ endif
endif
- endif
- enddo ; enddo ; enddo ; enddo
+ enddo ; enddo
+ enddo ; enddo
if (float_cond(i,j) == 1) then
Hcell(:,:) = H_node(i-1:i,j-1:j)
@@ -2371,6 +2716,8 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac,
do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi
if (CS%umask(Itgt,Jtgt) == 1) then
u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j)
+ endif
+ if (CS%vmask(Itgt,Jtgt) == 1) then
v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j)
endif
enddo ; enddo
@@ -2435,8 +2782,8 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc,
!! flow law. The exact form and units depend on the
!! basal law exponent. [R L4 Z T-1 ~> kg m2 s-1].
real, dimension(SZDI_(G),SZDJ_(G)), &
- intent(in) :: basal_trac !< A field related to the nonlinear part of the
- !! "linearized" basal stress [R Z T-1 ~> kg m-2 s-1].
+ intent(in) :: basal_trac !< Area-integrated taub_beta field related to the nonlinear
+ !! part of the "linearized" basal stress [R L3 T-1 ~> kg s-1].
real, dimension(SZDI_(G),SZDJ_(G)), &
intent(in) :: float_cond !< An array indicating where the ice
@@ -2459,18 +2806,22 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc,
real :: uq, vq ! Interpolated velocities [L T-1 ~> m s-1]
real, dimension(2,2) :: Ucell,Vcell,Hcell,Usubcontr,Vsubcontr
integer :: i, j, isc, jsc, iec, jec, iq, jq, iphi, jphi, ilq, jlq, Itgt, Jtgt
+ real :: Ee
isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec
xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3))
- do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (ISS%hmask(i,j) == 1) then
+ Ee=1.0
+
+ do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (ISS%hmask(i,j) == 1 .or. ISS%hmask(i,j) == 3) then
! process this cell if any corners have umask set to non-dirichlet bdry.
- ! NOTE: vmask not considered, probably should be
if ((CS%umask(I-1,J-1) == 3) .OR. (CS%umask(I,J-1) == 3) .OR. &
- (CS%umask(I-1,J) == 3) .OR. (CS%umask(I,J) == 3)) then
+ (CS%umask(I-1,J) == 3) .OR. (CS%umask(I,J) == 3) .OR. &
+ (CS%vmask(I-1,J-1) == 3) .OR. (CS%vmask(I,J-1) == 3) .OR. &
+ (CS%vmask(I-1,J) == 3) .OR. (CS%vmask(I,J) == 3)) then
call bilinear_shape_fn_grid(G, i, j, Phi)
@@ -2479,15 +2830,15 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc,
do iq=1,2 ; do jq=1,2
- uq = CS%u_bdry_val(I-1,J-1) * xquad(3-iq) * xquad(3-jq) + &
- CS%u_bdry_val(I,J-1) * xquad(iq) * xquad(3-jq) + &
- CS%u_bdry_val(I-1,J) * xquad(3-iq) * xquad(jq) + &
- CS%u_bdry_val(I,J) * xquad(iq) * xquad(jq)
+ uq = CS%u_bdry_val(I-1,J-1) * (xquad(3-iq) * xquad(3-jq)) + &
+ CS%u_bdry_val(I,J-1) * (xquad(iq) * xquad(3-jq)) + &
+ CS%u_bdry_val(I-1,J) * (xquad(3-iq) * xquad(jq)) + &
+ CS%u_bdry_val(I,J) * (xquad(iq) * xquad(jq))
- vq = CS%v_bdry_val(I-1,J-1) * xquad(3-iq) * xquad(3-jq) + &
- CS%v_bdry_val(I,J-1) * xquad(iq) * xquad(3-jq) + &
- CS%v_bdry_val(I-1,J) * xquad(3-iq) * xquad(jq) + &
- CS%v_bdry_val(I,J) * xquad(iq) * xquad(jq)
+ vq = CS%v_bdry_val(I-1,J-1) * (xquad(3-iq) * xquad(3-jq)) + &
+ CS%v_bdry_val(I,J-1) * (xquad(iq) * xquad(3-jq)) + &
+ CS%v_bdry_val(I-1,J) * (xquad(3-iq) * xquad(jq)) + &
+ CS%v_bdry_val(I,J) * (xquad(iq) * xquad(jq))
ux = CS%u_bdry_val(I-1,J-1) * Phi(1,2*(jq-1)+iq) + &
CS%u_bdry_val(I,J-1) * Phi(3,2*(jq-1)+iq) + &
@@ -2509,29 +2860,31 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc,
CS%v_bdry_val(I-1,J) * Phi(6,2*(jq-1)+iq) + &
CS%v_bdry_val(I,J) * Phi(8,2*(jq-1)+iq)
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") Ee = CS%Ee(i,j,2*(jq-1)+iq)
+
do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi
ilq = 1 ; if (iq == iphi) ilq = 2
jlq = 1 ; if (jq == jphi) jlq = 2
if (CS%umask(Itgt,Jtgt) == 1) then
u_bdry_contr(Itgt,Jtgt) = u_bdry_contr(Itgt,Jtgt) + &
- 0.25 * ice_visc(i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
+ 0.25 * Ee * ice_visc(i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
(uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) )
if (float_cond(i,j) == 0) then
u_bdry_contr(Itgt,Jtgt) = u_bdry_contr(Itgt,Jtgt) + &
- 0.25 * basal_trac(i,j) * uq * xquad(ilq) * xquad(jlq)
+ 0.25 * basal_trac(i,j) * uq * (xquad(ilq) * xquad(jlq))
endif
endif
if (CS%vmask(Itgt,Jtgt) == 1) then
v_bdry_contr(Itgt,Jtgt) = v_bdry_contr(Itgt,Jtgt) + &
- 0.25 * ice_visc(i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
+ 0.25 * Ee * ice_visc(i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
(4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) )
if (float_cond(i,j) == 0) then
v_bdry_contr(Itgt,Jtgt) = v_bdry_contr(Itgt,Jtgt) + &
- 0.25 * basal_trac(i,j) * vq * xquad(ilq) * xquad(jlq)
+ 0.25 * basal_trac(i,j) * vq * (xquad(ilq) * xquad(jlq))
endif
endif
enddo ; enddo
@@ -2572,7 +2925,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf)
real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), &
intent(inout) :: v_shlf !< The meridional ice shelf velocity [L T-1 ~> m s-1].
real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian
- ! quadrature points surrounding the cell vertices [L-1 ~> m-1].
+ ! quadrature points surrounding the cell vertices [L-1 ~> m-1].
+ real, pointer, dimension(:,:,:) :: PhiC => NULL() ! Same as Phi, but 1 quadrature point per cell (rather than 4)
+
! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve
@@ -2595,12 +2950,17 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf)
is = iscq - 1; js = jscq - 1
i_off = G%idg_offset ; j_off = G%jdg_offset
- allocate(Phi(1:8,1:4,isd:ied,jsd:jed), source=0.0)
-
-! do j=jsc,jec ; do i=isc,iec
- do j=jscq,jecq ; do i=iscq,iecq
- call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j))
- enddo ; enddo
+ if (trim(CS%ice_viscosity_compute) == "MODEL") then
+ allocate(PhiC(1:8,isc:iec,jsc:jec), source=0.0)
+ do j=jsc,jec ; do i=isc,iec
+ call bilinear_shape_fn_grid_1qp(G, i, j, PhiC(:,i,j))
+ enddo; enddo
+ elseif (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") then
+ allocate(Phi(1:8,1:4,isc:iec,jsc:jec), source=0.0)
+ do j=jsc,jec ; do i=isc,iec
+ call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j))
+ enddo; enddo
+ endif
n_g = CS%n_glen; eps_min = CS%eps_glen_min
CS%ice_visc(:,:) = 1.0e22
@@ -2608,43 +2968,79 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf)
do j=jsc,jec ; do i=isc,iec
if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then
- Visc_coef = ( (US%RL2_T2_to_Pa)**(-CS%n_glen)*US%T_to_s )**(-1./CS%n_glen) * (CS%AGlen_visc(i,j))**(-1./CS%n_glen)
- ! Units of Aglen_visc [Pa-3 s-1]
- do iq=1,2 ; do jq=1,2
- ux = ( (u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + &
- u_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + &
- (u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + &
- u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) )
-
- vx = ( (v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + &
- v_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + &
- (v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + &
- v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) )
-
- uy = ( (u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq,i,j) + &
- u_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + &
- (u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + &
- u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) )
-
- vy = ( (v_shlf(I-1,j-1) * Phi(2,2*(jq-1)+iq,i,j) + &
- v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + &
- (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + &
- v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) )
- enddo ; enddo
if (trim(CS%ice_viscosity_compute) == "CONSTANT") then
CS%ice_visc(i,j) = 1e15 * US%kg_m3_to_R*US%m_to_L*US%m_s_to_L_T * (G%areaT(i,j) * ISS%h_shelf(i,j))
! constant viscocity for debugging
- elseif (trim(CS%ice_viscosity_compute) == "MODEL") then
- CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * &
- (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g))
elseif (trim(CS%ice_viscosity_compute) == "OBS") then
if (CS%AGlen_visc(i,j) >0) CS%ice_visc(i,j) = CS%AGlen_visc(i,j)*(G%areaT(i,j) * ISS%h_shelf(i,j))
! Here CS%Aglen_visc(i,j) is the ice viscocity [Pa s-1] computed from obs and read from a file
+ elseif (trim(CS%ice_viscosity_compute) == "MODEL") then
+
+ Visc_coef = ( (US%RL2_T2_to_Pa)**(-CS%n_glen)*US%T_to_s )**(-1./CS%n_glen) * &
+ (CS%AGlen_visc(i,j))**(-1./CS%n_glen)
+ ! Units of Aglen_visc [Pa-3 s-1]
+
+ ux = u_shlf(I-1,J-1) * PhiC(1,i,j) + &
+ u_shlf(I,J) * PhiC(7,i,j) + &
+ u_shlf(I-1,J) * PhiC(5,i,j) + &
+ u_shlf(I,J-1) * PhiC(3,i,j)
+
+ vx = v_shlf(I-1,J-1) * PhiC(1,i,j) + &
+ v_shlf(I,J) * PhiC(7,i,j) + &
+ v_shlf(I-1,J) * PhiC(5,i,j) + &
+ v_shlf(I,J-1) * PhiC(3,i,j)
+
+ uy = u_shlf(I-1,J-1) * PhiC(2,i,j) + &
+ u_shlf(I,J) * PhiC(8,i,j) + &
+ u_shlf(I-1,J) * PhiC(6,i,j) + &
+ u_shlf(I,J-1) * PhiC(4,i,j)
+
+ vy = v_shlf(I-1,J-1) * PhiC(2,i,j) + &
+ v_shlf(I,J) * PhiC(8,i,j) + &
+ v_shlf(I-1,J) * PhiC(6,i,j) + &
+ v_shlf(I,J-1) * PhiC(4,i,j)
+
+ CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * &
+ (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g))
+ elseif (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") then
+ !in this case, we will compute viscosity at quadrature points within subroutines CG_action
+ !and apply_boundary_values. CS%ice_visc(i,j) will include everything except the effective strain rate term:
+ Visc_coef = ( (US%RL2_T2_to_Pa)**(-CS%n_glen)*US%T_to_s )**(-1./CS%n_glen) * &
+ (CS%AGlen_visc(i,j))**(-1./CS%n_glen)
+ CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j))
+
+ do iq=1,2 ; do jq=1,2
+
+ ux = u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + &
+ u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j) + &
+ u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + &
+ u_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)
+
+ vx = v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + &
+ v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j) + &
+ v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + &
+ v_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)
+
+ uy = u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq,i,j) + &
+ u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j) + &
+ u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + &
+ u_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)
+
+ vy = v_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq,i,j) + &
+ v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j) + &
+ v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + &
+ v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)
+
+ CS%Ee(i,j,2*(jq-1)+iq) = &
+ (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g))
+ enddo; enddo
endif
endif
enddo ; enddo
- deallocate(Phi)
+
+ if (trim(CS%ice_viscosity_compute) == "MODEL") deallocate(PhiC)
+ if (trim(CS%ice_viscosity_compute) == "MODEL_QUADRATURE") deallocate(Phi)
end subroutine calc_shelf_visc
@@ -2667,6 +3063,10 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf)
integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq
integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec, is, js
real :: umid, vmid, unorm, eps_min ! Velocities [L T-1 ~> m s-1]
+ real :: alpha !Coulomb coefficient [nondim]
+ real :: Hf !"floatation thickness" for Coulomb friction [Z ~> m]
+ real :: fN !Effective pressure (ice pressure - ocean pressure) for Coulomb friction [R L2 T-2 ~> Pa]
+ real :: fB !for Coulomb Friction [(L T-1)^CS%CF_PostPeak ~> (m s-1)^CS%CF_PostPeak]
isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec
iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB
@@ -2678,15 +3078,34 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf)
eps_min = CS%eps_glen_min
+ if (CS%CoulombFriction) then
+ if (CS%CF_PostPeak.ne.1.0) THEN
+ alpha = (CS%CF_PostPeak-1.0)**(CS%CF_PostPeak-1.0) / CS%CF_PostPeak**CS%CF_PostPeak ![nondim]
+ else
+ alpha = 1.0
+ endif
+ endif
do j=jsd+1,jed
do i=isd+1,ied
if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then
umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25
vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25
- unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2))
-! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1)
- CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction(i,j) * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1)
+ unorm = US%L_T_to_m_s*sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2))
+
+ !Coulomb friction (Schoof 2005, Gagliardini et al 2007)
+ if (CS%CoulombFriction) then
+ !Effective pressure
+ Hf = max(CS%density_ocean_avg * CS%bed_elev(i,j)/CS%density_ice, 0.0)
+ fN = max(CS%density_ice * CS%g_Earth * (ISS%h_shelf(i,j) - Hf),CS%CF_MinN)
+
+ fB = alpha * (CS%C_basal_friction(i,j) / (CS%CF_Max * fN))**(CS%CF_PostPeak/CS%n_basal_fric)
+ CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction(i,j) * &
+ unorm**(CS%n_basal_fric-1.0) / (1.0 + fB * unorm**CS%CF_PostPeak)**(CS%n_basal_fric)
+ else
+ !linear (CS%n_basal_fric=1) or "Weertman"/power-law (CS%n_basal_fric .ne. 1)
+ CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction(i,j) * unorm**(CS%n_basal_fric-1)
+ endif
endif
enddo
enddo
@@ -2724,11 +3143,11 @@ subroutine update_OD_ffrac(CS, G, US, ocean_mass, find_avg)
CS%ground_frac(i,j) = 1.0 - (CS%ground_frac_rt(i,j) * I_counter)
CS%OD_av(i,j) = CS%OD_rt(i,j) * I_counter
- CS%OD_rt(i,j) = 0.0 ; CS%ground_frac_rt(i,j) = 0.0
+ CS%OD_rt(i,j) = 0.0 ; CS%ground_frac_rt(i,j) = 0.0; CS%OD_rt_counter = 0
enddo ; enddo
- call pass_var(CS%ground_frac, G%domain)
- call pass_var(CS%OD_av, G%domain)
+ call pass_var(CS%ground_frac, G%domain, complete=.false.)
+ call pass_var(CS%OD_av, G%domain, complete=.true.)
endif
end subroutine update_OD_ffrac
@@ -2761,6 +3180,53 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf)
end subroutine update_OD_ffrac_uncoupled
+subroutine change_in_draft(CS, G, h_shelf0, h_shelf1, ddraft)
+ type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure
+ type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf.
+ real, dimension(SZDI_(G),SZDJ_(G)), &
+ intent(in) :: h_shelf0 !< the previous thickness of the ice shelf [Z ~> m].
+ real, dimension(SZDI_(G),SZDJ_(G)), &
+ intent(in) :: h_shelf1 !< the current thickness of the ice shelf [Z ~> m].
+ real, dimension(SZDI_(G),SZDJ_(G)), &
+ intent(inout) :: ddraft !< the change in shelf draft thickness
+ real :: b0,b1
+ integer :: i, j, isc, iec, jsc, jec
+ real :: rhoi_rhow, OD
+
+ rhoi_rhow = CS%density_ice / CS%density_ocean_avg
+ isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec
+ ddraft = 0.0
+
+ do j=jsc,jec
+ do i=isc,iec
+
+ b0=0.0; b1=0.0
+
+ if (h_shelf0(i,j)>0.0) then
+ OD = CS%bed_elev(i,j) - rhoi_rhow * h_shelf0(i,j)
+ if (OD >= 0) then
+ !floating
+ b0 = rhoi_rhow * h_shelf0(i,j)
+ else
+ b0 = CS%bed_elev(i,j)
+ endif
+ endif
+
+ if (h_shelf1(i,j)>0.0) then
+ OD = CS%bed_elev(i,j) - rhoi_rhow * h_shelf1(i,j)
+ if (OD >= 0) then
+ !floating
+ b1 = rhoi_rhow * h_shelf1(i,j)
+ else
+ b1 = CS%bed_elev(i,j)
+ endif
+ endif
+
+ ddraft(i,j) = b1-b0
+ enddo
+ enddo
+end subroutine change_in_draft
+
!> This subroutine calculates the gradients of bilinear basis elements that
!! that are centered at the vertices of the cell. Values are calculated at
!! points of gaussian quadrature.
@@ -2800,8 +3266,8 @@ subroutine bilinear_shape_functions (X, Y, Phi, area)
a = -X(1)*(1-yquad(qpoint)) + X(2)*(1-yquad(qpoint)) - X(3)*yquad(qpoint) + X(4)*yquad(qpoint) ! d(x)/d(x*)
b = -Y(1)*(1-yquad(qpoint)) + Y(2)*(1-yquad(qpoint)) - Y(3)*yquad(qpoint) + Y(4)*yquad(qpoint) ! d(y)/d(x*)
- c = -X(1)*(1-xquad(qpoint)) - X(2)*(xquad(qpoint)) + X(3)*(1-xquad(qpoint)) + X(4)*(xquad(qpoint)) ! d(x)/d(y*)
- d = -Y(1)*(1-xquad(qpoint)) - Y(2)*(xquad(qpoint)) + Y(3)*(1-xquad(qpoint)) + Y(4)*(xquad(qpoint)) ! d(y)/d(y*)
+ c = -X(1)*(1-xquad(qpoint)) - X(2)*xquad(qpoint) + X(3)*(1-xquad(qpoint)) + X(4)*xquad(qpoint) ! d(x)/d(y*)
+ d = -Y(1)*(1-xquad(qpoint)) - Y(2)*xquad(qpoint) + Y(3)*(1-xquad(qpoint)) + Y(4)*xquad(qpoint) ! d(y)/d(y*)
do node=1,4
@@ -2895,6 +3361,50 @@ subroutine bilinear_shape_fn_grid(G, i, j, Phi)
end subroutine bilinear_shape_fn_grid
+!> This subroutine calculates the gradients of bilinear basis elements that are centered at the
+!! vertices of the cell using a locally orthogoal MOM6 grid. Values are calculated at
+!! a sinlge cell-centered quadrature point, which should match the grid cell h-point
+subroutine bilinear_shape_fn_grid_1qp(G, i, j, Phi)
+ type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf.
+ integer, intent(in) :: i !< The i-index in the grid to work on.
+ integer, intent(in) :: j !< The j-index in the grid to work on.
+ real, dimension(8), intent(inout) :: Phi !< The gradients of bilinear basis elements at Gaussian
+ !! quadrature points surrounding the cell vertices [L-1 ~> m-1].
+
+! This subroutine calculates the gradients of bilinear basis elements that
+! that are centered at the vertices of the cell. The values are calculated at
+! a cell-cented point of gaussian quadrature. (in 1D: .5 for [0,1])
+! (ordered in same way as vertices)
+!
+! Phi(2*i-1) gives d(Phi_i)/dx at the quadrature point
+! Phi(2*i) gives d(Phi_i)/dy at the quadrature point
+! Phi_i is equal to 1 at vertex i, and 0 at vertex k /= i, and bilinear
+
+ real :: a, d ! Interpolated grid spacings [L ~> m]
+ real :: xexp=0.5, yexp=0.5 ! [nondim]
+ integer :: node, qpoint, xnode, ynode
+
+ ! d(x)/d(x*)
+ if (J>1) then
+ a = 0.5 * (G%dxCv(i,J-1) + G%dxCv(i,J))
+ else
+ a = G%dxCv(i,J)
+ endif
+
+ ! d(y)/d(y*)
+ if (I>1) then
+ d = 0.5 * (G%dyCu(I-1,j) + G%dyCu(I,j))
+ else
+ d = G%dyCu(I,j)
+ endif
+
+ do node=1,4
+ xnode = 2-mod(node,2) ; ynode = ceiling(REAL(node)/2)
+ Phi(2*node-1) = ( d * (2 * xnode - 3) * yexp ) / (a*d)
+ Phi(2*node) = ( a * (2 * ynode - 3) * xexp ) / (a*d)
+ enddo
+end subroutine bilinear_shape_fn_grid_1qp
+
subroutine bilinear_shape_functions_subgrid(Phisub, nsub)
integer, intent(in) :: nsub !< The number of subgridscale quadrature locations in each direction
@@ -2959,7 +3469,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face
real, dimension(SZDIB_(G),SZDJB_(G)), &
intent(out) :: vmask !< A coded mask indicating the nature of the
!! meridional flow at the corner point
-real, dimension(SZDIB_(G),SZDJB_(G)), &
+ real, dimension(SZDIB_(G),SZDJB_(G)), &
intent(out) :: u_face_mask !< A coded mask for velocities at the C-grid u-face
real, dimension(SZDIB_(G),SZDJB_(G)), &
intent(out) :: v_face_mask !< A coded mask for velocities at the C-grid v-face
@@ -2970,11 +3480,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face
integer :: i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq
integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec
- integer :: i_off, j_off
isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec
iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB
- i_off = G%idg_offset ; j_off = G%jdg_offset
isd = G%isd ; jsd = G%jsd
iegq = G%iegB ; jegq = G%jegB
gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo
@@ -2989,61 +3497,73 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face
is = isd+1 ; js = jsd+1
endif
+ do j=js,G%jed; do i=is,G%ied
+ if (hmask(i,j) == 1 .or. hmask(i,j)==3) then
+ umask(I-1:I,J-1:J)=1
+ vmask(I-1:I,J-1:J)=1
+ endif
+ enddo; enddo
+
do j=js,G%jed
do i=is,G%ied
if ((hmask(i,j) == 1) .OR. (hmask(i,j) == 3)) then
- umask(I,j) = 1.
- vmask(I,j) = 1.
-
do k=0,1
select case (int(CS%u_face_mask_bdry(I-1+k,j)))
+ case (5)
+ umask(I-1+k,J-1:J) = 3.
+ u_face_mask(I-1+k,j) = 5.
case (3)
- vmask(I-1+k,J-1) = 3.
+ umask(I-1+k,J-1:J) = 3.
+ vmask(I-1+k,J-1:J) = 3.
u_face_mask(I-1+k,j) = 3.
- umask(I-1+k,J) = 3.
- vmask(I-1+k,J) = 3.
- vmask(I-1+k,J) = 3.
+ case (6)
+ vmask(I-1+k,J-1:J) = 3.
+ u_face_mask(I-1+k,j) = 6.
case (2)
u_face_mask(I-1+k,j) = 2.
case (4)
umask(I-1+k,J-1:J) = 0.
- vmask(I-1+k,J-1:J) = 0.
u_face_mask(I-1+k,j) = 4.
case (0)
umask(I-1+k,J-1:J) = 0.
- vmask(I-1+k,J-1:J) = 0.
u_face_mask(I-1+k,j) = 0.
case (1) ! stress free x-boundary
umask(I-1+k,J-1:J) = 0.
case default
+ umask(I-1+k,J-1) = max(1. , umask(I-1+k,J-1))
+ umask(I-1+k,J) = max(1. , umask(I-1+k,J))
end select
enddo
do k=0,1
select case (int(CS%v_face_mask_bdry(i,J-1+k)))
+ case (5)
+ vmask(I-1:I,J-1+k) = 3.
+ v_face_mask(i,J-1+k) = 5.
case (3)
- vmask(I-1,J-1+k) = 3.
- umask(I-1,J-1+k) = 3.
- vmask(I,J-1+k) = 3.
- umask(I,J-1+k) = 3.
+ vmask(I-1:I,J-1+k) = 3.
+ umask(I-1:I,J-1+k) = 3.
v_face_mask(i,J-1+k) = 3.
+ case (6)
+ umask(I-1:I,J-1+k) = 3.
+ v_face_mask(i,J-1+k) = 6.
case (2)
v_face_mask(i,J-1+k) = 2.
case (4)
- umask(I-1:I,J-1+k) = 0.
vmask(I-1:I,J-1+k) = 0.
v_face_mask(i,J-1+k) = 4.
case (0)
- umask(I-1:I,J-1+k) = 0.
vmask(I-1:I,J-1+k) = 0.
v_face_mask(i,J-1+k) = 0.
case (1) ! stress free y-boundary
vmask(I-1:I,J-1+k) = 0.
case default
+ vmask(I-1,J-1+k) = max(1. , vmask(I-1,J-1+k))
+ vmask(I,J-1+k) = max(1. , vmask(I,J-1+k))
end select
enddo
@@ -3119,7 +3639,7 @@ subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node)
num_h = 0
do k=0,1
do l=0,1
- if (hmask(i+k,j+l) == 1.0) then
+ if (hmask(i+k,j+l) == 1.0 .or. hmask(i+k,j+l) == 3.0) then
summ = summ + h_shelf(i+k,j+l)
num_h = num_h + 1
endif
@@ -3149,6 +3669,7 @@ subroutine ice_shelf_dyn_end(CS)
deallocate(CS%umask, CS%vmask)
deallocate(CS%ice_visc, CS%AGlen_visc)
+ deallocate(CS%Ee)
deallocate(CS%basal_traction,CS%C_basal_friction)
deallocate(CS%OD_rt, CS%OD_av)
deallocate(CS%t_bdry_val, CS%bed_elev)
@@ -3236,8 +3757,8 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time)
endif
enddo ; enddo
- call pass_var(CS%t_shelf, G%domain)
- call pass_var(CS%tmask, G%domain)
+ call pass_var(CS%t_shelf, G%domain, complete=.false.)
+ call pass_var(CS%tmask, G%domain, complete=.true.)
if (CS%debug) then
call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3, scale=US%C_to_degC)
diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90
index e49fb03aaf..1e2076f889 100644
--- a/src/ice_shelf/MOM_ice_shelf_initialize.F90
+++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90
@@ -22,6 +22,7 @@ module MOM_ice_shelf_initialize
public initialize_ice_shelf_boundary_from_file
public initialize_ice_C_basal_friction
public initialize_ice_AGlen
+public initialize_ice_SMB
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
@@ -351,7 +352,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b
hmask(i+1,j) = 3.0
h_bdry_val(i+1,j) = h_shelf(i+1,j)
thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j)
- u_face_mask_bdry(i+1,j) = 3.0
+ u_face_mask_bdry(i+1,j) = 5.0
u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !velocity distribution
endif
@@ -429,31 +430,32 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,&
filename = trim(inputdir)//trim(vel_file)
call log_param(PF, mdl, "INPUTDIR/THICKNESS_FILE", filename)
call get_param(PF, mdl, "ICE_U_VEL_VARNAME", ushelf_varname, &
- "The name of the thickness variable in ICE_VELOCITY_FILE.", &
+ "The name of the u velocity variable in ICE_VELOCITY_FILE.", &
default="u_shelf")
call get_param(PF, mdl, "ICE_V_VEL_VARNAME", vshelf_varname, &
- "The name of the thickness variable in ICE_VELOCITY_FILE.", &
+ "The name of the v velocity variable in ICE_VELOCITY_FILE.", &
default="v_shelf")
call get_param(PF, mdl, "ICE_VISC_VARNAME", ice_visc_varname, &
- "The name of the thickness variable in ICE_VELOCITY_FILE.", &
+ "The name of the ice viscosity variable in ICE_VELOCITY_FILE.", &
default="viscosity")
+ call get_param(PF, mdl, "ICE_FLOAT_FRAC_VARNAME", floatfr_varname, &
+ "The name of the ice float fraction (grounding fraction) variable in ICE_VELOCITY_FILE.", &
+ default="float_frac")
call get_param(PF, mdl, "BED_TOPO_FILE", bed_topo_file, &
"The file from which the bed elevation is read.", &
default="ice_shelf_vel.nc")
call get_param(PF, mdl, "BED_TOPO_VARNAME", bed_varname, &
- "The name of the thickness variable in ICE_INPUT_FILE.", &
+ "The name of the bed elevation variable in ICE_INPUT_FILE.", &
default="depth")
if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, &
" initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename))
- floatfr_varname = "float_frac"
-
call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, position=CORNER, scale=US%m_s_to_L_T)
call MOM_read_data(filename, trim(vshelf_varname), v_shelf, G%Domain, position=CORNER, scale=US%m_s_to_L_T)
call MOM_read_data(filename, trim(floatfr_varname), float_cond, G%Domain, scale=1.)
filename = trim(inputdir)//trim(bed_topo_file)
- call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.0)
+ call MOM_read_data(filename, trim(bed_varname), bed_elev, G%Domain, scale=US%m_to_Z)
end subroutine initialize_ice_flow_from_file
@@ -656,5 +658,51 @@ subroutine initialize_ice_AGlen(AGlen, G, US, PF)
call MOM_read_data(filename,trim(varname), AGlen, G%Domain)
endif
-end subroutine
+end subroutine initialize_ice_AGlen
+
+!> Initialize ice surface mass balance field that is held constant over time
+subroutine initialize_ice_SMB(SMB, G, US, PF)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ real, dimension(SZDI_(G),SZDJ_(G)), &
+ intent(inout) :: SMB !< Ice surface mass balance parameter, often in [kg m-2 s-1]
+ type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors
+ type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters
+
+ real :: SMB_val ! Constant ice surface mass balance parameter, often in [kg m-2 s-1]
+ character(len=40) :: mdl = "initialize_ice_SMB" ! This subroutine's name.
+ character(len=200) :: config
+ character(len=200) :: varname
+ character(len=200) :: inputdir, filename, SMB_file
+
+ call get_param(PF, mdl, "ICE_SMB_CONFIG", config, &
+ "This specifies how the initial ice surface mass balance parameter is specified. "//&
+ "Valid values are: CONSTANT and FILE.", &
+ default="CONSTANT")
+
+ if (trim(config)=="CONSTANT") then
+ call get_param(PF, mdl, "SMB", SMB_val, &
+ "Surface mass balance.", units="kg m-2 s-1", default=0.0)
+
+ SMB(:,:) = SMB_val
+
+ elseif (trim(config)=="FILE") then
+ call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading SMB parameter")
+ call get_param(PF, mdl, "INPUTDIR", inputdir, default=".")
+ inputdir = slasher(inputdir)
+
+ call get_param(PF, mdl, "ICE_SMB_FILE", SMB_file, &
+ "The file from which the ice surface mass balance is read.", &
+ default="ice_SMB.nc")
+ filename = trim(inputdir)//trim(SMB_file)
+ call log_param(PF, mdl, "INPUTDIR/ICE_SMB_FILE", filename)
+ call get_param(PF, mdl, "ICE_SMB_VARNAME", varname, &
+ "The variable to use as surface mass balance.", &
+ default="SMB")
+
+ if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, &
+ " initialize_ice_SMV_from_file: Unable to open "//trim(filename))
+ call MOM_read_data(filename,trim(varname), SMB, G%Domain)
+
+ endif
+end subroutine initialize_ice_SMB
end module MOM_ice_shelf_initialize
diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90
index 32413ad2d8..e6be780073 100644
--- a/src/ice_shelf/MOM_ice_shelf_state.F90
+++ b/src/ice_shelf/MOM_ice_shelf_state.F90
@@ -26,13 +26,14 @@ module MOM_ice_shelf_state
area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf [L2 ~> m2].
h_shelf => NULL(), & !< the thickness of the shelf [Z ~> m], redundant with mass but may
!! make the code more readable
+ dhdt_shelf => NULL(), & !< the change in thickness of the shelf over time [Z T-1 ~> m s-1]
hmask => NULL(),& !< Mask used to indicate ice-covered or partiall-covered cells
!! 1: fully covered, solve for velocity here (for now all
!! ice-covered cells are treated the same, this may change)
!! 2: partially covered, do not solve for velocity
!! 0: no ice in cell.
- !! 3: bdry condition on thickness set - not in computational domain
- !! -2 : default (out of computational boundary, and) not = 3
+ !! 3: bdry condition on thickness set
+ !! -2 : default (out of computational boundary)
!! NOTE: hmask will change over time and NEEDS TO BE MAINTAINED
!! otherwise the wrong nodes will be included in velocity calcs.
@@ -70,6 +71,7 @@ subroutine ice_shelf_state_init(ISS, G)
allocate(ISS%mass_shelf(isd:ied,jsd:jed), source=0.0 )
allocate(ISS%area_shelf_h(isd:ied,jsd:jed), source=0.0 )
allocate(ISS%h_shelf(isd:ied,jsd:jed), source=0.0 )
+ allocate(ISS%dhdt_shelf(isd:ied,jsd:jed), source=0.0 )
allocate(ISS%hmask(isd:ied,jsd:jed), source=-2.0 )
allocate(ISS%tflux_ocn(isd:ied,jsd:jed), source=0.0 )
@@ -87,7 +89,7 @@ subroutine ice_shelf_state_end(ISS)
if (.not.associated(ISS)) return
- deallocate(ISS%mass_shelf, ISS%area_shelf_h, ISS%h_shelf, ISS%hmask)
+ deallocate(ISS%mass_shelf, ISS%area_shelf_h, ISS%h_shelf, ISS%dhdt_shelf, ISS%hmask)
deallocate(ISS%tflux_ocn, ISS%water_flux, ISS%salt_flux, ISS%tflux_shelf)
deallocate(ISS%tfreeze)
diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90
index 8af8cd3bc6..37c719209b 100644
--- a/src/initialization/MOM_coord_initialization.F90
+++ b/src/initialization/MOM_coord_initialization.F90
@@ -126,6 +126,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file)
! Local variables
real :: g_int ! Reduced gravities across the internal interfaces [L2 Z-1 T-2 ~> m s-2].
real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2].
+ real :: Rlay_Ref ! The target density of the surface layer [R ~> kg m-3].
character(len=40) :: mdl = "set_coord_from_gprime" ! This subroutine's name.
integer :: k, nz
nz = GV%ke
@@ -138,11 +139,20 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file)
call get_param(param_file, mdl, "GINT", g_int, &
"The reduced gravity across internal interfaces.", &
units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m)
+ call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, &
+ "The reference potential density used for layer 1.", &
+ units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R)
g_prime(1) = g_fs
do k=2,nz ; g_prime(k) = g_int ; enddo
- Rlay(1) = GV%Rho0
- do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo
+ Rlay(1) = Rlay_Ref
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo
+ else
+ do k=2,nz
+ Rlay(k) = Rlay(k-1) * ((GV%g_Earth + 0.5*g_prime(k)) / (GV%g_Earth - 0.5*g_prime(k)))
+ enddo
+ endif
call callTree_leave(trim(mdl)//'()')
@@ -184,9 +194,15 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file)
enddo
! These statements set the interface reduced gravities. !
g_prime(1) = g_fs
- do k=2,nz
- g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1))
- enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz
+ g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1))
+ enddo
+ else
+ do k=2,nz
+ g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1))
+ enddo
+ endif
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_from_layer_density
@@ -237,7 +253,13 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state
call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state)
! These statements set the layer densities. !
- do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo
+ else
+ do k=2,nz
+ Rlay(k) = Rlay(k-1) * ((GV%g_Earth + 0.5*g_prime(k)) / (GV%g_Earth - 0.5*g_prime(k)))
+ enddo
+ endif
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_from_TS_ref
@@ -294,7 +316,15 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s
g_prime(1) = g_fs
do k=1,nz ; Pref(k) = P_Ref ; enddo
call calculate_density(T0, S0, Pref, Rlay, eqn_of_state, (/1,nz/) )
- do k=2,nz; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz
+ g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1))
+ enddo
+ else
+ do k=2,nz
+ g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1))
+ enddo
+ endif
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_from_TS_profile
@@ -387,7 +417,15 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta
do k=k_light-1,1,-1
Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2)
enddo
- do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz
+ g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1))
+ enddo
+ else
+ do k=2,nz
+ g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1))
+ enddo
+ endif
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_from_TS_range
@@ -429,7 +467,15 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file)
call MOM_read_data(filename, coord_var, Rlay, scale=US%kg_m3_to_R)
g_prime(1) = g_fs
- do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz
+ g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1))
+ enddo
+ else
+ do k=2,nz
+ g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1))
+ enddo
+ endif
do k=1,nz ; if (g_prime(k) <= 0.0) then
call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//&
"Zero or negative g_primes read from variable "//"Layer"//" in file "//&
@@ -479,9 +525,15 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file)
enddo
! These statements set the interface reduced gravities.
g_prime(1) = g_fs
- do k=2,nz
- g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1))
- enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz
+ g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1))
+ enddo
+ else
+ do k=2,nz
+ g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1))
+ enddo
+ endif
call callTree_leave(trim(mdl)//'()')
end subroutine set_coord_linear
@@ -498,6 +550,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file)
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
! Local variables
real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2].
+ real :: Rlay_Ref ! The target density of the surface layer [R ~> kg m-3].
character(len=40) :: mdl = "set_coord_to_none" ! This subroutine's name.
integer :: k, nz
nz = GV%ke
@@ -507,11 +560,20 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file)
call get_param(param_file, mdl, "GFS" , g_fs, &
"The reduced gravity at the free surface.", units="m s-2", &
default=GV%g_Earth*US%L_T_to_m_s**2*US%m_to_Z, scale=US%m_s_to_L_T**2*US%Z_to_m)
+ call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, &
+ "The reference potential density used for layer 1.", &
+ units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R)
g_prime(1) = g_fs
do k=2,nz ; g_prime(k) = 0. ; enddo
- Rlay(1) = GV%Rho0
- do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo
+ Rlay(1) = Rlay_Ref
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo
+ else
+ do k=2,nz
+ Rlay(k) = Rlay(k-1) * ((GV%g_Earth + 0.5*g_prime(k)) / (GV%g_Earth - 0.5*g_prime(k)))
+ enddo
+ endif
call callTree_leave(trim(mdl)//'()')
@@ -522,8 +584,8 @@ end subroutine set_coord_to_none
subroutine write_vertgrid_file(GV, US, param_file, directory)
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
- character(len=*), intent(in) :: directory !< The directory into which to place the file.
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ character(len=*), intent(in) :: directory !< The directory into which to place the file.
! Local variables
character(len=240) :: filepath
type(vardesc) :: vars(2)
diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90
index 0321d7511a..a0de043555 100644
--- a/src/initialization/MOM_state_initialization.F90
+++ b/src/initialization/MOM_state_initialization.F90
@@ -18,6 +18,7 @@ module MOM_state_initialization
use MOM_get_input, only : directories
use MOM_grid, only : ocean_grid_type, isPointInCell
use MOM_interface_heights, only : find_eta, dz_to_thickness, dz_to_thickness_simple
+use MOM_interface_heights, only : calc_derived_thermo
use MOM_io, only : file_exists, field_size, MOM_read_data, MOM_read_vector, slasher
use MOM_open_boundary, only : ocean_OBC_type, open_boundary_init, set_tracer_data
use MOM_open_boundary, only : OBC_NONE
@@ -153,7 +154,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m]
real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! The layer thicknesses in geopotential (z) units [Z ~> m]
character(len=200) :: inputdir ! The directory where NetCDF input files are.
- character(len=200) :: config
+ character(len=200) :: config, h_config
real :: H_rescale ! A rescaling factor for thicknesses from the representation in
! a restart file to the internal representation in this run [various units ~> 1]
real :: dt ! The baroclinic dynamics timestep for this run [T ~> s].
@@ -263,7 +264,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
convert = .false.
else
! Initialize thickness, h.
- call get_param(PF, mdl, "THICKNESS_CONFIG", config, &
+ call get_param(PF, mdl, "THICKNESS_CONFIG", h_config, &
"A string that determines how the initial layer "//&
"thicknesses are specified for a new run: \n"//&
" \t file - read interface heights from the file specified \n"//&
@@ -294,7 +295,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
" \t rossby_front - a mixed layer front in thermal wind balance.\n"//&
" \t USER - call a user modified routine.", &
default="uniform", do_not_log=just_read)
- select case (trim(config))
+ select case (trim(h_config))
case ("file")
call initialize_thickness_from_file(dz, depth_tot, G, GV, US, PF, file_has_thickness=.false., &
mass_file=.false., just_read=just_read)
@@ -344,12 +345,13 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
case ("soliton"); call soliton_initialize_thickness(dz, depth_tot, G, GV, US)
case ("phillips"); call Phillips_initialize_thickness(dz, depth_tot, G, GV, US, PF, &
just_read=just_read)
- case ("rossby_front"); call Rossby_front_initialize_thickness(dz, G, GV, US, &
- PF, just_read=just_read)
+ case ("rossby_front")
+ call Rossby_front_initialize_thickness(h, G, GV, US, PF, just_read=just_read)
+ convert = .false. ! Rossby_front initialization works directly in thickness units.
case ("USER"); call user_initialize_thickness(dz, G, GV, PF, &
just_read=just_read)
case default ; call MOM_error(FATAL, "MOM_initialize_state: "//&
- "Unrecognized layer thickness configuration "//trim(config))
+ "Unrecognized layer thickness configuration "//trim(h_config))
end select
! Initialize temperature and salinity (T and S).
@@ -376,6 +378,16 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
" \t USER - call a user modified routine.", &
fail_if_missing=new_sim, do_not_log=just_read)
! " \t baroclinic_zone - an analytic baroclinic zone. \n"//&
+
+ ! Check for incompatible THICKNESS_CONFIG and TS_CONFIG settings
+ if (new_sim .and. (.not.convert)) then ; select case (trim(config))
+ case ("DOME2D", "ISOMIP", "adjustment2d", "baroclinic_zone", "sloshing", &
+ "seamount", "dumbbell", "SCM_CVMix_tests", "dense")
+ call MOM_error(FATAL, "TS_CONFIG = "//trim(config)//" does not work with thicknesses "//&
+ "that have already been converted to thickness units, as is the case with "//&
+ "THICKNESS_CONFIG = "//trim(h_config)//".")
+ end select ; endif
+
select case (trim(config))
case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, US, PF, &
eos, tv%P_Ref, just_read=just_read)
@@ -401,8 +413,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
tv%S, dz, G, GV, US, PF, just_read=just_read)
case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, &
tv%S, dz, G, GV, US, PF, just_read=just_read)
- case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, &
- tv%S, dz, G, GV, US, PF, just_read=just_read)
+ case ("rossby_front")
+ if (convert .and. .not.just_read) call dz_to_thickness(dz, tv, h, G, GV, US)
+ call Rossby_front_initialize_temperature_salinity ( tv%T, tv%S, h, &
+ G, GV, US, PF, just_read=just_read)
case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, dz, &
G, GV, US, PF, just_read=just_read)
case ("dense"); call dense_water_initialize_TS(G, GV, US, PF, tv%T, tv%S, &
@@ -464,7 +478,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
if (new_sim .and. debug) &
call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_MKS)
- call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, OBC, tracer_Reg, &
+ call ALE_regrid_accelerated(ALE_CSp, G, GV, US, h, tv, regrid_iterations, u, v, OBC, tracer_Reg, &
dt=dt, initial=.true.)
endif
endif
@@ -594,8 +608,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, &
call initialize_segment_data(G, GV, US, OBC, PF)
! call open_boundary_config(G, US, PF, OBC)
! Call this once to fill boundary arrays from fixed values
- if (.not. OBC%needs_IO_for_data) &
+ if (OBC%some_need_no_IO_for_data) then
+ call calc_derived_thermo(tv, h, G, GV, US)
call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time)
+ endif
call get_param(PF, mdl, "OBC_USER_CONFIG", config, &
"A string that sets how the user code is invoked to set open boundary data: \n"//&
@@ -704,7 +720,10 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f
"The name of the thickness file.", &
fail_if_missing=.not.just_read, do_not_log=just_read)
- filename = trim(inputdir)//trim(thickness_file)
+ filename = trim(thickness_file)
+ if (scan(thickness_file, "/") == 0) then ! prepend inputdir if only a filename is given
+ filename = trim(inputdir)//trim(thickness_file)
+ endif
if (.not.just_read) call log_param(param_file, mdl, "INPUTDIR/THICKNESS_FILE", filename)
if ((.not.just_read) .and. (.not.file_exists(filename, G%Domain))) call MOM_error(FATAL, &
@@ -1117,10 +1136,6 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read)
real :: z_tolerance ! The tolerance with which to find the depth matching a specified pressure [Z ~> m].
integer :: i, j, k
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the remapping answers from 2018. If false, use more
- ! robust forms of the same remapping expressions.
integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use
! for remapping. Values below 20190101 recover the remapping
! answers from 2018, while higher values use more robust
@@ -1156,25 +1171,16 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read)
call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231, do_not_log=just_read)
- call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101), do_not_log=just_read)
- call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read)
- ! Revise inconsistent default answer dates for remapping.
- if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date, do_not_log=just_read)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=just_read.or.(.not.GV%Boussinesq))
+ if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701)
else
remap_answer_date = 20181231
+ if (.not.GV%Boussinesq) remap_answer_date = 20230701
endif
if (just_read) return ! All run-time parameters have been read, so return.
@@ -1443,7 +1449,10 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read)
call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
inputdir = slasher(inputdir)
- filename = trim(inputdir)//trim(velocity_file)
+ filename = trim(velocity_file)
+ if (scan(velocity_file, '/')== 0) then ! prepend inputdir if only a filename is given
+ filename = trim(inputdir)//trim(velocity_file)
+ endif
if (.not.just_read) call log_param(param_file, mdl, "INPUTDIR/VELOCITY_FILE", filename)
call get_param(param_file, mdl, "U_IC_VAR", u_IC_var, &
@@ -1624,7 +1633,10 @@ subroutine initialize_temp_salt_from_file(T, S, G, GV, US, param_file, just_read
call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
inputdir = slasher(inputdir)
- filename = trim(inputdir)//trim(ts_file)
+ filename = trim(ts_file)
+ if (scan(ts_file, '/')== 0) then ! prepend inputdir if only a filename is given
+ filename = trim(inputdir)//trim(ts_file)
+ endif
if (.not.just_read) call log_param(param_file, mdl, "INPUTDIR/TS_FILE", filename)
call get_param(param_file, mdl, "TEMP_IC_VAR", temp_var, &
"The initial condition variable for potential temperature.", &
@@ -1644,7 +1656,10 @@ subroutine initialize_temp_salt_from_file(T, S, G, GV, US, param_file, just_read
! Read the temperatures and salinities from netcdf files.
call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain, scale=US%degC_to_C)
- salt_filename = trim(inputdir)//trim(salt_file)
+ salt_filename = trim(salt_file)
+ if (scan(salt_file, '/')== 0) then ! prepend inputdir if only a filename is given
+ salt_filename = trim(inputdir)//trim(salt_file)
+ endif
if (.not.file_exists(salt_filename, G%Domain)) call MOM_error(FATAL, &
" initialize_temp_salt_from_file: Unable to open "//trim(salt_filename))
@@ -1974,7 +1989,10 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t
default=.false.)
! Read in sponge damping rate for tracers
- filename = trim(inputdir)//trim(damping_file)
+ filename = trim(damping_file)
+ if (scan(damping_file, '/')== 0) then ! prepend inputdir if only a filename is given
+ filename = trim(inputdir)//trim(damping_file)
+ endif
call log_param(param_file, mdl, "INPUTDIR/SPONGE_DAMPING_FILE", filename)
if (.not.file_exists(filename, G%Domain)) &
call MOM_error(FATAL, " initialize_sponges: Unable to open "//trim(filename))
@@ -2278,7 +2296,10 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p
! call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, default=.false., do_not_log=.true.)
! Read in incremental update for tracers
- filename = trim(inputdir)//trim(inc_file)
+ filename = trim(inc_file)
+ if (scan(inc_file, '/')== 0) then ! prepend inputdir if only a filename is given
+ filename = trim(inputdir)//trim(inc_file)
+ endif
call log_param(param_file, mdl, "INPUTDIR/ODA_INCUPD_FILE", filename)
if (.not.file_exists(filename, G%Domain)) &
call MOM_error(FATAL, " initialize_oda_incupd: Unable to open "//trim(filename))
@@ -2486,17 +2507,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just
logical :: homogenize, useALEremapping, remap_full_column, remap_general, remap_old_alg
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the remapping answers from 2018. If false, use more
- ! robust forms of the same remapping expressions.
- integer :: default_remap_ans_date ! The default setting for remap_answer_date
integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use
! for remapping. Values below 20190101 recover the remapping
! answers from 2018, while higher values use more robust
! forms of the same remapping expressions.
- logical :: hor_regrid_answers_2018
- integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date
integer :: hor_regrid_answer_date ! The vintage of the order of arithmetic and expressions to use
! for horizontal regridding. Values below 20190101 recover the
! answers from 2018, while higher values use expressions that have
@@ -2565,7 +2579,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just
call get_param(PF, mdl, "Z_INIT_REMAP_GENERAL", remap_general, &
"If false, only initializes to z* coordinates. "//&
"If true, allows initialization directly to general coordinates.", &
- default=.false., do_not_log=just_read)
+ default=.not.(GV%Boussinesq.or.GV%semi_Boussinesq) , do_not_log=just_read)
call get_param(PF, mdl, "Z_INIT_REMAP_FULL_COLUMN", remap_full_column, &
"If false, only reconstructs profiles for valid data points. "//&
"If true, inserts vanished layers below the valid data.", &
@@ -2577,46 +2591,27 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just
call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231, do_not_log=just_read)
- call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101), do_not_log=just_read)
call get_param(PF, mdl, "TEMP_SALT_INIT_VERTICAL_REMAP_ONLY", pre_gridded, &
"If true, initial conditions are on the model horizontal grid. " //&
"Extrapolation over missing ocean values is done using an ICE-9 "//&
"procedure with vertical ALE remapping .", &
default=.false., do_not_log=just_read)
if (useALEremapping) then
- call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read)
- ! Revise inconsistent default answer dates for remapping.
- default_remap_ans_date = default_answer_date
- if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231
- if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101
call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_remap_ans_date, do_not_log=just_read)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=just_read.or.(.not.GV%Boussinesq))
+ if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701)
endif
- call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, &
- "If true, use the order of arithmetic for horizontal regridding that recovers "//&
- "the answers from the end of 2018. Otherwise, use rotationally symmetric "//&
- "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read)
- ! Revise inconsistent default answer dates for horizontal regridding.
- default_hor_reg_ans_date = default_answer_date
- if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231
- if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101
call get_param(PF, mdl, "HOR_REGRID_ANSWER_DATE", hor_regrid_answer_date, &
"The vintage of the order of arithmetic for horizontal regridding. "//&
"Dates before 20190101 give the same answers as the code did in late 2018, "//&
"while later versions add parentheses for rotational symmetry. "//&
- "Dates after 20230101 use reproducing sums for global averages. "//&
- "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_hor_reg_ans_date, do_not_log=just_read)
+ "Dates after 20230101 use reproducing sums for global averages.", &
+ default=default_answer_date, do_not_log=just_read.or.(.not.GV%Boussinesq))
+ if (.not.GV%Boussinesq) hor_regrid_answer_date = max(hor_regrid_answer_date, 20230701)
if (.not.useALEremapping) then
call get_param(PF, mdl, "ADJUST_THICKNESS", correct_thickness, &
@@ -2787,7 +2782,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just
call regridding_preadjust_reqs(regridCS, do_conv_adj, ignore)
if (do_conv_adj) call convective_adjustment(G, GV_loc, h1, tv_loc)
- call regridding_main( remapCS, regridCS, G, GV_loc, h1, tv_loc, h, dz_interface, &
+ call regridding_main( remapCS, regridCS, G, GV_loc, US, h1, tv_loc, h, dz_interface, &
frac_shelf_h=frac_shelf_h )
deallocate( dz_interface )
diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90
index 64f6673371..808430df2c 100644
--- a/src/initialization/MOM_tracer_initialization_from_Z.F90
+++ b/src/initialization/MOM_tracer_initialization_from_Z.F90
@@ -87,17 +87,10 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_
integer :: nPoints ! The number of valid input data points in a column
integer :: id_clock_routine, id_clock_ALE
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the remapping answers from 2018. If false, use more
- ! robust forms of the same remapping expressions.
- integer :: default_remap_ans_date ! The default setting for remap_answer_date
integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use
! for remapping. Values below 20190101 recover the remapping
! answers from 2018, while higher values use more robust
! forms of the same remapping expressions.
- logical :: hor_regrid_answers_2018
- integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date
integer :: hor_regrid_answer_date ! The vintage of the order of arithmetic and expressions to use
! for horizontal regridding. Values below 20190101 recover the
! answers from 2018, while higher values use expressions that have
@@ -125,41 +118,22 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_
call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
if (useALE) then
- call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- default_remap_ans_date = default_answer_date
- if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231
- if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101
call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_remap_ans_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701)
endif
- call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, &
- "If true, use the order of arithmetic for horizonal regridding that recovers "//&
- "the answers from the end of 2018. Otherwise, use rotationally symmetric "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for horizontal regridding.
- default_hor_reg_ans_date = default_answer_date
- if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231
- if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101
call get_param(PF, mdl, "HOR_REGRID_ANSWER_DATE", hor_regrid_answer_date, &
"The vintage of the order of arithmetic for horizontal regridding. "//&
"Dates before 20190101 give the same answers as the code did in late 2018, "//&
"while later versions add parentheses for rotational symmetry. "//&
- "Dates after 20230101 use reproducing sums for global averages. "//&
- "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_hor_reg_ans_date)
+ "Dates after 20230101 use reproducing sums for global averages.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) hor_regrid_answer_date = max(hor_regrid_answer_date, 20230701)
if (PRESENT(homogenize)) homog=homogenize
if (PRESENT(useALEremapping)) useALE=useALEremapping
diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90
index 1fdf09e258..f45939d007 100644
--- a/src/ocean_data_assim/MOM_oda_driver.F90
+++ b/src/ocean_data_assim/MOM_oda_driver.F90
@@ -182,11 +182,7 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS)
character(len=80) :: basin_var
character(len=80) :: remap_scheme
character(len=80) :: bias_correction_file, inc_file
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure')
allocate(CS)
@@ -253,22 +249,12 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS)
call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(PF, mdl, "ODA_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from original version of the ODA driver. Otherwise, use updated and "//&
- "more robust forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(PF, mdl, "ODA_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions used by the ODA driver "//&
"Values below 20190101 recover the answers from the end of 2018, while higher "//&
- "values use updated and more robust forms of the same expressions. "//&
- "If both ODA_2018_ANSWERS and ODA_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "values use updated and more robust forms of the same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
inputdir = slasher(inputdir)
select case(lowercase(trim(assim_method)))
diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90
index 6a439dfd22..d269171da9 100644
--- a/src/parameterizations/lateral/MOM_MEKE.F90
+++ b/src/parameterizations/lateral/MOM_MEKE.F90
@@ -75,15 +75,16 @@ module MOM_MEKE
!! which is calculated at each time step.
logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather
!! than the streamfunction for the MEKE GM source term.
- real :: MEKE_min_depth_tot !< The minimum total depth over which to distribute MEKE energy
- !! sources from GM energy conversion [Z ~> m]. When the total
- !! depth is less than this, the sources are scaled away.
+ real :: MEKE_min_depth_tot !< The minimum total thickness over which to distribute MEKE energy
+ !! sources from GM energy conversion [H ~> m or kg m-2]. When the total
+ !! thickness is less than this, the sources are scaled away.
logical :: Rd_as_max_scale !< If true the length scale can not exceed the
!! first baroclinic deformation radius.
logical :: use_old_lscale !< Use the old formula for mixing length scale.
logical :: use_min_lscale !< Use simple minimum for mixing length scale.
+ logical :: MEKE_positive !< If true, it guarantees that MEKE will always be >= 0.
real :: lscale_maxval !< The ceiling on the MEKE mixing length scale when use_min_lscale is true [L ~> m].
- real :: cdrag !< The bottom drag coefficient for MEKE [nondim].
+ real :: cdrag !< The bottom drag coefficient for MEKE, times rescaling factors [H L-1 ~> nondim or kg m-3]
real :: MEKE_BGsrc !< Background energy source for MEKE [L2 T-3 ~> W kg-1] (= m2 s-3).
real :: MEKE_dtScale !< Scale factor to accelerate time-stepping [nondim]
real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh [nondim]
@@ -115,6 +116,9 @@ module MOM_MEKE
logical :: fixed_total_depth !< If true, use the nominal bathymetric depth as the estimate of
!! the time-varying ocean depth. Otherwise base the depth on the total
!! ocean mass per unit area.
+ real :: rho_fixed_total_depth !< A density used to translate the nominal bathymetric depth into an
+ !! estimate of the total ocean mass per unit area when MEKE_FIXED_TOTAL_DEPTH
+ !! is true [R ~> kg m-3]
logical :: kh_flux_enabled !< If true, lateral diffusive MEKE flux is enabled.
logical :: initialize !< If True, invokes a steady state solver to calculate MEKE.
logical :: debug !< If true, write out checksums of data for debugging
@@ -186,10 +190,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
data_eke, & ! EKE from file [L2 T-2 ~> m2 s-2]
mass, & ! The total mass of the water column [R Z ~> kg m-2].
I_mass, & ! The inverse of mass [R-1 Z-1 ~> m2 kg-1].
- depth_tot, & ! The depth of the water column [Z ~> m].
+ depth_tot, & ! The depth of the water column [H ~> m or kg m-2].
src, & ! The sum of all MEKE sources [L2 T-3 ~> W kg-1] (= m2 s-3).
MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1].
- drag_rate_visc, & ! Near-bottom velocity contribution to bottom drag [L T-1 ~> m s-1]
+ drag_rate_visc, & ! Near-bottom velocity contribution to bottom drag [H T-1 ~> m s-1 or kg m-2 s-1]
drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1].
del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [T-2 ~> s-2].
del4MEKE, & ! Time-integrated MEKE tendency arising from the biharmonic of MEKE [L2 T-2 ~> m2 s-2].
@@ -205,23 +209,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
! In one place, MEKE_uflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2].
Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1].
baroHu, & ! Depth integrated accumulated zonal mass flux [R Z L2 ~> kg].
- drag_vel_u ! A (vertical) viscosity associated with bottom drag at u-points [Z T-1 ~> m s-1].
+ drag_vel_u ! A piston velocity associated with bottom drag at u-points [H T-1 ~> m s-1 or kg m-2 s-1]
real, dimension(SZI_(G),SZJB_(G)) :: &
MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3].
! In one place, MEKE_vflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2].
Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1].
baroHv, & ! Depth integrated accumulated meridional mass flux [R Z L2 ~> kg].
- drag_vel_v ! A (vertical) viscosity associated with bottom drag at v-points [Z T-1 ~> m s-1].
+ drag_vel_v ! A piston velocity associated with bottom drag at v-points [H T-1 ~> m s-1 or kg m-2 s-1]
real :: Kh_here ! The local horizontal viscosity [L2 T-1 ~> m2 s-1]
real :: Inv_Kh_max ! The inverse of the local horizontal viscosity [T L-2 ~> s m-2]
real :: K4_here ! The local horizontal biharmonic viscosity [L4 T-1 ~> m4 s-1]
real :: Inv_K4_max ! The inverse of the local horizontal biharmonic viscosity [T L-4 ~> s m-4]
- real :: cdrag2 ! The square of the drag coefficient [nondim]
+ real :: cdrag2 ! The square of the drag coefficient times unit conversion factors [H2 L-2 ~> nondim or kg2 m-6]
real :: advFac ! The product of the advection scaling factor and 1/dt [T-1 ~> s-1]
real :: mass_neglect ! A negligible mass [R Z ~> kg m-2].
real :: ldamping ! The MEKE damping rate [T-1 ~> s-1].
- real :: Rho0 ! A density used to convert mass to distance [R ~> kg m-3]
- real :: I_Rho0 ! The inverse of the density used to convert mass to distance [R-1 ~> m3 kg-1]
real :: sdt ! dt to use locally [T ~> s] (could be scaled to accelerate)
real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split).
logical :: use_drag_rate ! Flag to indicate drag_rate is finite
@@ -266,8 +268,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
endif
sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping
- Rho0 = GV%Rho0
- I_Rho0 = 1.0 / GV%Rho0
mass_neglect = GV%H_to_RZ * GV%H_subroundoff
cdrag2 = CS%cdrag**2
@@ -322,7 +322,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
!$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
- drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * US%Z_to_L * &
+ drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * &
((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + &
G%areaCu(I,j)*drag_vel_u(I,j)) + &
(G%areaCv(i,J-1)*drag_vel_v(i,J-1) + &
@@ -348,14 +348,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
enddo
if (CS%fixed_total_depth) then
- !$OMP parallel do default(shared)
- do j=js-1,je+1 ; do i=is-1,ie+1
- depth_tot(i,j) = G%bathyT(i,j) + G%Z_ref
- enddo ; enddo
+ if (GV%Boussinesq) then
+ !$OMP parallel do default(shared)
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ depth_tot(i,j) = (G%bathyT(i,j) + G%Z_ref) * GV%Z_to_H
+ enddo ; enddo
+ else
+ !$OMP parallel do default(shared)
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ depth_tot(i,j) = (G%bathyT(i,j) + G%Z_ref) * CS%rho_fixed_total_depth * GV%RZ_to_H
+ enddo ; enddo
+ endif
else
!$OMP parallel do default(shared)
do j=js-1,je+1 ; do i=is-1,ie+1
- depth_tot(i,j) = mass(i,j) * I_Rho0
+ depth_tot(i,j) = mass(i,j) * GV%RZ_to_H
enddo ; enddo
endif
@@ -369,9 +376,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
if (CS%debug) then
if (CS%visc_drag) &
call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI, &
- scale=US%Z_to_m*US%s_to_T, scalar_pair=.true.)
+ scale=GV%H_to_mks*US%s_to_T, scalar_pair=.true.)
call hchksum(mass, 'MEKE mass',G%HI,haloshift=1, scale=US%RZ_to_kg_m2)
- call hchksum(drag_rate_visc, 'MEKE drag_rate_visc', G%HI, scale=US%L_T_to_m_s)
+ call hchksum(drag_rate_visc, 'MEKE drag_rate_visc', G%HI, scale=GV%H_to_mks*US%s_to_T)
call hchksum(bottomFac2, 'MEKE bottomFac2', G%HI)
call hchksum(barotrFac2, 'MEKE barotrFac2', G%HI)
call hchksum(LmixScale, 'MEKE LmixScale', G%HI,scale=US%L_to_m)
@@ -402,7 +409,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
!$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / &
- (GV%Rho0 * MAX(CS%MEKE_min_depth_tot, depth_tot(i,j)))
+ (GV%H_to_RZ * MAX(CS%MEKE_min_depth_tot, depth_tot(i,j)))
enddo ; enddo
else
!$OMP parallel do default(shared)
@@ -413,7 +420,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
endif
if (CS%MEKE_equilibrium_restoring) then
- call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, &
+ call MEKE_equilibrium_restoring(CS, G, GV, US, SN_u, SN_v, depth_tot, &
equilibrium_value)
do j=js,je ; do i=is,ie
src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - equilibrium_value(i,j))
@@ -434,7 +441,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies)
!$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
- drag_rate(i,j) = (US%L_to_Z*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
+ drag_rate(i,j) = (GV%H_to_RZ * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) )
enddo ; enddo
else
@@ -607,7 +614,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
if (use_drag_rate) then
!$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
- drag_rate(i,j) = (US%L_to_Z*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
+ drag_rate(i,j) = (GV%H_to_RZ * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) )
enddo ; enddo
endif
@@ -642,6 +649,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
call MOM_error(FATAL,"Invalid method specified for calculating EKE")
end select
+ if (CS%MEKE_positive) then
+ !$OMP parallel do default(shared)
+ do j=js,je ; do i=is,ie
+ MEKE%MEKE(i,j) = MAX(0., MEKE%MEKE(i,j))
+ enddo ; enddo
+ endif
+
call cpu_clock_begin(CS%id_clock_pass)
call do_group_pass(CS%pass_MEKE, G%Domain)
call cpu_clock_end(CS%id_clock_pass)
@@ -753,20 +767,19 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1].
real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1].
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution
- !! to the MEKE drag rate [L T-1 ~> m s-1]
+ !! to the MEKE drag rate [H T-1 ~> m s-1 or kg m-2 s-1]
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [R-1 Z-1 ~> m2 kg-1].
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The thickness of the water column [H ~> m or kg m-2].
! Local variables
real :: beta ! Combined topographic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1]
real :: SN ! The local Eady growth rate [T-1 ~> s-1]
real :: bottomFac2, barotrFac2 ! Vertical structure factors [nondim]
real :: LmixScale, LRhines, LEady ! Various mixing length scales [L ~> m]
- real :: I_H ! The inverse of the total column mass, converted to an inverse horizontal length [L-1 ~> m-1]
real :: KhCoeff ! A copy of MEKE_KhCoeff from the control structure [nondim]
real :: Kh ! A lateral diffusivity [L2 T-1 ~> m2 s-1]
real :: Ubg2 ! Background (tidal?) velocity squared [L2 T-2 ~> m2 s-2]
- real :: cd2 ! The square of the drag coefficient [nondim]
+ real :: cd2 ! The square of the drag coefficient times unit conversion factors [H2 L-2 ~> nondim or kg2 m-6]
real :: drag_rate ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1].
real :: src ! The sum of MEKE sources [L2 T-3 ~> W kg-1]
real :: ldamping ! The MEKE damping rate [T-1 ~> s-1].
@@ -774,7 +787,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
real :: resid, ResMin, ResMax ! Residuals [L2 T-3 ~> W kg-1]
real :: FatH ! Coriolis parameter at h points; to compute topographic beta [T-1 ~> s-1]
real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1]
- real :: dZ_neglect ! A negligible change in height [Z ~> m]
+ real :: h_neglect ! A negligible thickness [H ~> m or kg m-2]
integer :: i, j, is, ie, js, je, n1, n2
real :: tolerance ! Width of EKE bracket [L2 T-2 ~> m2 s-2].
logical :: useSecant, debugIteration
@@ -786,7 +799,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
Ubg2 = CS%MEKE_Uscale**2
cd2 = CS%cdrag**2
tolerance = 1.0e-12*US%m_s_to_L_T**2
- dZ_neglect = GV%H_to_Z*GV%H_subroundoff
+ h_neglect = GV%H_subroundoff
!$OMP do
do j=js,je ; do i=is,ie
@@ -795,7 +808,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1))
if (CS%MEKE_equilibrium_alt) then
- MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2
+ MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * depth_tot(i,j))**2 / cd2
else
FatH = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + &
(G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points
@@ -807,21 +820,19 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
!### Consider different combinations of these estimates of topographic beta.
beta_topo_x = -CS%MEKE_topographic_beta * FatH * 0.5 * ( &
(depth_tot(i+1,j)-depth_tot(i,j)) * G%IdxCu(I,j) &
- / max(depth_tot(i+1,j), depth_tot(i,j), dZ_neglect) &
+ / max(depth_tot(i+1,j), depth_tot(i,j), h_neglect) &
+ (depth_tot(i,j)-depth_tot(i-1,j)) * G%IdxCu(I-1,j) &
- / max(depth_tot(i,j), depth_tot(i-1,j), dZ_neglect) )
+ / max(depth_tot(i,j), depth_tot(i-1,j), h_neglect) )
beta_topo_y = -CS%MEKE_topographic_beta * FatH * 0.5 * ( &
(depth_tot(i,j+1)-depth_tot(i,j)) * G%IdyCv(i,J) &
- / max(depth_tot(i,j+1), depth_tot(i,j), dZ_neglect) + &
+ / max(depth_tot(i,j+1), depth_tot(i,j), h_neglect) + &
(depth_tot(i,j)-depth_tot(i,j-1)) * G%IdyCv(i,J-1) &
- / max(depth_tot(i,j), depth_tot(i,j-1), dZ_neglect) )
+ / max(depth_tot(i,j), depth_tot(i,j-1), h_neglect) )
endif
beta = sqrt((G%dF_dx(i,j) + beta_topo_x)**2 + &
(G%dF_dy(i,j) + beta_topo_y)**2 )
- I_H = US%L_to_Z*GV%Rho0 * I_mass(i,j)
-
- if (KhCoeff*SN*I_H>0.) then
+ if (KhCoeff*SN*I_mass(i,j)>0.) then
! Solve resid(E) = 0, where resid = Kh(E) * (SN)^2 - damp_rate(E) E
EKEmin = 0. ! Use the trivial root as the left bracket
ResMin = 0. ! Need to detect direction of left residual
@@ -839,7 +850,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
! TODO: Should include resolution function in Kh
Kh = (KhCoeff * sqrt(2.*barotrFac2*EKE) * LmixScale)
src = Kh * (SN * SN)
- drag_rate = I_H * sqrt(drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) )
+ drag_rate = (GV%H_to_RZ * I_mass(i,j)) * sqrt(drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) )
ldamping = CS%MEKE_damping + drag_rate * bottomFac2
resid = src - ldamping * EKE
! if (debugIteration) then
@@ -879,7 +890,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
! TODO: Should include resolution function in Kh
Kh = (KhCoeff * sqrt(2.*barotrFac2*EKE) * LmixScale)
src = Kh * (SN * SN)
- drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) )
+ drag_rate = (GV%H_to_RZ * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) )
ldamping = CS%MEKE_damping + drag_rate * bottomFac2
resid = src - ldamping * EKE
if (useSecant .and. resid>ResMin) useSecant = .false.
@@ -908,14 +919,15 @@ end subroutine MEKE_equilibrium
!< This subroutine calculates a new equilibrium value for MEKE at each time step. This is not copied into
!! MEKE%MEKE; rather, it is used as a restoring term to nudge MEKE%MEKE back to an equilibrium value
-subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, &
+subroutine MEKE_equilibrium_restoring(CS, G, GV, US, SN_u, SN_v, depth_tot, &
equilibrium_value)
type(ocean_grid_type), intent(inout) :: G !< Ocean grid.
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type.
type(MEKE_CS), intent(in) :: CS !< MEKE control structure.
real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1].
real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1].
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The thickness of the water column [H ~> m or kg m-2].
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: equilibrium_value
!< Equilbrium value of MEKE to be calculated at each time step [L2 T-2 ~> m2 s-2]
@@ -933,7 +945,7 @@ subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, &
! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.)
! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v
SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1))
- equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2
+ equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * depth_tot(i,j))**2 / cd2
enddo ; enddo
if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, equilibrium_value, CS%diag)
@@ -952,7 +964,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, &
real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1].
real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1].
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2].
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The thickness of the water column [H ~> m or kg m-2].
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 [nondim]
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 [nondim]
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [L ~> m].
@@ -962,11 +974,11 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, &
real :: SN ! The local Eady growth rate [T-1 ~> s-1]
real :: FatH ! Coriolis parameter at h points [T-1 ~> s-1]
real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1]
- real :: dZ_neglect ! A negligible change in height [Z ~> m]
+ real :: h_neglect ! A negligible thickness [H ~> m or kg m-2]
integer :: i, j, is, ie, js, je
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- dZ_neglect = GV%H_to_Z*GV%H_subroundoff
+ h_neglect = GV%H_subroundoff
!$OMP do
do j=js,je ; do i=is,ie
@@ -988,14 +1000,14 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, &
!### Consider different combinations of these estimates of topographic beta.
beta_topo_x = -CS%MEKE_topographic_beta * FatH * 0.5 * ( &
(depth_tot(i+1,j)-depth_tot(i,j)) * G%IdxCu(I,j) &
- / max(depth_tot(i+1,j), depth_tot(i,j), dZ_neglect) &
+ / max(depth_tot(i+1,j), depth_tot(i,j), h_neglect) &
+ (depth_tot(i,j)-depth_tot(i-1,j)) * G%IdxCu(I-1,j) &
- / max(depth_tot(i,j), depth_tot(i-1,j), dZ_neglect) )
+ / max(depth_tot(i,j), depth_tot(i-1,j), h_neglect) )
beta_topo_y = -CS%MEKE_topographic_beta * FatH * 0.5 * ( &
(depth_tot(i,j+1)-depth_tot(i,j)) * G%IdyCv(i,J) &
- / max(depth_tot(i,j+1), depth_tot(i,j), dZ_neglect) + &
+ / max(depth_tot(i,j+1), depth_tot(i,j), h_neglect) + &
(depth_tot(i,j)-depth_tot(i,j-1)) * G%IdyCv(i,J-1) &
- / max(depth_tot(i,j), depth_tot(i,j-1), dZ_neglect) )
+ / max(depth_tot(i,j), depth_tot(i,j-1), h_neglect) )
endif
beta = sqrt((G%dF_dx(i,j) + beta_topo_x)**2 + &
(G%dF_dy(i,j) + beta_topo_y)**2 )
@@ -1017,13 +1029,13 @@ end subroutine MEKE_lengthScales
!> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$
!! functions that are ratios of either bottom or barotropic eddy energy to the
!! column eddy energy, respectively. See \ref section_MEKE_equations.
-subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, &
+subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth_tot, Rd_dx, SN, EKE, &
bottomFac2, barotrFac2, LmixScale, Lrhines, Leady)
type(MEKE_CS), intent(in) :: CS !< MEKE control structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, intent(in) :: area !< Grid cell area [L2 ~> m2]
real, intent(in) :: beta !< Planetary beta = \f$ \nabla f\f$ [T-1 L-1 ~> s-1 m-1]
- real, intent(in) :: depth !< Ocean depth [Z ~> m]
+ real, intent(in) :: depth_tot !< The total thickness of the water column [H ~> m or kg m-2]
real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim].
real, intent(in) :: SN !< Eady growth rate [T-1 ~> s-1].
real, intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2].
@@ -1039,7 +1051,7 @@ subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, &
! Length scale for MEKE derived diffusivity
Lgrid = sqrt(area) ! Grid scale
Ldeform = Lgrid * Rd_dx ! Deformation scale
- Lfrict = (US%Z_to_L * depth) / CS%cdrag ! Frictional arrest scale
+ Lfrict = depth_tot / CS%cdrag ! Frictional arrest scale
! gamma_b^2 is the ratio of bottom eddy energy to mean column eddy energy
! used in calculating bottom drag
bottomFac2 = CS%MEKE_CD_SCALE**2
@@ -1088,12 +1100,13 @@ end subroutine MEKE_lengthScales_0d
!> Initializes the MOM_MEKE module and reads parameters.
!! Returns True if module is to be used, otherwise returns False.
-logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, restart_CS, meke_in_dynamics)
+logical function MEKE_init(Time, G, GV, US, param_file, diag, dbcomms_CS, CS, MEKE, restart_CS, meke_in_dynamics)
type(time_type), intent(in) :: Time !< The current model time.
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< Parameter file parser structure.
- type(dbcomms_CS_type), intent(in) :: dbcomms_CS !< Database communications control structure
+ type(dbcomms_CS_type), intent(in) :: dbcomms_CS !< Database communications control structure
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure.
type(MEKE_CS), intent(inout) :: CS !< MEKE control structure.
type(MEKE_type), intent(inout) :: MEKE !< MEKE fields
@@ -1102,7 +1115,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE,
!! otherwise in tracer dynamics
! Local variables
- real :: MEKE_restoring_timescale ! The timescale used to nudge MEKE toward its equilibrium value [T ~> s]
+ real :: MEKE_restoring_timescale ! The timescale used to nudge MEKE toward its equilibrium value [T ~> s]
real :: cdrag ! The default bottom drag coefficient [nondim].
character(len=200) :: eke_filename, eke_varname, inputdir
character(len=16) :: eke_source_str
@@ -1223,6 +1236,9 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE,
call get_param(param_file, mdl, "MEKE_DTSCALE", CS%MEKE_dtScale, &
"A scaling factor to accelerate the time evolution of MEKE.", &
units="nondim", default=1.0)
+ call get_param(param_file, mdl, "MEKE_POSITIVE", CS%MEKE_positive, &
+ "If true, it guarantees that MEKE will always be >= 0.", &
+ default=.false.)
case("dbclient")
CS%eke_src = EKE_DBCLIENT
call ML_MEKE_init(diag, G, US, Time, param_file, dbcomms_CS, CS)
@@ -1247,7 +1263,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE,
call get_param(param_file, mdl, "MEKE_MIN_DEPTH_TOT", CS%MEKE_min_depth_tot, &
"The minimum total depth over which to distribute MEKE energy sources. "//&
"When the total depth is less than this, the sources are scaled away.", &
- units="m", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%GM_src_alt)
+ units="m", default=1.0, scale=GV%m_to_H, do_not_log=.not.CS%GM_src_alt)
call get_param(param_file, mdl, "MEKE_VISC_DRAG", CS%visc_drag, &
"If true, use the vertvisc_type to calculate the bottom "//&
"drag acting on MEKE.", default=.true.)
@@ -1295,6 +1311,11 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE,
"If true, use the nominal bathymetric depth as the estimate of the "//&
"time-varying ocean depth. Otherwise base the depth on the total ocean mass"//&
"per unit area.", default=.true.)
+ call get_param(param_file, mdl, "MEKE_TOTAL_DEPTH_RHO", CS%rho_fixed_total_depth, &
+ "A density used to translate the nominal bathymetric depth into an estimate "//&
+ "of the total ocean mass per unit area when MEKE_FIXED_TOTAL_DEPTH is true.", &
+ units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=(GV%Boussinesq.or.(.not.CS%fixed_total_depth)))
call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, &
"If positive, is a coefficient weighting the deformation scale "//&
@@ -1347,7 +1368,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE,
"field to the bottom stress.", units="nondim", default=0.003)
call get_param(param_file, mdl, "MEKE_CDRAG", CS%cdrag, &
"Drag coefficient relating the magnitude of the velocity "//&
- "field to the bottom stress in MEKE.", units="nondim", default=cdrag)
+ "field to the bottom stress in MEKE.", units="nondim", default=cdrag, scale=US%L_to_m*GV%m_to_H)
call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.)
call get_param(param_file, mdl, "BIHARMONIC", biharmonic, default=.false., do_not_log=.true.)
@@ -1577,7 +1598,8 @@ subroutine ML_MEKE_calculate_features(G, GV, US, CS, Rd_dx_h, u, v, tv, h, dt, f
h_v(i,J,k) = 0.5*(h(i,j,k)*G%mask2dT(i,j) + h(i,j+1,k)*G%mask2dT(i,j+1)) + GV%Angstrom_H
enddo; enddo; enddo;
call find_eta(h, tv, G, GV, US, e, halo_size=2)
- call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*1.e-7, .false., slope_x, slope_y)
+ ! Note the hard-coded dimenisional constant in the following line.
+ call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*1.e-7*GV%m2_s_to_HZ_T, .false., slope_x, slope_y)
call pass_vector(slope_x, slope_y, G%Domain)
do j=js-1,je+1; do i=is-1,ie+1
slope_x_vert_avg(I,j) = vertical_average_interface(slope_x(i,j,:), h_u(i,j,:), GV%H_subroundoff)
diff --git a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90
index 500e4a508c..b49d123377 100644
--- a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90
+++ b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90
@@ -1,23 +1,26 @@
-! > Calculates Zanna and Bolton 2020 parameterization
+!> Calculates Zanna and Bolton 2020 parameterization
+!! Implemented by Perezhogin P.A. Contact: pperezhogin@gmail.com
module MOM_Zanna_Bolton
+! This file is part of MOM6. See LICENSE.md for the license.
use MOM_grid, only : ocean_grid_type
use MOM_verticalGrid, only : verticalGrid_type
use MOM_diag_mediator, only : diag_ctrl, time_type
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_unit_scaling, only : unit_scale_type
use MOM_diag_mediator, only : post_data, register_diag_field
-use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
+use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type, &
+ start_group_pass, complete_group_pass
use MOM_domains, only : To_North, To_East
use MOM_domains, only : pass_var, CORNER
-use MOM_coms, only : reproducing_sum, max_across_PEs, min_across_PEs
-use MOM_error_handler, only : MOM_error, WARNING
+use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
+use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE
implicit none ; private
#include
-public Zanna_Bolton_2020, ZB_2020_init
+public ZB2020_lateral_stress, ZB2020_init, ZB2020_end, ZB2020_copy_gradient_and_thickness
!> Control structure for Zanna-Bolton-2020 parameterization.
type, public :: ZB2020_CS ; private
@@ -31,50 +34,86 @@ module MOM_Zanna_Bolton
integer :: ZB_cons !< Select a discretization scheme for ZB model
!! 0 - non-conservative scheme
!! 1 - conservative scheme for deviatoric component
- integer :: LPF_iter !< Number of smoothing passes for the Velocity Gradient (VG) components
- !! in ZB model.
- integer :: LPF_order !< The scale selectivity of the smoothing filter
- !! 1 - Laplacian filter
- !! 2 - Bilaplacian filter
integer :: HPF_iter !< Number of sharpening passes for the Velocity Gradient (VG) components
!! in ZB model.
- integer :: HPF_order !< The scale selectivity of the sharpening filter
- !! 1 - Laplacian filter
- !! 2 - Bilaplacian filter
integer :: Stress_iter !< Number of smoothing passes for the Stress tensor components
!! in ZB model.
- integer :: Stress_order !< The scale selectivity of the smoothing filter
- !! 1 - Laplacian filter
- !! 2 - Bilaplacian filter
- integer :: ssd_iter !< Hyperviscosity parameter. Defines the number of sharpening passes
- !! in Laplacian viscosity model:
- !! -1: hyperviscosity is off
- !! 0: Laplacian viscosity
- !! 9: (Laplacian)^10 viscosity, ...
- real :: ssd_bound_coef !< The non-dimensional damping coefficient of the grid harmonic
- !! by hyperviscous dissipation:
- !! 0.0: no damping
- !! 1.0: grid harmonic is removed after a step in time
- real :: DT !< The (baroclinic) dynamics time step [T ~> s]
+ real :: Klower_R_diss !< Attenuation of
+ !! the ZB parameterization in the regions of
+ !! geostrophically-unbalanced flows (Klower 2018, Juricke2020,2019)
+ !! Subgrid stress is multiplied by 1/(1+(shear/(f*R_diss)))
+ !! R_diss=-1: attenuation is not used; typical value R_diss=1.0 [nondim]
+ integer :: Klower_shear !< Type of expression for shear in Klower formula
+ !! 0: sqrt(sh_xx**2 + sh_xy**2)
+ !! 1: sqrt(sh_xx**2 + sh_xy**2 + vort_xy**2)
+ integer :: Marching_halo !< The number of filter iterations per a single MPI
+ !! exchange
+
+ real, dimension(:,:,:), allocatable :: &
+ sh_xx, & !< Horizontal tension (du/dx - dv/dy) in h (CENTER)
+ !! points including metric terms [T-1 ~> s-1]
+ sh_xy, & !< Horizontal shearing strain (du/dy + dv/dx) in q (CORNER)
+ !! points including metric terms [T-1 ~> s-1]
+ vort_xy, & !< Vertical vorticity (dv/dx - du/dy) in q (CORNER)
+ !! points including metric terms [T-1 ~> s-1]
+ hq !< Thickness in CORNER points [H ~> m or kg m-2]
+
+ real, dimension(:,:,:), allocatable :: &
+ Txx, & !< Subgrid stress xx component in h [L2 T-2 ~> m2 s-2]
+ Tyy, & !< Subgrid stress yy component in h [L2 T-2 ~> m2 s-2]
+ Txy !< Subgrid stress xy component in q [L2 T-2 ~> m2 s-2]
+
+ real, dimension(:,:), allocatable :: &
+ kappa_h, & !< Scaling coefficient in h points [L2 ~> m2]
+ kappa_q !< Scaling coefficient in q points [L2 ~> m2]
+
+ real, allocatable :: &
+ ICoriolis_h(:,:), & !< Inverse Coriolis parameter at h points [T ~> s]
+ c_diss(:,:,:) !< Attenuation parameter at h points
+ !! (Klower 2018, Juricke2019,2020) [nondim]
+
+ real, dimension(:,:), allocatable :: &
+ maskw_h, & !< Mask of land point at h points multiplied by filter weight [nondim]
+ maskw_q !< Same mask but for q points [nondim]
type(diag_ctrl), pointer :: diag => NULL() !< A type that regulates diagnostics output
!>@{ Diagnostic handles
integer :: id_ZB2020u = -1, id_ZB2020v = -1, id_KE_ZB2020 = -1
- integer :: id_maskT = -1
- integer :: id_maskq = -1
- integer :: id_S_11 = -1
- integer :: id_S_22 = -1
- integer :: id_S_12 = -1
+ integer :: id_Txx = -1
+ integer :: id_Tyy = -1
+ integer :: id_Txy = -1
+ integer :: id_cdiss = -1
+ !>@}
+
+ !>@{ CPU time clock IDs
+ integer :: id_clock_module
+ integer :: id_clock_copy
+ integer :: id_clock_cdiss
+ integer :: id_clock_stress
+ integer :: id_clock_divergence
+ integer :: id_clock_mpi
+ integer :: id_clock_filter
+ integer :: id_clock_post
+ integer :: id_clock_source
+ !>@}
+
+ !>@{ MPI group passes
+ type(group_pass_type) :: &
+ pass_Tq, pass_Th, & !< handles for halo passes of Txy and Txx, Tyy
+ pass_xx, pass_xy !< handles for halo passes of sh_xx and sh_xy, vort_xy
+ integer :: Stress_halo = -1, & !< The halo size in filter of the stress tensor
+ HPF_halo = -1 !< The halo size in filter of the velocity gradient
!>@}
end type ZB2020_CS
contains
-!> Read parameters and register output fields
-!! used in Zanna_Bolton_2020().
-subroutine ZB_2020_init(Time, GV, US, param_file, diag, CS, use_ZB2020)
+!> Read parameters, allocate and precompute arrays,
+!! register diagnosicts used in Zanna_Bolton_2020().
+subroutine ZB2020_init(Time, G, GV, US, param_file, diag, CS, use_ZB2020)
type(time_type), intent(in) :: Time !< The current model time.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< Parameter file parser structure.
@@ -82,10 +121,19 @@ subroutine ZB_2020_init(Time, GV, US, param_file, diag, CS, use_ZB2020)
type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
logical, intent(out) :: use_ZB2020 !< If true, turns on ZB scheme.
+ real :: subroundoff_Cor ! A negligible parameter which avoids division by zero
+ ! but small compared to Coriolis parameter [T-1 ~> s-1]
+
+ integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq
+ integer :: i, j
+
! This include declares and sets the variable "version".
#include "version_variable.h"
character(len=40) :: mdl = "MOM_Zanna_Bolton" ! This module's name.
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+
call log_version(param_file, mdl, version, "")
call get_param(param_file, mdl, "USE_ZB2020", use_ZB2020, &
@@ -95,7 +143,7 @@ subroutine ZB_2020_init(Time, GV, US, param_file, diag, CS, use_ZB2020)
call get_param(param_file, mdl, "ZB_SCALING", CS%amplitude, &
"The nondimensional scaling factor in ZB model, " //&
- "typically 0.1 - 10.", units="nondim", default=0.3)
+ "typically 0.5-2.5", units="nondim", default=0.5)
call get_param(param_file, mdl, "ZB_TRACE_MODE", CS%ZB_type, &
"Select how to compute the trace part of ZB model:\n" //&
@@ -108,59 +156,31 @@ subroutine ZB_2020_init(Time, GV, US, param_file, diag, CS, use_ZB2020)
"\t 0 - non-conservative scheme\n" //&
"\t 1 - conservative scheme for deviatoric component", default=1)
- call get_param(param_file, mdl, "VG_SMOOTH_PASS", CS%LPF_iter, &
- "Number of smoothing passes for the Velocity Gradient (VG) components " //&
- "in ZB model.", default=0)
-
- call get_param(param_file, mdl, "VG_SMOOTH_SEL", CS%LPF_order, &
- "The scale selectivity of the smoothing filter " //&
- "for VG components:\n" //&
- "\t 1 - Laplacian filter\n" //&
- "\t 2 - Bilaplacian filter, ...", &
- default=1, do_not_log = CS%LPF_iter==0)
-
call get_param(param_file, mdl, "VG_SHARP_PASS", CS%HPF_iter, &
"Number of sharpening passes for the Velocity Gradient (VG) components " //&
"in ZB model.", default=0)
- call get_param(param_file, mdl, "VG_SHARP_SEL", CS%HPF_order, &
- "The scale selectivity of the sharpening filter " //&
- "for VG components:\n" //&
- "\t 1 - Laplacian filter\n" //&
- "\t 2 - Bilaplacian filter,...", &
- default=1, do_not_log = CS%HPF_iter==0)
-
call get_param(param_file, mdl, "STRESS_SMOOTH_PASS", CS%Stress_iter, &
"Number of smoothing passes for the Stress tensor components " //&
"in ZB model.", default=0)
- call get_param(param_file, mdl, "STRESS_SMOOTH_SEL", CS%Stress_order, &
- "The scale selectivity of the smoothing filter " //&
- "for the Stress tensor components:\n" //&
- "\t 1 - Laplacian filter\n" //&
- "\t 2 - Bilaplacian filter,...", &
- default=1, do_not_log = CS%Stress_iter==0)
-
- call get_param(param_file, mdl, "ZB_HYPERVISC", CS%ssd_iter, &
- "Select an additional hyperviscosity to stabilize the ZB model:\n" //&
- "\t 0 - off\n" //&
- "\t 1 - Laplacian viscosity\n" //&
- "\t 10 - (Laplacian)**10 viscosity, ...", &
- default=0)
- ! Convert to the number of sharpening passes
- ! applied to the Laplacian viscosity model
- CS%ssd_iter = CS%ssd_iter-1
-
- call get_param(param_file, mdl, "HYPVISC_GRID_DAMP", CS%ssd_bound_coef, &
- "The non-dimensional damping coefficient of the grid harmonic " //&
- "by hyperviscous dissipation:\n" //&
- "\t 0.0 - no damping\n" //&
- "\t 1.0 - grid harmonic is removed after a step in time", &
- units="nondim", default=0.2, do_not_log = CS%ssd_iter==-1)
-
- call get_param(param_file, mdl, "DT", CS%dt, &
- "The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T, &
- fail_if_missing=.true.)
+ call get_param(param_file, mdl, "ZB_KLOWER_R_DISS", CS%Klower_R_diss, &
+ "Attenuation of " //&
+ "the ZB parameterization in the regions of " //&
+ "geostrophically-unbalanced flows (Klower 2018, Juricke2020,2019). " //&
+ "Subgrid stress is multiplied by 1/(1+(shear/(f*R_diss))):\n" //&
+ "\t R_diss=-1. - attenuation is not used\n\t R_diss= 1. - typical value", &
+ units="nondim", default=-1.)
+
+ call get_param(param_file, mdl, "ZB_KLOWER_SHEAR", CS%Klower_shear, &
+ "Type of expression for shear in Klower formula:\n" //&
+ "\t 0: sqrt(sh_xx**2 + sh_xy**2)\n" //&
+ "\t 1: sqrt(sh_xx**2 + sh_xy**2 + vort_xy**2)", &
+ default=1, do_not_log=.not.CS%Klower_R_diss>0)
+
+ call get_param(param_file, mdl, "ZB_MARCHING_HALO", CS%Marching_halo, &
+ "The number of filter iterations per single MPI " //&
+ "exchange", default=4, do_not_log=(CS%Stress_iter==0).and.(CS%HPF_iter==0))
! Register fields for output from this module.
CS%diag => diag
@@ -173,726 +193,832 @@ subroutine ZB_2020_init(Time, GV, US, param_file, diag, CS, use_ZB2020)
'Kinetic Energy Source from Horizontal Viscosity', &
'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T)
- CS%id_maskT = register_diag_field('ocean_model', 'maskT', diag%axesTL, Time, &
- 'Mask of wet points in T (CENTER) points', '1', conversion=1.)
+ CS%id_Txx = register_diag_field('ocean_model', 'Txx', diag%axesTL, Time, &
+ 'Diagonal term (Txx) in the ZB stress tensor', 'm2 s-2', conversion=US%L_T_to_m_s**2)
+
+ CS%id_Tyy = register_diag_field('ocean_model', 'Tyy', diag%axesTL, Time, &
+ 'Diagonal term (Tyy) in the ZB stress tensor', 'm2 s-2', conversion=US%L_T_to_m_s**2)
+
+ CS%id_Txy = register_diag_field('ocean_model', 'Txy', diag%axesBL, Time, &
+ 'Off-diagonal term (Txy) in the ZB stress tensor', 'm2 s-2', conversion=US%L_T_to_m_s**2)
+
+ if (CS%Klower_R_diss > 0) then
+ CS%id_cdiss = register_diag_field('ocean_model', 'c_diss', diag%axesTL, Time, &
+ 'Klower (2018) attenuation coefficient', 'nondim')
+ endif
+
+ ! Clock IDs
+ ! Only module is measured with syncronization. While smaller
+ ! parts are measured without - because these are nested clocks.
+ CS%id_clock_module = cpu_clock_id('(Ocean Zanna-Bolton-2020)', grain=CLOCK_MODULE)
+ CS%id_clock_copy = cpu_clock_id('(ZB2020 copy fields)', grain=CLOCK_ROUTINE, sync=.false.)
+ CS%id_clock_cdiss = cpu_clock_id('(ZB2020 compute c_diss)', grain=CLOCK_ROUTINE, sync=.false.)
+ CS%id_clock_stress = cpu_clock_id('(ZB2020 compute stress)', grain=CLOCK_ROUTINE, sync=.false.)
+ CS%id_clock_divergence = cpu_clock_id('(ZB2020 compute divergence)', grain=CLOCK_ROUTINE, sync=.false.)
+ CS%id_clock_mpi = cpu_clock_id('(ZB2020 filter MPI exchanges)', grain=CLOCK_ROUTINE, sync=.false.)
+ CS%id_clock_filter = cpu_clock_id('(ZB2020 filter no MPI)', grain=CLOCK_ROUTINE, sync=.false.)
+ CS%id_clock_post = cpu_clock_id('(ZB2020 post data)', grain=CLOCK_ROUTINE, sync=.false.)
+ CS%id_clock_source = cpu_clock_id('(ZB2020 compute energy source)', grain=CLOCK_ROUTINE, sync=.false.)
+
+ ! Allocate memory
+ ! We set the stress tensor and velocity gradient tensor to zero
+ ! with full halo because they potentially may be filtered
+ ! with marching halo algorithm
+ allocate(CS%sh_xx(SZI_(G),SZJ_(G),SZK_(GV)), source=0.)
+ allocate(CS%sh_xy(SZIB_(G),SZJB_(G),SZK_(GV)), source=0.)
+ allocate(CS%vort_xy(SZIB_(G),SZJB_(G),SZK_(GV)), source=0.)
+ allocate(CS%hq(SZIB_(G),SZJB_(G),SZK_(GV)))
+
+ allocate(CS%Txx(SZI_(G),SZJ_(G),SZK_(GV)), source=0.)
+ allocate(CS%Tyy(SZI_(G),SZJ_(G),SZK_(GV)), source=0.)
+ allocate(CS%Txy(SZIB_(G),SZJB_(G),SZK_(GV)), source=0.)
+ allocate(CS%kappa_h(SZI_(G),SZJ_(G)))
+ allocate(CS%kappa_q(SZIB_(G),SZJB_(G)))
+
+ ! Precomputing the scaling coefficient
+ ! Mask is included to automatically satisfy B.C.
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ CS%kappa_h(i,j) = -CS%amplitude * G%areaT(i,j) * G%mask2dT(i,j)
+ enddo; enddo
+
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ CS%kappa_q(I,J) = -CS%amplitude * G%areaBu(I,J) * G%mask2dBu(I,J)
+ enddo; enddo
+
+ if (CS%Klower_R_diss > 0) then
+ allocate(CS%ICoriolis_h(SZI_(G),SZJ_(G)))
+ allocate(CS%c_diss(SZI_(G),SZJ_(G),SZK_(GV)))
+
+ subroundoff_Cor = 1e-30 * US%T_to_s
+ ! Precomputing 1/(f * R_diss)
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ CS%ICoriolis_h(i,j) = 1. / ((abs(0.25 * ((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) &
+ + (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1)))) + subroundoff_Cor) &
+ * CS%Klower_R_diss)
+ enddo; enddo
+ endif
+
+ if (CS%Stress_iter > 0 .or. CS%HPF_iter > 0) then
+ ! Include 1/16. factor to the mask for filter implementation
+ allocate(CS%maskw_h(SZI_(G),SZJ_(G))); CS%maskw_h(:,:) = G%mask2dT(:,:) * 0.0625
+ allocate(CS%maskw_q(SZIB_(G),SZJB_(G))); CS%maskw_q(:,:) = G%mask2dBu(:,:) * 0.0625
+ endif
+
+ ! Initialize MPI group passes
+ if (CS%Stress_iter > 0) then
+ ! reduce size of halo exchange accordingly to
+ ! Marching halo, number of iterations and the array size
+ ! But let exchange width be at least 1
+ CS%Stress_halo = max(min(CS%Marching_halo, CS%Stress_iter, &
+ G%Domain%nihalo, G%Domain%njhalo), 1)
+
+ call create_group_pass(CS%pass_Tq, CS%Txy, G%Domain, halo=CS%Stress_halo, &
+ position=CORNER)
+ call create_group_pass(CS%pass_Th, CS%Txx, G%Domain, halo=CS%Stress_halo)
+ call create_group_pass(CS%pass_Th, CS%Tyy, G%Domain, halo=CS%Stress_halo)
+ endif
+
+ if (CS%HPF_iter > 0) then
+ ! The minimum halo size is 2 because it is requirement for the
+ ! outputs of function filter_velocity_gradients
+ CS%HPF_halo = max(min(CS%Marching_halo, CS%HPF_iter, &
+ G%Domain%nihalo, G%Domain%njhalo), 2)
+
+ call create_group_pass(CS%pass_xx, CS%sh_xx, G%Domain, halo=CS%HPF_halo)
+ call create_group_pass(CS%pass_xy, CS%sh_xy, G%Domain, halo=CS%HPF_halo, &
+ position=CORNER)
+ call create_group_pass(CS%pass_xy, CS%vort_xy, G%Domain, halo=CS%HPF_halo, &
+ position=CORNER)
+ endif
+
+end subroutine ZB2020_init
- CS%id_maskq = register_diag_field('ocean_model', 'maskq', diag%axesBL, Time, &
- 'Mask of wet points in q (CORNER) points', '1', conversion=1.)
+!> Deallocate any variables allocated in ZB_2020_init
+subroutine ZB2020_end(CS)
+ type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
- ! action of filter on momentum flux
- CS%id_S_11 = register_diag_field('ocean_model', 'S_11', diag%axesTL, Time, &
- 'Diagonal term (11) in the ZB stress tensor', 'm2s-2', conversion=US%L_T_to_m_s**2)
+ deallocate(CS%sh_xx)
+ deallocate(CS%sh_xy)
+ deallocate(CS%vort_xy)
+ deallocate(CS%hq)
- CS%id_S_22 = register_diag_field('ocean_model', 'S_22', diag%axesTL, Time, &
- 'Diagonal term (22) in the ZB stress tensor', 'm2s-2', conversion=US%L_T_to_m_s**2)
+ deallocate(CS%Txx)
+ deallocate(CS%Tyy)
+ deallocate(CS%Txy)
+ deallocate(CS%kappa_h)
+ deallocate(CS%kappa_q)
- CS%id_S_12 = register_diag_field('ocean_model', 'S_12', diag%axesBL, Time, &
- 'Off-diagonal term in the ZB stress tensor', 'm2s-2', conversion=US%L_T_to_m_s**2)
+ if (CS%Klower_R_diss > 0) then
+ deallocate(CS%ICoriolis_h)
+ deallocate(CS%c_diss)
+ endif
+
+ if (CS%Stress_iter > 0 .or. CS%HPF_iter > 0) then
+ deallocate(CS%maskw_h)
+ deallocate(CS%maskw_q)
+ endif
+
+end subroutine ZB2020_end
+
+!> Save precomputed velocity gradients and thickness
+!! from the horizontal eddy viscosity module
+!! We save as much halo for velocity gradients as possible
+!! In symmetric (preferable) memory model: halo 2 for sh_xx
+!! and halo 1 for sh_xy and vort_xy
+!! We apply zero boundary conditions to velocity gradients
+!! which is required for filtering operations
+subroutine ZB2020_copy_gradient_and_thickness(sh_xx, sh_xy, vort_xy, hq, &
+ G, GV, CS, k)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
+
+ real, dimension(SZIB_(G),SZJB_(G)), &
+ intent(in) :: sh_xy !< horizontal shearing strain (du/dy + dv/dx)
+ !! including metric terms [T-1 ~> s-1]
+ real, dimension(SZIB_(G),SZJB_(G)), &
+ intent(in) :: vort_xy !< Vertical vorticity (dv/dx - du/dy)
+ !! including metric terms [T-1 ~> s-1]
+ real, dimension(SZIB_(G),SZJB_(G)), &
+ intent(in) :: hq !< harmonic mean of the harmonic means
+ !! of the u- & v point thicknesses [H ~> m or kg m-2]
+
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: sh_xx !< horizontal tension (du/dx - dv/dy)
+ !! including metric terms [T-1 ~> s-1]
+
+ integer, intent(in) :: k !< The vertical index of the layer to be passed.
+
+ integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq
+ integer :: i, j
+
+ call cpu_clock_begin(CS%id_clock_copy)
+
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+
+ do J=js-1,Jeq ; do I=is-1,Ieq
+ CS%hq(I,J,k) = hq(I,J)
+ enddo; enddo
+
+ ! No physical B.C. is required for
+ ! sh_xx in ZB2020. However, filtering
+ ! may require BC
+ do j=Jsq-1,je+2 ; do i=Isq-1,ie+2
+ CS%sh_xx(i,j,k) = sh_xx(i,j) * G%mask2dT(i,j)
+ enddo ; enddo
+
+ ! We multiply by mask to remove
+ ! implicit dependence on CS%no_slip
+ ! flag in hor_visc module
+ do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
+ CS%sh_xy(I,J,k) = sh_xy(I,J) * G%mask2dBu(I,J)
+ enddo; enddo
+
+ do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
+ CS%vort_xy(I,J,k) = vort_xy(I,J) * G%mask2dBu(I,J)
+ enddo; enddo
-end subroutine ZB_2020_init
+ call cpu_clock_end(CS%id_clock_copy)
+
+end subroutine ZB2020_copy_gradient_and_thickness
!> Baroclinic Zanna-Bolton-2020 parameterization, see
!! eq. 6 in https://laurezanna.github.io/files/Zanna-Bolton-2020.pdf
-!! We collect all contributions to a tensor S, with components:
-!! (S_11, S_12;
-!! S_12, S_22)
-!! Which consists of the deviatoric and trace components, respectively:
-!! S = (-vort_xy * sh_xy, vort_xy * sh_xx;
-!! vort_xy * sh_xx, vort_xy * sh_xy) +
-!! 1/2 * (vort_xy^2 + sh_xy^2 + sh_xx^2, 0;
-!! 0, vort_xy^2 + sh_xy^2 + sh_xx^2)
-!! Where:
-!! vort_xy = dv/dx - du/dy - relative vorticity
-!! sh_xy = dv/dx + du/dy - shearing deformation (or horizontal shear strain)
-!! sh_xx = du/dx - dv/dy - stretching deformation (or horizontal tension)
-!! Update of the governing equations:
-!! (du/dt, dv/dt) = k_BC * div(S)
-!! Where:
-!! k_BC = - amplitude * grid_cell_area
-!! amplitude = 0.1..10 (approx)
-
-subroutine Zanna_Bolton_2020(u, v, h, fx, fy, G, GV, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
- type(ZB2020_CS), intent(in) :: CS !< ZB2020 control structure.
+!! We compute the lateral stress tensor according to ZB2020 model
+!! and update the acceleration due to eddy viscosity (diffu, diffv)
+!! as follows:
+!! diffu = diffu + ZB2020u
+!! diffv = diffv + ZB2020v
+subroutine ZB2020_lateral_stress(u, v, h, diffu, diffv, G, GV, CS, &
+ dx2h, dy2h, dx2q, dy2q)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
+ type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1].
+ intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
- intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
+ intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2].
+ intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
- intent(out) :: fx !< Zonal acceleration due to convergence of
- !! along-coordinate stress tensor [L T-2 ~> m s-2]
+ intent(inout) :: diffu !< Zonal acceleration due to eddy viscosity.
+ !! It is updated with ZB closure [L T-2 ~> m s-2]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
- intent(out) :: fy !< Meridional acceleration due to convergence
- !! of along-coordinate stress tensor [L T-2 ~> m s-2]
-
- ! Arrays defined in h (CENTER) points
- real, dimension(SZI_(G),SZJ_(G)) :: &
- dx_dyT, & ! dx/dy at h points [nondim]
- dy_dxT, & ! dy/dx at h points [nondim]
- dx2h, & ! dx^2 at h points [L2 ~> m2]
- dy2h, & ! dy^2 at h points [L2 ~> m2]
- dudx, dvdy, & ! Components in the horizontal tension [T-1 ~> s-1]
- sh_xx, & ! Horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1]
- vort_xy_center, & ! Vorticity interpolated to the center [T-1 ~> s-1]
- sh_xy_center, & ! Shearing strain interpolated to the center [T-1 ~> s-1]
- S_11, S_22, & ! Diagonal terms in the ZB stress tensor:
- ! Above Line 539 [L2 T-2 ~> m2 s-2]
- ! Below Line 539 it is layer-integrated [H L2 T-2 ~> m3 s-2 or kg s-2]
- ssd_11, & ! Diagonal component of hyperviscous stress [L2 T-2 ~> m2 s-2]
- ssd_11_coef, & ! Viscosity coefficient in hyperviscous stress in center points
- ! [L2 T-1 ~> m2 s-1]
- mask_T ! Mask of wet points in T (CENTER) points [nondim]
-
- ! Arrays defined in q (CORNER) points
- real, dimension(SZIB_(G),SZJB_(G)) :: &
- dx_dyBu, & ! dx/dy at q points [nondim]
- dy_dxBu, & ! dy/dx at q points [nondim]
- dx2q, & ! dx^2 at q points [L2 ~> m2]
- dy2q, & ! dy^2 at q points [L2 ~> m2]
- dvdx, dudy, & ! Components in the shearing strain [T-1 ~> s-1]
- vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1]
- sh_xy, & ! Horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1]
- sh_xx_corner, & ! Horizontal tension interpolated to the corner [T-1 ~> s-1]
- S_12, & ! Off-diagonal term in the ZB stress tensor:
- ! Above Line 539 [L2 T-2 ~> m2 s-2]
- ! Below Line 539 it is layer-integrated [H L2 T-2 ~> m3 s-2 or kg s-2]
- ssd_12, & ! Off-diagonal component of hyperviscous stress [L2 T-2 ~> m2 s-2]
- ssd_12_coef, & ! Viscosity coefficient in hyperviscous stress in corner points
- ! [L2 T-1 ~> m2 s-1]
- mask_q ! Mask of wet points in q (CORNER) points [nondim]
-
- ! Thickness arrays for computing the horizontal divergence of the stress tensor
- real, dimension(SZIB_(G),SZJB_(G)) :: &
- hq ! Thickness in CORNER points [H ~> m or kg m-2].
- real, dimension(SZIB_(G),SZJ_(G)) :: &
- h_u ! Thickness interpolated to u points [H ~> m or kg m-2].
- real, dimension(SZI_(G),SZJB_(G)) :: &
- h_v ! Thickness interpolated to v points [H ~> m or kg m-2].
-
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
- mask_T_3d, & ! Mask of wet points in T (CENTER) points [nondim]
- S_11_3d, S_22_3d ! Diagonal terms in the ZB stress tensor [L2 T-2 ~> m2 s-2]
+ intent(inout) :: diffv !< Meridional acceleration due to eddy viscosity.
+ !! It is updated with ZB closure [L T-2 ~> m s-2]
- real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: &
- mask_q_3d, & ! Mask of wet points in q (CORNER) points [nondim]
- S_12_3d ! Off-diagonal term in the ZB stress tensor [L2 T-2 ~> m2 s-2]
-
- real :: h_neglect ! Thickness so small it can be lost in roundoff and so neglected [H ~> m or kg m-2]
- real :: h_neglect3 ! h_neglect^3 [H3 ~> m3 or kg3 m-6]
- real :: h2uq, h2vq ! Temporary variables [H2 ~> m2 or kg2 m-4].
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: dx2h !< dx^2 at h points [L2 ~> m2]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: dy2h !< dy^2 at h points [L2 ~> m2]
- real :: sum_sq ! 1/2*(vort_xy^2 + sh_xy^2 + sh_xx^2) [T-2 ~> s-2]
- real :: vort_sh ! vort_xy*sh_xy [T-2 ~> s-2]
-
- real :: k_bc ! Constant in from of the parameterization [L2 ~> m2]
- ! Related to the amplitude as follows:
- ! k_bc = - amplitude * grid_cell_area < 0
+ real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: dx2q !< dx^2 at q points [L2 ~> m2]
+ real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: dy2q !< dy^2 at q points [L2 ~> m2]
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
integer :: i, j, k, n
- ! Line 407 of MOM_hor_visc.F90
+ call cpu_clock_begin(CS%id_clock_module)
+
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- h_neglect = GV%H_subroundoff ! Line 410 on MOM_hor_visc.F90
- h_neglect3 = h_neglect**3
+ ! Compute attenuation if specified
+ call compute_c_diss(G, GV, CS)
- fx(:,:,:) = 0.
- fy(:,:,:) = 0.
+ ! Sharpen velocity gradients if specified
+ call filter_velocity_gradients(G, GV, CS)
- ! Calculate metric terms (line 2119 of MOM_hor_visc.F90)
- do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
- dx2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; dy2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J)
- DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J)
- enddo ; enddo
+ ! Compute the stress tensor given the
+ ! (optionally sharpened) velocity gradients
+ call compute_stress(G, GV, CS)
- ! Calculate metric terms (line 2122 of MOM_hor_visc.F90)
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- dx2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; dy2h(i,j) = G%dyT(i,j)*G%dyT(i,j)
- DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j)
- enddo ; enddo
+ ! Smooth the stress tensor if specified
+ call filter_stress(G, GV, CS)
- if (CS%ssd_iter > -1) then
- ssd_11_coef(:,:) = 0.
- ssd_12_coef(:,:) = 0.
- do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- ssd_11_coef(i,j) = ((CS%ssd_bound_coef * 0.25) / CS%DT) &
- * ((dx2h(i,j) * dy2h(i,j)) / (dx2h(i,j) + dy2h(i,j)))
- enddo; enddo
+ ! Update the acceleration due to eddy viscosity (diffu, diffv)
+ ! with the ZB2020 lateral parameterization
+ call compute_stress_divergence(u, v, h, diffu, diffv, &
+ dx2h, dy2h, dx2q, dy2q, &
+ G, GV, CS)
- do J=js-1,Jeq ; do I=is-1,Ieq
- ssd_12_coef(I,J) = ((CS%ssd_bound_coef * 0.25) / CS%DT) &
- * ((dx2q(I,J) * dy2q(I,J)) / (dx2q(I,J) + dy2q(I,J)))
- enddo; enddo
- endif
+ call cpu_clock_begin(CS%id_clock_post)
+ if (CS%id_Txx>0) call post_data(CS%id_Txx, CS%Txx, CS%diag)
+ if (CS%id_Tyy>0) call post_data(CS%id_Tyy, CS%Tyy, CS%diag)
+ if (CS%id_Txy>0) call post_data(CS%id_Txy, CS%Txy, CS%diag)
- do k=1,nz
+ if (CS%id_cdiss>0) call post_data(CS%id_cdiss, CS%c_diss, CS%diag)
+ call cpu_clock_end(CS%id_clock_post)
- sh_xx(:,:) = 0.
- sh_xy(:,:) = 0.
- vort_xy(:,:) = 0.
- S_12(:,:) = 0.
- S_11(:,:) = 0.
- S_22(:,:) = 0.
- ssd_11(:,:) = 0.
- ssd_12(:,:) = 0.
-
- ! Calculate horizontal tension (line 590 of MOM_hor_visc.F90)
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- dudx(i,j) = DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - &
- G%IdyCu(I-1,j) * u(I-1,j,k))
- dvdy(i,j) = DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - &
- G%IdxCv(i,J-1) * v(i,J-1,k))
- sh_xx(i,j) = dudx(i,j) - dvdy(i,j) ! center of the cell
- enddo ; enddo
+ call cpu_clock_end(CS%id_clock_module)
- ! Components for the shearing strain (line 599 of MOM_hor_visc.F90)
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- dvdx(I,J) = DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J))
- dudy(I,J) = DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j))
- enddo ; enddo
+end subroutine ZB2020_lateral_stress
- ! Shearing strain with free-slip B.C. (line 751 of MOM_hor_visc.F90)
- ! We use free-slip as cannot guarantee that non-diagonal stress
- ! will accelerate or decelerate currents
- ! Note that as there is no stencil operator, set of indices
- ! is identical to the previous loop, compared to MOM_hor_visc.F90
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- sh_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) + dudy(I,J) ) ! corner of the cell
- enddo ; enddo
+!> Compute the attenuation parameter similarly
+!! to Klower2018, Juricke2019,2020: c_diss = 1/(1+(shear/(f*R_diss)))
+!! where shear = sqrt(sh_xx**2 + sh_xy**2) or shear = sqrt(sh_xx**2 + sh_xy**2 + vort_xy**2)
+!! In symmetric memory model, components of velocity gradient tensor
+!! should have halo 1 and zero boundary conditions. The result: c_diss having halo 1.
+subroutine compute_c_diss(G, GV, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
- ! Relative vorticity with free-slip B.C. (line 789 of MOM_hor_visc.F90)
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) ! corner of the cell
- enddo ; enddo
+ integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
+ integer :: i, j, k, n
- call compute_masks(G, GV, h, mask_T, mask_q, k)
- if (CS%id_maskT>0) then
- do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- mask_T_3d(i,j,k) = mask_T(i,j)
- enddo; enddo
- endif
+ real :: shear ! Shear in Klower2018 formula at h points [T-1 ~> s-1]
- if (CS%id_maskq>0) then
- do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- mask_q_3d(i,j,k) = mask_q(i,j)
- enddo; enddo
- endif
+ if (.not. CS%Klower_R_diss > 0) &
+ return
- ! Numerical scheme for ZB2020 requires
- ! interpolation center <-> corner
- ! This interpolation requires B.C.,
- ! and that is why B.C. for Velocity Gradients should be
- ! well defined
- ! The same B.C. will be used by all filtering operators
- do J=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2
- sh_xx(i,j) = sh_xx(i,j) * mask_T(i,j)
- enddo ; enddo
+ call cpu_clock_begin(CS%id_clock_cdiss)
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- sh_xy(i,j) = sh_xy(i,j) * mask_q(i,j)
- vort_xy(i,j) = vort_xy(i,j) * mask_q(i,j)
- enddo ; enddo
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- if (CS%ssd_iter > -1) then
- do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- ssd_11(i,j) = sh_xx(i,j) * ssd_11_coef(i,j)
- enddo; enddo
+ do k=1,nz
- do J=js-1,Jeq ; do I=is-1,Ieq
- ssd_12(I,J) = sh_xy(I,J) * ssd_12_coef(I,J)
+ ! sqrt(sh_xx**2 + sh_xy**2)
+ if (CS%Klower_shear == 0) then
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ shear = sqrt(CS%sh_xx(i,j,k)**2 + 0.25 * ( &
+ (CS%sh_xy(I-1,J-1,k)**2 + CS%sh_xy(I,J ,k)**2) &
+ + (CS%sh_xy(I-1,J ,k)**2 + CS%sh_xy(I,J-1,k)**2) &
+ ))
+ CS%c_diss(i,j,k) = 1. / (1. + shear * CS%ICoriolis_h(i,j))
enddo; enddo
- if (CS%ssd_iter > 0) then
- call filter(G, mask_T, mask_q, -1, CS%ssd_iter, T=ssd_11)
- call filter(G, mask_T, mask_q, -1, CS%ssd_iter, q=ssd_12)
- endif
+ ! sqrt(sh_xx**2 + sh_xy**2 + vort_xy**2)
+ elseif (CS%Klower_shear == 1) then
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ shear = sqrt(CS%sh_xx(i,j,k)**2 + 0.25 * ( &
+ ((CS%sh_xy(I-1,J-1,k)**2 + CS%vort_xy(I-1,J-1,k)**2) &
+ + (CS%sh_xy(I,J,k)**2 + CS%vort_xy(I,J,k)**2)) &
+ + ((CS%sh_xy(I-1,J,k)**2 + CS%vort_xy(I-1,J,k)**2) &
+ + (CS%sh_xy(I,J-1,k)**2 + CS%vort_xy(I,J-1,k)**2)) &
+ ))
+ CS%c_diss(i,j,k) = 1. / (1. + shear * CS%ICoriolis_h(i,j))
+ enddo; enddo
endif
- call filter(G, mask_T, mask_q, -CS%HPF_iter, CS%HPF_order, T=sh_xx)
- call filter(G, mask_T, mask_q, +CS%LPF_iter, CS%LPF_order, T=sh_xx)
+ enddo ! end of k loop
- call filter(G, mask_T, mask_q, -CS%HPF_iter, CS%HPF_order, q=sh_xy)
- call filter(G, mask_T, mask_q, +CS%LPF_iter, CS%LPF_order, q=sh_xy)
+ call cpu_clock_end(CS%id_clock_cdiss)
- call filter(G, mask_T, mask_q, -CS%HPF_iter, CS%HPF_order, q=vort_xy)
- call filter(G, mask_T, mask_q, +CS%LPF_iter, CS%LPF_order, q=vort_xy)
+end subroutine compute_c_diss
- ! Corner to center interpolation (line 901 of MOM_hor_visc.F90)
- ! lower index as in loop for sh_xy, but minus 1
- ! upper index is identical
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- sh_xy_center(i,j) = 0.25 * ( (sh_xy(I-1,J-1) + sh_xy(I,J)) &
- + (sh_xy(I-1,J) + sh_xy(I,J-1)) )
- vort_xy_center(i,j) = 0.25 * ( (vort_xy(I-1,J-1) + vort_xy(I,J)) &
- + (vort_xy(I-1,J) + vort_xy(I,J-1)) )
- enddo ; enddo
+!> Compute stress tensor T =
+!! (Txx, Txy;
+!! Txy, Tyy)
+!! Which consists of the deviatoric and trace components, respectively:
+!! T = (-vort_xy * sh_xy, vort_xy * sh_xx;
+!! vort_xy * sh_xx, vort_xy * sh_xy) +
+!! 1/2 * (vort_xy^2 + sh_xy^2 + sh_xx^2, 0;
+!! 0, vort_xy^2 + sh_xy^2 + sh_xx^2)
+!! This stress tensor is multiplied by precomputed kappa=-CS%amplitude * G%area:
+!! T -> T * kappa
+!! The sign of the stress tensor is such that (neglecting h):
+!! (du/dt, dv/dt) = div(T)
+!! In symmetric memory model: sh_xy and vort_xy should have halo 1
+!! and zero B.C.; sh_xx should have halo 2 and zero B.C.
+!! Result: Txx, Tyy, Txy with halo 1 and zero B.C.
+subroutine compute_stress(G, GV, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
+
+ real :: &
+ vort_xy_h, & ! Vorticity interpolated to h point [T-1 ~> s-1]
+ sh_xy_h ! Shearing strain interpolated to h point [T-1 ~> s-1]
+
+ real :: &
+ sh_xx_q ! Horizontal tension interpolated to q point [T-1 ~> s-1]
+
+ ! Local variables
+ real :: sum_sq ! 1/2*(vort_xy^2 + sh_xy^2 + sh_xx^2) in h point [T-2 ~> s-2]
+ real :: vort_sh ! vort_xy*sh_xy in h point [T-2 ~> s-2]
- ! Center to corner interpolation
- ! lower index as in loop for sh_xx
- ! upper index as in the same loop, but minus 1
- do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- sh_xx_corner(I,J) = 0.25 * ( (sh_xx(i+1,j+1) + sh_xx(i,j)) &
- + (sh_xx(i+1,j) + sh_xx(i,j+1)))
- enddo ; enddo
+ integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
+ integer :: i, j, k, n
- ! WITH land mask (line 622 of MOM_hor_visc.F90)
- ! Use of mask eliminates dependence on the
- ! values on land
- do j=js-2,je+2 ; do I=Isq-1,Ieq+1
- h_u(I,j) = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i+1,j)*h(i+1,j,k))
- enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do i=is-2,ie+2
- h_v(i,J) = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i,j+1)*h(i,j+1,k))
- enddo ; enddo
+ logical :: sum_sq_flag ! Flag to compute trace
+ logical :: vort_sh_scheme_0, vort_sh_scheme_1 ! Flags to compute diagonal trace-free part
- ! Line 1187 of MOM_hor_visc.F90
- do J=js-1,Jeq ; do I=is-1,Ieq
- h2uq = 4.0 * (h_u(I,j) * h_u(I,j+1))
- h2vq = 4.0 * (h_v(i,J) * h_v(i+1,J))
- hq(I,J) = (2.0 * (h2uq * h2vq)) &
- / (h_neglect3 + (h2uq + h2vq) * ((h_u(I,j) + h_u(I,j+1)) + (h_v(i,J) + h_v(i+1,J))))
- enddo ; enddo
+ call cpu_clock_begin(CS%id_clock_stress)
- ! Form S_11 and S_22 tensors
- ! Indices - intersection of loops for
- ! sh_xy_center and sh_xx
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- if (CS%ZB_type == 1) then
- sum_sq = 0.
- else
- sum_sq = 0.5 * &
- (vort_xy_center(i,j)**2 + sh_xy_center(i,j)**2 + sh_xx(i,j)**2)
- endif
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- if (CS%ZB_type == 2) then
- vort_sh = 0.
- else
- if (CS%ZB_cons == 1) then
- vort_sh = 0.25 * ( &
- (G%areaBu(I-1,J-1) * vort_xy(I-1,J-1) * sh_xy(I-1,J-1) + &
- G%areaBu(I ,J ) * vort_xy(I ,J ) * sh_xy(I ,J )) + &
- (G%areaBu(I-1,J ) * vort_xy(I-1,J ) * sh_xy(I-1,J ) + &
- G%areaBu(I ,J-1) * vort_xy(I ,J-1) * sh_xy(I ,J-1)) &
- ) * G%IareaT(i,j)
- else if (CS%ZB_cons == 0) then
- vort_sh = vort_xy_center(i,j) * sh_xy_center(i,j)
- endif
+ sum_sq = 0.
+ vort_sh = 0.
+
+ sum_sq_flag = CS%ZB_type /= 1
+ vort_sh_scheme_0 = CS%ZB_type /= 2 .and. CS%ZB_cons == 0
+ vort_sh_scheme_1 = CS%ZB_type /= 2 .and. CS%ZB_cons == 1
+
+ do k=1,nz
+
+ ! compute Txx, Tyy tensor
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ ! It is assumed that B.C. is applied to sh_xy and vort_xy
+ sh_xy_h = 0.25 * ( (CS%sh_xy(I-1,J-1,k) + CS%sh_xy(I,J,k)) &
+ + (CS%sh_xy(I-1,J,k) + CS%sh_xy(I,J-1,k)) )
+
+ vort_xy_h = 0.25 * ( (CS%vort_xy(I-1,J-1,k) + CS%vort_xy(I,J,k)) &
+ + (CS%vort_xy(I-1,J,k) + CS%vort_xy(I,J-1,k)) )
+
+ if (sum_sq_flag) then
+ sum_sq = 0.5 * &
+ ((vort_xy_h * vort_xy_h &
+ + sh_xy_h * sh_xy_h) &
+ + CS%sh_xx(i,j,k) * CS%sh_xx(i,j,k) &
+ )
endif
- k_bc = - CS%amplitude * G%areaT(i,j)
- S_11(i,j) = k_bc * (- vort_sh + sum_sq)
- S_22(i,j) = k_bc * (+ vort_sh + sum_sq)
- enddo ; enddo
- ! Form S_12 tensor
- ! indices correspond to sh_xx_corner loop
- do J=Jsq-1,Jeq ; do I=Isq-1,Ieq
- if (CS%ZB_type == 2) then
- vort_sh = 0.
- else
- vort_sh = vort_xy(I,J) * sh_xx_corner(I,J)
+ if (vort_sh_scheme_0) &
+ vort_sh = vort_xy_h * sh_xy_h
+
+ if (vort_sh_scheme_1) then
+ ! It is assumed that B.C. is applied to sh_xy and vort_xy
+ vort_sh = 0.25 * ( &
+ ((G%areaBu(I-1,J-1) * CS%vort_xy(I-1,J-1,k)) * CS%sh_xy(I-1,J-1,k) + &
+ (G%areaBu(I ,J ) * CS%vort_xy(I ,J ,k)) * CS%sh_xy(I ,J ,k)) + &
+ ((G%areaBu(I-1,J ) * CS%vort_xy(I-1,J ,k)) * CS%sh_xy(I-1,J ,k) + &
+ (G%areaBu(I ,J-1) * CS%vort_xy(I ,J-1,k)) * CS%sh_xy(I ,J-1,k)) &
+ ) * G%IareaT(i,j)
endif
- k_bc = - CS%amplitude * G%areaBu(i,j)
- S_12(I,J) = k_bc * vort_sh
+
+ ! B.C. is already applied in kappa_h
+ CS%Txx(i,j,k) = CS%kappa_h(i,j) * (- vort_sh + sum_sq)
+ CS%Tyy(i,j,k) = CS%kappa_h(i,j) * (+ vort_sh + sum_sq)
+
enddo ; enddo
- call filter(G, mask_T, mask_q, CS%Stress_iter, CS%Stress_order, T=S_11)
- call filter(G, mask_T, mask_q, CS%Stress_iter, CS%Stress_order, T=S_22)
- call filter(G, mask_T, mask_q, CS%Stress_iter, CS%Stress_order, q=S_12)
+ ! Here we assume that Txy is initialized to zero
+ if (CS%ZB_type /= 2) then
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ sh_xx_q = 0.25 * ( (CS%sh_xx(i+1,j+1,k) + CS%sh_xx(i,j,k)) &
+ + (CS%sh_xx(i+1,j,k) + CS%sh_xx(i,j+1,k)))
+ ! B.C. is already applied in kappa_q
+ CS%Txy(I,J,k) = CS%kappa_q(I,J) * (CS%vort_xy(I,J,k) * sh_xx_q)
- if (CS%ssd_iter>-1) then
- do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- S_11(i,j) = S_11(i,j) + ssd_11(i,j)
- S_22(i,j) = S_22(i,j) - ssd_11(i,j)
- enddo ; enddo
- do J=js-1,Jeq ; do I=is-1,Ieq
- S_12(I,J) = S_12(I,J) + ssd_12(I,J)
enddo ; enddo
endif
- if (CS%id_S_11>0) then
- do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- S_11_3d(i,j,k) = S_11(i,j)
- enddo; enddo
- endif
+ enddo ! end of k loop
- if (CS%id_S_22>0) then
- do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- S_22_3d(i,j,k) = S_22(i,j)
- enddo; enddo
- endif
+ call cpu_clock_end(CS%id_clock_stress)
+
+end subroutine compute_stress
+
+!> Compute the divergence of subgrid stress
+!! weighted with thickness, i.e.
+!! (fx,fy) = 1/h Div(h * [Txx, Txy; Txy, Tyy])
+!! and update the acceleration due to eddy viscosity as
+!! diffu = diffu + dx; diffv = diffv + dy
+!! Optionally, before computing the divergence, we attenuate the stress
+!! according to the Klower formula.
+!! In symmetric memory model: Txx, Tyy, Txy, c_diss should have halo 1
+!! with applied zero B.C.
+subroutine compute_stress_divergence(u, v, h, diffu, diffv, dx2h, dy2h, dx2q, dy2q, G, GV, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(ZB2020_CS), intent(in) :: CS !< ZB2020 control structure.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1].
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
+ intent(out) :: diffu !< Zonal acceleration due to convergence of
+ !! along-coordinate stress tensor [L T-2 ~> m s-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
+ intent(out) :: diffv !< Meridional acceleration due to convergence
+ !! of along-coordinate stress tensor [L T-2 ~> m s-2]
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: dx2h !< dx^2 at h points [L2 ~> m2]
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: dy2h !< dy^2 at h points [L2 ~> m2]
+ real, dimension(SZIB_(G),SZJB_(G)), &
+ intent(in) :: dx2q !< dx^2 at q points [L2 ~> m2]
+ real, dimension(SZIB_(G),SZJB_(G)), &
+ intent(in) :: dy2q !< dy^2 at q points [L2 ~> m2]
+
+ ! Local variables
+ real, dimension(SZI_(G),SZJ_(G)) :: &
+ Mxx, & ! Subgrid stress Txx multiplied by thickness and dy^2 [H L4 T-2 ~> m5 s-2]
+ Myy ! Subgrid stress Tyy multiplied by thickness and dx^2 [H L4 T-2 ~> m5 s-2]
+
+ real, dimension(SZIB_(G),SZJB_(G)) :: &
+ Mxy ! Subgrid stress Txy multiplied by thickness [H L2 T-2 ~> m3 s-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: &
+ ZB2020u !< Zonal acceleration due to convergence of
+ !! along-coordinate stress tensor for ZB model
+ !! [L T-2 ~> m s-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: &
+ ZB2020v !< Meridional acceleration due to convergence
+ !! of along-coordinate stress tensor for ZB model
+ !! [L T-2 ~> m s-2]
+
+ real :: h_u ! Thickness interpolated to u points [H ~> m or kg m-2].
+ real :: h_v ! Thickness interpolated to v points [H ~> m or kg m-2].
+ real :: fx ! Zonal acceleration [L T-2 ~> m s-2]
+ real :: fy ! Meridional acceleration [L T-2 ~> m s-2]
+
+ real :: h_neglect ! Thickness so small it can be lost in
+ ! roundoff and so neglected [H ~> m or kg m-2]
+
+ integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
+ integer :: i, j, k
+ logical :: save_ZB2020u, save_ZB2020v ! Save the acceleration due to ZB2020 model
+
+ call cpu_clock_begin(CS%id_clock_divergence)
+
+ save_ZB2020u = (CS%id_ZB2020u > 0) .or. (CS%id_KE_ZB2020 > 0)
+ save_ZB2020v = (CS%id_ZB2020v > 0) .or. (CS%id_KE_ZB2020 > 0)
+
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- if (CS%id_S_12>0) then
+ h_neglect = GV%H_subroundoff
+
+ do k=1,nz
+ if (CS%Klower_R_diss > 0) then
do J=js-1,Jeq ; do I=is-1,Ieq
- S_12_3d(I,J,k) = S_12(I,J)
- enddo; enddo
+ Mxy(I,J) = (CS%Txy(I,J,k) * &
+ (0.25 * ( (CS%c_diss(i,j ,k) + CS%c_diss(i+1,j+1,k)) &
+ + (CS%c_diss(i,j+1,k) + CS%c_diss(i+1,j ,k))) &
+ ) &
+ ) * CS%hq(I,J,k)
+ enddo ; enddo
+ else
+ do J=js-1,Jeq ; do I=is-1,Ieq
+ Mxy(I,J) = CS%Txy(I,J,k) * CS%hq(I,J,k)
+ enddo ; enddo
endif
- ! Weight with interface height (Line 1478 of MOM_hor_visc.F90)
- ! Note that reduction is removed
- do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- S_11(i,j) = S_11(i,j) * h(i,j,k)
- S_22(i,j) = S_22(i,j) * h(i,j,k)
- enddo ; enddo
-
- ! Free slip (Line 1487 of MOM_hor_visc.F90)
- do J=js-1,Jeq ; do I=is-1,Ieq
- S_12(I,J) = S_12(I,J) * (hq(I,J) * G%mask2dBu(I,J))
- enddo ; enddo
+ if (CS%Klower_R_diss > 0) then
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ Mxx(i,j) = ((CS%Txx(i,j,k) * CS%c_diss(i,j,k)) * h(i,j,k)) * dy2h(i,j)
+ Myy(i,j) = ((CS%Tyy(i,j,k) * CS%c_diss(i,j,k)) * h(i,j,k)) * dx2h(i,j)
+ enddo ; enddo
+ else
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ Mxx(i,j) = ((CS%Txx(i,j,k)) * h(i,j,k)) * dy2h(i,j)
+ Myy(i,j) = ((CS%Tyy(i,j,k)) * h(i,j,k)) * dx2h(i,j)
+ enddo ; enddo
+ endif
! Evaluate 1/h x.Div(h S) (Line 1495 of MOM_hor_visc.F90)
! Minus occurs because in original file (du/dt) = - div(S),
! but here is the discretization of div(S)
do j=js,je ; do I=Isq,Ieq
- fx(I,j,k) = - ((G%IdyCu(I,j)*(dy2h(i,j) *S_11(i,j) - &
- dy2h(i+1,j)*S_11(i+1,j)) + &
- G%IdxCu(I,j)*(dx2q(I,J-1)*S_12(I,J-1) - &
- dx2q(I,J) *S_12(I,J))) * &
- G%IareaCu(I,j)) / (h_u(I,j) + h_neglect)
+ h_u = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i+1,j)*h(i+1,j,k)) + h_neglect
+ fx = -((G%IdyCu(I,j)*(Mxx(i,j) - &
+ Mxx(i+1,j)) + &
+ G%IdxCu(I,j)*(dx2q(I,J-1)*Mxy(I,J-1) - &
+ dx2q(I,J) *Mxy(I,J))) * &
+ G%IareaCu(I,j)) / h_u
+ diffu(I,j,k) = diffu(I,j,k) + fx
+ if (save_ZB2020u) &
+ ZB2020u(I,j,k) = fx
enddo ; enddo
! Evaluate 1/h y.Div(h S) (Line 1517 of MOM_hor_visc.F90)
do J=Jsq,Jeq ; do i=is,ie
- fy(i,J,k) = - ((G%IdyCv(i,J)*(dy2q(I-1,J)*S_12(I-1,J) - &
- dy2q(I,J) *S_12(I,J)) + & ! NOTE this plus
- G%IdxCv(i,J)*(dx2h(i,j) *S_22(i,j) - &
- dx2h(i,j+1)*S_22(i,j+1))) * &
- G%IareaCv(i,J)) / (h_v(i,J) + h_neglect)
+ h_v = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i,j+1)*h(i,j+1,k)) + h_neglect
+ fy = -((G%IdyCv(i,J)*(dy2q(I-1,J)*Mxy(I-1,J) - &
+ dy2q(I,J) *Mxy(I,J)) + & ! NOTE this plus
+ G%IdxCv(i,J)*(Myy(i,j) - &
+ Myy(i,j+1))) * &
+ G%IareaCv(i,J)) / h_v
+ diffv(i,J,k) = diffv(i,J,k) + fy
+ if (save_ZB2020v) &
+ ZB2020v(i,J,k) = fy
enddo ; enddo
enddo ! end of k loop
- if (CS%id_ZB2020u>0) call post_data(CS%id_ZB2020u, fx, CS%diag)
- if (CS%id_ZB2020v>0) call post_data(CS%id_ZB2020v, fy, CS%diag)
-
- if (CS%id_maskT>0) call post_data(CS%id_maskT, mask_T_3d, CS%diag)
- if (CS%id_maskq>0) call post_data(CS%id_maskq, mask_q_3d, CS%diag)
-
- if (CS%id_S_11>0) call post_data(CS%id_S_11, S_11_3d, CS%diag)
-
- if (CS%id_S_22>0) call post_data(CS%id_S_22, S_22_3d, CS%diag)
-
- if (CS%id_S_12>0) call post_data(CS%id_S_12, S_12_3d, CS%diag)
-
- call compute_energy_source(u, v, h, fx, fy, G, GV, CS)
-
-end subroutine Zanna_Bolton_2020
-
-!> Filter which is used to smooth velocity gradient tensor
-!! or the stress tensor.
-!! If n_lowpass and n_highpass are positive,
-!! the filter is given by:
-!! I - (I-G^n_lowpass)^n_highpass
-!! where I is the identity matrix and G is smooth_Tq().
-!! It is filter of order 2*n_highpass,
-!! where n_lowpass is the number of iterations
-!! which defines the filter scale.
-!! If n_lowpass is negative, returns residual
-!! for the same filter:
-!! (I-G^|n_lowpass|)^n_highpass
-!! Input does not require halo. Output has full halo.
-subroutine filter(G, mask_T, mask_q, n_lowpass, n_highpass, T, q)
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
- integer, intent(in) :: n_lowpass !< number of low-pass iterations
- integer, intent(in) :: n_highpass !< number of high-pass iterations
- real, dimension(SZI_(G),SZJ_(G)), &
- intent(in) :: mask_T !< mask of wet points in T (CENTER) points [nondim]
- real, dimension(SZIB_(G),SZJB_(G)), &
- intent(in) :: mask_q !< mask of wet points in q (CORNER) points [nondim]
- real, dimension(SZI_(G),SZJ_(G)), &
- optional, intent(inout) :: T !< any field at T (CENTER) points [arbitrary]
- real, dimension(SZIB_(G),SZJB_(G)), &
- optional, intent(inout) :: q !< any field at q (CORNER) points [arbitrary]
+ call cpu_clock_end(CS%id_clock_divergence)
- real, dimension(SZIB_(G),SZJB_(G)) :: q1, q2 ! intermediate q-fields [arbitrary]
- real, dimension(SZI_(G),SZJ_(G)) :: T1, T2 ! intermediate T-fields [arbitrary]
- real :: max_before, min_before, max_after, min_after ! minimum and maximum values of fields
- ! before and after filtering [arbitrary]
+ call cpu_clock_begin(CS%id_clock_post)
+ if (CS%id_ZB2020u>0) call post_data(CS%id_ZB2020u, ZB2020u, CS%diag)
+ if (CS%id_ZB2020v>0) call post_data(CS%id_ZB2020v, ZB2020v, CS%diag)
+ call cpu_clock_end(CS%id_clock_post)
- integer :: i_highpass, i_lowpass
- integer :: i, j
- integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq
+ call compute_energy_source(u, v, h, ZB2020u, ZB2020v, G, GV, CS)
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+end subroutine compute_stress_divergence
- if (n_lowpass==0) then
- return
- endif
+!> Filtering of the velocity gradients sh_xx, sh_xy, vort_xy.
+!! Here instead of smoothing we do sharpening, i.e.
+!! return (initial - smoothed) fields.
+!! The algorithm: marching halo with non-blocking grouped MPI
+!! exchanges. The input array sh_xx should have halo 2 with
+!! applied zero B.C. The arrays sh_xy and vort_xy should have
+!! halo 1 with applied B.C. The output have the same halo and B.C.
+subroutine filter_velocity_gradients(G, GV, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
- ! Total operator is I - (I-G^n_lowpass)^n_highpass
- if (present(q)) then
- call pass_var(q, G%Domain, position=CORNER, complete=.true.)
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- q(I,J) = q(I,J) * mask_q(I,J)
- enddo ; enddo
+ real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: &
+ sh_xx ! Copy of CS%sh_xx [T-1 ~> s-1]
+ real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: &
+ sh_xy, vort_xy ! Copy of CS%sh_xy and CS%vort_xy [T-1 ~> s-1]
- if (n_highpass==1 .AND. n_lowpass>0) then
- call min_max(G, min_before, max_before, q=q)
- endif
+ integer :: xx_halo, xy_halo, vort_halo ! currently available halo for gradient components
+ integer :: xx_iter, xy_iter, vort_iter ! remaining number of iterations
+ integer :: niter ! required number of iterations
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- q1(I,J) = q(I,J)
- enddo ; enddo
+ integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
+ integer :: i, j, k, n
- ! q1 -> ((I-G^n_lowpass)^n_highpass)*q1
- do i_highpass=1,n_highpass
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- q2(I,J) = q1(I,J)
- enddo ; enddo
- ! q2 -> (G^n_lowpass)*q2
- do i_lowpass=1,ABS(n_lowpass)
- call smooth_Tq(G, mask_T, mask_q, q=q2)
- enddo
- ! q1 -> (I-G^n_lowpass)*q1
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- q1(I,J) = q1(I,J) - q2(I,J)
- enddo ; enddo
- enddo
+ niter = CS%HPF_iter
- if (n_lowpass>0) then
- ! q -> q - ((I-G^n_lowpass)^n_highpass)*q
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- q(I,J) = q(I,J) - q1(I,J)
- enddo ; enddo
- else
- ! q -> ((I-G^n_lowpass)^n_highpass)*q
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- q(I,J) = q1(I,J)
- enddo ; enddo
- endif
+ if (niter == 0) return
- if (n_highpass==1 .AND. n_lowpass>0) then
- call min_max(G, min_after, max_after, q=q)
- if (max_after > max_before .OR. min_after < min_before) then
- call MOM_error(WARNING, "MOM_Zanna_Bolton.F90, filter applied in CORNER points "//&
- "does not preserve [min,max] values. There may be issues with "//&
- "boundary conditions")
- endif
- endif
- endif
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- if (present(T)) then
- call pass_var(T, G%Domain)
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- T(i,j) = T(i,j) * mask_T(i,j)
- enddo ; enddo
+ if (.not. G%symmetric) &
+ call do_group_pass(CS%pass_xx, G%Domain, &
+ clock=CS%id_clock_mpi)
- if (n_highpass==1 .AND. n_lowpass>0) then
- call min_max(G, min_before, max_before, T=T)
- endif
+ ! This is just copy of the array
+ call cpu_clock_begin(CS%id_clock_filter)
+ do k=1,nz
+ ! Halo of size 2 is valid
+ do j=js-2,je+2; do i=is-2,ie+2
+ sh_xx(i,j,k) = CS%sh_xx(i,j,k)
+ enddo; enddo
+ ! Only halo of size 1 is valid
+ do J=Jsq-1,Jeq+1; do I=Isq-1,Ieq+1
+ sh_xy(I,J,k) = CS%sh_xy(I,J,k)
+ vort_xy(I,J,k) = CS%vort_xy(I,J,k)
+ enddo; enddo
+ enddo
+ call cpu_clock_end(CS%id_clock_filter)
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- T1(i,j) = T(i,j)
- enddo ; enddo
+ xx_halo = 2; xy_halo = 1; vort_halo = 1;
+ xx_iter = niter; xy_iter = niter; vort_iter = niter;
- do i_highpass=1,n_highpass
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- T2(i,j) = T1(i,j)
- enddo ; enddo
- do i_lowpass=1,ABS(n_lowpass)
- call smooth_Tq(G, mask_T, mask_q, T=T2)
- enddo
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- T1(i,j) = T1(i,j) - T2(i,j)
- enddo ; enddo
- enddo
+ do while &
+ (xx_iter > 0 .or. xy_iter > 0 .or. & ! filter iterations remain to be done
+ xx_halo < 2 .or. xy_halo < 1) ! there is no halo for VG tensor
- if (n_lowpass>0) then
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- T(i,j) = T(i,j) - T1(i,j)
- enddo ; enddo
- else
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- T(i,j) = T1(i,j)
- enddo ; enddo
+ ! ---------- filtering sh_xx ---------
+ if (xx_halo < 2) then
+ call complete_group_pass(CS%pass_xx, G%Domain, clock=CS%id_clock_mpi)
+ xx_halo = CS%HPF_halo
endif
- if (n_highpass==1 .AND. n_lowpass>0) then
- call min_max(G, min_after, max_after, T=T)
- if (max_after > max_before .OR. min_after < min_before) then
- call MOM_error(WARNING, "MOM_Zanna_Bolton.F90, filter applied in CENTER points "//&
- " does not preserve [min,max] values. There may be issues with "//&
- " boundary conditions")
- endif
- endif
- endif
-end subroutine filter
-
-!> One iteration of 3x3 filter
-!! [1 2 1;
-!! 2 4 2;
-!! 1 2 1]/16
-!! removing chess-harmonic.
-!! It is used as a buiding block in filter().
-!! Zero Dirichlet boundary conditions are applied
-!! with mask_T and mask_q.
-subroutine smooth_Tq(G, mask_T, mask_q, T, q)
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
- real, dimension(SZI_(G),SZJ_(G)), &
- intent(in) :: mask_T !< mask of wet points in T (CENTER) points [nondim]
- real, dimension(SZIB_(G),SZJB_(G)), &
- intent(in) :: mask_q !< mask of wet points in q (CORNER) points [nondim]
- real, dimension(SZI_(G),SZJ_(G)), &
- optional, intent(inout) :: T !< any field at T (CENTER) points [arbitrary]
- real, dimension(SZIB_(G),SZJB_(G)), &
- optional, intent(inout) :: q !< any field at q (CORNER) points [arbitrary]
+ call filter_hq(G, GV, CS, xx_halo, xx_iter, h=CS%sh_xx)
- real, dimension(SZI_(G),SZJ_(G)) :: Tim ! intermediate T-field [arbitrary]
- real, dimension(SZIB_(G),SZJB_(G)) :: qim ! intermediate q-field [arbitrary]
+ if (xx_halo < 2) &
+ call start_group_pass(CS%pass_xx, G%Domain, clock=CS%id_clock_mpi)
- real :: wside ! weights for side points
- ! (i+1,j), (i-1,j), (i,j+1), (i,j-1)
- ! [nondim]
- real :: wcorner ! weights for corner points
- ! (i+1,j+1), (i+1,j-1), (i-1,j-1), (i-1,j+1)
- ! [nondim]
- real :: wcenter ! weight for the center point (i,j) [nondim]
+ ! ------ filtering sh_xy, vort_xy ----
+ if (xy_halo < 1) then
+ call complete_group_pass(CS%pass_xy, G%Domain, clock=CS%id_clock_mpi)
+ xy_halo = CS%HPF_halo; vort_halo = CS%HPF_halo
+ endif
- integer :: i, j
- integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq
+ call filter_hq(G, GV, CS, xy_halo, xy_iter, q=CS%sh_xy)
+ call filter_hq(G, GV, CS, vort_halo, vort_iter, q=CS%vort_xy)
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+ if (xy_halo < 1) &
+ call start_group_pass(CS%pass_xy, G%Domain, clock=CS%id_clock_mpi)
- wside = 1. / 8.
- wcorner = 1. / 16.
- wcenter = 1. - (wside*4. + wcorner*4.)
+ enddo
- if (present(q)) then
- call pass_var(q, G%Domain, position=CORNER, complete=.true.)
- do J = Jsq-1, Jeq+1; do I = Isq-1, Ieq+1
- qim(I,J) = q(I,J) * mask_q(I,J)
+ ! We implement sharpening by computing residual
+ ! B.C. are already applied to all fields
+ call cpu_clock_begin(CS%id_clock_filter)
+ do k=1,nz
+ do j=js-2,je+2; do i=is-2,ie+2
+ CS%sh_xx(i,j,k) = sh_xx(i,j,k) - CS%sh_xx(i,j,k)
enddo; enddo
- do J = Jsq, Jeq
- do I = Isq, Ieq
- q(I,J) = wcenter * qim(i,j) &
- + wcorner * ( &
- (qim(I-1,J-1)+qim(I+1,J+1)) &
- + (qim(I-1,J+1)+qim(I+1,J-1)) &
- ) &
- + wside * ( &
- (qim(I-1,J)+qim(I+1,J)) &
- + (qim(I,J-1)+qim(I,J+1)) &
- )
- q(I,J) = q(I,J) * mask_q(I,J)
- enddo
- enddo
- call pass_var(q, G%Domain, position=CORNER, complete=.true.)
- endif
-
- if (present(T)) then
- call pass_var(T, G%Domain)
- do j = js-1, je+1; do i = is-1, ie+1
- Tim(i,j) = T(i,j) * mask_T(i,j)
+ do J=Jsq-1,Jeq+1; do I=Isq-1,Ieq+1
+ CS%sh_xy(I,J,k) = sh_xy(I,J,k) - CS%sh_xy(I,J,k)
+ CS%vort_xy(I,J,k) = vort_xy(I,J,k) - CS%vort_xy(I,J,k)
enddo; enddo
- do j = js, je
- do i = is, ie
- T(i,j) = wcenter * Tim(i,j) &
- + wcorner * ( &
- (Tim(i-1,j-1)+Tim(i+1,j+1)) &
- + (Tim(i-1,j+1)+Tim(i+1,j-1)) &
- ) &
- + wside * ( &
- (Tim(i-1,j)+Tim(i+1,j)) &
- + (Tim(i,j-1)+Tim(i,j+1)) &
- )
- T(i,j) = T(i,j) * mask_T(i,j)
- enddo
- enddo
- call pass_var(T, G%Domain)
- endif
+ enddo
+ call cpu_clock_end(CS%id_clock_filter)
-end subroutine smooth_Tq
+ if (.not. G%symmetric) &
+ call do_group_pass(CS%pass_xy, G%Domain, &
+ clock=CS%id_clock_mpi)
-!> Returns min and max values of array across all PEs.
-!! It is used in filter() to check its monotonicity.
-subroutine min_max(G, min_val, max_val, T, q)
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
- real, dimension(SZI_(G),SZJ_(G)), &
- optional, intent(inout) :: T !< any field at T (CENTER) points [arbitrary]
- real, dimension(SZIB_(G),SZJB_(G)), &
- optional, intent(inout) :: q !< any field at q (CORNER) points [arbitrary]
- real, intent(out) :: min_val, max_val !< min and max values of array accross PEs [arbitrary]
+end subroutine filter_velocity_gradients
- integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq
+!> Filtering of the stress tensor Txx, Tyy, Txy.
+!! The algorithm: marching halo with non-blocking grouped MPI
+!! exchanges. The input arrays (Txx, Tyy, Txy) must have halo 1
+!! with zero B.C. applied. The output have the same halo and B.C.
+subroutine filter_stress(G, GV, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure.
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+ integer :: Txx_halo, Tyy_halo, Txy_halo ! currently available halo for stress components
+ integer :: Txx_iter, Tyy_iter, Txy_iter ! remaining number of iterations
+ integer :: niter ! required number of iterations
- if (present(q)) then
- min_val = minval(q(Isq:Ieq, Jsq:Jeq))
- max_val = maxval(q(Isq:Ieq, Jsq:Jeq))
- endif
+ niter = CS%Stress_iter
- if (present(T)) then
- min_val = minval(T(is:ie, js:je))
- max_val = maxval(T(is:ie, js:je))
- endif
+ if (niter == 0) return
- call min_across_PEs(min_val)
- call max_across_PEs(max_val)
-
-end subroutine
-
-!> Computes mask of wet points in T (CENTER) and q (CORNER) points.
-!! Method: compare layer thicknesses with Angstrom_H.
-!! Mask is computed separately for every vertical layer and
-!! for every time step.
-subroutine compute_masks(G, GV, h, mask_T, mask_q, k)
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
- type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
- real, dimension(SZI_(G),SZJ_(G)), &
- intent(inout) :: mask_T !< mask of wet points in T (CENTER) points [nondim]
- real, dimension(SZIB_(G),SZJB_(G)), &
- intent(inout) :: mask_q !< mask of wet points in q (CORNER) points [nondim]
- integer, intent(in) :: k !< index of vertical layer
-
- real :: hmin ! Minimum layer thickness
- ! beyond which we have boundary [H ~> m or kg m-2]
- integer :: i, j
+ Txx_halo = 1; Tyy_halo = 1; Txy_halo = 1; ! these are required halo for Txx, Tyy, Txy
+ Txx_iter = niter; Tyy_iter = niter; Txy_iter = niter;
+
+ do while &
+ (Txx_iter > 0 .or. Txy_iter > 0 .or. & ! filter iterations remain to be done
+ Txx_halo < 1 .or. Txy_halo < 1) ! there is no halo for Txx or Txy
+
+ ! ---------- filtering Txy -----------
+ if (Txy_halo < 1) then
+ call complete_group_pass(CS%pass_Tq, G%Domain, clock=CS%id_clock_mpi)
+ Txy_halo = CS%Stress_halo
+ endif
+
+ call filter_hq(G, GV, CS, Txy_halo, Txy_iter, q=CS%Txy)
+
+ if (Txy_halo < 1) &
+ call start_group_pass(CS%pass_Tq, G%Domain, clock=CS%id_clock_mpi)
+
+ ! ------- filtering Txx, Tyy ---------
+ if (Txx_halo < 1) then
+ call complete_group_pass(CS%pass_Th, G%Domain, clock=CS%id_clock_mpi)
+ Txx_halo = CS%Stress_halo; Tyy_halo = CS%Stress_halo
+ endif
+
+ call filter_hq(G, GV, CS, Txx_halo, Txx_iter, h=CS%Txx)
+ call filter_hq(G, GV, CS, Tyy_halo, Tyy_iter, h=CS%Tyy)
+
+ if (Txx_halo < 1) &
+ call start_group_pass(CS%pass_Th, G%Domain, clock=CS%id_clock_mpi)
- hmin = GV%Angstrom_H * 2.
-
- mask_q(:,:) = 0.
- do J = G%JscB, G%JecB
- do I = G%IscB, G%IecB
- if (h(i+1,j+1,k) < hmin .or. &
- h(i ,j ,k) < hmin .or. &
- h(i+1,j ,k) < hmin .or. &
- h(i ,j+1,k) < hmin &
- ) then
- mask_q(I,J) = 0.
- else
- mask_q(I,J) = 1.
- endif
- mask_q(I,J) = mask_q(I,J) * G%mask2dBu(I,J)
- enddo
enddo
- call pass_var(mask_q, G%Domain, position=CORNER, complete=.true.)
- mask_T(:,:) = 0.
- do j = G%jsc, G%jec
- do i = G%isc, G%iec
- if (h(i,j,k) < hmin) then
- mask_T(i,j) = 0.
+end subroutine filter_stress
+
+!> Wrapper for filter_3D function. The border indices for q and h
+!! arrays are substituted.
+subroutine filter_hq(G, GV, CS, current_halo, remaining_iterations, q, h)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
+ type(ZB2020_CS), intent(in) :: CS !< ZB2020 control structure.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, &
+ intent(inout) :: h !< Input/output array in h points [arbitrary]
+ real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)), optional, &
+ intent(inout) :: q !< Input/output array in q points [arbitrary]
+ integer, intent(inout) :: current_halo !< Currently available halo points
+ integer, intent(inout) :: remaining_iterations !< The number of iterations to perform
+
+ logical :: direction ! The direction of the first 1D filter
+
+ direction = (MOD(G%first_direction,2) == 0)
+
+ call cpu_clock_begin(CS%id_clock_filter)
+
+ if (present(h)) then
+ call filter_3D(h, CS%maskw_h, &
+ G%isd, G%ied, G%jsd, G%jed, &
+ G%isc, G%iec, G%jsc, G%jec, GV%ke, &
+ current_halo, remaining_iterations, &
+ direction)
+ endif
+
+ if (present(q)) then
+ call filter_3D(q, CS%maskw_q, &
+ G%IsdB, G%IedB, G%JsdB, G%JedB, &
+ G%IscB, G%IecB, G%JscB, G%JecB, GV%ke, &
+ current_halo, remaining_iterations, &
+ direction)
+ endif
+
+ call cpu_clock_end(CS%id_clock_filter)
+end subroutine filter_hq
+
+!> Spatial lateral filter applied to 3D array. The lateral filter is given
+!! by the convolutional kernel:
+!! [1 2 1]
+!! C = |2 4 2| * 1/16
+!! [1 2 1]
+!! The fast algorithm decomposes the 2D filter into two 1D filters as follows:
+!! [1]
+!! C = |2| * [1 2 1] * 1/16
+!! [1]
+!! The input array must have zero B.C. applied. B.C. is applied for output array.
+!! Note that maskw contains both land mask and 1/16 factor.
+!! Filter implements marching halo. The available halo is specified and as many
+!! filter iterations as possible and as needed are performed.
+subroutine filter_3D(x, maskw, isd, ied, jsd, jed, is, ie, js, je, nz, &
+ current_halo, remaining_iterations, &
+ direction)
+ integer, intent(in) :: isd !< Indices of array size
+ integer, intent(in) :: ied !< Indices of array size
+ integer, intent(in) :: jsd !< Indices of array size
+ integer, intent(in) :: jed !< Indices of array size
+ integer, intent(in) :: is !< Indices of owned points
+ integer, intent(in) :: ie !< Indices of owned points
+ integer, intent(in) :: js !< Indices of owned points
+ integer, intent(in) :: je !< Indices of owned points
+ integer, intent(in) :: nz !< Vertical array size
+ real, dimension(isd:ied,jsd:jed,nz), &
+ intent(inout) :: x !< Input/output array [arbitrary]
+ real, dimension(isd:ied,jsd:jed), &
+ intent(in) :: maskw !< Mask array of land points divided by 16 [nondim]
+ integer, intent(inout) :: current_halo !< Currently available halo points
+ integer, intent(inout) :: remaining_iterations !< The number of iterations to perform
+ logical, intent(in) :: direction !< The direction of the first 1D filter
+
+ real, parameter :: weight = 2. ! Filter weight [nondim]
+ integer :: i, j, k, iter, niter, halo
+
+ real :: tmp(isd:ied, jsd:jed) ! Array with temporary results [arbitrary]
+
+ ! Do as many iterations as needed and possible
+ niter = min(current_halo, remaining_iterations)
+ if (niter == 0) return ! nothing to do
+
+ ! Update remaining iterations
+ remaining_iterations = remaining_iterations - niter
+ ! Update halo information
+ current_halo = current_halo - niter
+
+ do k=1,Nz
+ halo = niter-1 + &
+ current_halo ! Save as many halo points as possible
+ do iter=1,niter
+
+ if (direction) then
+ do j = js-halo, je+halo; do i = is-halo-1, ie+halo+1
+ tmp(i,j) = weight * x(i,j,k) + (x(i,j-1,k) + x(i,j+1,k))
+ enddo; enddo
+
+ do j = js-halo, je+halo; do i = is-halo, ie+halo;
+ x(i,j,k) = (weight * tmp(i,j) + (tmp(i-1,j) + tmp(i+1,j))) * maskw(i,j)
+ enddo; enddo
else
- mask_T(i,j) = 1.
+ do j = js-halo-1, je+halo+1; do i = is-halo, ie+halo
+ tmp(i,j) = weight * x(i,j,k) + (x(i-1,j,k) + x(i+1,j,k))
+ enddo; enddo
+
+ do j = js-halo, je+halo; do i = is-halo, ie+halo;
+ x(i,j,k) = (weight * tmp(i,j) + (tmp(i,j-1) + tmp(i,j+1))) * maskw(i,j)
+ enddo; enddo
endif
- mask_T(i,j) = mask_T(i,j) * G%mask2dT(i,j)
+
+ halo = halo - 1
enddo
enddo
- call pass_var(mask_T, G%Domain)
-end subroutine compute_masks
+end subroutine filter_3D
!> Computes the 3D energy source term for the ZB2020 scheme
!! similarly to MOM_diagnostics.F90, specifically 1125 line.
@@ -906,7 +1032,7 @@ subroutine compute_energy_source(u, v, h, fx, fy, G, GV, CS)
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2].
+ intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: fx !< Zonal acceleration due to convergence of
@@ -922,11 +1048,6 @@ subroutine compute_energy_source(u, v, h, fx, fy, G, GV, CS)
real :: KE_v(SZI_(G),SZJB_(G)) ! The area integral of a KE term in a layer at v-points
! [H L4 T-3 ~> m5 s-3 or kg m2 s-3]
- !real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! temporary array for integration
- !real :: global_integral ! Global integral of the energy effect of ZB2020
- ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3]
-
-
real :: uh ! Transport through zonal faces = u*h*dy,
! [H L2 T-1 ~> m3 s-1 or kg s-1].
real :: vh ! Transport through meridional faces = v*h*dx,
@@ -937,14 +1058,14 @@ subroutine compute_energy_source(u, v, h, fx, fy, G, GV, CS)
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
integer :: i, j, k
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
- Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
-
if (CS%id_KE_ZB2020 > 0) then
+ call cpu_clock_begin(CS%id_clock_source)
call create_group_pass(pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East)
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+
KE_term(:,:,:) = 0.
- !tmp(:,:,:) = 0.
! Calculate the KE source from Zanna-Bolton2020 [H L2 T-3 ~> m3 s-3].
do k=1,nz
KE_u(:,:) = 0.
@@ -963,14 +1084,14 @@ subroutine compute_energy_source(u, v, h, fx, fy, G, GV, CS)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
- ! copy-paste from MOM_spatial_means.F90, line 42
- !tmp(i,j,k) = KE_term(i,j,k) * G%areaT(i,j) * G%mask2dT(i,j)
enddo ; enddo
enddo
- !global_integral = reproducing_sum(tmp)
+ call cpu_clock_end(CS%id_clock_source)
+ call cpu_clock_begin(CS%id_clock_post)
call post_data(CS%id_KE_ZB2020, KE_term, CS%diag)
+ call cpu_clock_end(CS%id_clock_post)
endif
end subroutine compute_energy_source
diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90
index b567c26b42..d59e6b3871 100644
--- a/src/parameterizations/lateral/MOM_hor_visc.F90
+++ b/src/parameterizations/lateral/MOM_hor_visc.F90
@@ -24,7 +24,8 @@ module MOM_hor_visc
use MOM_unit_scaling, only : unit_scale_type
use MOM_verticalGrid, only : verticalGrid_type
use MOM_variables, only : accel_diag_ptrs
-use MOM_Zanna_Bolton, only : Zanna_Bolton_2020, ZB_2020_init, ZB2020_CS
+use MOM_Zanna_Bolton, only : ZB2020_lateral_stress, ZB2020_init, ZB2020_end, &
+ ZB2020_CS, ZB2020_copy_gradient_and_thickness
implicit none ; private
@@ -75,6 +76,8 @@ module MOM_hor_visc
!! Ah is the background. Leithy = Leith+E
real :: c_K !< Fraction of energy dissipated by the biharmonic term
!! that gets backscattered in the Leith+E scheme. [nondim]
+ logical :: smooth_Ah !< If true (default), then Ah and m_leithy are smoothed.
+ !! This smoothing requires a lot of blocking communication.
logical :: use_QG_Leith_visc !< If true, use QG Leith nonlinear eddy viscosity.
!! KH is the background value.
logical :: bound_Coriolis !< If true & SMAGORINSKY_AH is used, the biharmonic
@@ -104,7 +107,7 @@ module MOM_hor_visc
!! the answers from the end of 2018, while higher values use updated
!! and more robust forms of the same expressions.
real :: GME_h0 !< The strength of GME tapers quadratically to zero when the bathymetric
- !! depth is shallower than GME_H0 [Z ~> m]
+ !! total water column thickness is less than GME_H0 [H ~> m or kg m-2]
real :: GME_efficiency !< The nondimensional prefactor multiplying the GME coefficient [nondim]
real :: GME_limiter !< The absolute maximum value the GME coefficient is allowed to take [L2 T-1 ~> m2 s-1].
real :: min_grid_Kh !< Minimum horizontal Laplacian viscosity used to
@@ -258,7 +261,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
!! related to Mesoscale Eddy Kinetic Energy.
type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control structure
+ type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control structure
type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type
type(barotropic_CS), intent(in), optional :: BT !< Barotropic control structure
type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control structure
@@ -272,16 +275,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1]
vort_xy_dy_smooth, & ! y-derivative of smoothed vertical vorticity [L-1 T-1 ~> m-1 s-1]
div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1]
- ubtav, & ! zonal barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1]
- u_smooth ! Zonal velocity, smoothed with a spatial low-pass filter [L T-1 ~> m s-1]
+ ubtav ! zonal barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJB_(G)) :: &
Del2v, & ! The v-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1]
h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2].
vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1]
vort_xy_dx_smooth, & ! x-derivative of smoothed vertical vorticity [L-1 T-1 ~> m-1 s-1]
div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1]
- vbtav, & ! meridional barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1]
- v_smooth ! Meridional velocity, smoothed with a spatial low-pass filter [L T-1 ~> m s-1]
+ vbtav ! meridional barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJ_(G)) :: &
dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1]
div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1]
@@ -299,8 +300,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
dudx, dvdy, & ! components in the horizontal tension [T-1 ~> s-1]
dudx_smooth, dvdy_smooth, & ! components in the horizontal tension from smoothed velocity [T-1 ~> s-1]
GME_effic_h, & ! The filtered efficiency of the GME terms at h points [nondim]
- htot, & ! The total thickness of all layers [Z ~> m]
- m_leithy ! Kh=m_leithy*Ah in Leith+E parameterization [L-2 ~> m-2]
+ m_leithy, & ! Kh=m_leithy*Ah in Leith+E parameterization [L-2 ~> m-2]
+ Ah_sq, & ! The square of the biharmonic viscosity [L8 T-2 ~> m8 s-2]
+ htot ! The total thickness of all layers [Z ~> m]
real :: Del2vort_h ! Laplacian of vorticity at h-points [L-2 T-1 ~> m-2 s-1]
real :: grad_vel_mag_bt_h ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2]
real :: boundary_mask_h ! A mask that zeroes out cells with at least one land edge [nondim]
@@ -323,9 +325,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1]
Del2vort_q, & ! Laplacian of vorticity at q-points [L-2 T-1 ~> m-2 s-1]
grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1]
- hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2]
- ! This form guarantees that hq/hu < 4.
- GME_effic_q ! The filtered efficiency of the GME terms at q points [nondim]
+ hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2]
+ ! This form guarantees that hq/hu < 4.
+ GME_effic_q ! The filtered efficiency of the GME terms at q points [nondim]
real :: grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [T-2 ~> s-2]
real :: boundary_mask_q ! A mask that zeroes out cells with at least one land edge [nondim]
@@ -352,17 +354,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
grid_Re_Kh, & ! Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim]
grid_Re_Ah, & ! Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim]
GME_coeff_h ! GME coefficient at h-points [L2 T-1 ~> m2 s-1]
-
- ! Zanna-Bolton fields
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: &
- ZB2020u !< Zonal acceleration due to convergence of
- !! along-coordinate stress tensor for ZB model
- !! [L T-2 ~> m s-2]
+ u_smooth ! Zonal velocity, smoothed with a spatial low-pass filter [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: &
- ZB2020v !< Meridional acceleration due to convergence
- !! of along-coordinate stress tensor for ZB model
- !! [L T-2 ~> m s-2]
-
+ v_smooth ! Meridional velocity, smoothed with a spatial low-pass filter [L T-1 ~> m s-1]
real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1]
real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1]
real :: AhLthy ! 2D Leith+E biharmonic viscosity [L4 T-1 ~> m4 s-1]
@@ -373,8 +368,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner
! points; these are first interpolated to u or v velocity
! points where masks are applied [H ~> m or kg m-2].
- real :: h_arith_q ! The arithmetic mean total thickness at q points [Z ~> m]
- real :: I_GME_h0 ! The inverse of GME tapering scale [Z-1 ~> m-1]
+ real :: h_arith_q ! The arithmetic mean total thickness at q points [H ~> m or kg m-2]
+ real :: I_GME_h0 ! The inverse of GME tapering scale [H-1 ~> m-1 or m2 kg-1]
real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected [H ~> m or kg m-2]
real :: h_neglect3 ! h_neglect^3 [H3 ~> m3 or kg3 m-6]
real :: h_min ! Minimum h at the 4 neighboring velocity points [H ~> m]
@@ -403,6 +398,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
logical :: use_MEKE_Ku
logical :: use_MEKE_Au
logical :: skeb_use_frict
+ integer :: is_vort, ie_vort, js_vort, je_vort ! Loop ranges for vorticity terms
+ integer :: is_Kh, ie_Kh, js_Kh, je_Kh ! Loop ranges for thickness point viscosities
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
integer :: i, j, k, n
real :: inv_PI3, inv_PI2, inv_PI6 ! Powers of the inverse of pi [nondim]
@@ -426,7 +423,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
h_neglect = GV%H_subroundoff
- h_neglect3 = h_neglect**3
+ !h_neglect3 = h_neglect**3
+ h_neglect3 = h_neglect*h_neglect*h_neglect
inv_PI3 = 1.0/((4.0*atan(1.0))**3)
inv_PI2 = 1.0/((4.0*atan(1.0))**2)
inv_PI6 = inv_PI3 * inv_PI3
@@ -434,7 +432,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
skeb_use_frict = .false.
if (present(STOCH)) skeb_use_frict = STOCH%skeb_use_frict
- m_leithy(:,:) = 0. ! Initialize
+ m_leithy(:,:) = 0.0 ! Initialize
if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then
apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally
@@ -471,6 +469,22 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
"RES_SCALE_MEKE_VISC is True.")
endif
+ ! Set the halo sizes used for the thickness-point viscosities.
+ if (CS%use_Leithy) then
+ js_Kh = js-1 ; je_Kh = je+1 ; is_Kh = is-1 ; ie_Kh = ie+1
+ else
+ js_Kh = Jsq ; je_Kh = je+1 ; is_Kh = Isq ; ie_Kh = ie+1
+ endif
+
+ ! Set the halo sizes used for the vorticity calculations.
+ if ((CS%Leith_Kh) .or. (CS%Leith_Ah) .or. (CS%use_Leithy)) then
+ js_vort = js_Kh-2 ; je_vort = Jeq+2 ; is_vort = is_Kh-2 ; ie_vort = Ieq+2
+ if ((G%isc-G%isd < 3) .or. (G%isc-G%isd < 3)) call MOM_error(FATAL, &
+ "The minimum halo size is 3 when a Leith viscosity is being used.")
+ else
+ js_vort = js-2 ; je_vort = Jeq+1 ; is_vort = is-2 ; ie_vort = Ieq+1
+ endif
+
legacy_bound = (CS%Smagorinsky_Kh .or. CS%Leith_Kh) .and. &
(CS%bound_Kh .and. .not.CS%better_bound_Kh)
@@ -489,7 +503,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
call pass_var(h, G%domain, halo=2)
! Calculate the barotropic horizontal tension
- do J=js-2,je+2 ; do I=is-2,ie+2
+ do j=js-2,je+2 ; do i=is-2,ie+2
dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - &
G%IdyCu(I-1,j) * ubtav(I-1,j))
dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - &
@@ -508,11 +522,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
enddo ; enddo
if (CS%no_slip) then
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
+ do J=js-2,je+1 ; do I=is-2,ie+1
sh_xy_bt(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_bt(I,J) + dudy_bt(I,J) )
enddo ; enddo
else
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
+ do J=js-2,je+1 ; do I=is-2,ie+1
sh_xy_bt(I,J) = G%mask2dBu(I,J) * ( dvdx_bt(I,J) + dudy_bt(I,J) )
enddo ; enddo
endif
@@ -521,7 +535,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
htot(i,j) = 0.0
enddo ; enddo
do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2
- htot(i,j) = htot(i,j) + GV%H_to_Z*h(i,j,k)
+ htot(i,j) = htot(i,j) + h(i,j,k)
enddo ; enddo ; enddo
I_GME_h0 = 1.0 / CS%GME_h0
@@ -563,12 +577,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif ! use_GME
+ if (CS%use_Leithy) then
+ ! Smooth the velocity. Right now it happens twice. In the future
+ ! one might make the number of smoothing cycles a user-specified parameter
+ do k=1,nz
+ ! One call applies the filter twice
+ u_smooth(:,:,k) = u(:,:,k)
+ v_smooth(:,:,k) = v(:,:,k)
+ call smooth_x9_uv(G, u_smooth(:,:,k), v_smooth(:,:,k), zero_land=.false.)
+ enddo
+ call pass_vector(u_smooth, v_smooth, G%Domain)
+ endif
+
!$OMP parallel do default(none) &
!$OMP shared( &
!$OMP CS, G, GV, US, OBC, VarMix, MEKE, u, v, h, &
- !$OMP is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, &
- !$OMP apply_OBC, rescale_Kh, legacy_bound, find_FrictWork, &
- !$OMP use_MEKE_Ku, use_MEKE_Au, skeb_use_frict, &
+ !$OMP is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, is_vort, ie_vort, js_vort, je_vort, &
+ !$OMP is_Kh, ie_Kh, js_Kh, je_Kh, apply_OBC, rescale_Kh, legacy_bound, find_FrictWork, &
+ !$OMP use_MEKE_Ku, use_MEKE_Au, u_smooth, v_smooth, skeb_use_frict, &
!$OMP backscat_subround, GME_effic_h, GME_effic_q, &
!$OMP h_neglect, h_neglect3, inv_PI3, inv_PI6, &
!$OMP diffu, diffv, Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, &
@@ -591,8 +617,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
!$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff, &
!$OMP dudx_smooth, dudy_smooth, dvdx_smooth, dvdy_smooth, &
!$OMP vort_xy_smooth, vort_xy_dx_smooth, vort_xy_dy_smooth, &
- !$OMP sh_xx_smooth, sh_xy_smooth, u_smooth, v_smooth, &
- !$OMP vert_vort_mag_smooth, m_leithy, AhLthy &
+ !$OMP sh_xx_smooth, sh_xy_smooth, &
+ !$OMP vert_vort_mag_smooth, m_leithy, Ah_sq, AhLthy &
!$OMP )
do k=1,nz
@@ -616,37 +642,32 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
enddo ; enddo
! Components for the shearing strain
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
+ do J=js_vort,je_vort ; do I=is_vort,ie_vort
dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J))
dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j))
enddo ; enddo
if (CS%use_Leithy) then
- ! Smooth the velocity. Right now it happens twice. In the future
- ! one might make the number of smoothing cycles a user-specified parameter
- u_smooth(:,:) = u(:,:,k)
- v_smooth(:,:) = v(:,:,k)
- call smooth_x9(CS, G, field_u=u_smooth,field_v=v_smooth) ! one call applies the filter twice
! Calculate horizontal tension from smoothed velocity
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- dudx_smooth(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u_smooth(I,j) - &
- G%IdyCu(I-1,j) * u_smooth(I-1,j))
- dvdy_smooth(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v_smooth(i,J) - &
- G%IdxCv(i,J-1) * v_smooth(i,J-1))
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ dudx_smooth(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u_smooth(I,j,k) - &
+ G%IdyCu(I-1,j) * u_smooth(I-1,j,k))
+ dvdy_smooth(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v_smooth(i,J,k) - &
+ G%IdxCv(i,J-1) * v_smooth(i,J-1,k))
sh_xx_smooth(i,j) = dudx_smooth(i,j) - dvdy_smooth(i,j)
enddo ; enddo
! Components for the shearing strain from smoothed velocity
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
+ do J=js_Kh-1,je_Kh ; do I=is_Kh-1,ie_Kh
dvdx_smooth(I,J) = CS%DY_dxBu(I,J) * &
- (v_smooth(i+1,J)*G%IdyCv(i+1,J) - v_smooth(i,J)*G%IdyCv(i,J))
+ (v_smooth(i+1,J,k)*G%IdyCv(i+1,J) - v_smooth(i,J,k)*G%IdyCv(i,J))
dudy_smooth(I,J) = CS%DX_dyBu(I,J) * &
- (u_smooth(I,j+1)*G%IdxCu(I,j+1) - u_smooth(I,j)*G%IdxCu(I,j))
+ (u_smooth(I,j+1,k)*G%IdxCu(I,j+1) - u_smooth(I,j,k)*G%IdxCu(I,j))
enddo ; enddo
- end if ! use Leith+E
+ endif ! use Leith+E
if (CS%id_normstress > 0) then
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
+ do j=js,je ; do i=is,ie
NoSt(i,j,k) = sh_xx(i,j)
enddo ; enddo
endif
@@ -657,17 +678,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! even with OBCs if the accelerations are zeroed at OBC points, in which
! case the j-loop for h_u could collapse to j=js=1,je+1. -RWH
if (CS%use_land_mask) then
- do j=js-2,je+2 ; do I=Isq-1,Ieq+1
+ do j=js-2,je+2 ; do I=is-2,Ieq+1
h_u(I,j) = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i+1,j)*h(i+1,j,k))
enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do i=is-2,ie+2
+ do J=js-2,Jeq+1 ; do i=is-2,ie+2
h_v(i,J) = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i,j+1)*h(i,j+1,k))
enddo ; enddo
else
- do j=js-2,je+2 ; do I=Isq-1,Ieq+1
+ do j=js-2,je+2 ; do I=is-2,Ieq+1
h_u(I,j) = 0.5 * (h(i,j,k) + h(i+1,j,k))
enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do i=is-2,ie+2
+ do J=js-2,Jeq+1 ; do i=is-2,ie+2
h_v(i,J) = 0.5 * (h(i,j,k) + h(i,j+1,k))
enddo ; enddo
endif
@@ -677,8 +698,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (apply_OBC) then ; do n=1,OBC%number_of_segments
J = OBC%segment(n)%HI%JsdB ; I = OBC%segment(n)%HI%IsdB
if (OBC%zero_strain .or. OBC%freeslip_strain .or. OBC%computed_strain) then
- if (OBC%segment(n)%is_N_or_S .and. (J >= js-2) .and. (J <= Jeq+1)) then
- do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB
+ if (OBC%segment(n)%is_N_or_S .and. (J >= Js_vort) .and. (J <= Je_vort)) then
+ do I = max(OBC%segment(n)%HI%IsdB,Is_vort), min(OBC%segment(n)%HI%IedB,Ie_vort)
if (OBC%zero_strain) then
dvdx(I,J) = 0. ; dudy(I,J) = 0.
elseif (OBC%freeslip_strain) then
@@ -698,9 +719,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J)
endif
endif
+ if (CS%use_Leithy) then
+ dvdx_smooth(I,J) = dvdx(I,J)
+ dudy_smooth(I,J) = dudy(I,J)
+ endif
enddo
- elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-2) .and. (I <= Ieq+1)) then
- do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB
+ elseif (OBC%segment(n)%is_E_or_W .and. (I >= is_vort) .and. (I <= ie_vort)) then
+ do J = max(OBC%segment(n)%HI%JsdB,js_vort), min(OBC%segment(n)%HI%JedB,je_vort)
if (OBC%zero_strain) then
dvdx(I,J) = 0. ; dudy(I,J) = 0.
elseif (OBC%freeslip_strain) then
@@ -720,6 +745,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J)
endif
endif
+ if (CS%use_Leithy) then
+ dvdx_smooth(I,J) = dvdx(I,J)
+ dudy_smooth(I,J) = dudy(I,J)
+ endif
enddo
endif
endif
@@ -729,25 +758,25 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! OBC projections, but they might not be necessary if the accelerations
! are always zeroed out at OBC points, in which case the i-loop below
! becomes do i=is-1,ie+1. -RWH
- if ((J >= Jsq-1) .and. (J <= Jeq+1)) then
+ if ((J >= js-2) .and. (J <= Jeq+1)) then
do i = max(is-2,OBC%segment(n)%HI%isd), min(ie+2,OBC%segment(n)%HI%ied)
h_v(i,J) = h(i,j,k)
enddo
endif
elseif (OBC%segment(n)%direction == OBC_DIRECTION_S) then
- if ((J >= Jsq-1) .and. (J <= Jeq+1)) then
+ if ((J >= js-2) .and. (J <= Jeq+1)) then
do i = max(is-2,OBC%segment(n)%HI%isd), min(ie+2,OBC%segment(n)%HI%ied)
h_v(i,J) = h(i,j+1,k)
enddo
endif
elseif (OBC%segment(n)%direction == OBC_DIRECTION_E) then
- if ((I >= Isq-1) .and. (I <= Ieq+1)) then
+ if ((I >= is-2) .and. (I <= Ieq+1)) then
do j = max(js-2,OBC%segment(n)%HI%jsd), min(je+2,OBC%segment(n)%HI%jed)
h_u(I,j) = h(i,j,k)
enddo
endif
elseif (OBC%segment(n)%direction == OBC_DIRECTION_W) then
- if ((I >= Isq-1) .and. (I <= Ieq+1)) then
+ if ((I >= is-2) .and. (I <= Ieq+1)) then
do j = max(js-2,OBC%segment(n)%HI%jsd), min(je+2,OBC%segment(n)%HI%jed)
h_u(I,j) = h(i+1,j,k)
enddo
@@ -759,25 +788,25 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
J = OBC%segment(n)%HI%JsdB ; I = OBC%segment(n)%HI%IsdB
if (OBC%segment(n)%direction == OBC_DIRECTION_N) then
if ((J >= js-2) .and. (J <= je)) then
- do I = max(Isq-1,OBC%segment(n)%HI%IsdB), min(Ieq+1,OBC%segment(n)%HI%IedB)
+ do I = max(is-2,OBC%segment(n)%HI%IsdB), min(Ieq+1,OBC%segment(n)%HI%IedB)
h_u(I,j+1) = h_u(I,j)
enddo
endif
elseif (OBC%segment(n)%direction == OBC_DIRECTION_S) then
if ((J >= js-1) .and. (J <= je+1)) then
- do I = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+1,OBC%segment(n)%HI%ied)
+ do I = max(is-2,OBC%segment(n)%HI%isd), min(Ieq+1,OBC%segment(n)%HI%ied)
h_u(I,j) = h_u(I,j+1)
enddo
endif
elseif (OBC%segment(n)%direction == OBC_DIRECTION_E) then
if ((I >= is-2) .and. (I <= ie)) then
- do J = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+1,OBC%segment(n)%HI%jed)
+ do J = max(js-2,OBC%segment(n)%HI%jsd), min(Jeq+1,OBC%segment(n)%HI%jed)
h_v(i+1,J) = h_v(i,J)
enddo
endif
elseif (OBC%segment(n)%direction == OBC_DIRECTION_W) then
if ((I >= is-1) .and. (I <= ie+1)) then
- do J = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+1,OBC%segment(n)%HI%jed)
+ do J = max(js-2,OBC%segment(n)%HI%jsd), min(Jeq+1,OBC%segment(n)%HI%jed)
h_v(i,J) = h_v(i+1,J)
enddo
endif
@@ -802,11 +831,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Shearing strain (including no-slip boundary conditions at the 2-D land-sea mask).
! dudy_smooth and dvdx_smooth do not (yet) include modifications at OBCs from above.
if (CS%no_slip) then
- do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
+ do J=js-1,Jeq ; do I=is-1,Ieq
sh_xy_smooth(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_smooth(I,J) + dudy_smooth(I,J) )
enddo ; enddo
else
- do J=js-2,Jeq+1 ; do I=is-2,Ieq+1
+ do J=js-1,Jeq ; do I=is-1,Ieq
sh_xy_smooth(I,J) = G%mask2dBu(I,J) * ( dvdx_smooth(I,J) + dudy_smooth(I,J) )
enddo ; enddo
endif
@@ -839,55 +868,53 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
! Vorticity
- if (CS%no_slip) then
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) )
- enddo ; enddo
- else
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) )
- enddo ; enddo
+ if ((CS%Leith_Kh) .or. (CS%Leith_Ah) .or. (CS%use_Leithy) .or. (CS%id_vort_xy_q>0)) then
+ if (CS%no_slip) then
+ do J=js_vort,je_vort ; do I=is_vort,ie_vort
+ vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) )
+ enddo ; enddo
+ else
+ do J=js_vort,je_vort ; do I=is_vort,ie_vort
+ vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) )
+ enddo ; enddo
+ endif
endif
if (CS%use_Leithy) then
if (CS%no_slip) then
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
+ do J=js_Kh-1,je_Kh ; do I=is_Kh-1,ie_Kh
vort_xy_smooth(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_smooth(I,J) - dudy_smooth(I,J) )
enddo ; enddo
else
- do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
+ do J=js_Kh-1,je_Kh ; do I=is_Kh-1,ie_Kh
vort_xy_smooth(I,J) = G%mask2dBu(I,J) * ( dvdx_smooth(I,J) - dudy_smooth(I,J) )
enddo ; enddo
endif
endif
- ! Divergence
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- div_xx(i,j) = dudx(i,j) + dvdy(i,j)
- enddo ; enddo
if ((CS%Leith_Kh) .or. (CS%Leith_Ah) .or. (CS%use_Leithy)) then
! Vorticity gradient
- do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2
+ do J=js-2,je_Kh ; do i=is_Kh-1,ie_Kh+1
DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J)
vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j))
enddo ; enddo
- do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1
+ do j=js_Kh-1,je_Kh+1 ; do I=is-2,ie_Kh
DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J)
vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1))
enddo ; enddo
if (CS%use_Leithy) then
! Gradient of smoothed vorticity
- do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2
+ do J=js_Kh-1,je_Kh ; do i=is_Kh,ie_Kh
DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J)
vort_xy_dx_smooth(i,J) = DY_dxBu * &
(vort_xy_smooth(I,J) * G%IdyCu(I,j) - vort_xy_smooth(I-1,J) * G%IdyCu(I-1,j))
enddo ; enddo
- do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1
+ do j=js_Kh,je_Kh ; do I=is_Kh-1,ie_Kh
DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J)
vort_xy_dy_smooth(I,j) = DX_dyBu * &
(vort_xy_smooth(I,J) * G%IdxCv(i,J) - vort_xy_smooth(I,J-1) * G%IdxCv(i,J-1))
@@ -895,46 +922,53 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif ! If Leithy
! Laplacian of vorticity
- do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ ! if (CS%Leith_Ah .or. CS%use_Leithy) then
+ do J=js_Kh-1,je_Kh ; do I=is_Kh-1,ie_Kh
DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J)
DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J)
Del2vort_q(I,J) = DY_dxBu * (vort_xy_dx(i+1,J) * G%IdyCv(i+1,J) - vort_xy_dx(i,J) * G%IdyCv(i,J)) + &
DX_dyBu * (vort_xy_dy(I,j+1) * G%IdyCu(I,j+1) - vort_xy_dy(I,j) * G%IdyCu(I,j))
enddo ; enddo
+ ! endif
if (CS%modified_Leith) then
+ ! Divergence
+ do j=js_Kh-1,je_Kh+1 ; do i=is_Kh-1,ie_Kh+1
+ div_xx(i,j) = dudx(i,j) + dvdy(i,j)
+ enddo ; enddo
+
! Divergence gradient
- do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1
+ do j=js-1,je+1 ; do I=is_Kh-1,ie_Kh
div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j))
enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2
+ do J=js_Kh-1,je_Kh ; do i=is-1,ie+1
div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j))
enddo ; enddo
! Magnitude of divergence gradient
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
grad_div_mag_h(i,j) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + &
(0.5*(div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2)
enddo ; enddo
- do j=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+1
+ do J=js-1,Jeq ; do I=is-1,Ieq
grad_div_mag_q(I,J) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + &
(0.5*(div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2)
enddo ; enddo
else
- do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1
+ do j=js-1,je+1 ; do I=is_Kh-1,ie_Kh
div_xx_dx(I,j) = 0.0
enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2
+ do J=js_Kh-1,je_Kh ; do i=is-1,ie+1
div_xx_dy(i,J) = 0.0
enddo ; enddo
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
grad_div_mag_h(i,j) = 0.0
enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ do J=js-1,Jeq ; do I=is-1,Ieq
grad_div_mag_q(I,J) = 0.0
enddo ; enddo
@@ -942,17 +976,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Add in beta for the Leith viscosity
if (CS%use_beta_in_Leith) then
- do J=js-2,Jeq+1 ; do i=is-1,Ieq+1
+ do J=js-2,Jeq+1 ; do i=is-1,ie+1
vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1))
enddo ; enddo
- do j=js-1,Jeq+1 ; do I=is-2,Ieq+1
+ do j=js-1,je+1 ; do I=is-2,Ieq+1
vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j))
enddo ; enddo
endif ! CS%use_beta_in_Leith
if (CS%use_QG_Leith_visc) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + &
(0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 )
enddo ; enddo
@@ -967,7 +1001,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + &
(0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 )
enddo ; enddo
@@ -977,7 +1011,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
enddo ; enddo
if (CS%use_Leithy) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
vert_vort_mag_smooth(i,j) = SQRT((0.5*(vort_xy_dx_smooth(i,J) + &
vort_xy_dx_smooth(i,J-1)))**2 + &
(0.5*(vort_xy_dy_smooth(I,j) + &
@@ -988,7 +1022,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif ! CS%Leith_Kh
if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
sh_xx_sq = sh_xx(i,j)**2
sh_xy_sq = 0.25 * ( (sh_xy(I-1,J-1)**2 + sh_xy(I,J)**2) &
+ (sh_xy(I-1,J)**2 + sh_xy(I,J-1)**2) )
@@ -997,13 +1031,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
if (CS%better_bound_Ah .or. CS%better_bound_Kh) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
h_min = min(h_u(I,j), h_u(I-1,j), h_v(i,J), h_v(i,J-1))
hrat_min(i,j) = min(1.0, h_min / (h(i,j,k) + h_neglect))
enddo ; enddo
if (CS%better_bound_Kh) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
visc_bound_rem(i,j) = 1.0
enddo ; enddo
endif
@@ -1014,28 +1048,28 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! largest value from several parameterizations. Also get
! the Laplacian component of str_xx.
- if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then
+ if ((CS%Leith_Kh) .or. (CS%Leith_Ah) .or. (CS%use_Leithy)) then
if (CS%use_QG_Leith_visc) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
grad_vort = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)
grad_vort_qg = 3. * grad_vort_mag_h_2d(i,j)
vert_vort_mag(i,j) = min(grad_vort, grad_vort_qg)
enddo ; enddo
else
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
vert_vort_mag(i,j) = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)
enddo ; enddo
endif
endif
! Static (pre-computed) background viscosity
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh(i,j) = CS%Kh_bg_xx(i,j)
enddo ; enddo
! NOTE: The following do-block can be decomposed and vectorized after the
! stack size has been reduced.
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
if (CS%add_LES_viscosity) then
if (CS%Smagorinsky_Kh) &
Kh(i,j) = Kh(i,j) + CS%Laplac2_const_xx(i,j) * Shear_mag(i,j)
@@ -1052,38 +1086,38 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! All viscosity contributions above are subject to resolution scaling
if (rescale_Kh) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh(i,j) = VarMix%Res_fn_h(i,j) * Kh(i,j)
enddo ; enddo
endif
if (legacy_bound) then
! Older method of bounding for stability
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh(i,j) = min(Kh(i,j), CS%Kh_Max_xx(i,j))
enddo ; enddo
endif
! Place a floor on the viscosity, if desired.
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh(i,j) = max(Kh(i,j), CS%Kh_bg_min)
enddo ; enddo
if (use_MEKE_Ku) then
! *Add* the MEKE contribution (which might be negative)
if (CS%res_scale_MEKE) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j) * VarMix%Res_fn_h(i,j)
enddo ; enddo
else
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh(i,j) = Kh(i,j) + MEKE%Ku(i,j)
enddo ; enddo
endif
endif
if (CS%anisotropic) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
! *Add* the tension component of anisotropic viscosity
Kh(i,j) = Kh(i,j) + CS%Kh_aniso * (1. - CS%n1n2_h(i,j)**2)
enddo ; enddo
@@ -1091,7 +1125,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Newer method of bounding for stability
if (CS%better_bound_Kh) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xx(i,j)) then
visc_bound_rem(i,j) = 0.0
Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xx(i,j)
@@ -1104,19 +1138,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! In Leith+E parameterization Kh is computed after Ah in the biharmonic loop.
! The harmonic component of str_xx is added in the biharmonic loop.
if (CS%use_Leithy) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh(i,j) = 0.
enddo ; enddo
- end if
+ endif
if (CS%id_Kh_h>0 .or. CS%debug) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Kh_h(i,j,k) = Kh(i,j)
enddo ; enddo
endif
if (CS%id_grid_Re_Kh>0) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js,je ; do i=is,ie
KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2)
grid_Kh = max(Kh(i,j), CS%min_grid_Kh)
grid_Re_Kh(i,j,k) = (sqrt(KE) * sqrt(CS%grid_sp_h2(i,j))) / grid_Kh
@@ -1124,13 +1158,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
if (CS%id_div_xx_h>0) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- div_xx_h(i,j,k) = div_xx(i,j)
+ do j=js,je ; do i=is,ie
+ div_xx_h(i,j,k) = dudx(i,j) + dvdy(i,j)
enddo ; enddo
endif
if (CS%id_sh_xx_h>0) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js,je ; do i=is,ie
sh_xx_h(i,j,k) = sh_xx(i,j)
enddo ; enddo
endif
@@ -1157,21 +1191,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Determine the biharmonic viscosity at h points, using the
! largest value from several parameterizations. Also get the
! biharmonic component of str_xx.
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Ah(i,j) = CS%Ah_bg_xx(i,j)
enddo ; enddo
if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah) .or. (CS%use_Leithy)) then
if (CS%Smagorinsky_Ah) then
if (CS%bound_Coriolis) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
AhSm = Shear_mag(i,j) * (CS%Biharm_const_xx(i,j) &
+ CS%Biharm_const2_xx(i,j) * Shear_mag(i,j) &
)
Ah(i,j) = max(Ah(i,j), AhSm)
enddo ; enddo
else
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
AhSm = CS%Biharm_const_xx(i,j) * Shear_mag(i,j)
Ah(i,j) = max(Ah(i,j), AhSm)
enddo ; enddo
@@ -1179,7 +1213,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
if (CS%Leith_Ah) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Del2vort_h = 0.25 * ((Del2vort_q(I,J) + Del2vort_q(I-1,J-1)) + &
(Del2vort_q(I-1,J) + Del2vort_q(I,J-1)))
AhLth = CS%Biharm6_const_xx(i,j) * abs(Del2vort_h) * inv_PI6
@@ -1189,7 +1223,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (CS%use_Leithy) then
! Get m_leithy
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ if (CS%smooth_Ah) m_leithy(:,:) = 0.0 ! This is here to initialize domain edge halo values.
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Del2vort_h = 0.25 * ((Del2vort_q(I,J) + Del2vort_q(I-1,J-1)) + &
(Del2vort_q(I-1,J) + Del2vort_q(I,J-1)))
AhLth = CS%Biharm6_const_xx(i,j) * inv_PI6 * abs(Del2vort_h)
@@ -1203,30 +1238,44 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
endif
enddo ; enddo
- ! Smooth m_leithy
- call smooth_x9(CS, G, field_h=m_leithy, zero_land=.true.)
+
+ if (CS%smooth_Ah) then
+ ! Smooth m_leithy. A single call smoothes twice.
+ call pass_var(m_leithy, G%Domain, halo=2)
+ call smooth_x9_h(G, m_leithy, zero_land=.true.)
+ call pass_var(m_leithy, G%Domain)
+ endif
! Get Ah
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Del2vort_h = 0.25 * ((Del2vort_q(I,J) + Del2vort_q(I-1,J-1)) + &
(Del2vort_q(I-1,J) + Del2vort_q(I,J-1)))
AhLthy = CS%Biharm6_const_xx(i,j) * inv_PI6 * &
sqrt(max(0.,Del2vort_h**2 - m_leithy(i,j)*vert_vort_mag_smooth(i,j)**2))
Ah(i,j) = max(CS%Ah_bg_xx(i,j), AhLthy)
enddo ; enddo
- ! Smooth Ah before applying upper bound
- ! square, then smooth, then square root
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- Ah_h(i,j,k) = Ah(i,j)**2
- enddo ; enddo
- call smooth_x9(CS, G, field_h=Ah_h(:,:,k))
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- Ah_h(i,j,k) = sqrt(Ah_h(i,j,k))
- Ah(i,j) = Ah_h(i,j,k)
- enddo ; enddo
+ if (CS%smooth_Ah) then
+ ! Smooth Ah before applying upper bound. Square Ah, then smooth, then take its square root.
+ Ah_sq(:,:) = 0.0 ! This is here to initialize domain edge halo values.
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
+ Ah_sq(i,j) = Ah(i,j)**2
+ enddo ; enddo
+ call pass_var(Ah_sq, G%Domain, halo=2)
+ ! A single call smoothes twice.
+ call smooth_x9_h(G, Ah_sq, zero_land=.false.)
+ call pass_var(Ah_sq, G%Domain)
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
+ Ah_h(i,j,k) = max(CS%Ah_bg_xx(i,j), sqrt(max(0., Ah_sq(i,j))))
+ Ah(i,j) = Ah_h(i,j,k)
+ enddo ; enddo
+ else
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
+ Ah_h(i,j,k) = Ah(i,j)
+ enddo ; enddo
+ endif
endif
if (CS%bound_Ah .and. .not. CS%better_bound_Ah) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Ah(i,j) = min(Ah(i,j), CS%Ah_Max_xx(i,j))
enddo ; enddo
endif
@@ -1234,13 +1283,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (use_MEKE_Au) then
! *Add* the MEKE contribution
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Ah(i,j) = Ah(i,j) + MEKE%Au(i,j)
enddo ; enddo
endif
if (CS%Re_Ah > 0.0) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2)
Ah(i,j) = sqrt(KE) * CS%Re_Ah_const_xx(i,j)
enddo ; enddo
@@ -1248,18 +1297,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (CS%better_bound_Ah) then
if (CS%better_bound_Kh) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Ah(i,j) = min(Ah(i,j), visc_bound_rem(i,j) * hrat_min(i,j) * CS%Ah_Max_xx(i,j))
enddo ; enddo
else
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Ah(i,j) = min(Ah(i,j), hrat_min(i,j) * CS%Ah_Max_xx(i,j))
enddo ; enddo
endif
endif
- if ((CS%id_Ah_h>0) .or. CS%debug) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ if ((CS%id_Ah_h>0) .or. CS%debug .or. CS%use_Leithy) then
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
Ah_h(i,j,k) = Ah(i,j)
enddo ; enddo
endif
@@ -1267,14 +1316,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (CS%use_Leithy) then
! Compute Leith+E Kh after bounds have been applied to Ah
! and after it has been smoothed. Kh = -m_leithy * Ah
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- Kh(i,j) = -m_leithy(i,j) * Ah(i,j)
- Kh_h(i,j,k) = Kh(i,j)
+ do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
+ Kh(i,j) = -m_leithy(i,j) * Ah(i,j)
+ Kh_h(i,j,k) = Kh(i,j)
enddo ; enddo
endif
if (CS%id_grid_Re_Ah>0) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js,je ; do i=is,ie
KE = 0.125 * ((u(I,j,k) + u(I-1,j,k))**2 + (v(i,J,k) + v(i,J-1,k))**2)
grid_Ah = max(Ah(i,j), CS%min_grid_Ah)
grid_Re_Ah(i,j,k) = (sqrt(KE) * CS%grid_sp_h3(i,j)) / grid_Ah
@@ -1381,6 +1430,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
enddo ; enddo
endif
+ ! Pass the velocity gradients and thickness to ZB2020
+ if (CS%use_ZB2020) then
+ call ZB2020_copy_gradient_and_thickness( &
+ sh_xx, sh_xy, vort_xy, &
+ hq, &
+ G, GV, CS%ZB2020, k)
+ endif
+
if (CS%Laplacian) then
! Determine the Laplacian viscosity at q points, using the
! largest value from several parameterizations. Also get the
@@ -1468,7 +1525,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Leith+E doesn't recompute Kh at q points, it just interpolates it from h to q points
if (CS%use_Leithy) then
- Kh(I,J) = Kh_h(i+1,j+1,k)
+ Kh(I,J) = 0.25 * ((Kh_h(i,j,k) + Kh_h(i+1,j+1,k)) + (Kh_h(i,j+1,k) + Kh_h(i+1,j,k)))
end if
if (CS%id_Kh_q>0 .or. CS%debug) &
@@ -1575,7 +1632,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Leith+E doesn't recompute Ah at q points, it just interpolates it from h to q points
if (CS%use_Leithy) then
do J=js-1,Jeq ; do I=is-1,Ieq
- Ah(I,J) = Ah_h(i+1,j+1,k)
+ Ah(I,J) = 0.25 * ((Ah_h(i,j,k) + Ah_h(i+1,j+1,k)) + (Ah_h(i,j+1,k) + Ah_h(i+1,j,k)))
enddo ; enddo
end if
@@ -1639,7 +1696,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
else ! .not. use_GME
! This changes the units of str_xx from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2].
- do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j))
enddo ; enddo
@@ -1812,18 +1869,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
enddo ! end of k loop
- if (CS%use_ZB2020) then
- call Zanna_Bolton_2020(u, v, h, ZB2020u, ZB2020v, G, GV, CS%ZB2020)
-
- do k=1,nz ; do j=js,je ; do I=Isq,Ieq
- diffu(I,j,k) = diffu(I,j,k) + ZB2020u(I,j,k)
- enddo ; enddo ; enddo
-
- do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie
- diffv(i,J,k) = diffv(i,J,k) + ZB2020v(i,J,k)
- enddo ; enddo ; enddo
- endif
-
! Offer fields for diagnostic averaging.
if (CS%id_normstress > 0) call post_data(CS%id_normstress, NoSt, CS%diag)
if (CS%id_shearstress > 0) call post_data(CS%id_shearstress, ShSt, CS%diag)
@@ -1893,6 +1938,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (CS%id_diffv_visc_rem > 0) call post_product_v(CS%id_diffv_visc_rem, diffv, ADp%visc_rem_v, G, nz, CS%diag)
endif
+ if (CS%use_ZB2020) then
+ call ZB2020_lateral_stress(u, v, h, diffu, diffv, G, GV, CS%ZB2020, &
+ CS%dx2h, CS%dy2h, CS%dx2q, CS%dy2q)
+ endif
+
end subroutine horizontal_viscosity
!> Allocates space for and calculates static variables used by horizontal_viscosity().
@@ -1948,11 +1998,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
logical :: split ! If true, use the split time stepping scheme.
! If false and USE_GME = True, issue a FATAL error.
logical :: use_MEKE ! If true, the MEKE parameterization is in use.
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags
character(len=200) :: inputdir, filename ! Input file names and paths
character(len=80) :: Kh_var ! Input variable names
real :: deg2rad ! Converts degrees to radians [radians degree-1]
@@ -1971,7 +2017,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
! init control structure
- call ZB_2020_init(Time, GV, US, param_file, diag, CS%ZB2020, CS%use_ZB2020)
+ call ZB2020_init(Time, G, GV, US, param_file, diag, CS%ZB2020, CS%use_ZB2020)
CS%initialized = .true.
@@ -1983,22 +2029,13 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "HOR_VISC_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for horizontal viscosity.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "HOR_VISC_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the horizontal "//&
"viscosity calculations. Values below 20190101 recover the answers from the "//&
"end of 2018, while higher values use updated and more robust forms of the "//&
- "same expressions. If both HOR_VISC_2018_ANSWERS and HOR_VISC_ANSWER_DATE are "//&
- "specified, the latter takes precedence.", default=default_answer_date)
+ "same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.)
call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, &
@@ -2217,7 +2254,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
if (.not.CS%Laplacian) CS%use_Kh_bg_2d = .false.
call get_param(param_file, mdl, "KH_BG_2D_BUG", CS%Kh_bg_2d_bug, &
"If true, retain an answer-changing horizontal indexing bug in setting "//&
- "the corner-point viscosities when USE_KH_BG_2D=True. This is"//&
+ "the corner-point viscosities when USE_KH_BG_2D=True. This is "//&
"not recommended.", default=.false., do_not_log=.not.CS%use_Kh_bg_2d)
call get_param(param_file, mdl, "USE_GME", CS%use_GME, &
@@ -2227,13 +2264,17 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
"Use the split time stepping if true.", default=.true., do_not_log=.true.)
if (CS%use_Leithy) then
if (.not.(CS%biharmonic .and. CS%Laplacian)) then
- call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//&
+ call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init: "//&
"LAPLACIAN and BIHARMONIC must both be True when USE_LEITHY=True.")
endif
- call get_param(param_file, mdl, "LEITHY_CK", CS%c_K, &
- "Fraction of biharmonic dissipation that gets backscattered, "//&
- "in Leith+E.", units="nondim", default=1.0)
endif
+ call get_param(param_file, mdl, "LEITHY_CK", CS%c_K, &
+ "Fraction of biharmonic dissipation that gets backscattered, "//&
+ "in Leith+E.", units="nondim", default=1.0, do_not_log=.not.CS%use_Leithy)
+ call get_param(param_file, mdl, "SMOOTH_AH", CS%smooth_Ah, &
+ "If true, Ah and m_leithy are smoothed within Leith+E. This requires "//&
+ "lots of blocking communications, which can be expensive", &
+ default=.true., do_not_log=.not.CS%use_Leithy)
if (CS%use_GME .and. .not.split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// &
"cannot be used with SPLIT=False.")
@@ -2245,7 +2286,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
call get_param(param_file, mdl, "GME_H0", CS%GME_h0, &
"The strength of GME tapers quadratically to zero when the bathymetric "//&
"depth is shallower than GME_H0.", &
- units="m", scale=US%m_to_Z, default=1000.0)
+ units="m", scale=GV%m_to_H, default=1000.0)
call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, &
"The nondimensional prefactor multiplying the GME coefficient.", &
units="nondim", default=1.0)
@@ -2370,7 +2411,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
CS%dx2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%dy2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J)
CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J)
enddo ; enddo
- do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
+ do j=js-2,Jeq+2 ; do i=is-2,Ieq+2
CS%dx2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%dy2h(i,j) = G%dyT(i,j)*G%dyT(i,j)
CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j)
enddo ; enddo
@@ -2411,7 +2452,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
! Calculate and store the background viscosity at h-points
min_grid_sp_h2 = huge(1.)
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js-1,Jeq+1 ; do i=is-1,Ieq+1
! Static factors in the Smagorinsky and Leith schemes
grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j) + CS%dy2h(i,j))
CS%grid_sp_h2(i,j) = grid_sp_h2
@@ -2470,11 +2511,11 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
enddo ; enddo
endif
if (CS%biharmonic) then
- do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ do j=js-1,Jeq+1 ; do I=is-2,Ieq+1
CS%Idx2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j)
CS%Idxdy2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j))
enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1
+ do J=js-2,Jeq+1 ; do i=is-1,Ieq+1
CS%Idx2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J)
CS%Idxdy2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J))
enddo ; enddo
@@ -2486,7 +2527,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel))
min_grid_sp_h4 = huge(1.)
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js-1,Jeq+1 ; do i=is-1,Ieq+1
grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j)+CS%dy2h(i,j))
grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2)
CS%grid_sp_h3(i,j) = grid_sp_h3
@@ -2544,7 +2585,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
endif
! The Laplacian bounds should avoid overshoots when CS%bound_coef < 1.
if (CS%Laplacian .and. CS%better_bound_Kh) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js-1,Jeq+1 ; do i=is-1,Ieq+1
denom = max( &
(CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * &
max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), &
@@ -2572,7 +2613,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
! The biharmonic bounds should avoid overshoots when CS%bound_coef < 0.5, but
! empirically work for CS%bound_coef <~ 1.0
if (CS%biharmonic .and. CS%better_bound_Ah) then
- do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ do j=js-1,Jeq+1 ; do I=is-2,Ieq+1
u0u(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + &
CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + &
CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + &
@@ -2582,7 +2623,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + &
CS%dx2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) )
enddo ; enddo
- do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1
+ do J=js-2,Jeq+1 ; do i=is-1,Ieq+1
v0u(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + &
CS%dy2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + &
CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + &
@@ -2592,7 +2633,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + &
CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) )
enddo ; enddo
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ do j=js-1,Jeq+1 ; do i=is-1,Ieq+1
denom = max( &
(CS%dy2h(i,j) * &
(CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + &
@@ -2871,112 +2912,113 @@ subroutine smooth_GME(CS, G, GME_flux_h, GME_flux_q)
enddo ! s-loop
end subroutine smooth_GME
-!> Apply a 9-point smoothing filter twice to reduce horizontal two-grid-point noise
-!! Note that this subroutine does not conserve mass or angular momentum, so don't use it
-!! in situations where you need conservation. Also can't apply it to Ah and Kh in the
-!! horizontal_viscosity subroutine because they are not supposed to be halo-updated.
-!! But you _can_ apply them to Kh_h and Ah_h.
-subroutine smooth_x9(CS, G, field_h, field_u, field_v, field_q, zero_land)
- type(hor_visc_CS), intent(in) :: CS !< Control structure
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
- real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: field_h !< field to be smoothed
- !! at h points
- real, dimension(SZIB_(G),SZJ_(G)), optional, intent(inout) :: field_u !< field to be smoothed
- !! at u points
- real, dimension(SZI_(G),SZJB_(G)), optional, intent(inout) :: field_v !< field to be smoothed
- !! at v points
- real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: field_q !< field to be smoothed
- !! at q points
- logical, optional, intent(in) :: zero_land !< An optional argument
- !! indicating whether to set values
- !! on land to zero (.true.) or
- !! whether to ignore land values
- !! (.false. or not present)
- ! local variables. It would be good to make the _original variables allocatable.
- real, dimension(SZI_(G),SZJ_(G)) :: field_h_original
- real, dimension(SZIB_(G),SZJ_(G)) :: field_u_original
- real, dimension(SZI_(G),SZJB_(G)) :: field_v_original
- real, dimension(SZIB_(G),SZJB_(G)) :: field_q_original
- real, dimension(3,3) :: weights, local_weights ! averaging weights for smoothing, nondimensional
- logical :: zero_land_val ! actual value of zero_land optional argument
- integer :: i, j, s
- integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq
+!> Apply a 9-point smoothing filter twice to a field staggered at a thickness point to reduce
+!! horizontal two-grid-point noise.
+!! Note that this subroutine does not conserve mass, so don't use it in situations where you
+!! need conservation. Also note that it assumes that the input field has valid values in the
+!! first two halo points upon entry.
+subroutine smooth_x9_h(G, field_h, zero_land)
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid
+ real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: field_h !< h-point field to be smoothed [arbitrary]
+ logical, optional, intent(in) :: zero_land !< If present and false, return the average
+ !! of the surrounding ocean points when
+ !! smoothing, otherwise use a value of 0 for
+ !! land points and include them in the averages.
+ ! Local variables
+ real :: fh_prev(SZI_(G),SZJ_(G)) ! The value of the h-point field at the previous iteration [arbitrary]
+ real :: Iwts ! The inverse of the sum of the weights [nondim]
+ logical :: zero_land_val ! The value of the zero_land optional argument or .true. if it is absent.
+ integer :: i, j, s, is, ie, js, je
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
- Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- weights = reshape([1., 2., 1., 2., 4., 2., 1., 2., 1.],shape(weights))/16.
+ zero_land_val = .true. ; if (present(zero_land)) zero_land_val = zero_land
+
+ do s=1,0,-1
+ fh_prev(:,:) = field_h(:,:)
+ ! apply smoothing on field_h using rotationally symmetric expressions.
+ do j=js-s,je+s ; do i=is-s,ie+s ; if (G%mask2dT(i,j) > 0.0) then
+ Iwts = 0.0625
+ if (.not. zero_land_val) &
+ Iwts = 1.0 / ( (4.0*G%mask2dT(i,j) + &
+ ( 2.0*((G%mask2dT(i-1,j) + G%mask2dT(i+1,j)) + &
+ (G%mask2dT(i,j-1) + G%mask2dT(i,j+1))) + &
+ ((G%mask2dT(i-1,j-1) + G%mask2dT(i+1,j+1)) + &
+ (G%mask2dT(i-1,j+1) + G%mask2dT(i+1,j-1))) ) ) + 1.0e-16 )
+ field_h(i,j) = Iwts * ( 4.0*G%mask2dT(i,j) * fh_prev(i,j) &
+ + (2.0*((G%mask2dT(i-1,j) * fh_prev(i-1,j) + G%mask2dT(i+1,j) * fh_prev(i+1,j)) + &
+ (G%mask2dT(i,j-1) * fh_prev(i,j-1) + G%mask2dT(i,j+1) * fh_prev(i,j+1))) &
+ + ((G%mask2dT(i-1,j-1) * fh_prev(i-1,j-1) + G%mask2dT(i+1,j+1) * fh_prev(i+1,j+1)) + &
+ (G%mask2dT(i-1,j+1) * fh_prev(i-1,j+1) + G%mask2dT(i+1,j-1) * fh_prev(i-1,j-1))) ))
+ endif ; enddo ; enddo
+ enddo
+
+end subroutine smooth_x9_h
+
+!> Apply a 9-point smoothing filter twice to a pair of velocity components to reduce
+!! horizontal two-grid-point noise.
+!! Note that this subroutine does not conserve angular momentum, so don't use it
+!! in situations where you need conservation. Also note that it assumes that the
+!! input fields have valid values in the first two halo points upon entry.
+subroutine smooth_x9_uv(G, field_u, field_v, zero_land)
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid
+ real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: field_u !< u-point field to be smoothed[arbitrary]
+ real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: field_v !< v-point field to be smoothed [arbitrary]
+ logical, optional, intent(in) :: zero_land !< If present and false, return the average
+ !! of the surrounding ocean points when
+ !! smoothing, otherwise use a value of 0 for
+ !! land points and include them in the averages.
+
+ ! Local variables.
+ real :: fu_prev(SZIB_(G),SZJ_(G)) ! The value of the u-point field at the previous iteration [arbitrary]
+ real :: fv_prev(SZI_(G),SZJB_(G)) ! The value of the v-point field at the previous iteration [arbitrary]
+ real :: Iwts ! The inverse of the sum of the weights [nondim]
+ logical :: zero_land_val ! The value of the zero_land optional argument or .true. if it is absent.
+ integer :: i, j, s, is, ie, js, je, Isq, Ieq, Jsq, Jeq
- if (present(zero_land)) then
- zero_land_val = zero_land
- else
- zero_land_val = .false.
- endif
-
- if (present(field_h)) then
- call pass_var(field_h, G%Domain, halo=2) ! Halo size 2 ensures that you can smooth twice
- do s=1,0,-1
- field_h_original(:,:) = field_h(:,:)
- ! apply smoothing on field_h
- do j=js-s,je+s ; do i=is-s,ie+s
- ! skip land points
- if (G%mask2dT(i,j)==0.) cycle
- ! compute local weights
- local_weights = weights*G%mask2dT(i-1:i+1,j-1:j+1)
- if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16)
- field_h(i,j) = sum(local_weights*field_h_original(i-1:i+1,j-1:j+1))
- enddo ; enddo
- enddo
- call pass_var(field_h, G%Domain)
- endif
-
- if (present(field_u)) then
- call pass_vector(field_u, field_v, G%Domain, halo=2)
- do s=1,0,-1
- field_u_original(:,:) = field_u(:,:)
- ! apply smoothing on field_u
- do j=js-s,je+s ; do I=Isq-s,Ieq+s
- ! skip land points
- if (G%mask2dCu(I,j)==0.) cycle
- ! compute local weights
- local_weights = weights*G%mask2dCu(I-1:I+1,j-1:j+1)
- if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16)
- field_u(I,j) = sum(local_weights*field_u_original(I-1:I+1,j-1:j+1))
- enddo ; enddo
-
- field_v_original(:,:) = field_v(:,:)
- ! apply smoothing on field_v
- do J=Jsq-s,Jeq+s ; do i=is-s,ie+s
- ! skip land points
- if (G%mask2dCv(i,J)==0.) cycle
- ! compute local weights
- local_weights = weights*G%mask2dCv(i-1:i+1,J-1:J+1)
- if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16)
- field_v(i,J) = sum(local_weights*field_v_original(i-1:i+1,J-1:J+1))
- enddo ; enddo
- enddo
- call pass_vector(field_u, field_v, G%Domain)
- endif
-
- if (present(field_q)) then
- call pass_var(field_q, G%Domain, halo=2, position=CORNER)
- do s=1,0,-1
- field_q_original(:,:) = field_q(:,:)
- ! apply smoothing on field_q
- do J=Jsq-s,Jeq+s ; do I=Isq-s,Ieq+s
- ! skip land points
- if (G%mask2dBu(I,J)==0.) cycle
- ! compute local weights
- local_weights = weights*G%mask2dBu(I-1:I+1,J-1:J+1)
- if (zero_land_val) local_weights = local_weights/(sum(local_weights) + 1.E-16)
- field_q(I,J) = sum(local_weights*field_q_original(I-1:I+1,J-1:J+1))
- enddo ; enddo
- enddo
- call pass_var(field_q, G%Domain, position=CORNER)
- endif
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
-end subroutine smooth_x9
+ zero_land_val = .true. ; if (present(zero_land)) zero_land_val = zero_land
+
+ do s=1,0,-1
+ fu_prev(:,:) = field_u(:,:)
+ ! apply smoothing on field_u using the original non-rotationally symmetric expressions.
+ do j=js-s,je+s ; do I=Isq-s,Ieq+s ; if (G%mask2dCu(I,j) > 0.0) then
+ Iwts = 0.0625
+ if (.not. zero_land_val) &
+ Iwts = 1.0 / ( (4.0*G%mask2dCu(I,j) + &
+ ( 2.0*((G%mask2dCu(I-1,j) + G%mask2dCu(I+1,j)) + &
+ (G%mask2dCu(I,j-1) + G%mask2dCu(I,j+1))) + &
+ ((G%mask2dCu(I-1,j-1) + G%mask2dCu(I+1,j+1)) + &
+ (G%mask2dCu(I-1,j+1) + G%mask2dCu(I+1,j-1))) ) ) + 1.0e-16 )
+ field_u(I,j) = Iwts * ( 4.0*G%mask2dCu(I,j) * fu_prev(I,j) &
+ + (2.0*((G%mask2dCu(I-1,j) * fu_prev(I-1,j) + G%mask2dCu(I+1,j) * fu_prev(I+1,j)) + &
+ (G%mask2dCu(I,j-1) * fu_prev(I,j-1) + G%mask2dCu(I,j+1) * fu_prev(I,j+1))) &
+ + ((G%mask2dCu(I-1,j-1) * fu_prev(I-1,j-1) + G%mask2dCu(I+1,j+1) * fu_prev(I+1,j+1)) + &
+ (G%mask2dCu(I-1,j+1) * fu_prev(I-1,j+1) + G%mask2dCu(I+1,j-1) * fu_prev(I-1,j-1))) ))
+ endif ; enddo ; enddo
+
+ fv_prev(:,:) = field_v(:,:)
+ ! apply smoothing on field_v using the original non-rotationally symmetric expressions.
+ do J=Jsq-s,Jeq+s ; do i=is-s,ie+s ; if (G%mask2dCv(i,J) > 0.0) then
+ Iwts = 0.0625
+ if (.not. zero_land_val) &
+ Iwts = 1.0 / ( (4.0*G%mask2dCv(i,J) + &
+ ( 2.0*((G%mask2dCv(i-1,J) + G%mask2dCv(i+1,J)) + &
+ (G%mask2dCv(i,J-1) + G%mask2dCv(i,J+1))) + &
+ ((G%mask2dCv(i-1,J-1) + G%mask2dCv(i+1,J+1)) + &
+ (G%mask2dCv(i-1,J+1) + G%mask2dCv(i+1,J-1))) ) ) + 1.0e-16 )
+ field_v(i,J) = Iwts * ( 4.0*G%mask2dCv(i,J) * fv_prev(i,J) &
+ + (2.0*((G%mask2dCv(i-1,J) * fv_prev(i-1,J) + G%mask2dCv(i+1,J) * fv_prev(i+1,J)) + &
+ (G%mask2dCv(i,J-1) * fv_prev(i,J-1) + G%mask2dCv(i,J+1) * fv_prev(i,J+1))) &
+ + ((G%mask2dCv(i-1,J-1) * fv_prev(i-1,J-1) + G%mask2dCv(i+1,J+1) * fv_prev(i+1,J+1)) + &
+ (G%mask2dCv(i-1,J+1) * fv_prev(i-1,J+1) + G%mask2dCv(i+1,J-1) * fv_prev(i-1,J-1))) ))
+ endif ; enddo ; enddo
+ enddo
+
+end subroutine smooth_x9_uv
!> Deallocates any variables allocated in hor_visc_init.
subroutine hor_visc_end(CS)
@@ -3027,6 +3069,11 @@ subroutine hor_visc_end(CS)
DEALLOC_(CS%n1n1_m_n2n2_h)
DEALLOC_(CS%n1n1_m_n2n2_q)
endif
+
+ if (CS%use_ZB2020) then
+ call ZB2020_end(CS%ZB2020)
+ endif
+
end subroutine hor_visc_end
!> \namespace mom_hor_visc
!!
diff --git a/src/parameterizations/lateral/MOM_interface_filter.F90 b/src/parameterizations/lateral/MOM_interface_filter.F90
index dd082f1558..07b698e294 100644
--- a/src/parameterizations/lateral/MOM_interface_filter.F90
+++ b/src/parameterizations/lateral/MOM_interface_filter.F90
@@ -148,7 +148,7 @@ subroutine interface_filter(h, uhtr, vhtr, tv, dt, G, GV, US, CDp, CS)
endif
! Calculate uhD, vhD from h, e, Lsm2_u, Lsm2_v
- call filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size=filter_itts-1)
+ call filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, tv, G, GV, US, halo_size=filter_itts-1)
do itt=2,filter_itts
@@ -156,14 +156,23 @@ subroutine interface_filter(h, uhtr, vhtr, tv, dt, G, GV, US, CDp, CS)
!$OMP parallel do default(shared)
do j=js-hs,je+hs
do i=is-hs,ie+hs ; de_smooth(i,j,nz+1) = 0.0 ; enddo
- do k=nz,1,-1 ; do i=is-hs,ie+hs
- de_smooth(i,j,k) = de_smooth(i,j,k+1) + GV%H_to_Z * G%IareaT(i,j) * &
- ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k)))
- enddo ; enddo
+
+ if (allocated(tv%SpV_avg)) then
+ ! This is the fully non-Boussinesq version.
+ do k=nz,1,-1 ; do i=is-hs,ie+hs
+ de_smooth(i,j,K) = de_smooth(i,j,K+1) + (GV%H_to_RZ * tv%SpV_avg(i,j,k)) * G%IareaT(i,j) * &
+ ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k)))
+ enddo ; enddo
+ else
+ do k=nz,1,-1 ; do i=is-hs,ie+hs
+ de_smooth(i,j,K) = de_smooth(i,j,K+1) + GV%H_to_Z * G%IareaT(i,j) * &
+ ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k)))
+ enddo ; enddo
+ endif
enddo
! Calculate uhD, vhD from h, de_smooth, Lsm2_u, Lsm2_v
- call filter_interface(h, de_smooth, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size=filter_itts-itt)
+ call filter_interface(h, de_smooth, Lsm2_u, Lsm2_v, uhD, vhD, tv, G, GV, US, halo_size=filter_itts-itt)
enddo
! Offer diagnostic fields for averaging. This must occur before updating the layer thicknesses
@@ -227,7 +236,7 @@ end subroutine interface_filter
!> Calculates parameterized layer transports for use in the continuity equation.
!! Fluxes are limited to give positive definite thicknesses.
!! Called by interface_filter().
-subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size)
+subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, tv, G, GV, US, halo_size)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -241,6 +250,7 @@ subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size
!! [H L2 ~> m3 or kg]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: vhD !< Meridional mass fluxes
!! [H L2 ~> m3 or kg]
+ type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure
integer, optional, intent(in) :: halo_size !< The size of the halo to work on,
!! 0 by default.
@@ -256,14 +266,16 @@ subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size
real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning
! streamfunction [H L2 ~> m3 or kg].
real :: Sfn ! The overturning streamfunction [H L2 ~> m3 or kg].
+ real :: Rho_avg ! The in situ density averaged to an interface [R ~> kg m-3]
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
+ real :: hn_2 ! Half of h_neglect [H ~> m or kg m-2].
integer :: i, j, k, is, ie, js, je, nz, hs
hs = 0 ; if (present(halo_size)) hs = halo_size
is = G%isc-hs ; ie = G%iec+hs ; js = G%jsc-hs ; je = G%jec+hs ; nz = GV%ke
- h_neglect = GV%H_subroundoff
+ h_neglect = GV%H_subroundoff ; hn_2 = 0.5*h_neglect
! Find the maximum and minimum permitted streamfunction.
!$OMP parallel do default(shared)
@@ -286,7 +298,15 @@ subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size
do I=is-1,ie
Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%OBCmaskCu(I,j)
- Sfn_est = (Lsm2_u(I,j)*G%dy_Cu(I,j)) * (GV%Z_to_H * Slope)
+ if (allocated(tv%SpV_avg)) then
+ ! This is the fully non-Boussinesq version.
+ Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i+1,j,k) + h(i+1,j,k-1))) + 4.0*hn_2 ) / &
+ ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + &
+ ((h(i+1,j,k)+hn_2)*tv%SpV_avg(i+1,j,k) + (h(i+1,j,k-1)+hn_2)*tv%SpV_avg(i+1,j,k-1)) )
+ Sfn_est = (Lsm2_u(I,j)*G%dy_Cu(I,j)) * (GV%RZ_to_H * Slope) * Rho_avg
+ else
+ Sfn_est = (Lsm2_u(I,j)*G%dy_Cu(I,j)) * (GV%Z_to_H * Slope)
+ endif
! Make sure that there is enough mass above to allow the streamfunction
! to satisfy the boundary condition of 0 at the surface.
@@ -318,7 +338,15 @@ subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size
do i=is,ie
Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%OBCmaskCv(i,J)
- Sfn_est = (Lsm2_v(i,J)*G%dx_Cv(i,J)) * (GV%Z_to_H * Slope)
+ if (allocated(tv%SpV_avg)) then
+ ! This is the fully non-Boussinesq version.
+ Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i,j+1,k) + h(i,j+1,k-1))) + 4.0*hn_2 ) / &
+ ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + &
+ ((h(i,j+1,k)+hn_2)*tv%SpV_avg(i,j+1,k) + (h(i,j+1,k-1)+hn_2)*tv%SpV_avg(i,j+1,k-1)) )
+ Sfn_est = (Lsm2_v(i,J)*G%dx_Cv(i,J)) * (GV%RZ_to_H * Slope) * Rho_avg
+ else
+ Sfn_est = (Lsm2_v(i,J)*G%dx_Cv(i,J)) * (GV%Z_to_H * Slope)
+ endif
! Make sure that there is enough mass above to allow the streamfunction
! to satisfy the boundary condition of 0 at the surface.
diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90
index 8c56107a4f..a8b0d3f813 100644
--- a/src/parameterizations/lateral/MOM_internal_tides.F90
+++ b/src/parameterizations/lateral/MOM_internal_tides.F90
@@ -16,9 +16,13 @@ module MOM_internal_tides
use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe
use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
-use MOM_io, only : slasher, MOM_read_data, file_exists
+use MOM_int_tide_input, only: int_tide_input_CS, get_input_TKE, get_barotropic_tidal_vel
+use MOM_io, only : slasher, MOM_read_data, file_exists, axis_info
+use MOM_io, only : set_axis_info, get_axis_info
use MOM_restart, only : register_restart_field, MOM_restart_CS, restart_init, save_restart
+use MOM_restart, only : lock_check, restart_registry_lock
use MOM_spatial_means, only : global_area_integral
+use MOM_string_functions, only: extract_real
use MOM_time_manager, only : time_type, time_type_to_real, operator(+), operator(/), operator(-)
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : surface, thermo_var_ptrs
@@ -29,12 +33,13 @@ module MOM_internal_tides
#include
-public propagate_int_tide !, register_int_tide_restarts
+public propagate_int_tide, register_int_tide_restarts
public internal_tides_init, internal_tides_end
public get_lowmode_loss
!> This control structure has parameters for the MOM_internal_tides module
type, public :: int_tide_CS ; private
+ logical :: initialized = .false. !< True if this control structure has been initialized.
logical :: do_int_tides !< If true, use the internal tide code.
integer :: nFreq = 0 !< The number of internal tide frequency bands
integer :: nMode = 1 !< The number of internal tide vertical modes
@@ -51,6 +56,9 @@ module MOM_internal_tides
!! the default is false; it is always true with aggress_adjust.
logical :: use_PPMang !< If true, use PPM for advection of energy in angular space.
+ real, allocatable, dimension(:,:) :: fraction_tidal_input
+ !< how the energy from one tidal component is distributed
+ !! over the various vertical modes, 2d in frequency and mode [nondim]
real, allocatable, dimension(:,:) :: refl_angle
!< local coastline/ridge/shelf angles read from file [rad]
! (could be in G control structure)
@@ -78,9 +86,10 @@ module MOM_internal_tides
real, allocatable, dimension(:,:,:,:,:) :: TKE_Froude_loss
!< energy lost due to wave breaking [R Z3 T-3 ~> W m-2]
real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed
- !< Fixed part of the energy lost due to small-scale drag [R L-2 Z3 ~> kg m-2] here;
- !! This will be multiplied by N and the squared near-bottom velocity to get
- !! the energy losses in [R Z3 T-3 ~> W m-2]
+ !< Fixed part of the energy lost due to small-scale drag [R Z3 L-2 ~> kg m-2] here;
+ !! This will be multiplied by N and the squared near-bottom velocity (and by
+ !! the near-bottom density in non-Boussinesq mode) to get the energy losses
+ !! in [R Z4 H-1 L-2 ~> kg m-2 or m]
real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss
!< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2]
real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss
@@ -106,11 +115,11 @@ module MOM_internal_tides
real, allocatable, dimension(:,:,:) :: u_struct_bot !< Bottom value of u_struct,
!! for each mode [Z-1 ~> m-1]
real, allocatable, dimension(:,:,:) :: int_w2 !< Vertical integral of w_struct squared,
- !! for each mode [Z ~> m]
+ !! for each mode [H ~> m or kg m-2]
real, allocatable, dimension(:,:,:) :: int_U2 !< Vertical integral of u_struct squared,
- !! for each mode [Z-1 ~> m-1]
+ !! for each mode [H Z-2 ~> m-1 or kg m-4]
real, allocatable, dimension(:,:,:) :: int_N2w2 !< Depth-integrated Brunt Vaissalla freqency times
- !! vertical profile squared, for each mode [Z T-2 ~> m s-2]
+ !! vertical profile squared, for each mode [H T-2 ~> m s-2 or kg m-2 s-2]
real :: q_itides !< fraction of local dissipation [nondim]
real :: En_sum !< global sum of energy for use in debugging, in MKS units [J]
type(time_type), pointer :: Time => NULL() !< A pointer to the model's clock.
@@ -120,7 +129,7 @@ module MOM_internal_tides
real :: cdrag !< The bottom drag coefficient [nondim].
real :: drag_min_depth !< The minimum total ocean thickness that will be used in the denominator
!! of the quadratic drag terms for internal tides when
- !! INTERNAL_TIDE_QUAD_DRAG is true [Z ~> m]
+ !! INTERNAL_TIDE_QUAD_DRAG is true [H ~> m or kg m-2]
logical :: apply_background_drag
!< If true, apply a drag due to background processes as a sink.
logical :: apply_bottom_drag
@@ -136,8 +145,17 @@ module MOM_internal_tides
real, allocatable :: En(:,:,:,:,:)
!< The internal wave energy density as a function of (i,j,angle,frequency,mode)
!! integrated within an angular and frequency band [R Z3 T-2 ~> J m-2]
- real, allocatable :: En_restart(:,:,:)
- !< The internal wave energy density as a function of (i,j,angle); temporary for restart
+ real, allocatable :: En_restart_mode1(:,:,:,:)
+ !< The internal wave energy density as a function of (i,j,angle,freq) for mode 1
+ real, allocatable :: En_restart_mode2(:,:,:,:)
+ !< The internal wave energy density as a function of (i,j,angle,freq) for mode 2
+ real, allocatable :: En_restart_mode3(:,:,:,:)
+ !< The internal wave energy density as a function of (i,j,angle,freq) for mode 3
+ real, allocatable :: En_restart_mode4(:,:,:,:)
+ !< The internal wave energy density as a function of (i,j,angle,freq) for mode 4
+ real, allocatable :: En_restart_mode5(:,:,:,:)
+ !< The internal wave energy density as a function of (i,j,angle,freq) for mode 5
+
real, allocatable, dimension(:) :: frequency !< The frequency of each band [T-1 ~> s-1].
type(wave_speed_CS) :: wave_speed !< Wave speed control structure
@@ -148,7 +166,7 @@ module MOM_internal_tides
! Diag handles relevant to all modes, frequencies, and angles
integer :: id_cg1 = -1 ! diagnostic handle for mode-1 speed
integer, allocatable, dimension(:) :: id_cn ! diagnostic handle for all mode speeds
- integer :: id_tot_En = -1, id_TKE_itidal_input = -1, id_itide_drag = -1
+ integer :: id_tot_En = -1
integer :: id_refl_pref = -1, id_refl_ang = -1, id_land_mask = -1
integer :: id_trans = -1, id_residual = -1
integer :: id_dx_Cv = -1, id_dy_Cu = -1
@@ -159,7 +177,12 @@ module MOM_internal_tides
integer, allocatable, dimension(:,:) :: &
id_En_mode, &
id_itidal_loss_mode, &
+ id_leak_loss_mode, &
+ id_quad_loss_mode, &
+ id_Froude_loss_mode, &
+ id_residual_loss_mode, &
id_allprocesses_loss_mode, &
+ id_itide_drag, &
id_Ub_mode, &
id_cp_mode
! Diag handles considering: all modes, frequencies, and angles
@@ -167,6 +190,7 @@ module MOM_internal_tides
id_En_ang_mode, &
id_itidal_loss_ang_mode
integer, allocatable, dimension(:) :: &
+ id_TKE_itidal_input, &
id_Ustruct_mode, &
id_Wstruct_mode, &
id_int_w2_mode, &
@@ -187,8 +211,7 @@ module MOM_internal_tides
!> Calls subroutines in this file that are needed to refract, propagate,
!! and dissipate energy density of the internal tide.
-subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
- G, GV, US, CS)
+subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_CSp, CS)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -196,18 +219,21 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables
!! (needed for wave structure).
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: TKE_itidal_input !< The energy input to the
- !! internal waves [R Z3 T-3 ~> W m-2].
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read
- !! from file [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1].
!! In some cases the input values are used, but in
!! others this is set along with the wave speeds.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Rho_bot !< Near-bottom density or the Boussinesq
+ !! reference density [R ~> kg m-3].
real, intent(in) :: dt !< Length of time over which to advance
!! the internal tides [T ~> s].
+ type(int_tide_input_CS), intent(in) :: inttide_input_CSp !< Internal tide input control structure
type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure
! Local variables
+ real, dimension(SZI_(G),SZJ_(G),CS%nFreq) :: &
+ TKE_itidal_input, & !< The energy input to the internal waves [R Z3 T-3 ~> W m-2].
+ vel_btTide !< Barotropic velocity read from file [L T-1 ~> m s-1].
+
real, dimension(SZI_(G),SZJ_(G),2) :: &
test ! A test unit vector used to determine grid rotation in halos [nondim]
real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: &
@@ -216,20 +242,27 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
tot_En_mode, & ! energy summed over angles only [R Z3 T-2 ~> J m-2]
Ub, & ! near-bottom horizontal velocity of wave (modal) [L T-1 ~> m s-1]
Umax ! Maximum horizontal velocity of wave (modal) [L T-1 ~> m s-1]
+ real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: &
+ drag_scale ! bottom drag scale [T-1 ~> s-1]
real, dimension(SZI_(G),SZJ_(G)) :: &
+ tot_vel_btTide2, &
tot_En, & ! energy summed over angles, modes, frequencies [R Z3 T-2 ~> J m-2]
tot_leak_loss, tot_quad_loss, tot_itidal_loss, tot_Froude_loss, tot_residual_loss, tot_allprocesses_loss, &
! energy loss rates summed over angle, freq, and mode [R Z3 T-3 ~> W m-2]
htot, & ! The vertical sum of the layer thicknesses [H ~> m or kg m-2]
- drag_scale, & ! bottom drag scale [T-1 ~> s-1]
itidal_loss_mode, & ! Energy lost due to small-scale wave drag, summed over angles [R Z3 T-3 ~> W m-2]
+ leak_loss_mode, &
+ quad_loss_mode, &
+ Froude_loss_mode, &
+ residual_loss_mode, &
allprocesses_loss_mode ! Total energy loss rates for a given mode and frequency (summed over
! all angles) [R Z3 T-3 ~> W m-2]
+
real :: frac_per_sector ! The inverse of the number of angular, modal and frequency bins [nondim]
real :: f2 ! The squared Coriolis parameter interpolated to a tracer point [T-2 ~> s-2]
real :: Kmag2 ! A squared horizontal wavenumber [L-2 ~> m-2]
- real :: I_D_here ! The inverse of the local depth [Z-1 ~> m-1]
- real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1]
+ real :: I_D_here ! The inverse of the local water column thickness [H-1 ~> m-1 or m2 kg-1]
+ real :: I_mass ! The inverse of the local water mass [R-1 Z-1 ~> m2 kg-1]
real :: freq2 ! The frequency squared [T-2 ~> s-2]
real :: PE_term ! total potential energy of profile [R Z ~> kg m-2]
real :: KE_term ! total kinetic energy of profile [R Z ~> kg m-2]
@@ -244,7 +277,8 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
real :: En_initial, Delta_E_check ! Energies for debugging [R Z3 T-2 ~> J m-2]
real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! Energy losses for debugging [R Z3 T-3 ~> W m-2]
character(len=160) :: mesg ! The text of an error message
- integer :: a, m, fr, i, j, k, is, ie, js, je, isd, ied, jsd, jed, nAngle, nzm
+ integer :: En_halo_ij_stencil ! The halo size needed for energy advection
+ integer :: a, m, fr, i, j, k, is, ie, js, je, isd, ied, jsd, jed, nAngle
integer :: id_g, jd_g ! global (decomp-invar) indices (for debugging)
type(group_pass_type), save :: pass_test, pass_En
type(time_type) :: time_end
@@ -252,18 +286,49 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle
- nzm = GV%ke
- I_rho0 = 1.0 / GV%Rho0
+
cn_subRO = 1e-30*US%m_s_to_L_T
en_subRO = 1e-30*US%W_m2_to_RZ3_T3*US%s_to_T
! initialize local arrays
- drag_scale(:,:) = 0.
+ TKE_itidal_input(:,:,:) = 0.
+ vel_btTide(:,:,:) = 0.
+ tot_vel_btTide2(:,:) = 0.
+ drag_scale(:,:,:,:) = 0.
Ub(:,:,:,:) = 0.
Umax(:,:,:,:) = 0.
cn(:,:,:) = 0.
+ ! Rebuild energy density array from multiple restarts
+ do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,1) = CS%En_restart_mode1(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+
+ if (CS%nMode >= 2) then
+ do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,2) = CS%En_restart_mode2(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
+ if (CS%nMode >= 3) then
+ do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,3) = CS%En_restart_mode3(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
+ if (CS%nMode >= 4) then
+ do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,4) = CS%En_restart_mode4(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
+ if (CS%nMode >= 5) then
+ do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,5) = CS%En_restart_mode5(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
! Set properties related to the internal tides, such as the wave speeds, storing some
! of them in the control structure for this module.
if (CS%uniform_test_cg > 0.0) then
@@ -271,35 +336,41 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
else
call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, CS%wave_speed, &
CS%w_struct, CS%u_struct, CS%u_struct_max, CS%u_struct_bot, &
- Nb, CS%int_w2, CS%int_U2, CS%int_N2w2, full_halos=.true.)
+ Nb, CS%int_w2, CS%int_U2, CS%int_N2w2, halo_size=2)
+ ! The value of halo_size above would have to be larger if there were
+ ! not a halo update between the calls to propagate_x and propagate_y.
+ ! It can be 1 point smaller if teleport is not used.
endif
! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.**********************
! This is wrong, of course, but it works reasonably in some cases.
! Uncomment if wave_speed is not used to calculate the true values (BDM).
- !do m=1,CS%nMode ; do j=jsd,jed ; do i=isd,ied
+ !do m=1,CS%nMode ; do j=js-2,je+2 ; do i=is-2,ie+2
! cn(i,j,m) = cn(i,j,1) / real(m)
!enddo ; enddo ; enddo
! Add the forcing.***************************************************************
+
+ call get_input_TKE(G, TKE_itidal_input, CS%nFreq, inttide_input_CSp)
+
if (CS%energized_angle <= 0) then
- frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq)
+ frac_per_sector = 1.0 / real(CS%nAngle)
do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
(G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))
if (CS%frequency(fr)**2 > f2) &
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * &
- TKE_itidal_input(i,j)
+ CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr)
enddo ; enddo ; enddo ; enddo ; enddo
elseif (CS%energized_angle <= CS%nAngle) then
- frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq)
+ frac_per_sector = 1.0
a = CS%energized_angle
do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie
f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
(G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))
if (CS%frequency(fr)**2 > f2) &
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * &
- TKE_itidal_input(i,j)
+ CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr)
enddo ; enddo ; enddo ; enddo
else
call MOM_error(WARNING, "Internal tide energy is being put into a angular "//&
@@ -319,9 +390,10 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, &
G, US, CS%nAngle, CS%use_PPMang)
enddo ; enddo
+ ! A this point, CS%En is only valid on the computational domain.
! Check for En<0 - for debugging, delete later
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
@@ -338,12 +410,18 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
call complete_group_pass(pass_test, G%domain)
+ ! Set the halo size to work on, using similar logic to that used in propagate. This may need
+ ! to be adjusted depending on the advection scheme and whether teleport is used.
+ if (CS%upwind_1st) then ; En_halo_ij_stencil = 2
+ else ; En_halo_ij_stencil = 3 ; endif
+
! Rotate points in the halos as necessary.
- call correct_halo_rotation(CS%En, test, G, CS%nAngle)
+ call correct_halo_rotation(CS%En, test, G, CS%nAngle, halo=En_halo_ij_stencil)
! Propagate the waves.
- do m=1,CS%NMode ; do fr=1,CS%Nfreq
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq
+ ! initialize residual loss, will be computed in propagate
CS%TKE_residual_loss(:,:,:,fr,m) = 0.
call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, &
@@ -351,7 +429,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
enddo ; enddo
! Check for En<0 - for debugging, delete later
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset
@@ -367,18 +445,19 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
enddo ; enddo ; enddo
! Apply the other half of the refraction.
- do m=1,CS%NMode ; do fr=1,CS%Nfreq
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq
call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, &
G, US, CS%NAngle, CS%use_PPMang)
enddo ; enddo
+ ! A this point, CS%En is only valid on the computational domain.
! Check for En<0 - for debugging, delete later
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
write(mesg,*) 'After second refraction: En<0.0 at ig=', id_g, ', jg=', jd_g, &
- 'En=',CS%En(i,j,a,fr,m)
+ 'En=', CS%En(i,j,a,fr,m)
call MOM_error(WARNING, "propagate_int_tide: "//trim(mesg))
CS%En(i,j,a,fr,m) = 0.0
! call MOM_error(FATAL, "propagate_int_tide: stopped due to negative energy.")
@@ -392,8 +471,8 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
.or. (CS%id_tot_En > 0)) then
tot_En(:,:) = 0.0
tot_En_mode(:,:,:,:) = 0.0
- do m=1,CS%NMode ; do fr=1,CS%Nfreq
- do j=jsd,jed ; do i=isd,ied ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq
+ do j=js,je ; do i=is,ie ; do a=1,CS%nAngle
tot_En(i,j) = tot_En(i,j) + CS%En(i,j,a,fr,m)
tot_En_mode(i,j,fr,m) = tot_En_mode(i,j,fr,m) + CS%En(i,j,a,fr,m)
enddo ; enddo ; enddo
@@ -402,7 +481,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! Extract the energy for mixing due to misc. processes (background leakage)------
if (CS%apply_background_drag) then
- do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
! Calculate loss rate and apply loss over the time step ; apply the same drag timescale
! to each En component (technically not correct; fix later)
CS%TKE_leak_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * CS%decay_rate ! loss rate [R Z3 T-3 ~> W m-2]
@@ -410,7 +489,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
enddo ; enddo ; enddo ; enddo ; enddo
endif
! Check for En<0 - for debugging, delete later
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
@@ -426,23 +505,40 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! Extract the energy for mixing due to bottom drag-------------------------------
if (CS%apply_bottom_drag) then
do j=jsd,jed ; do i=isd,ied ; htot(i,j) = 0.0 ; enddo ; enddo
+
+ call get_barotropic_tidal_vel(G, vel_btTide, CS%nFreq, inttide_input_CSp)
+
+ do fr=1,CS%Nfreq ; do j=jsd,jed ; do i=isd,ied
+ tot_vel_btTide2(i,j) = tot_vel_btTide2(i,j) + vel_btTide(i,j,fr)**2
+ enddo ; enddo ; enddo
+
do k=1,GV%ke ; do j=jsd,jed ; do i=isd,ied
htot(i,j) = htot(i,j) + h(i,j,k)
enddo ; enddo ; enddo
- do j=jsd,jed ; do i=isd,ied
- I_D_here = 1.0 / (max(GV%H_to_Z*htot(i,j), CS%drag_min_depth))
- drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, US%L_to_Z**2*vel_btTide(i,j)**2 + &
- tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here
- enddo ; enddo
- do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ if (GV%Boussinesq) then
+ ! This is mathematically equivalent to the form in the option below, but they differ at roundoff.
+ do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do j=jsd,jed ; do i=isd,ied
+ I_D_here = 1.0 / (max(htot(i,j), CS%drag_min_depth))
+ drag_scale(i,j,fr,m) = CS%cdrag * sqrt(max(0.0, US%L_to_Z**2*tot_vel_btTide2(i,j)**2 + &
+ tot_En_mode(i,j,fr,m) * GV%RZ_to_H * I_D_here)) * GV%Z_to_H*I_D_here
+ enddo ; enddo ; enddo ; enddo
+ else
+ do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do j=jsd,jed ; do i=isd,ied
+ I_mass = GV%RZ_to_H / (max(htot(i,j), CS%drag_min_depth))
+ drag_scale(i,j,fr,m) = (CS%cdrag * (Rho_bot(i,j)*I_mass)) * &
+ sqrt(max(0.0, US%L_to_Z**2*tot_vel_btTide2(i,j)**2 + &
+ tot_En_mode(i,j,fr,m) * I_mass))
+ enddo ; enddo ; enddo ; enddo
+ endif
+ do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
! Calculate loss rate and apply loss over the time step ; apply the same drag timescale
! to each En component (technically not correct; fix later)
- CS%TKE_quad_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * drag_scale(i,j) ! loss rate
- CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * drag_scale(i,j)) ! implicit update
+ CS%TKE_quad_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * drag_scale(i,j,fr,m) ! loss rate
+ CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * drag_scale(i,j,fr,m)) ! implicit update
enddo ; enddo ; enddo ; enddo ; enddo
endif
! Check for En<0 - for debugging, delete later
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
@@ -460,10 +556,10 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! still need to allow a portion of the extracted energy to go to higher modes.
! First, find velocity profiles
if (CS%apply_wave_drag .or. CS%apply_Froude_drag) then
- do m=1,CS%NMode ; do fr=1,CS%Nfreq
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq
! compute near-bottom and max horizontal baroclinic velocity values at each point
- do j=jsd,jed ; do i=isd,ied
+ do j=js,je ; do i=is,ie
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
! Calculate wavenumber magnitude
@@ -477,9 +573,9 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! Back-calculate amplitude from energy equation
if ( (G%mask2dT(i,j) > 0.5) .and. (freq2*Kmag2 > 0.0)) then
! Units here are [R Z ~> kg m-2]
- KE_term = 0.25*GV%Rho0*( ((freq2 + f2) / (freq2*Kmag2))*US%L_to_Z**2*CS%int_U2(i,j,m) + &
+ KE_term = 0.25*GV%H_to_RZ*( ((freq2 + f2) / (freq2*Kmag2))*US%L_to_Z**2*CS%int_U2(i,j,m) + &
CS%int_w2(i,j,m) )
- PE_term = 0.25*GV%Rho0*( CS%int_N2w2(i,j,m) / freq2 )
+ PE_term = 0.25*GV%H_to_RZ*( CS%int_N2w2(i,j,m) / freq2 )
if (KE_term + PE_term > 0.0) then
W0 = sqrt( tot_En_mode(i,j,fr,m) / (KE_term + PE_term) )
@@ -504,11 +600,11 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! Finally, apply loss
if (CS%apply_wave_drag) then
! Calculate loss rate and apply loss over the time step
- call itidal_lowmode_loss(G, US, CS, Nb, Ub, CS%En, CS%TKE_itidal_loss_fixed, &
- CS%TKE_itidal_loss, dt, full_halos=.false.)
+ call itidal_lowmode_loss(G, GV, US, CS, Nb, Rho_bot, Ub, CS%En, CS%TKE_itidal_loss_fixed, &
+ CS%TKE_itidal_loss, dt, halo_size=0)
endif
! Check for En<0 - for debugging, delete later
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
@@ -524,7 +620,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! Extract the energy for mixing due to wave breaking-----------------------------
if (CS%apply_Froude_drag) then
! Pick out maximum baroclinic velocity values; calculate Fr=max(u)/cg
- do m=1,CS%NMode ; do fr=1,CS%Nfreq
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq
freq2 = CS%frequency(fr)**2
do j=js,je ; do i=is,ie
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
@@ -575,7 +671,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
enddo ; enddo
endif
! Check for En<0 - for debugging, delete later
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle
do j=js,je ; do i=is,ie
if (CS%En(i,j,a,fr,m)<0.0) then
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset
@@ -592,7 +688,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! loss from residual of reflection/transmission coefficients
if (CS%apply_residual_drag) then
- do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
! implicit form
!CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%TKE_residual_loss(i,j,a,fr,m) / &
! (CS%En(i,j,a,fr,m) + en_subRO))
@@ -607,7 +703,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! Check for energy conservation on computational domain.*************************
- do m=1,CS%NMode ; do fr=1,CS%Nfreq
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq
call sum_En(G, US, CS, CS%En(:,:,:,fr,m), 'prop_int_tide')
enddo ; enddo
@@ -622,12 +718,17 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
! Output two-dimensional diagnostics
if (CS%id_tot_En > 0) call post_data(CS%id_tot_En, tot_En, CS%diag)
- if (CS%id_itide_drag > 0) call post_data(CS%id_itide_drag, drag_scale, CS%diag)
- if (CS%id_TKE_itidal_input > 0) call post_data(CS%id_TKE_itidal_input, &
- TKE_itidal_input, CS%diag)
+ do fr=1,CS%nFreq
+ if (CS%id_TKE_itidal_input(fr) > 0) call post_data(CS%id_TKE_itidal_input(fr), &
+ TKE_itidal_input(:,:,fr), CS%diag)
+ enddo
+
+ do m=1,CS%nMode ; do fr=1,CS%nFreq
+ if (CS%id_itide_drag(fr,m) > 0) call post_data(CS%id_itide_drag(fr,m), drag_scale(:,:,fr,m), CS%diag)
+ enddo ; enddo
! Output 2-D energy density (summed over angles) for each frequency and mode
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_En_mode(fr,m) > 0) then
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; if (CS%id_En_mode(fr,m) > 0) then
tot_En(:,:) = 0.0
do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
tot_En(i,j) = tot_En(i,j) + CS%En(i,j,a,fr,m)
@@ -635,8 +736,37 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
call post_data(CS%id_En_mode(fr,m), tot_En, CS%diag)
endif ; enddo ; enddo
+ ! split energy array into multiple restarts
+ do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En_restart_mode1(i,j,a,fr) = CS%En(i,j,a,fr,1)
+ enddo ; enddo ; enddo ; enddo
+
+ if (CS%nMode >= 2) then
+ do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En_restart_mode2(i,j,a,fr) = CS%En(i,j,a,fr,2)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
+ if (CS%nMode >= 3) then
+ do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En_restart_mode3(i,j,a,fr) = CS%En(i,j,a,fr,3)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
+ if (CS%nMode >= 4) then
+ do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En_restart_mode4(i,j,a,fr) = CS%En(i,j,a,fr,4)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
+ if (CS%nMode >= 5) then
+ do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied
+ CS%En_restart_mode5(i,j,a,fr) = CS%En(i,j,a,fr,5)
+ enddo ; enddo ; enddo ; enddo
+ endif
+
! Output 3-D (i,j,a) energy density for each frequency and mode
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_En_ang_mode(fr,m) > 0) then
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; if (CS%id_En_ang_mode(fr,m) > 0) then
call post_data(CS%id_En_ang_mode(fr,m), CS%En(:,:,:,fr,m) , CS%diag)
endif ; enddo ; enddo
@@ -647,7 +777,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
tot_Froude_loss(:,:) = 0.0
tot_residual_loss(:,:) = 0.0
tot_allprocesses_loss(:,:) = 0.0
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
tot_leak_loss(i,j) = tot_leak_loss(i,j) + CS%TKE_leak_loss(i,j,a,fr,m)
tot_quad_loss(i,j) = tot_quad_loss(i,j) + CS%TKE_quad_loss(i,j,a,fr,m)
tot_itidal_loss(i,j) = tot_itidal_loss(i,j) + CS%TKE_itidal_loss(i,j,a,fr,m)
@@ -685,53 +815,65 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, &
endif
! Output 2-D energy loss (summed over angles) for each frequency and mode
- do m=1,CS%NMode ; do fr=1,CS%Nfreq
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq
if (CS%id_itidal_loss_mode(fr,m) > 0 .or. CS%id_allprocesses_loss_mode(fr,m) > 0) then
itidal_loss_mode(:,:) = 0.0 ! wave-drag processes (could do others as well)
+ leak_loss_mode(:,:) = 0.0
+ quad_loss_mode(:,:) = 0.0
+ Froude_loss_mode(:,:) = 0.0
+ residual_loss_mode(:,:) = 0.0
allprocesses_loss_mode(:,:) = 0.0 ! all processes summed together
do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
itidal_loss_mode(i,j) = itidal_loss_mode(i,j) + CS%TKE_itidal_loss(i,j,a,fr,m)
+ leak_loss_mode(i,j) = leak_loss_mode(i,j) + CS%TKE_leak_loss(i,j,a,fr,m)
+ quad_loss_mode(i,j) = quad_loss_mode(i,j) + CS%TKE_quad_loss(i,j,a,fr,m)
+ Froude_loss_mode(i,j) = Froude_loss_mode(i,j) + CS%TKE_Froude_loss(i,j,a,fr,m)
+ residual_loss_mode(i,j) = residual_loss_mode(i,j) + CS%TKE_residual_loss(i,j,a,fr,m)
allprocesses_loss_mode(i,j) = allprocesses_loss_mode(i,j) + &
((((CS%TKE_leak_loss(i,j,a,fr,m) + CS%TKE_quad_loss(i,j,a,fr,m)) + &
CS%TKE_itidal_loss(i,j,a,fr,m)) + CS%TKE_Froude_loss(i,j,a,fr,m)) + &
CS%TKE_residual_loss(i,j,a,fr,m))
enddo ; enddo ; enddo
call post_data(CS%id_itidal_loss_mode(fr,m), itidal_loss_mode, CS%diag)
+ call post_data(CS%id_leak_loss_mode(fr,m), leak_loss_mode, CS%diag)
+ call post_data(CS%id_quad_loss_mode(fr,m), quad_loss_mode, CS%diag)
+ call post_data(CS%id_Froude_loss_mode(fr,m), Froude_loss_mode, CS%diag)
+ call post_data(CS%id_residual_loss_mode(fr,m), residual_loss_mode, CS%diag)
call post_data(CS%id_allprocesses_loss_mode(fr,m), allprocesses_loss_mode, CS%diag)
endif ; enddo ; enddo
! Output 3-D (i,j,a) energy loss for each frequency and mode
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_itidal_loss_ang_mode(fr,m) > 0) then
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; if (CS%id_itidal_loss_ang_mode(fr,m) > 0) then
call post_data(CS%id_itidal_loss_ang_mode(fr,m), CS%TKE_itidal_loss(:,:,:,fr,m) , CS%diag)
endif ; enddo ; enddo
! Output 2-D period-averaged horizontal near-bottom mode velocity for each frequency and mode
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_Ub_mode(fr,m) > 0) then
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; if (CS%id_Ub_mode(fr,m) > 0) then
call post_data(CS%id_Ub_mode(fr,m), Ub(:,:,fr,m), CS%diag)
endif ; enddo ; enddo
- do m=1,CS%NMode ; if (CS%id_Ustruct_mode(m) > 0) then
+ do m=1,CS%nMode ; if (CS%id_Ustruct_mode(m) > 0) then
call post_data(CS%id_Ustruct_mode(m), CS%u_struct(:,:,:,m), CS%diag)
endif ; enddo
- do m=1,CS%NMode ; if (CS%id_Wstruct_mode(m) > 0) then
+ do m=1,CS%nMode ; if (CS%id_Wstruct_mode(m) > 0) then
call post_data(CS%id_Wstruct_mode(m), CS%w_struct(:,:,:,m), CS%diag)
endif ; enddo
- do m=1,CS%NMode ; if (CS%id_int_w2_mode(m) > 0) then
+ do m=1,CS%nMode ; if (CS%id_int_w2_mode(m) > 0) then
call post_data(CS%id_int_w2_mode(m), CS%int_w2(:,:,m), CS%diag)
endif ; enddo
- do m=1,CS%NMode ; if (CS%id_int_U2_mode(m) > 0) then
+ do m=1,CS%nMode ; if (CS%id_int_U2_mode(m) > 0) then
call post_data(CS%id_int_U2_mode(m), CS%int_U2(:,:,m), CS%diag)
endif ; enddo
- do m=1,CS%NMode ; if (CS%id_int_N2w2_mode(m) > 0) then
+ do m=1,CS%nMode ; if (CS%id_int_N2w2_mode(m) > 0) then
call post_data(CS%id_int_N2w2_mode(m), CS%int_N2w2(:,:,m), CS%diag)
endif ; enddo
! Output 2-D horizontal phase velocity for each frequency and mode
- do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_cp_mode(fr,m) > 0) then
+ do m=1,CS%nMode ; do fr=1,CS%Nfreq ; if (CS%id_cp_mode(fr,m) > 0) then
call post_data(CS%id_cp_mode(fr,m), CS%cp(:,:,fr,m), CS%diag)
endif ; enddo ; enddo
@@ -782,28 +924,30 @@ end subroutine sum_En
!> Calculates the energy lost from the propagating internal tide due to
!! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001).
-subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos)
+subroutine itidal_lowmode_loss(G, GV, US, CS, Nb, Rho_bot, Ub, En, TKE_loss_fixed, TKE_loss, dt, halo_size)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(int_tide_CS), intent(in) :: CS !< Internal tide control structure
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
intent(in) :: Nb !< Near-bottom stratification [T-1 ~> s-1].
+ real, dimension(G%isd:G%ied,G%jsd:G%jed), &
+ intent(in) :: Rho_bot !< Near-bottom density [R ~> kg m-3].
real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), &
intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal
!! mode velocity [L T-1 ~> m s-1].
real, dimension(G%isd:G%ied,G%jsd:G%jed), &
- intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [R L-2 Z3 ~> kg m-2]
- !! (rho*kappa*h^2).
+ intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [R Z4 H-1 L-2 ~> kg m-2 or m]
+ !! (rho*kappa*h^2) or (kappa*h^2).
real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), &
intent(inout) :: En !< Energy density of the internal waves [R Z3 T-2 ~> J m-2].
real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), &
intent(out) :: TKE_loss !< Energy loss rate [R Z3 T-3 ~> W m-2]
!! (q*rho*kappa*h^2*N*U^2).
real, intent(in) :: dt !< Time increment [T ~> s].
- logical,optional, intent(in) :: full_halos !< If true, do the calculation over the
- !! entire computational domain.
+ integer, optional, intent(in) :: halo_size !< The halo size over which to do the calculations
! Local variables
- integer :: j,i,m,fr,a, is, ie, js, je
+ integer :: j, i, m, fr, a, is, ie, js, je, halo
real :: En_tot ! energy for a given mode, frequency, and point summed over angles [R Z3 T-2 ~> J m-2]
real :: TKE_loss_tot ! dissipation for a given mode, frequency, and point summed over angles [R Z3 T-3 ~> W m-2]
real :: frac_per_sector ! fraction of energy in each wedge [nondim]
@@ -817,9 +961,10 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss,
q_itides = CS%q_itides
En_negl = 1e-30*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**2
- if (present(full_halos)) then ; if (full_halos) then
- is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed
- endif ; endif
+ if (present(halo_size)) then
+ halo = halo_size
+ is = G%isc - halo ; ie = G%iec + halo ; js = G%jsc - halo ; je = G%jec + halo
+ endif
do j=js,je ; do i=is,ie ; do m=1,CS%nMode ; do fr=1,CS%nFreq
@@ -830,20 +975,26 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss,
enddo
! Calculate TKE loss rate; units of [R Z3 T-3 ~> W m-2] here.
- TKE_loss_tot = q_itides * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ TKE_loss_tot = q_itides * GV%Z_to_H * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2
+ else
+ TKE_loss_tot = q_itides * (GV%RZ_to_H * Rho_bot(i,j)) * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2
+ endif
! Update energy remaining (this is a pseudo implicit calc)
! (E(t+1)-E(t))/dt = -TKE_loss(E(t+1)/E(t)), which goes to zero as E(t+1) goes to zero
if (En_tot > 0.0) then
do a=1,CS%nAngle
frac_per_sector = En(i,j,a,fr,m)/En_tot
- TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! Wm-2
+ TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! [R Z3 T-3 ~> W m-2]
loss_rate = TKE_loss(i,j,a,fr,m) / (En(i,j,a,fr,m) + En_negl) ! [T-1 ~> s-1]
En(i,j,a,fr,m) = En(i,j,a,fr,m) / (1.0 + dt*loss_rate)
enddo
else
! no loss if no energy
- TKE_loss(i,j,:,fr,m) = 0.0
+ do a=1,CS%nAngle
+ TKE_loss(i,j,a,fr,m) = 0.0
+ enddo
endif
! Update energy remaining (this is the old explicit calc)
@@ -2011,7 +2162,7 @@ end subroutine teleport
!> Rotates points in the halos where required to accommodate
!! changes in grid orientation, such as at the tripolar fold.
-subroutine correct_halo_rotation(En, test, G, NAngle)
+subroutine correct_halo_rotation(En, test, G, NAngle, halo)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
real, dimension(:,:,:,:,:), intent(inout) :: En !< The internal gravity wave energy density as a
!! function of space, angular orientation, frequency,
@@ -2022,18 +2173,19 @@ subroutine correct_halo_rotation(En, test, G, NAngle)
!! wave energies in the halo region to be corrected [nondim].
integer, intent(in) :: NAngle !< The number of wave orientations in the
!! discretized wave energy spectrum.
+ integer, intent(in) :: halo !< The halo size over which to do the calculations
! Local variables
real, dimension(G%isd:G%ied,NAngle) :: En2d ! A zonal row of the internal gravity wave energy density
! in a frequency band and mode [R Z3 T-2 ~> J m-2].
integer, dimension(G%isd:G%ied) :: a_shift
integer :: i_first, i_last, a_new
- integer :: a, i, j, isd, ied, jsd, jed, m, fr
+ integer :: a, i, j, ish, ieh, jsh, jeh, m, fr
character(len=160) :: mesg ! The text of an error message
- isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
+ ish = G%isc-halo ; ieh = G%iec+halo ; jsh = G%jsc-halo ; jeh = G%jec+halo
- do j=jsd,jed
- i_first = ied+1 ; i_last = isd-1
- do i=isd,ied
+ do j=jsh,jeh
+ i_first = ieh+1 ; i_last = ish-1
+ do i=ish,ieh
a_shift(i) = 0
if (test(i,j,1) /= 1.0) then
if (i= 6 are dissipated locally and do not propagate
+ ! so we only allow for 5 vertical modes and each has its own variable
+
+ ! allocate restart arrays
+ allocate(CS%En_restart_mode1(isd:ied, jsd:jed, num_angle, num_freq), source=0.0)
+ if (num_mode >= 2) allocate(CS%En_restart_mode2(isd:ied, jsd:jed, num_angle, num_freq), source=0.0)
+ if (num_mode >= 3) allocate(CS%En_restart_mode3(isd:ied, jsd:jed, num_angle, num_freq), source=0.0)
+ if (num_mode >= 4) allocate(CS%En_restart_mode4(isd:ied, jsd:jed, num_angle, num_freq), source=0.0)
+ if (num_mode >= 5) allocate(CS%En_restart_mode5(isd:ied, jsd:jed, num_angle, num_freq), source=0.0)
+
+ ! register all 4d restarts and copy into full Energy array when restarting from previous state
+ call register_restart_field(CS%En_restart_mode1(:,:,:,:), "IW_energy_mode1", .false., restart_CS, &
+ longname="The internal wave energy density f(i,j,angle,freq) for mode 1", &
+ units="J m-2", conversion=US%RZ3_T3_to_W_m2*US%T_to_s, z_grid='1', t_grid="s", &
+ extra_axes=axes_inttides)
+
+ do fr=1,num_freq ; do a=1,num_angle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,1) = CS%En_restart_mode1(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+
+ if (num_mode >= 2) then
+ call register_restart_field(CS%En_restart_mode2(:,:,:,:), "IW_energy_mode2", .false., restart_CS, &
+ longname="The internal wave energy density f(i,j,angle,freq) for mode 2", &
+ units="J m-2", conversion=US%RZ3_T3_to_W_m2*US%T_to_s, z_grid='1', t_grid="s", &
+ extra_axes=axes_inttides)
+
+ do fr=1,num_freq ; do a=1,num_angle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,2) = CS%En_restart_mode2(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+
+ endif
+
+ if (num_mode >= 3) then
+ call register_restart_field(CS%En_restart_mode3(:,:,:,:), "IW_energy_mode3", .false., restart_CS, &
+ longname="The internal wave energy density f(i,j,angle,freq) for mode 3", &
+ units="J m-2", conversion=US%RZ3_T3_to_W_m2*US%T_to_s, z_grid='1', t_grid="s", &
+ extra_axes=axes_inttides)
+
+ do fr=1,num_freq ; do a=1,num_angle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,3) = CS%En_restart_mode3(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+
+ endif
+
+ if (num_mode >= 4) then
+ call register_restart_field(CS%En_restart_mode4(:,:,:,:), "IW_energy_mode4", .false., restart_CS, &
+ longname="The internal wave energy density f(i,j,angle,freq) for mode 4", &
+ units="J m-2", conversion=US%RZ3_T3_to_W_m2*US%T_to_s, z_grid='1', t_grid="s", &
+ extra_axes=axes_inttides)
+
+ do fr=1,num_freq ; do a=1,num_angle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,4) = CS%En_restart_mode4(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+
+ endif
+
+ if (num_mode >= 5) then
+ call register_restart_field(CS%En_restart_mode5(:,:,:,:), "IW_energy_mode5", .false., restart_CS, &
+ longname="The internal wave energy density f(i,j,angle,freq) for mode 5", &
+ units="J m-2", conversion=US%RZ3_T3_to_W_m2*US%T_to_s, z_grid='1', t_grid="s", &
+ extra_axes=axes_inttides)
+
+ do fr=1,num_freq ; do a=1,num_angle ; do j=jsd,jed ; do i=isd,ied
+ CS%En(i,j,a,fr,5) = CS%En_restart_mode5(i,j,a,fr)
+ enddo ; enddo ; enddo ; enddo
+
+ endif
+
+end subroutine register_int_tide_restarts
!> This subroutine initializes the internal tides module.
subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
@@ -2306,7 +2535,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
!! parameters.
type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate
!! diagnostic output.
- type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure
+ type(int_tide_CS), pointer :: CS !< Internal tide control structure
! Local variables
real :: Angle_size ! size of wedges [rad]
@@ -2322,6 +2551,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
real :: RMS_roughness_frac ! The maximum RMS topographic roughness as a fraction of the
! nominal ocean depth, or a negative value for no limit [nondim]
real :: period_1 ! The period of the gravest modeled mode [T ~> s]
+ real :: period ! A tidal period read from namelist [T ~> s]
integer :: num_angle, num_freq, num_mode, m, fr
integer :: isd, ied, jsd, jed, a, id_ang, i, j, nz
type(axes_grp) :: axes_ang
@@ -2337,9 +2567,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
character(len=200) :: h2_file
character(len=80) :: rough_var ! Input file variable names
+ character(len=240), dimension(:), allocatable :: energy_fractions
+ character(len=240) :: periods
+
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
nz = GV%ke
+ CS%initialized = .true.
+
use_int_tides = .false.
call read_param(param_file, "INTERNAL_TIDES", use_int_tides)
CS%do_int_tides = use_int_tides
@@ -2358,20 +2593,29 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
if (.not.((num_freq > 0) .and. (num_angle > 0) .and. (num_mode > 0))) return
CS%nFreq = num_freq ; CS%nAngle = num_angle ; CS%nMode = num_mode
- ! Allocate energy density array
- allocate(CS%En(isd:ied, jsd:jed, num_angle, num_freq, num_mode), source=0.0)
+ allocate(energy_fractions(num_freq))
+ allocate(CS%fraction_tidal_input(num_freq,num_mode))
+
+ call read_param(param_file, "ENERGY_FRACTION_PER_MODE", energy_fractions)
+
+ do fr=1,num_freq ; do m=1,num_mode
+ CS%fraction_tidal_input(fr,m) = extract_real(energy_fractions(fr), " ,", m, 0.)
+ enddo ; enddo
! Allocate phase speed array
allocate(CS%cp(isd:ied, jsd:jed, num_freq, num_mode), source=0.0)
! Allocate and populate frequency array (each a multiple of first for now)
allocate(CS%frequency(num_freq))
- call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, &
- "The period of the first mode for internal tides", default=44567., &
- units="s", scale=US%s_to_T)
+
+
+ ! The periods of the tidal constituents for internal tides raytracing
+ call read_param(param_file, "TIDAL_PERIODS", periods)
do fr=1,num_freq
- CS%frequency(fr) = (8.0*atan(1.0) * (real(fr)) / period_1) ! ADDED BDM
+ period = extract_real(periods, " ,", fr, 0.)
+ if (period == 0.) call MOM_error(FATAL, "MOM_internal_tides: invalid tidal period")
+ CS%frequency(fr) = 8.0*atan(1.0)/period
enddo
! Read all relevant parameters and write them to the model log.
@@ -2412,7 +2656,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
"Inconsistent number of frequencies.")
if (CS%NAngle /= num_angle) call MOM_error(FATAL, "Internal_tides_init: "//&
"Inconsistent number of angles.")
- if (CS%NMode /= num_mode) call MOM_error(FATAL, "Internal_tides_init: "//&
+ if (CS%nMode /= num_mode) call MOM_error(FATAL, "Internal_tides_init: "//&
"Inconsistent number of modes.")
if (4*(num_angle/4) /= num_angle) call MOM_error(FATAL, &
"Internal_tides_init: INTERNAL_TIDE_ANGLES must be a multiple of 4.")
@@ -2458,8 +2702,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, "INTERNAL_TIDE_DRAG_MIN_DEPTH", CS%drag_min_depth, &
"The minimum total ocean thickness that will be used in the denominator "//&
"of the quadratic drag terms for internal tides.", &
- units="m", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%apply_bottom_drag)
- CS%drag_min_depth = MAX(CS%drag_min_depth, GV%H_subroundoff * GV%H_to_Z)
+ units="m", default=1.0, scale=GV%m_to_H, do_not_log=.not.CS%apply_bottom_drag)
+ CS%drag_min_depth = MAX(CS%drag_min_depth, GV%H_subroundoff)
call get_param(param_file, mdl, "INTERNAL_TIDE_FROUDE_DRAG", CS%apply_Froude_drag, &
"If true, apply wave breaking as a sink.", &
default=.false.)
@@ -2543,9 +2787,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
else
h2(i,j) = max(h2(i,j), 0.0)
endif
- ! Compute the fixed part; units are [R L-2 Z3 ~> kg m-2] here
- ! will be multiplied by N and the squared near-bottom velocity to get into [R Z3 T-3 ~> W m-2]
- CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j)
+ ! Compute the fixed part; units are [R Z4 H-1 L-2 ~> kg m-2 or m] here
+ ! will be multiplied by N and the squared near-bottom velocity (and by the
+ ! near-bottom density in non-Boussinesq mode) to get into [R Z3 T-3 ~> W m-2]
+ CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor* GV%H_to_RZ * US%L_to_Z*kappa_itides * h2(i,j)
enddo ; enddo
deallocate(h2)
@@ -2568,7 +2813,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
do j=G%jsc,G%jec ; do i=G%isc,G%iec
if (is_NaN(CS%refl_angle(i,j))) CS%refl_angle(i,j) = CS%nullangle
enddo ; enddo
- call pass_var(CS%refl_angle,G%domain)
+ call pass_var(CS%refl_angle, G%domain)
! Read in prescribed partial reflection coefficients from file
call get_param(param_file, mdl, "REFL_PREF_FILE", refl_pref_file, &
@@ -2584,19 +2829,17 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
"REFL_PREF_FILE: "//trim(filename)//" not found")
endif
!CS%refl_pref = CS%refl_pref*1 ! adjust partial reflection if desired
- call pass_var(CS%refl_pref,G%domain)
+ call pass_var(CS%refl_pref, G%domain)
! Tag reflection cells with partial reflection (done here for speed)
allocate(CS%refl_pref_logical(isd:ied,jsd:jed), source=.false.)
- do j=jsd,jed
- do i=isd,ied
- ! flag cells with partial reflection
- if (CS%refl_angle(i,j) /= CS%nullangle .and. &
- CS%refl_pref(i,j) < 1.0 .and. CS%refl_pref(i,j) > 0.0) then
- CS%refl_pref_logical(i,j) = .true.
- endif
- enddo
- enddo
+ do j=jsd,jed ; do i=isd,ied
+ ! flag cells with partial reflection
+ if ((CS%refl_angle(i,j) /= CS%nullangle) .and. &
+ (CS%refl_pref(i,j) < 1.0) .and. (CS%refl_pref(i,j) > 0.0)) then
+ CS%refl_pref_logical(i,j) = .true.
+ endif
+ enddo ; enddo
! Read in double-reflective (ridge) tags from file
call get_param(param_file, mdl, "REFL_DBL_FILE", refl_dbl_file, &
@@ -2611,11 +2854,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
if (trim(refl_dbl_file) /= '' ) call MOM_error(FATAL, &
"REFL_DBL_FILE: "//trim(filename)//" not found")
endif
- call pass_var(ridge_temp,G%domain)
+ call pass_var(ridge_temp, G%domain)
allocate(CS%refl_dbl(isd:ied,jsd:jed), source=.false.)
- do i=isd,ied ; do j=jsd,jed
- if (ridge_temp(i,j) == 1) then; CS%refl_dbl(i,j) = .true.
- else ; CS%refl_dbl(i,j) = .false. ; endif
+ do j=jsd,jed ; do i=isd,ied
+ CS%refl_dbl(i,j) = (ridge_temp(i,j) == 1)
enddo ; enddo
! Read in the transmission coefficient and infer the residual
@@ -2632,29 +2874,27 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
"TRANS_FILE: "//trim(filename)//" not found")
endif
- call pass_var(CS%trans,G%domain)
+ call pass_var(CS%trans, G%domain)
+
! residual
allocate(CS%residual(isd:ied,jsd:jed), source=0.0)
- do j=jsd,jed
- do i=isd,ied
- if (CS%refl_pref_logical(i,j)) then
- CS%residual(i,j) = 1. - CS%refl_pref(i,j) - CS%trans(i,j)
- endif
- enddo
- enddo
- call pass_var(CS%residual,G%domain)
-
- CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, &
- Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s)
- allocate(CS%id_cn(CS%nMode), source=-1)
- do m=1,CS%nMode
- write(var_name, '("cn_mode",i1)') m
- write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m
- CS%id_cn(m) = register_diag_field('ocean_model',var_name, diag%axesT1, &
- Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s)
- call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
- enddo
+ do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ if (CS%refl_pref_logical(i,j)) then
+ CS%residual(i,j) = 1. - CS%refl_pref(i,j) - CS%trans(i,j)
+ endif
+ enddo ; enddo
+ call pass_var(CS%residual, G%domain)
+ CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, &
+ Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s)
+ allocate(CS%id_cn(CS%nMode), source=-1)
+ do m=1,CS%nMode
+ write(var_name, '("cn_mode",i1)') m
+ write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m
+ CS%id_cn(m) = register_diag_field('ocean_model',var_name, diag%axesT1, &
+ Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s)
+ call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
+ enddo
! Register maps of reflection parameters
CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, &
@@ -2684,14 +2924,18 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
CS%id_tot_En = register_diag_field('ocean_model', 'ITide_tot_En', diag%axesT1, &
Time, 'Internal tide total energy density', &
'J m-2', conversion=US%RZ3_T3_to_W_m2*US%T_to_s)
- ! Register 2-D drag scale used for quadratic bottom drag
- CS%id_itide_drag = register_diag_field('ocean_model', 'ITide_drag', diag%axesT1, &
- Time, 'Interior and bottom drag internal tide decay timescale', 's-1', conversion=US%s_to_T)
- !Register 2-D energy input into internal tides
- CS%id_TKE_itidal_input = register_diag_field('ocean_model', 'TKE_itidal_input', diag%axesT1, &
- Time, 'Conversion from barotropic to baroclinic tide, '//&
- 'a fraction of which goes into rays', &
- 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+
+ allocate(CS%id_itide_drag(CS%nFreq, CS%nMode), source=-1)
+ allocate(CS%id_TKE_itidal_input(CS%nFreq), source=-1)
+ do fr=1,CS%nFreq
+ ! Register 2-D energy input into internal tides for each frequency
+ write(var_name, '("TKE_itidal_input_freq",i1)') fr
+ write(var_descript, '("a fraction of which goes into rays in frequency ",i1)') fr
+
+ CS%id_TKE_itidal_input(fr) = register_diag_field('ocean_model', var_name, diag%axesT1, &
+ Time, 'Conversion from barotropic to baroclinic tide, '//&
+ var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+ enddo
! Register 2-D energy losses (summed over angles, freq, modes)
CS%id_tot_leak_loss = register_diag_field('ocean_model', 'ITide_tot_leak_loss', diag%axesT1, &
Time, 'Internal tide energy loss to background drag', &
@@ -2715,6 +2959,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
allocate(CS%id_En_mode(CS%nFreq,CS%nMode), source=-1)
allocate(CS%id_En_ang_mode(CS%nFreq,CS%nMode), source=-1)
allocate(CS%id_itidal_loss_mode(CS%nFreq,CS%nMode), source=-1)
+ allocate(CS%id_leak_loss_mode(CS%nFreq,CS%nMode), source=-1)
+ allocate(CS%id_quad_loss_mode(CS%nFreq,CS%nMode), source=-1)
+ allocate(CS%id_Froude_loss_mode(CS%nFreq,CS%nMode), source=-1)
+ allocate(CS%id_residual_loss_mode(CS%nFreq,CS%nMode), source=-1)
allocate(CS%id_allprocesses_loss_mode(CS%nFreq,CS%nMode), source=-1)
allocate(CS%id_itidal_loss_ang_mode(CS%nFreq,CS%nMode), source=-1)
allocate(CS%id_Ub_mode(CS%nFreq,CS%nMode), source=-1)
@@ -2755,6 +3003,30 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
CS%id_itidal_loss_mode(fr,m) = register_diag_field('ocean_model', var_name, &
diag%axesT1, Time, var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2)
call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
+ ! Leakage loss
+ write(var_name, '("Itide_leak_loss_freq",i1,"_mode",i1)') fr, m
+ write(var_descript, '("Internal tide energy loss due to leakage from frequency ",i1," mode ",i1)') fr, m
+ CS%id_leak_loss_mode(fr,m) = register_diag_field('ocean_model', var_name, &
+ diag%axesT1, Time, var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+ call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
+ ! Quad loss
+ write(var_name, '("Itide_quad_loss_freq",i1,"_mode",i1)') fr, m
+ write(var_descript, '("Internal tide energy quad loss from frequency ",i1," mode ",i1)') fr, m
+ CS%id_quad_loss_mode(fr,m) = register_diag_field('ocean_model', var_name, &
+ diag%axesT1, Time, var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+ call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
+ ! Froude loss
+ write(var_name, '("Itide_froude_loss_freq",i1,"_mode",i1)') fr, m
+ write(var_descript, '("Internal tide energy Froude loss from frequency ",i1," mode ",i1)') fr, m
+ CS%id_froude_loss_mode(fr,m) = register_diag_field('ocean_model', var_name, &
+ diag%axesT1, Time, var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+ call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
+ ! residual losses
+ write(var_name, '("Itide_residual_loss_freq",i1,"_mode",i1)') fr, m
+ write(var_descript, '("Internal tide energy residual loss from frequency ",i1," mode ",i1)') fr, m
+ CS%id_residual_loss_mode(fr,m) = register_diag_field('ocean_model', var_name, &
+ diag%axesT1, Time, var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+ call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
! all loss processes
write(var_name, '("Itide_allprocesses_loss_freq",i1,"_mode",i1)') fr, m
write(var_descript, '("Internal tide energy loss due to all processes from frequency ",i1," mode ",i1)') fr, m
@@ -2784,6 +3056,12 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s)
call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
+ ! Register 2-D drag scale used for quadratic bottom drag for each frequency and mode
+ write(var_name, '("ITide_drag_freq",i1,"_mode",i1)') fr, m
+ write(var_descript, '("Interior and bottom drag int tide decay timescale in frequency ",i1, " mode ",i1)') fr, m
+
+ CS%id_itide_drag(fr,m) = register_diag_field('ocean_model', var_name, diag%axesT1, Time, &
+ 's-1', conversion=US%s_to_T)
enddo ; enddo
@@ -2806,19 +3084,19 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS)
write(var_name, '("Itide_int_w2","_mode",i1)') m
write(var_descript, '("integral of w2 for mode ",i1)') m
CS%id_int_w2_mode(m) = register_diag_field('ocean_model', var_name, &
- diag%axesT1, Time, var_descript, 'm', conversion=US%Z_to_m)
+ diag%axesT1, Time, var_descript, 'm', conversion=GV%H_to_m)
call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
write(var_name, '("Itide_int_U2","_mode",i1)') m
write(var_descript, '("integral of U2 for mode ",i1)') m
CS%id_int_U2_mode(m) = register_diag_field('ocean_model', var_name, &
- diag%axesT1, Time, var_descript, 'm-1', conversion=US%m_to_L)
+ diag%axesT1, Time, var_descript, 'm-1', conversion=US%m_to_Z*GV%H_to_Z)
call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
write(var_name, '("Itide_int_N2w2","_mode",i1)') m
write(var_descript, '("integral of N2w2 for mode ",i1)') m
CS%id_int_N2w2_mode(m) = register_diag_field('ocean_model', var_name, &
- diag%axesT1, Time, var_descript, 'm s-2', conversion=US%Z_to_m*US%s_to_T**2)
+ diag%axesT1, Time, var_descript, 'm s-2', conversion=GV%H_to_m*US%s_to_T**2)
call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5)
enddo
diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
index 7d71a62e25..4f1dbb89ac 100644
--- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
+++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
@@ -10,7 +10,7 @@ module MOM_lateral_mixing_coeffs
use MOM_domains, only : create_group_pass, do_group_pass
use MOM_domains, only : group_pass_type, pass_var, pass_vector
use MOM_file_parser, only : get_param, log_version, param_file_type
-use MOM_interface_heights, only : find_eta
+use MOM_interface_heights, only : find_eta, thickness_to_dz
use MOM_isopycnal_slopes, only : calc_isoneutral_slopes
use MOM_grid, only : ocean_grid_type
use MOM_unit_scaling, only : unit_scale_type
@@ -59,16 +59,21 @@ module MOM_lateral_mixing_coeffs
!! This parameter is set depending on other parameters.
logical :: calculate_depth_fns !< If true, calculate all the depth factors.
!! This parameter is set depending on other parameters.
- logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate.
+ logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rates.
!! This parameter is set depending on other parameters.
logical :: use_stanley_iso !< If true, use Stanley parameterization in MOM_isopycnal_slopes
logical :: use_simpler_Eady_growth_rate !< If true, use a simpler method to calculate the
!! Eady growth rate that avoids division by layer thickness.
!! This parameter is set depending on other parameters.
+ logical :: full_depth_Eady_growth_rate !< If true, calculate the Eady growth rate based on an
+ !! average that includes contributions from sea-level changes
+ !! in its denominator, rather than just the nominal depth of
+ !! the bathymetry. This only applies when using the model
+ !! interface heights as a proxy for isopycnal slopes.
real :: cropping_distance !< Distance from surface or bottom to filter out outcropped or
!! incropped interfaces for the Eady growth rate calc [Z ~> m]
real :: h_min_N2 !< The minimum vertical distance to use in the denominator of the
- !! bouyancy frequency used in the slope calculation [Z ~> m]
+ !! bouyancy frequency used in the slope calculation [H ~> m or kg m-2]
real, allocatable :: SN_u(:,:) !< S*N at u-points [T-1 ~> s-1]
real, allocatable :: SN_v(:,:) !< S*N at v-points [T-1 ~> s-1]
@@ -135,7 +140,7 @@ module MOM_lateral_mixing_coeffs
!! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power)
real :: depth_scaled_khth_h0 !< The depth above which KHTH is linearly scaled away [Z ~> m]
real :: depth_scaled_khth_exp !< The exponent used in the depth dependent scaling function for KHTH [nondim]
- real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1]
+ real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
integer :: Res_fn_power_khth !< The power of dx/Ld in the KhTh resolution function. Any
!! positive integer power may be used, but even powers
!! and especially 2 are coded to be more efficient.
@@ -449,6 +454,12 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS)
if (CS%id_Res_fn > 0) call post_data(CS%id_Res_fn, CS%Res_fn_h, CS%diag)
endif
+ if (CS%debug) then
+ call hchksum(CS%cg1, "calc_resoln_fn cg1", G%HI, haloshift=1, scale=US%L_T_to_m_s)
+ call uvchksum("Res_fn_[uv]", CS%Res_fn_u, CS%Res_fn_v, G%HI, haloshift=0, &
+ scale=1.0, scalar_pair=.true.)
+ endif
+
end subroutine calc_resoln_function
!> Calculates and stores functions of isopycnal slopes, e.g. Sx, Sy, S*N, mostly used in the Visbeck et al.
@@ -684,7 +695,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN,
integer :: i, j, k, l_seg
logical :: crop
- dz_neglect = GV%H_subroundoff * GV%H_to_Z
+ dz_neglect = GV%dZ_subroundoff
D_scale = CS%Eady_GR_D_scale
if (D_scale<=0.) D_scale = 64.*GV%max_depth ! 0 means use full depth so choose something big
r_crp_dist = 1. / max( dz_neglect, CS%cropping_distance )
@@ -818,12 +829,16 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface position [Z ~> m]
+ ! type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables
logical, intent(in) :: calculate_slopes !< If true, calculate slopes
!! internally otherwise use slopes stored in CS
! Local variables
real :: E_x(SZIB_(G),SZJ_(G)) ! X-slope of interface at u points [Z L-1 ~> nondim] (for diagnostics)
real :: E_y(SZI_(G),SZJB_(G)) ! Y-slope of interface at v points [Z L-1 ~> nondim] (for diagnostics)
+ real :: dz_tot(SZI_(G),SZJ_(G)) ! The total thickness of the water columns [Z ~> m]
+ ! real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! The vertical distance across each layer [Z ~> m]
real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2]
+ real :: dZ_cutoff ! A minimum water column depth for masking [H ~> m or kg m-2]
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
real :: S2 ! Interface slope squared [Z2 L-2 ~> nondim]
@@ -834,6 +849,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
! the buoyancy frequency squared at u-points [Z T-2 ~> m s-2]
real :: S2N2_v_local(SZI_(G),SZJB_(G),SZK_(GV)) ! The depth integral of the slope times
! the buoyancy frequency squared at v-points [Z T-2 ~> m s-2]
+ logical :: use_dztot ! If true, use the total water column thickness rather than the
+ ! bathymetric depth for certain calculations.
integer :: is, ie, js, je, nz
integer :: i, j, k
integer :: l_seg
@@ -851,6 +868,25 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
h_neglect = GV%H_subroundoff
H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect)
+ dZ_cutoff = real(2*nz) * (GV%Angstrom_Z + GV%dz_subroundoff)
+
+ use_dztot = CS%full_depth_Eady_growth_rate ! .or. .not.(GV%Boussinesq or GV%semi_Boussinesq)
+
+ if (use_dztot) then
+ !$OMP parallel do default(shared)
+ do j=js-1,je+1 ; do i=is-1,ie+1
+ dz_tot(i,j) = e(i,j,1) - e(i,j,nz+1)
+ enddo ; enddo
+ ! The following mathematically equivalent expression is more expensive but is less
+ ! sensitive to roundoff for large Z_ref:
+ ! call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+ ! do j=js-1,je+1
+ ! do i=is-1,ie+1 ; dz_tot(i,j) = 0.0 ; enddo
+ ! do k=1,nz ; do i=is-1,ie+1
+ ! dz_tot(i,j) = dz_tot(i,j) + dz(i,j,k)
+ ! enddo ; enddo
+ ! enddo
+ endif
! To set the length scale based on the deformation radius, use wave_speed to
! calculate the first-mode gravity wave speed and then blend the equatorial
@@ -864,49 +900,50 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
do j=js-1,je+1 ; do I=is-1,ie
E_x(I,j) = (e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j)
! Mask slopes where interface intersects topography
- if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0.
+ if (min(h(i,j,k),h(i+1,j,k)) < H_cutoff) E_x(I,j) = 0.
enddo ; enddo
do J=js-1,je ; do i=is-1,ie+1
E_y(i,J) = (e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J)
! Mask slopes where interface intersects topography
- if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0.
+ if (min(h(i,j,k),h(i,j+1,k)) < H_cutoff) E_y(i,J) = 0.
enddo ; enddo
else ! This branch is not used.
do j=js-1,je+1 ; do I=is-1,ie
E_x(I,j) = CS%slope_x(I,j,k)
- if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0.
+ if (min(h(i,j,k),h(i+1,j,k)) < H_cutoff) E_x(I,j) = 0.
enddo ; enddo
- do j=js-1,je ; do I=is-1,ie+1
+ do J=js-1,je ; do i=is-1,ie+1
E_y(i,J) = CS%slope_y(i,J,k)
- if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0.
+ if (min(h(i,j,k),h(i,j+1,k)) < H_cutoff) E_y(i,J) = 0.
enddo ; enddo
endif
! Calculate N*S*h from this layer and add to the sum
do j=js,je ; do I=is-1,ie
S2 = ( E_x(I,j)**2 + 0.25*( &
- (E_y(I,j)**2+E_y(I+1,j-1)**2) + (E_y(I+1,j)**2+E_y(I,j-1)**2) ) )
+ (E_y(i,J)**2+E_y(i+1,J-1)**2) + (E_y(i+1,J)**2+E_y(i,J-1)**2) ) )
+ if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) S2 = 0.0
+
Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect)
Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect)
H_geom = sqrt(Hdn*Hup)
- N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2))
- if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) &
- S2 = 0.0
- S2N2_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2
+ ! N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2))
+ S2N2_u_local(I,j,k) = (H_geom * S2) * (GV%g_prime(k) / max(Hdn, Hup, CS%h_min_N2) )
enddo ; enddo
do J=js-1,je ; do i=is,ie
S2 = ( E_y(i,J)**2 + 0.25*( &
- (E_x(i,J)**2+E_x(i-1,J+1)**2) + (E_x(i,J+1)**2+E_x(i-1,J)**2) ) )
+ (E_x(I,j)**2+E_x(I-1,j+1)**2) + (E_x(I,j+1)**2+E_x(I-1,j)**2) ) )
+ if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) S2 = 0.0
+
Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect)
Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect)
H_geom = sqrt(Hdn*Hup)
- N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2))
- if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) &
- S2 = 0.0
- S2N2_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2
+ ! N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2))
+ S2N2_v_local(i,J,k) = (H_geom * S2) * (GV%g_prime(k) / (max(Hdn, Hup, CS%h_min_N2)))
enddo ; enddo
enddo ! k
+
!$OMP parallel do default(shared)
do j=js,je
do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo
@@ -914,17 +951,22 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
CS%SN_u(I,j) = CS%SN_u(I,j) + S2N2_u_local(I,j,k)
enddo ; enddo
! SN above contains S^2*N^2*H, convert to vertical average of S*N
- do I=is-1,ie
- !### Replace G%bathT+G%Z_ref here with (e(i,j,1) - e(i,j,nz+1)).
- !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(i,j), G%bathyT(i+1,j)) + (G%Z_ref + GV%Angstrom_Z) ) )
- !The code below behaves better than the line above. Not sure why? AJA
- if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then
+
+ if (use_dztot) then
+ do I=is-1,ie
CS%SN_u(I,j) = G%OBCmaskCu(I,j) * sqrt( CS%SN_u(I,j) / &
- (max(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref) )
- else
- CS%SN_u(I,j) = 0.0
- endif
- enddo
+ max(dz_tot(i,j), dz_tot(i+1,j), GV%dz_subroundoff) )
+ enddo
+ else
+ do I=is-1,ie
+ if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > dZ_cutoff ) then
+ CS%SN_u(I,j) = G%OBCmaskCu(I,j) * sqrt( CS%SN_u(I,j) / &
+ (max(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref) )
+ else
+ CS%SN_u(I,j) = 0.0
+ endif
+ enddo
+ endif
enddo
!$OMP parallel do default(shared)
do J=js-1,je
@@ -932,17 +974,24 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie
CS%SN_v(i,J) = CS%SN_v(i,J) + S2N2_v_local(i,J,k)
enddo ; enddo
- do i=is,ie
- !### Replace G%bathT+G%Z_ref here with (e(i,j,1) - e(i,j,nz+1)).
- !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + (G%Z_ref + GV%Angstrom_Z) ) )
- !The code below behaves better than the line above. Not sure why? AJA
- if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then
+ if (use_dztot) then
+ do i=is,ie
CS%SN_v(i,J) = G%OBCmaskCv(i,J) * sqrt( CS%SN_v(i,J) / &
- (max(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref) )
- else
- CS%SN_v(i,J) = 0.0
- endif
- enddo
+ max(dz_tot(i,j), dz_tot(i,j+1), GV%dz_subroundoff) )
+ enddo
+ else
+ do i=is,ie
+ ! There is a primordial horizontal indexing bug on the following line from the previous
+ ! versions of the code. This comment should be deleted by the end of 2024.
+ ! if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > dZ_cutoff ) then
+ if ( min(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref > dZ_cutoff ) then
+ CS%SN_v(i,J) = G%OBCmaskCv(i,J) * sqrt( CS%SN_v(i,J) / &
+ (max(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref) )
+ else
+ CS%SN_v(i,J) = 0.0
+ endif
+ enddo
+ endif
enddo
end subroutine calc_slope_functions_using_just_e
@@ -982,7 +1031,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo
real :: Ih ! The inverse of a combination of thicknesses [H-1 ~> m-1 or m2 kg-1]
real :: f ! A copy of the Coriolis parameter [T-1 ~> s-1]
real :: inv_PI3 ! The inverse of pi cubed [nondim]
- integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz
+ integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
@@ -1002,8 +1051,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo
h_at_slope_below = 2. * ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) * h(i+1,j,k+1) ) / &
( ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) + h(i+1,j,k+1) ) &
+ ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff**2 )
- Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z )
- dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih
+ Ih = 1. / ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff )
+ dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * (GV%Z_to_H * Ih)
h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih
enddo ; enddo
@@ -1016,8 +1065,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo
h_at_slope_below = 2. * ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) * h(i,j+1,k+1) ) / &
( ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) + h(i,j+1,k+1) ) &
+ ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff**2 )
- Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z )
- dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih
+ Ih = 1. / ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff )
+ dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * (GV%Z_to_H * Ih)
h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih
enddo ; enddo
@@ -1103,15 +1152,13 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
real :: oneOrTwo ! A variable that may be 1 or 2, depending on which form
! of the equatorial deformation radius us used [nondim]
real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when
- ! calculating the first-mode wave speed [Z ~> m]
+ ! calculating the first-mode wave speed [H ~> m or kg m-2]
real :: KhTr_passivity_coeff ! Coefficient setting the ratio between along-isopycnal tracer
! mixing and interface height mixing [nondim]
real :: absurdly_small_freq ! A miniscule frequency that is used to avoid division by 0 [T-1 ~> s-1]. The
! default value is roughly (pi / (the age of the universe)).
logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018
integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use
! for remapping. Values below 20190101 recover the remapping
! answers from 2018, while higher values use more robust
@@ -1145,7 +1192,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
CS%calculate_cg1 = .false.
CS%calculate_Rd_dx = .false.
CS%calculate_res_fns = .false.
- CS%use_simpler_Eady_growth_rate = .false.
+ CS%use_simpler_Eady_growth_rate = .false.
+ CS%full_depth_Eady_growth_rate = .false.
CS%calculate_depth_fns = .false.
! Read all relevant parameters and write them to the model log.
call log_version(param_file, mdl, version, "")
@@ -1239,8 +1287,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
in_use = .true.
call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, &
"The depth below which N2 is monotonized to avoid stratification "//&
- "artifacts from altering the equivalent barotropic mode structure.",&
- units="m", default=2000., scale=US%m_to_Z)
+ "artifacts from altering the equivalent barotropic mode structure. "//&
+ "This monotonzization is disabled if this parameter is negative.", &
+ units="m", default=-1.0, scale=GV%m_to_H)
allocate(CS%ebt_struct(isd:ied,jsd:jed,GV%ke), source=0.0)
endif
@@ -1264,7 +1313,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, &
"A diapycnal diffusivity that is used to interpolate "//&
"more sensible values of T & S into thin layers.", &
- units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s)
+ units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T)
endif
if (CS%calculate_Eady_growth_rate) then
@@ -1299,6 +1348,14 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
"The minimum vertical distance to use in the denominator of the "//&
"bouyancy frequency used in the slope calculation.", &
units="m", default=1.0, scale=GV%m_to_H, do_not_log=CS%use_stored_slopes)
+
+ call get_param(param_file, mdl, "FULL_DEPTH_EADY_GROWTH_RATE", CS%full_depth_Eady_growth_rate, &
+ "If true, calculate the Eady growth rate based on average slope times "//&
+ "stratification that includes contributions from sea-level changes "//&
+ "in its denominator, rather than just the nominal depth of the bathymetry. "//&
+ "This only applies when using the model interface heights as a proxy for "//&
+ "isopycnal slopes.", default=.not.(GV%Boussinesq.or.GV%semi_Boussinesq), &
+ do_not_log=CS%use_stored_slopes)
endif
endif
@@ -1504,23 +1561,13 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701)
call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_TOL", wave_speed_tol, &
"The fractional tolerance for finding the wave speeds.", &
diff --git a/src/parameterizations/lateral/MOM_load_love_numbers.F90 b/src/parameterizations/lateral/MOM_load_love_numbers.F90
index 84819b5915..3d573d894d 100644
--- a/src/parameterizations/lateral/MOM_load_love_numbers.F90
+++ b/src/parameterizations/lateral/MOM_load_love_numbers.F90
@@ -1452,30 +1452,32 @@ module MOM_load_love_numbers
/), (/4, lmax+1/)) !< Load Love numbers
!> \namespace mom_load_love_numbers
-!! This module serves the sole purpose of storing load Love number. The Love numbers are used for the self-attraction
-!! and loading (SAL) calculation, which is currently embedded in MOM_tidal_forcing module. This separate module ensures
-!! the readability of the tidal module.
+!! This module serves the sole purpose of storing load Love number. The Love numbers are used for the spherical harmonic
+!! self-attraction and loading (SAL) calculation in MOM_self_attr_load module. This separate module ensures readability
+!! of the SAL module.
!!
!! Variable Love_Data stores the Love numbers up to degree 1440. From left to right: degree, h, l, and k. Data in this
!! module is imported from SAL calculation in Model for Prediction Across Scales (MPAS)-Ocean developed by Los Alamos
-!! National Laboratory and University of Michigan (Barton et al. (2022) and Brus et al. (2022)). The load Love numbers
+!! National Laboratory and University of Michigan [Barton et al. (2022) and Brus et al. (2022)]. The load Love numbers
!! are from Wang et al. (2012), which are in the center of mass of total Earth system reference frame (CM). When used,
-!! Love numbers with degree<2 should be converted to center of mass solid Earth reference frame (CF) (Blewitt (2003)),
+!! Love numbers with degree<2 should be converted to center of mass solid Earth reference frame (CF) [Blewitt (2003)],
!! as in subroutine calc_love_scaling in MOM_tidal_forcing module.
!!
!! References:
!!
-!! Barton, K.N., Nairita, P., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J.,
-!! Wirasaet, D., and Schindelegger, M., 2022: Performance of Model for Prediction Across Scales (MPAS) Ocean as a
-!! Global Barotropic Tide Model. Journal of Advances in Modeling Earth Systems, in review.
+!! Barton, K.N., Pal, N., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J.J.,
+!! Wirasaet, D. and Schindelegger, M., 2022. Global Barotropic Tide Modeling Using Inline Self‐Attraction and Loading in
+!! MPAS‐Ocean. Journal of Advances in Modeling Earth Systems, 14(11), p.e2022MS003207.
+!! https://doi.org/10.1029/2022MS003207
!!
!! Blewitt, G., 2003. Self‐consistency in reference frames, geocenter definition, and surface loading of the solid
!! Earth. Journal of geophysical research: solid earth, 108(B2).
!! https://doi.org/10.1029/2002JB002082
!!
-!! Brus, S.R., Barton, K.N., Nairita, P., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D.,
-!! Westerink, J., and Schindelegger, M., 2022: Scalable self attraction and loading calculations for unstructured ocean
-!! models. Ocean Modelling, in review.
+!! Brus, S.R., Barton, K.N., Pal, N., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D.,
+!! Westerink, J.J. and Schindelegger, M., 2023. Scalable self attraction and loading calculations for unstructured ocean
+!! tide models. Ocean Modelling, p.102160.
+!! https://doi.org/10.1016/j.ocemod.2023.102160
!!
!! Wang, H., Xiang, L., Jia, L., Jiang, L., Wang, Z., Hu, B. and Gao, P., 2012. Load Love numbers and Green's functions
!! for elastic Earth models PREM, iasp91, ak135, and modified models with refined crustal structure from Crust 2.0.
diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
index 206773ecb0..e21c33beaf 100644
--- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
+++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
@@ -11,7 +11,7 @@ module MOM_mixed_layer_restrat
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_file_parser, only : openParameterBlock, closeParameterBlock
-use MOM_forcing_type, only : mech_forcing
+use MOM_forcing_type, only : mech_forcing, find_ustar
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
use MOM_lateral_mixing_coeffs, only : VarMix_CS
@@ -19,7 +19,7 @@ module MOM_mixed_layer_restrat
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units
-use MOM_EOS, only : calculate_density, EOS_domain
+use MOM_EOS, only : calculate_density, calculate_spec_vol, EOS_domain
implicit none ; private
@@ -86,15 +86,17 @@ module MOM_mixed_layer_restrat
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
!! timing of diagnostic output.
- logical :: use_stanley_ml !< If true, use the Stanley parameterization of SGS T variance
- real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1]
+ logical :: use_Stanley_ML !< If true, use the Stanley parameterization of SGS T variance
+ real :: ustar_min !< A minimum value of ustar in thickness units to avoid numerical
+ !! problems [H T-1 ~> m s-1 or kg m-2 s-1]
real :: Kv_restrat !< A viscosity that sets a floor on the momentum mixing rate
- !! during restratification [Z2 T-1 ~> m2 s-1]
+ !! during restratification, rescaled into thickness-based
+ !! units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1]
real, dimension(:,:), allocatable :: &
MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2]
MLD_filtered_slow, & !< Slower time-filtered MLD [H ~> m or kg m-2]
- wpup_filtered !< Time-filtered vertical momentum flux [Z2 T-2 ~> m2 s-2]
+ wpup_filtered !< Time-filtered vertical momentum flux [H L T-2 ~> m2 s-2 or kg m-1 s-2]
!>@{
!! Diagnostic identifier
@@ -173,7 +175,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
real, intent(in) :: dt !< Time increment [T ~> s]
real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the
- !! PBL scheme [Z ~> m] (not H)
+ !! PBL scheme [Z ~> m]
type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure
type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure
@@ -184,24 +186,37 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
h_avail ! The volume available for diffusion out of each face of each
! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1].
real, dimension(SZI_(G),SZJ_(G)) :: &
+ U_star_2d, & ! The wind friction velocity in thickness-based units, calculated using
+ ! the Boussinesq reference density or the time-evolving surface density
+ ! in non-Boussinesq mode [H T-1 ~> m s-1 or kg m-2 s-1]
MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2]
htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2]
- Rml_av_fast, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2]
+ Rml_av_fast, & ! Negative g_Rho0 times the average mixed layer density or G_Earth
+ ! times the average specific volume [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]
MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2]
htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2]
- Rml_av_slow ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2]
- real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]
+ Rml_av_slow ! Negative g_Rho0 times the average mixed layer density or G_Earth
+ ! times the average specific volume [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]
+ real :: g_Rho0 ! G_Earth/Rho0 times a thickness conversion factor
+ ! [L2 H-1 T-2 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]
real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3]
+ real :: rml_int_fast(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-3]
+ real :: rml_int_slow(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-3]
+ real :: SpV_ml(SZI_(G)) ! Specific volume evaluated at the surface pressure [R-1 ~> m3 kg-1]
+ real :: SpV_int_fast(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m]
+ real :: SpV_int_slow(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m]
+ real :: H_mld(SZI_(G)) ! The thickness of water within the topmost MLD_in of height [H ~> m or kg m-2]
+ real :: MLD_rem(SZI_(G)) ! The vertical extent of the MLD_in that has not yet been accounted for [Z ~> m]
real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa]
- real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H).
+ real :: h_vel ! htot interpolated onto velocity points [H ~> m or kg m-2]
real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1]
- real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1].
+ real :: u_star ! surface friction velocity, interpolated to velocity points and recast into
+ ! thickness-based units [H T-1 ~> m s-1 or kg m-2 s-1].
real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1]
real :: timescale ! mixing growth timescale [T ~> s]
real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0.
real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2]
- real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m]
real :: I4dt ! 1/(4 dt) [T-1 ~> s-1]
real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1]
real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux
@@ -253,6 +268,12 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) &
call MOM_error(FATAL, "mixedlayer_restrat_OM4: "// &
"The resolution argument, Rd/dx, was not associated.")
+ if (CS%use_Stanley_ML .and. .not.GV%Boussinesq) call MOM_error(FATAL, &
+ "MOM_mixedlayer_restrat: The Stanley parameterization is not"//&
+ "available without the Boussinesq approximation.")
+
+ ! Extract the friction velocity from the forcing type.
+ call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1, H_T_units=.true.)
if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD.
!! TODO: use derivatives and mid-MLD pressure. Currently this is sigma-0. -AJA
@@ -298,9 +319,30 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
enddo
enddo ! j-loop
elseif (CS%MLE_use_PBL_MLD) then
- do j = js-1, je+1 ; do i = is-1, ie+1
- MLD_fast(i,j) = (CS%MLE_MLD_stretch * GV%Z_to_H) * MLD_in(i,j)
- enddo ; enddo
+ if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then
+ do j = js-1, je+1 ; do i = is-1, ie+1
+ MLD_fast(i,j) = CS%MLE_MLD_stretch * GV%Z_to_H * MLD_in(i,j)
+ enddo ; enddo
+ else ! The fully non-Boussinesq conversion between height in MLD_in and thickness.
+ do j=js-1,je+1
+ do i=is-1,ie+1 ; MLD_rem(i) = MLD_in(i,j) ; H_mld(i) = 0.0 ; enddo
+ do k=1,nz
+ keep_going = .false.
+ do i=is-1,ie+1 ; if (MLD_rem(i) > 0.0) then
+ if (MLD_rem(i) > GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)) then
+ H_mld(i) = H_mld(i) + h(i,j,k)
+ MLD_rem(i) = MLD_rem(i) - GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)
+ keep_going = .true.
+ else
+ H_mld(i) = H_mld(i) + GV%RZ_to_H * MLD_rem(i) / tv%SpV_avg(i,j,k)
+ MLD_rem(i) = 0.0
+ endif
+ endif ; enddo
+ if (.not.keep_going) exit
+ enddo
+ do i=is-1,ie+1 ; MLD_fast(i,j) = CS%MLE_MLD_stretch * H_mld(i) ; enddo
+ enddo
+ endif
else
call MOM_error(FATAL, "mixedlayer_restrat_OM4: "// &
"No MLD to use for MLE parameterization.")
@@ -309,7 +351,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
! Apply time filter (to remove diurnal cycle)
if (CS%MLE_MLD_decay_time>0.) then
if (CS%debug) then
- call hchksum(CS%MLD_filtered, 'mixed_layer_restrat: MLD_filtered', G%HI, haloshift=1, scale=GV%H_to_m)
+ call hchksum(CS%MLD_filtered, 'mixed_layer_restrat: MLD_filtered', G%HI, haloshift=1, scale=GV%H_to_mks)
call hchksum(MLD_in, 'mixed_layer_restrat: MLD in', G%HI, haloshift=1, scale=US%Z_to_m)
endif
aFac = CS%MLE_MLD_decay_time / ( dt + CS%MLE_MLD_decay_time )
@@ -326,8 +368,8 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
! Apply slower time filter (to remove seasonal cycle) on already filtered MLD_fast
if (CS%MLE_MLD_decay_time2>0.) then
if (CS%debug) then
- call hchksum(CS%MLD_filtered_slow,'mixed_layer_restrat: MLD_filtered_slow',G%HI,haloshift=1,scale=GV%H_to_m)
- call hchksum(MLD_fast,'mixed_layer_restrat: MLD fast',G%HI,haloshift=1,scale=GV%H_to_m)
+ call hchksum(CS%MLD_filtered_slow, 'mixed_layer_restrat: MLD_filtered_slow', G%HI, haloshift=1, scale=GV%H_to_mks)
+ call hchksum(MLD_fast, 'mixed_layer_restrat: MLD fast', G%HI, haloshift=1, scale=GV%H_to_mks)
endif
aFac = CS%MLE_MLD_decay_time2 / ( dt + CS%MLE_MLD_decay_time2 )
bFac = dt / ( dt + CS%MLE_MLD_decay_time2 )
@@ -347,9 +389,8 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
uDml(:) = 0.0 ; vDml(:) = 0.0
uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0
I4dt = 0.25 / dt
- g_Rho0 = GV%g_Earth / GV%Rho0
+ g_Rho0 = GV%H_to_Z * GV%g_Earth / GV%Rho0
h_neglect = GV%H_subroundoff
- dz_neglect = GV%H_subroundoff*GV%H_to_Z
if (CS%front_length>0.) then
res_upscale = .true.
I_LFront = 1. / CS%front_length
@@ -360,58 +401,106 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
p0(:) = 0.0
EOSdom(:) = EOS_domain(G%HI, halo=1)
!$OMP parallel default(shared) private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, &
- !$OMP line_is_empty, keep_going,res_scaling_fac, &
+ !$OMP SpV_ml,SpV_int_fast,SpV_int_slow,Rml_int_fast,Rml_int_slow, &
+ !$OMP line_is_empty,keep_going,res_scaling_fac, &
!$OMP a,IhTot,b,Ihtot_slow,zpb,hAtVel,zpa,dh) &
!$OMP firstprivate(uDml,vDml,uDml_slow,vDml_slow)
- !$OMP do
- do j=js-1,je+1
- do i=is-1,ie+1
- htot_fast(i,j) = 0.0 ; Rml_av_fast(i,j) = 0.0
- htot_slow(i,j) = 0.0 ; Rml_av_slow(i,j) = 0.0
- enddo
- keep_going = .true.
- do k=1,nz
+
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ !$OMP do
+ do j=js-1,je+1
do i=is-1,ie+1
- h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
+ htot_fast(i,j) = 0.0 ; Rml_int_fast(i) = 0.0
+ htot_slow(i,j) = 0.0 ; Rml_int_slow(i) = 0.0
enddo
- if (keep_going) then
- if (CS%use_Stanley_ML) then
- call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, &
- rho_ml(:), tv%eqn_of_state, EOSdom)
- else
- call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom)
- endif
- line_is_empty = .true.
+ keep_going = .true.
+ do k=1,nz
do i=is-1,ie+1
- if (htot_fast(i,j) < MLD_fast(i,j)) then
- dh = min( h(i,j,k), MLD_fast(i,j)-htot_fast(i,j) )
- Rml_av_fast(i,j) = Rml_av_fast(i,j) + dh*rho_ml(i)
- htot_fast(i,j) = htot_fast(i,j) + dh
- line_is_empty = .false.
- endif
- if (htot_slow(i,j) < MLD_slow(i,j)) then
- dh = min( h(i,j,k), MLD_slow(i,j)-htot_slow(i,j) )
- Rml_av_slow(i,j) = Rml_av_slow(i,j) + dh*rho_ml(i)
- htot_slow(i,j) = htot_slow(i,j) + dh
- line_is_empty = .false.
- endif
+ h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
enddo
- if (line_is_empty) keep_going=.false.
- endif
+ if (keep_going) then
+ if (CS%use_Stanley_ML) then
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, &
+ rho_ml(:), tv%eqn_of_state, EOSdom)
+ else
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom)
+ endif
+ line_is_empty = .true.
+ do i=is-1,ie+1
+ if (htot_fast(i,j) < MLD_fast(i,j)) then
+ dh = min( h(i,j,k), MLD_fast(i,j)-htot_fast(i,j) )
+ Rml_int_fast(i) = Rml_int_fast(i) + dh*rho_ml(i)
+ htot_fast(i,j) = htot_fast(i,j) + dh
+ line_is_empty = .false.
+ endif
+ if (htot_slow(i,j) < MLD_slow(i,j)) then
+ dh = min( h(i,j,k), MLD_slow(i,j)-htot_slow(i,j) )
+ Rml_int_slow(i) = Rml_int_slow(i) + dh*rho_ml(i)
+ htot_slow(i,j) = htot_slow(i,j) + dh
+ line_is_empty = .false.
+ endif
+ enddo
+ if (line_is_empty) keep_going=.false.
+ endif
+ enddo
+
+ do i=is-1,ie+1
+ Rml_av_fast(i,j) = -(g_Rho0*Rml_int_fast(i)) / (htot_fast(i,j) + h_neglect)
+ Rml_av_slow(i,j) = -(g_Rho0*Rml_int_slow(i)) / (htot_slow(i,j) + h_neglect)
+ enddo
enddo
+ else ! This is only used in non-Boussinesq mode.
+ !$OMP do
+ do j=js-1,je+1
+ do i=is-1,ie+1
+ htot_fast(i,j) = 0.0 ; SpV_int_fast(i) = 0.0
+ htot_slow(i,j) = 0.0 ; SpV_int_slow(i) = 0.0
+ enddo
+ keep_going = .true.
+ do k=1,nz
+ do i=is-1,ie+1
+ h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
+ enddo
+ if (keep_going) then
+ ! if (CS%use_Stanley_ML) then ! This is not implemented yet in the EoS code.
+ ! call calculate_spec_vol(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, &
+ ! rho_ml(:), tv%eqn_of_state, EOSdom)
+ ! else
+ call calculate_spec_vol(tv%T(:,j,k), tv%S(:,j,k), p0, SpV_ml, tv%eqn_of_state, EOSdom)
+ ! endif
+ line_is_empty = .true.
+ do i=is-1,ie+1
+ if (htot_fast(i,j) < MLD_fast(i,j)) then
+ dh = min( h(i,j,k), MLD_fast(i,j)-htot_fast(i,j) )
+ SpV_int_fast(i) = SpV_int_fast(i) + dh*SpV_ml(i)
+ htot_fast(i,j) = htot_fast(i,j) + dh
+ line_is_empty = .false.
+ endif
+ if (htot_slow(i,j) < MLD_slow(i,j)) then
+ dh = min( h(i,j,k), MLD_slow(i,j)-htot_slow(i,j) )
+ SpV_int_slow(i) = SpV_int_slow(i) + dh*SpV_ml(i)
+ htot_slow(i,j) = htot_slow(i,j) + dh
+ line_is_empty = .false.
+ endif
+ enddo
+ if (line_is_empty) keep_going=.false.
+ endif
+ enddo
- do i=is-1,ie+1
- Rml_av_fast(i,j) = -(g_Rho0*Rml_av_fast(i,j)) / (htot_fast(i,j) + h_neglect)
- Rml_av_slow(i,j) = -(g_Rho0*Rml_av_slow(i,j)) / (htot_slow(i,j) + h_neglect)
+ ! Convert the vertically integrated specific volume into a positive variable with units of density.
+ do i=is-1,ie+1
+ Rml_av_fast(i,j) = (GV%H_to_RZ*GV%g_Earth * SpV_int_fast(i)) / (htot_fast(i,j) + h_neglect)
+ Rml_av_slow(i,j) = (GV%H_to_RZ*GV%g_Earth * SpV_int_slow(i)) / (htot_slow(i,j) + h_neglect)
+ enddo
enddo
- enddo
+ endif
if (CS%debug) then
- call hchksum(h,'mixed_layer_restrat: h', G%HI, haloshift=1, scale=GV%H_to_m)
- call hchksum(forces%ustar,'mixed_layer_restrat: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T)
- call hchksum(MLD_fast,'mixed_layer_restrat: MLD', G%HI, haloshift=1, scale=GV%H_to_m)
- call hchksum(Rml_av_fast,'mixed_layer_restrat: rml', G%HI, haloshift=1, &
- scale=US%m_to_Z*US%L_T_to_m_s**2)
+ call hchksum(h, 'mixed_layer_restrat: h', G%HI, haloshift=1, scale=GV%H_to_mks)
+ call hchksum(U_star_2d, 'mixed_layer_restrat: u*', G%HI, haloshift=1, scale=GV%H_to_m*US%s_to_T)
+ call hchksum(MLD_fast, 'mixed_layer_restrat: MLD', G%HI, haloshift=1, scale=GV%H_to_mks)
+ call hchksum(Rml_av_fast, 'mixed_layer_restrat: rml', G%HI, haloshift=1, &
+ scale=GV%m_to_H*US%L_T_to_m_s**2)
endif
! TO DO:
@@ -421,7 +510,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
! U - Component
!$OMP do
do j=js,je ; do I=is-1,ie
- u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)))
+ u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i+1,j)))
absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
! If needed, res_scaling_fac = min( ds, L_d ) / l_f
@@ -431,34 +520,34 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
- h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z
+ h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect)
! NOTE: growth_time changes answers on some systems, see below.
- ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
+ ! timescale = growth_time(u_star, h_vel, absf, h_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
mom_mixrate = vonKar_x_pi2*u_star**2 / &
- (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
+ (absf*h_vel**2 + 4.0*(h_vel+h_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef
if (res_upscale) timescale = timescale * res_scaling_fac
uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * &
- (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H)
+ (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2)
! As above but using the slow filtered MLD
- h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z
+ h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect)
! NOTE: growth_time changes answers on some systems, see below.
- ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2)
+ ! timescale = growth_time(u_star, h_vel, absf, h_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2)
mom_mixrate = vonKar_x_pi2*u_star**2 / &
- (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
+ (absf*h_vel**2 + 4.0*(h_vel+h_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef2
if (res_upscale) timescale = timescale * res_scaling_fac
uDml_slow(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * &
- (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H)
+ (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2)
if (uDml(I) + uDml_slow(I) == 0.) then
do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo
@@ -508,7 +597,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
! V- component
!$OMP do
do J=js-1,je ; do i=is,ie
- u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)))
+ u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i,j+1)))
absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
! If needed, res_scaling_fac = min( ds, L_d ) / l_f
@@ -518,34 +607,34 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix,
! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
- h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z
+ h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect)
! NOTE: growth_time changes answers on some systems, see below.
- ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
+ ! timescale = growth_time(u_star, h_vel, absf, h_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
mom_mixrate = vonKar_x_pi2*u_star**2 / &
- (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
+ (absf*h_vel**2 + 4.0*(h_vel+h_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef
if (res_upscale) timescale = timescale * res_scaling_fac
vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * &
- (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H)
+ (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2)
! As above but using the slow filtered MLD
- h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z
+ h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect)
! NOTE: growth_time changes answers on some systems, see below.
- ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2)
+ ! timescale = growth_time(u_star, h_vel, absf, h_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2)
mom_mixrate = vonKar_x_pi2*u_star**2 / &
- (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
+ (absf*h_vel**2 + 4.0*(h_vel+h_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef2
if (res_upscale) timescale = timescale * res_scaling_fac
vDml_slow(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * &
- (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H)
+ (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2)
if (vDml(i) + vDml_slow(i) == 0.) then
do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo
@@ -704,28 +793,40 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
real :: vol_dt_avail(SZI_(G),SZJ_(G),SZK_(GV)) ! The volume available for exchange out of each face of
! each layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]
real, dimension(SZI_(G),SZJ_(G)) :: &
- little_h, & ! "Little h" representing active mixing layer depth [Z ~> m]
- big_H, & ! "Big H" representing the mixed layer depth [Z ~> m]
+ little_h, & ! "Little h" representing active mixing layer depth [H ~> m or kg m-2]
+ big_H, & ! "Big H" representing the mixed layer depth [H ~> m or kg m-2]
htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2]
- buoy_av, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2]
- wpup ! Turbulent vertical momentum [ ????? ~> m2 s-2]
+ buoy_av, & ! g_Rho0 times the average mixed layer density or G_Earth
+ ! times the average specific volume [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]
+ wpup ! Turbulent vertical momentum [L H T-2 ~> m2 s-2 or kg m-1 s-2]
real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1]
real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1]
- real :: covTS(SZI_(G)) ! SGS TS covariance in Stanley param; currently 0 [degC ppt]
- real :: varS(SZI_(G)) ! SGS S variance in Stanley param; currently 0 [ppt2]
+ real :: U_star_2d(SZI_(G),SZJ_(G)) ! The wind friction velocity, calculated using the Boussinesq
+ ! reference density or the time-evolving surface density in non-Boussinesq
+ ! mode [Z T-1 ~> m s-1]
+ real :: BLD_in_H(SZI_(G)) ! The thickness of the active boundary layer with the topmost BLD of
+ ! height [H ~> m or kg m-2]
+ real :: covTS(SZI_(G)) ! SGS TS covariance in Stanley param; currently 0 [C S ~> degC ppt]
+ real :: varS(SZI_(G)) ! SGS S variance in Stanley param; currently 0 [S2 ~> ppt2]
real :: dmu(SZK_(GV)) ! Change in mu(z) across layer k [nondim]
+ real :: Rml_int(SZI_(G)) ! Potential density integrated through the mixed layer [R H ~> kg m-2 or kg2 m-5]
+ real :: SpV_ml(SZI_(G)) ! Specific volume evaluated at the surface pressure [R-1 ~> m3 kg-1]
+ real :: SpV_int(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m]
+ real :: H_mld(SZI_(G)) ! The thickness of water within the topmost BLD of height [H ~> m or kg m-2]
+ real :: MLD_rem(SZI_(G)) ! The vertical extent of the BLD that has not yet been accounted for [Z ~> m]
real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3]
real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa]
- real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]
+ real :: g_Rho0 ! G_Earth/Rho0 times a thickness conversion factor
+ ! [L2 H-1 T-2 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]
real :: h_vel ! htot interpolated onto velocity points [H ~> m or kg m-2]
real :: w_star3 ! Cube of turbulent convective velocity [m3 s-3]
real :: u_star3 ! Cube of surface fruction velocity [m3 s-3]
- real :: r_wpup ! reciprocal of vertical momentum flux [Z-2 T2 ~> m-2 s2]
+ real :: r_wpup ! reciprocal of vertical momentum flux [T2 L-1 H-1 ~> s2 m-2 or m s2 kg-1]
real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1]
real :: grid_dsd ! combination of grid scales [L2 ~> m2]
- real :: h_sml ! "Little h", the active mixing depth with diurnal cycle removed [Z ~> m]
- real :: h_big ! "Big H", the mixed layer depth based on a time filtered "little h" [Z ~> m]
- real :: grd_b ! The vertically average gradient of buoyancy [L Z-1 T-2 ~> s-2]
+ real :: h_sml ! "Little h", the active mixing depth with diurnal cycle removed [H ~> m or kg m-2]
+ real :: h_big ! "Big H", the mixed layer depth based on a time filtered "little h" [H ~> m or kg m-2]
+ real :: grd_b ! The vertically average gradient of buoyancy [L H-1 T-2 ~> s-2 or m-3 kg-1 s-2]
real :: psi_mag ! Magnitude of stream function [L2 H T-1 ~> m3 s-1 or kg s-1]
real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2]
real :: I4dt ! 1/(4 dt) [T-1 ~> s-1]
@@ -736,7 +837,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
real :: muza ! mu(z) at top of the layer [nondim]
real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2]
real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim]
- real, parameter :: two_thirds = 2./3.
+ real, parameter :: two_thirds = 2./3. ! [nondim]
logical :: line_is_empty, keep_going
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
@@ -745,7 +846,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
I4dt = 0.25 / dt
- g_Rho0 = GV%g_Earth / GV%Rho0
+ g_Rho0 = GV%H_to_Z * GV%g_Earth / GV%Rho0
h_neglect = GV%H_subroundoff
covTS(:) = 0.0 ! Might be in tv% in the future. Not implemented for the time being.
@@ -762,25 +863,53 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
call pass_var(bflux, G%domain, halo=1)
+ ! Extract the friction velocity from the forcing type.
+ call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1)
+
if (CS%debug) then
- call hchksum(h,'mixed_Bodner: h', G%HI, haloshift=1, scale=GV%H_to_m)
+ call hchksum(h,'mixed_Bodner: h', G%HI, haloshift=1, scale=GV%H_to_mks)
call hchksum(BLD, 'mle_Bodner: BLD in', G%HI, haloshift=1, scale=US%Z_to_m)
if (associated(bflux)) &
call hchksum(bflux, 'mle_Bodner: bflux', G%HI, haloshift=1, scale=US%Z_to_m**2*US%s_to_T**3)
- call hchksum(forces%ustar,'mle_Bodner: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T)
+ call hchksum(U_star_2d, 'mle_Bodner: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T)
call hchksum(CS%MLD_filtered, 'mle_Bodner: MLD_filtered 1', &
- G%HI, haloshift=1, scale=US%Z_to_m)
+ G%HI, haloshift=1, scale=GV%H_to_mks)
call hchksum(CS%MLD_filtered_slow,'mle_Bodner: MLD_filtered_slow 1', &
- G%HI, haloshift=1, scale=US%Z_to_m)
+ G%HI, haloshift=1, scale=GV%H_to_mks)
endif
! Apply time filter to BLD (to remove diurnal cycle) to obtain "little h".
! "little h" is representative of the active mixing layer depth, used in B22 formula (eq 27).
- do j = js-1, je+1 ; do i = is-1, ie+1
- little_h(i,j) = rmean2ts(BLD(i,j), CS%MLD_filtered(i,j), &
- CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt)
- CS%MLD_filtered(i,j) = little_h(i,j)
- enddo ; enddo
+ if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then
+ do j = js-1, je+1 ; do i = is-1, ie+1
+ little_h(i,j) = rmean2ts(GV%Z_to_H*BLD(i,j), CS%MLD_filtered(i,j), &
+ CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt)
+ CS%MLD_filtered(i,j) = little_h(i,j)
+ enddo ; enddo
+ else ! The fully non-Boussinesq conversion between height in BLD and thickness.
+ do j=js-1,je+1
+ do i=is-1,ie+1 ; MLD_rem(i) = BLD(i,j) ; H_mld(i) = 0.0 ; enddo
+ do k=1,nz
+ keep_going = .false.
+ do i=is-1,ie+1 ; if (MLD_rem(i) > 0.0) then
+ if (MLD_rem(i) > GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)) then
+ H_mld(i) = H_mld(i) + h(i,j,k)
+ MLD_rem(i) = MLD_rem(i) - GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)
+ keep_going = .true.
+ else
+ H_mld(i) = H_mld(i) + GV%RZ_to_H * MLD_rem(i) / tv%SpV_avg(i,j,k)
+ MLD_rem(i) = 0.0
+ endif
+ endif ; enddo
+ if (.not.keep_going) exit
+ enddo
+ do i=is-1,ie+1
+ little_h(i,j) = rmean2ts(H_mld(i), CS%MLD_filtered(i,j), &
+ CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt)
+ CS%MLD_filtered(i,j) = little_h(i,j)
+ enddo
+ enddo
+ endif
! Calculate "big H", representative of the mixed layer depth, used in B22 formula (eq 27).
do j = js-1, je+1 ; do i = is-1, ie+1
@@ -792,11 +921,11 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
! Estimate w'u' at h-points
do j = js-1, je+1 ; do i = is-1, ie+1
w_star3 = max(0., -bflux(i,j)) * BLD(i,j) & ! (this line in Z3 T-3 ~> m3 s-3)
- * ( ( US%Z_to_m * US%s_to_T )**3 ) ! m3 s-3
- u_star3 = ( US%Z_to_m * US%s_to_T * forces%ustar(i,j) )**3 ! m3 s-3
+ * ( ( US%Z_to_m * US%s_to_T )**3 ) ! [m3 T3 Z-3 s-3 ~> 1]
+ u_star3 = ( US%Z_to_m * US%s_to_T * U_star_2d(i,j) )**3 ! m3 s-3
wpup(i,j) = max( CS%min_wstar2, & ! The max() avoids division by zero later
( CS%mstar * u_star3 + CS%nstar * w_star3 )**two_thirds ) & ! (this line m2 s-2)
- * ( ( US%m_to_Z * US%T_to_s )**2 ) ! Z2 T-2 ~> m2 s-2
+ * ( US%m_to_L * GV%m_to_H * US%T_to_s**2 ) ! [L H s2 m-2 T-2 ~> 1 or kg m-3]
! We filter w'u' with the same time scales used for "little h"
wpup(i,j) = rmean2ts(wpup(i,j), CS%wpup_filtered(i,j), &
CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt)
@@ -804,13 +933,13 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
enddo ; enddo
if (CS%debug) then
- call hchksum(little_h,'mle_Bodner: little_h', G%HI, haloshift=1, scale=US%Z_to_m)
- call hchksum(big_H,'mle_Bodner: big_H', G%HI, haloshift=1, scale=US%Z_to_m)
+ call hchksum(little_h,'mle_Bodner: little_h', G%HI, haloshift=1, scale=GV%H_to_mks)
+ call hchksum(big_H,'mle_Bodner: big_H', G%HI, haloshift=1, scale=GV%H_to_mks)
call hchksum(CS%MLD_filtered,'mle_Bodner: MLD_filtered 2', &
- G%HI, haloshift=1, scale=US%Z_to_m)
+ G%HI, haloshift=1, scale=GV%H_to_mks)
call hchksum(CS%MLD_filtered_slow,'mle_Bodner: MLD_filtered_slow 2', &
- G%HI, haloshift=1, scale=US%Z_to_m)
- call hchksum(wpup,'mle_Bodner: wpup', G%HI, haloshift=1, scale=(US%Z_to_m*US%s_to_T)**2)
+ G%HI, haloshift=1, scale=GV%H_to_mks)
+ call hchksum(wpup,'mle_Bodner: wpup', G%HI, haloshift=1, scale=US%L_to_m*GV%H_to_mks*US%s_to_T**2)
endif
! Calculate the average density in the "mixed layer".
@@ -822,11 +951,13 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
!$OMP default(shared) &
!$OMP private(i, j, k, keep_going, line_is_empty, dh, &
!$OMP grid_dsd, absf, h_sml, h_big, grd_b, r_wpup, psi_mag, IhTot, &
- !$OMP sigint, muzb, muza, hAtVel)
+ !$OMP sigint, muzb, muza, hAtVel, Rml_int, SpV_int)
+
!$OMP do
do j=js-1,je+1
+ rho_ml(:) = 0.0 ; SpV_ml(:) = 0.0
do i=is-1,ie+1
- htot(i,j) = 0.0 ; buoy_av(i,j) = 0.0
+ htot(i,j) = 0.0 ; Rml_int(i) = 0.0 ; SpV_int(i) = 0.0
enddo
keep_going = .true.
do k=1,nz
@@ -834,17 +965,22 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
vol_dt_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
enddo
if (keep_going) then
- if (CS%use_Stanley_ML) then
- call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, &
- rho_ml(:), tv%eqn_of_state, EOSdom)
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ if (CS%use_Stanley_ML) then
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, &
+ rho_ml, tv%eqn_of_state, EOSdom)
+ else
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml, tv%eqn_of_state, EOSdom)
+ endif
else
- call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom)
+ call calculate_spec_vol(tv%T(:,j,k), tv%S(:,j,k), p0, SpV_ml, tv%eqn_of_state, EOSdom)
endif
line_is_empty = .true.
do i=is-1,ie+1
- if (htot(i,j) < big_H(i,j)*GV%Z_to_H) then
- dh = min( h(i,j,k), big_H(i,j)*GV%Z_to_H - htot(i,j) )
- buoy_av(i,j) = buoy_av(i,j) + dh*rho_ml(i) ! Here, buoy_av has units of R H ~> kg m-2
+ if (htot(i,j) < big_H(i,j)) then
+ dh = min( h(i,j,k), big_H(i,j) - htot(i,j) )
+ Rml_int(i) = Rml_int(i) + dh*rho_ml(i) ! Rml_int has units of [R H ~> kg m-2]
+ SpV_int(i) = SpV_int(i) + dh*SpV_ml(i) ! SpV_int has units of [H R-1 ~> m4 kg-1 or m]
htot(i,j) = htot(i,j) + dh
line_is_empty = .false.
endif
@@ -853,18 +989,24 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
endif
enddo
- do i=is-1,ie+1
- ! Hereafter, buoy_av has units (L2 Z-1 T-2 R-1) * (R H) * H-1 = L2 Z-1 T-2 ~> m s-2
- buoy_av(i,j) = -( g_Rho0 * buoy_av(i,j) ) / (htot(i,j) + h_neglect)
- enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do i=is-1,ie+1
+ ! Buoy_av has units (L2 H-1 T-2 R-1) * (R H) * H-1 = L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2
+ buoy_av(i,j) = -( g_Rho0 * Rml_int(i) ) / (htot(i,j) + h_neglect)
+ enddo
+ else
+ do i=is-1,ie+1
+ ! Buoy_av has units (R L2 H-1 T-2) * (R-1 H) * H-1 = L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2
+ buoy_av(i,j) = (GV%H_to_RZ*GV%g_Earth * SpV_int(i)) / (htot(i,j) + h_neglect)
+ enddo
+ endif
enddo
if (CS%debug) then
- call hchksum(htot,'mle_Bodner: htot', G%HI, haloshift=1, scale=GV%H_to_m)
+ call hchksum(htot,'mle_Bodner: htot', G%HI, haloshift=1, scale=GV%H_to_mks)
call hchksum(vol_dt_avail,'mle_Bodner: vol_dt_avail', G%HI, haloshift=1, &
- scale=US%L_to_m**2*GV%H_to_m*US%s_to_T)
- call hchksum(buoy_av,'mle_Bodner: buoy_av', G%HI, haloshift=1, &
- scale=US%m_to_Z*US%L_T_to_m_s**2)
+ scale=US%L_to_m**2*GV%H_to_mks*US%s_to_T)
+ call hchksum(buoy_av,'mle_Bodner: buoy_av', G%HI, haloshift=1, scale=GV%m_to_H*US%L_T_to_m_s**2)
endif
! U - Component
@@ -873,12 +1015,12 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
if (G%OBCmaskCu(I,j) > 0.) then
grid_dsd = sqrt(0.5*( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 )) * G%dyCu(I,j) ! L2 ~> m2
absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! T-1 ~> s-1
- h_sml = 0.5*( little_h(i,j) + little_h(i+1,j) ) ! Z ~> m
- h_big = 0.5*( big_H(i,j) + big_H(i+1,j) ) ! Z ~> m
- grd_b = ( buoy_av(i+1,j) - buoy_av(i,j) ) * G%IdxCu(I,j) ! L Z-1 T-2 ~> s-2
- r_wpup = 2. / ( wpup(i,j) + wpup(i+1,j) ) ! Z-2 T2 ~> m-2 s2
+ h_sml = 0.5*( little_h(i,j) + little_h(i+1,j) ) ! H ~> m or kg m-3
+ h_big = 0.5*( big_H(i,j) + big_H(i+1,j) ) ! H ~> m or kg m-3
+ grd_b = ( buoy_av(i+1,j) - buoy_av(i,j) ) * G%IdxCu(I,j) ! L H-1 T-2 ~> s-2 or m3 kg-1 s-2
+ r_wpup = 2. / ( wpup(i,j) + wpup(i+1,j) ) ! T2 L-1 H-1 ~> s2 m-2 or m s2 kg-1
psi_mag = ( ( ( CS%Cr * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1
- * ( ( h_big**2 ) * grd_b ) ) * r_wpup * US%L_to_Z * GV%Z_to_H
+ * ( ( h_big**2 ) * grd_b ) ) * r_wpup
else ! There is no flux on land and no gradient at open boundary points.
psi_mag = 0.0
endif
@@ -914,12 +1056,12 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
if (G%OBCmaskCv(i,J) > 0.) then
grid_dsd = sqrt(0.5*( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 )) * G%dxCv(i,J) ! L2 ~> m2
absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! T-1 ~> s-1
- h_sml = 0.5*( little_h(i,j) + little_h(i,j+1) ) ! Z ~> m
- h_big = 0.5*( big_H(i,j) + big_H(i,j+1) ) ! Z ~> m
- grd_b = ( buoy_av(i,j+1) - buoy_av(i,j) ) * G%IdyCv(I,j) ! L Z-1 T-2 ~> s-2
- r_wpup = 2. / ( wpup(i,j) + wpup(i,j+1) ) ! Z-2 T2 ~> m-2 s2
+ h_sml = 0.5*( little_h(i,j) + little_h(i,j+1) ) ! H ~> m or kg m-3
+ h_big = 0.5*( big_H(i,j) + big_H(i,j+1) ) ! H ~> m or kg m-3
+ grd_b = ( buoy_av(i,j+1) - buoy_av(i,j) ) * G%IdyCv(I,j) ! L H-1 T-2 ~> s-2 or m3 kg-1 s-2
+ r_wpup = 2. / ( wpup(i,j) + wpup(i,j+1) ) ! T2 L-1 H-1 ~> s2 m-2 or m s2 kg-1
psi_mag = ( ( ( CS%Cr * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1
- * ( ( h_big**2 ) * grd_b ) ) * r_wpup * US%L_to_Z * GV%Z_to_H
+ * ( ( h_big**2 ) * grd_b ) ) * r_wpup
else ! There is no flux on land and no gradient at open boundary points.
psi_mag = 0.0
endif
@@ -965,7 +1107,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d
! Offer diagnostic fields for averaging.
if (query_averaging_enabled(CS%diag)) then
- if (CS%id_ustar > 0) call post_data(CS%id_ustar, forces%ustar, CS%diag)
+ if (CS%id_ustar > 0) call post_data(CS%id_ustar, U_star_2d, CS%diag)
if (CS%id_bflux > 0) call post_data(CS%id_bflux, bflux, CS%diag)
if (CS%id_wpup > 0) call post_data(CS%id_wpup, wpup, CS%diag)
if (CS%id_Rml > 0) call post_data(CS%id_Rml, buoy_av, CS%diag)
@@ -1014,7 +1156,7 @@ real elemental function rmean2ts(signal, filtered, tau_growing, tau_decaying, dt
real, intent(in) :: tau_decaying ! Time scale for decaying signal [T ~> s]
real, intent(in) :: dt ! Time step [T ~> s]
! Local variables
- real :: afac, bfac ! Non-dimensional weights
+ real :: afac, bfac ! Non-dimensional fractional weights [nondim]
real :: rt ! Reciprocal time scale [T-1 ~> s-1]
if (signal>=filtered) then
@@ -1053,22 +1195,30 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS)
h_avail ! The volume available for diffusion out of each face of each
! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1].
real, dimension(SZI_(G),SZJ_(G)) :: &
+ U_star_2d, & ! The wind friction velocity in thickness-based units, calculated using
+ ! the Boussinesq reference density or the time-evolving surface density
+ ! in non-Boussinesq mode [H T-1 ~> m s-1 or kg m-2 s-1]
htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2]
- Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2]
- real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]
- real :: Rho0(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3]
+ Rml_av ! g_Rho0 times the average mixed layer density or negative G_Earth
+ ! times the average specific volume [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]
+ real :: g_Rho0 ! G_Earth/Rho0 times a thickness conversion factor
+ ! [L2 H-1 T-2 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]
+ real :: Rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3]
+ real :: rho_int(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-3]
+ real :: SpV_ml(SZI_(G)) ! Specific volume evaluated at the surface pressure [R-1 ~> m3 kg-1]
+ real :: SpV_int(SZI_(G)) ! Specific volume integrated through the surface layer [H R-1 ~> m4 kg-1 or m]
real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa]
- real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.)
+ real :: h_vel ! htot interpolated onto velocity points [H ~> m or kg m-2]
real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1]
- real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1].
+ real :: u_star ! surface friction velocity, interpolated to velocity points and recast into
+ ! thickness-based units [H T-1 ~> m s-1 or kg m-2 s-1].
real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times
! pi squared [nondim]
real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1]
real :: timescale ! mixing growth timescale [T ~> s]
real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0.
real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2]
- real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m]
real :: I4dt ! 1/(4 dt) [T-1 ~> s-1]
real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2]
real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2]
@@ -1098,11 +1248,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS)
h_min = 0.5*GV%Angstrom_H ! This should be GV%Angstrom_H, but that value would change answers.
uDml(:) = 0.0 ; vDml(:) = 0.0
I4dt = 0.25 / dt
- g_Rho0 = GV%g_Earth / GV%Rho0
+ g_Rho0 = GV%H_to_Z * GV%g_Earth / GV%Rho0
vonKar_x_pi2 = CS%vonKar * 9.8696
use_EOS = associated(tv%eqn_of_state)
h_neglect = GV%H_subroundoff
- dz_neglect = GV%H_subroundoff*GV%H_to_Z
if (.not.use_EOS) call MOM_error(FATAL, "mixedlayer_restrat_BML: "// &
"An equation of state must be used with this module.")
@@ -1110,31 +1259,57 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS)
if (CS%use_Stanley_ML) call MOM_error(FATAL, "mixedlayer_restrat_BML: "// &
"The Stanley parameterization is not available with the BML.")
+ ! Extract the friction velocity from the forcing type.
+ call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1, H_T_units=.true.)
+
! Fix this later for nkml >= 3.
p0(:) = 0.0
EOSdom(:) = EOS_domain(G%HI, halo=1)
- !$OMP parallel default(shared) private(Rho0,h_vel,u_star,absf,mom_mixrate,timescale, &
- !$OMP I2htot,z_topx2,hx2,a) &
+ !$OMP parallel default(shared) private(Rho_ml,rho_int,h_vel,u_star,absf,mom_mixrate,timescale, &
+ !$OMP SpV_ml,SpV_int,I2htot,z_topx2,hx2,a) &
!$OMP firstprivate(uDml,vDml)
- !$OMP do
- do j=js-1,je+1
- do i=is-1,ie+1
- htot(i,j) = 0.0 ; Rml_av(i,j) = 0.0
- enddo
- do k=1,nkml
- call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, Rho0(:), tv%eqn_of_state, EOSdom)
+
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ !$OMP do
+ do j=js-1,je+1
+ do i=is-1,ie+1
+ htot(i,j) = 0.0 ; rho_int(i) = 0.0
+ enddo
+ do k=1,nkml
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, Rho_ml(:), tv%eqn_of_state, EOSdom)
+ do i=is-1,ie+1
+ rho_int(i) = rho_int(i) + h(i,j,k)*Rho_ml(i)
+ htot(i,j) = htot(i,j) + h(i,j,k)
+ h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
+ enddo
+ enddo
+
do i=is-1,ie+1
- Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i)
- htot(i,j) = htot(i,j) + h(i,j,k)
- h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
+ Rml_av(i,j) = (g_Rho0*rho_int(i)) / (htot(i,j) + h_neglect)
enddo
enddo
+ else ! This is only used in non-Boussinesq mode.
+ !$OMP do
+ do j=js-1,je+1
+ do i=is-1,ie+1
+ htot(i,j) = 0.0 ; SpV_int(i) = 0.0
+ enddo
+ do k=1,nkml
+ call calculate_spec_vol(tv%T(:,j,k), tv%S(:,j,k), p0, SpV_ml, tv%eqn_of_state, EOSdom)
+ do i=is-1,ie+1
+ SpV_int(i) = SpV_int(i) + h(i,j,k)*SpV_ml(i) ! [H R-1 ~> m4 kg-1 or m]
+ htot(i,j) = htot(i,j) + h(i,j,k)
+ h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
+ enddo
+ enddo
- do i=is-1,ie+1
- Rml_av(i,j) = (g_Rho0*Rml_av(i,j)) / (htot(i,j) + h_neglect)
+ ! Convert the vertically integrated specific volume into a negative variable with units of density.
+ do i=is-1,ie+1
+ Rml_av(i,j) = (-GV%H_to_RZ*GV%g_Earth * SpV_int(i)) / (htot(i,j) + h_neglect)
+ enddo
enddo
- enddo
+ endif
! TO DO:
! 1. Mixing extends below the mixing layer to the mixed layer. Find it!
@@ -1143,26 +1318,26 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS)
! U - Component
!$OMP do
do j=js,je ; do I=is-1,ie
- h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z
+ h_vel = 0.5*(htot(i,j) + htot(i+1,j))
- u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)))
+ u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i+1,j)))
absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
! NOTE: growth_time changes answers on some systems, see below.
- ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
+ ! timescale = growth_time(u_star, h_vel, absf, h_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
mom_mixrate = vonKar_x_pi2*u_star**2 / &
- (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
+ (absf*h_vel**2 + 4.0*(h_vel+h_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef
! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2)
uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * &
- (Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H)
+ (Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2)
if (uDml(I) == 0) then
do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo
@@ -1194,26 +1369,26 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS)
! V- component
!$OMP do
do J=js-1,je ; do i=is,ie
- h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z
+ h_vel = 0.5*(htot(i,j) + htot(i,j+1))
- u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)))
+ u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i,j+1)))
absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
! NOTE: growth_time changes answers on some systems, see below.
- ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
+ ! timescale = growth_time(u_star, h_vel, absf, h_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef)
! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
! momentum mixing rate: pi^2*visc/h_ml^2
mom_mixrate = vonKar_x_pi2*u_star**2 / &
- (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star)
+ (absf*h_vel**2 + 4.0*(h_vel+h_neglect)*u_star)
timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)
timescale = timescale * CS%ml_restrat_coef
! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2)
vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * &
- (Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H)
+ (Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2)
if (vDml(i) == 0) then
do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo
else
@@ -1283,19 +1458,21 @@ end subroutine mixedlayer_restrat_BML
!> Return the growth timescale for the submesoscale mixed layer eddies in [T ~> s]
real function growth_time(u_star, hBL, absf, h_neg, vonKar, Kv_rest, restrat_coef)
- real, intent(in) :: u_star !< Surface friction velocity [Z T-1 ~> m s-1]
+ real, intent(in) :: u_star !< Surface friction velocity in thickness-based units [H T-1 ~> m s-1 or kg m-2 s-1]
real, intent(in) :: hBL !< Boundary layer thickness including at least a neglible
- !! value to keep it positive definite [Z ~> m]
+ !! value to keep it positive definite [H ~> m or kg m-2]
real, intent(in) :: absf !< Absolute value of the Coriolis parameter [T-1 ~> s-1]
- real, intent(in) :: h_neg !< A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m]
- real, intent(in) :: Kv_rest !< The background laminar vertical viscosity used for restratification [Z2 T-1 ~> m2 s-1]
+ real, intent(in) :: h_neg !< A tiny thickness that is usually lost in roundoff so can be
+ !! neglected [H ~> m or kg m-2]
+ real, intent(in) :: Kv_rest !< The background laminar vertical viscosity used for restratification,
+ !! rescaled into thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1]
real, intent(in) :: vonKar !< The von Karman constant, used to scale the turbulent limits
!! on the restratification timescales [nondim]
real, intent(in) :: restrat_coef !< An overall scaling factor for the restratification timescale [nondim]
! Local variables
real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1]
- real :: Kv_eff ! An effective overall viscosity [Z2 T-1 ~> m2 s-1]
+ real :: Kv_eff ! An effective overall viscosity in thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1]
real :: pi2 ! A scaling constant that is approximately pi^2 [nondim]
! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + Kv_water
@@ -1336,7 +1513,6 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
real :: ustar_min_dflt ! The default value for RESTRAT_USTAR_MIN [Z T-1 ~> m s-1]
real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale
! temperature variance [nondim]
- real :: BLD_units ! Set to either H_to_m or Z_to_m depending on scheme [m H-1 or m Z-1 ~> 1]
! This include declares and sets the variable "version".
# include "version_variable.h"
integer :: i, j
@@ -1411,7 +1587,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
"a division-by-zero in the limit when u* and the buoyancy flux are zero. "//&
"The default is less than the molecular viscosity of water times the Coriolis "//&
"parameter a micron away from the equator.", &
- units="m2 s-2", default=1.0e-24)
+ units="m2 s-2", default=1.0e-24) ! This parameter stays in MKS units.
call get_param(param_file, mdl, "TAIL_DH", CS%MLE_tail_dh, &
"Fraction by which to extend the mixed-layer restratification "//&
"depth used for a smoother stream function at the base of "//&
@@ -1446,7 +1622,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_Stanley_ML, &
"If true, turn on Stanley SGS T variance parameterization "// &
"in ML restrat code.", default=.false.)
- if (CS%use_stanley_ml) then
+ if (CS%use_Stanley_ML) then
call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, &
"Coefficient correlating the temperature gradient and SGS T variance.", &
units="nondim", default=-1.0, do_not_log=.true.)
@@ -1502,23 +1678,21 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
"A small viscosity that sets a floor on the momentum mixing rate during "//&
"restratification. If this is positive, it will prevent some possible "//&
"divisions by zero even if ustar, RESTRAT_USTAR_MIN, and f are all 0.", &
- units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=0.0, scale=GV%m2_s_to_HZ_T*(US%Z_to_m*GV%m_to_H))
call get_param(param_file, mdl, "OMEGA", omega, &
"The rotation rate of the earth.", &
units="s-1", default=7.2921e-5, scale=US%T_to_s)
- ustar_min_dflt = 2.0e-4 * omega * (GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff)
+ ustar_min_dflt = 2.0e-4 * omega * (GV%Angstrom_Z + GV%dZ_subroundoff)
call get_param(param_file, mdl, "RESTRAT_USTAR_MIN", CS%ustar_min, &
"The minimum value of ustar that will be used by the mixed layer "//&
"restratification module. This can be tiny, but if this is greater than 0, "//&
"it will prevent divisions by zero when f and KV_RESTRAT are zero.", &
- units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=US%m_to_Z*US%T_to_s)
+ units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=GV%m_to_H*US%T_to_s)
endif
CS%diag => diag
flux_to_kg_per_s = GV%H_to_kg_m2 * US%L_to_m**2 * US%s_to_T
- if (CS%use_Bodner) then; BLD_units = US%Z_to_m
- else; BLD_units = GV%H_to_m; endif
CS%id_uhml = register_diag_field('ocean_model', 'uhml', diag%axesCuL, Time, &
'Zonal Thickness Flux to Restratify Mixed Layer', &
@@ -1532,13 +1706,13 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
'Mixed Layer Meridional Restratification Timescale', 's', conversion=US%T_to_s)
CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, &
'Mixed Layer Depth as used in the mixed-layer restratification parameterization', &
- 'm', conversion=BLD_units)
+ 'm', conversion=GV%H_to_m)
CS%id_BLD = register_diag_field('ocean_model', 'BLD_restrat', diag%axesT1, Time, &
'Boundary Layer Depth as used in the mixed-layer restratification parameterization', &
- 'm', conversion=BLD_units)
+ 'm', conversion=GV%H_to_m)
CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, &
'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', &
- 'm s-2', conversion=US%m_to_Z*(US%L_T_to_m_s**2))
+ 'm s-2', conversion=GV%m_to_H*(US%L_T_to_m_s**2))
CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, &
'Transport stream function amplitude for zonal restratification of mixed layer', &
'm3 s-1', conversion=GV%H_to_m*(US%L_to_m**2)*US%s_to_T)
@@ -1554,7 +1728,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
if (CS%use_Bodner) then
CS%id_wpup = register_diag_field('ocean_model', 'MLE_wpup', diag%axesT1, Time, &
'Vertical turbulent momentum flux in Bodner mixed layer restratificiation parameterization', &
- 'm2 s-2', conversion=(US%Z_to_m*US%s_to_T)**2)
+ 'm2 s-2', conversion=US%L_to_m*GV%H_to_m*US%s_to_T**2)
CS%id_ustar = register_diag_field('ocean_model', 'MLE_ustar', diag%axesT1, Time, &
'Surface turbulent friction velicity, u*, in Bodner mixed layer restratificiation parameterization', &
'm s-1', conversion=(US%Z_to_m*US%s_to_T))
@@ -1566,6 +1740,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
! If MLD_filtered is being used, we need to update halo regions after a restart
if (allocated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain)
if (allocated(CS%MLD_filtered_slow)) call pass_var(CS%MLD_filtered_slow, G%domain)
+ if (allocated(CS%wpup_filtered)) call pass_var(CS%wpup_filtered, G%domain)
end function mixedlayer_restrat_init
@@ -1580,6 +1755,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, GV, US, param_file, CS, rest
type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure
! Local variables
+ character(len=64) :: mom_flux_units
logical :: mixedlayer_restrat_init, use_Bodner
! Check to see if this module will be used
@@ -1605,18 +1781,21 @@ subroutine mixedlayer_restrat_register_restarts(HI, GV, US, param_file, CS, rest
allocate(CS%MLD_filtered_slow(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.)
call register_restart_field(CS%MLD_filtered_slow, "MLD_MLE_filtered_slow", .false., restart_CS, &
longname="Slower time-filtered MLD for use in MLE", &
- units=get_thickness_units(GV), conversion=GV%H_to_MKS) ! UNITS ARE WRONG -AJA
+ units=get_thickness_units(GV), conversion=GV%H_to_MKS)
endif
if (use_Bodner) then
! CS%MLD_filtered_slow is used to keep a running mean of the PBL's seasonal or winter MLD.
+ mom_flux_units = "m2 s-2" ; if (.not.GV%Boussinesq) mom_flux_units = "kg m-1 s-2"
allocate(CS%wpup_filtered(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.)
call register_restart_field(CS%wpup_filtered, "MLE_Bflux", .false., restart_CS, &
longname="Time-filtered vertical turbulent momentum flux for use in MLE", &
- units='m2 s-2', conversion=(US%Z_to_m*US%s_to_T)**2 )
+ units=mom_flux_units, conversion=US%L_to_m*GV%H_to_mks*US%s_to_T**2 )
endif
end subroutine mixedlayer_restrat_register_restarts
+!> Returns true if a unit test of functions in MOM_mixedlayer_restrat fail.
+!! Returns false otherwise.
logical function mixedlayer_restrat_unit_tests(verbose)
logical, intent(in) :: verbose !< If true, write results to stdout
! Local variables
diff --git a/src/parameterizations/lateral/MOM_self_attr_load.F90 b/src/parameterizations/lateral/MOM_self_attr_load.F90
new file mode 100644
index 0000000000..7f7215c9d8
--- /dev/null
+++ b/src/parameterizations/lateral/MOM_self_attr_load.F90
@@ -0,0 +1,277 @@
+module MOM_self_attr_load
+
+use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_MODULE
+use MOM_domains, only : pass_var
+use MOM_error_handler, only : MOM_error, FATAL, WARNING
+use MOM_file_parser, only : read_param, get_param, log_version, param_file_type
+use MOM_obsolete_params, only : obsolete_logical, obsolete_int
+use MOM_grid, only : ocean_grid_type
+use MOM_unit_scaling, only : unit_scale_type
+use MOM_spherical_harmonics, only : spherical_harmonics_init, spherical_harmonics_end
+use MOM_spherical_harmonics, only : spherical_harmonics_forward, spherical_harmonics_inverse
+use MOM_spherical_harmonics, only : sht_CS, order2index, calc_lmax
+use MOM_load_love_numbers, only : Love_Data
+
+implicit none ; private
+
+public calc_SAL, scalar_SAL_sensitivity, SAL_init, SAL_end
+
+#include
+
+!> The control structure for the MOM_self_attr_load module
+type, public :: SAL_CS ; private
+ logical :: use_sal_scalar !< If true, use the scalar approximation to calculate SAL.
+ logical :: use_sal_sht !< If true, use online spherical harmonics to calculate SAL
+ logical :: use_tidal_sal_prev !< If true, read the tidal SAL from the previous iteration of
+ !! the tides to facilitate convergence.
+ real :: sal_scalar_value !< The constant of proportionality between sea surface height
+ !! (really it should be bottom pressure) anomalies and bottom
+ !! geopotential anomalies [nondim].
+ type(sht_CS) :: sht !< Spherical harmonic transforms (SHT) control structure
+ integer :: sal_sht_Nd !< Maximum degree for SHT [nodim]
+ real, allocatable :: Love_Scaling(:) !< Love number for each SHT mode [nodim]
+ real, allocatable :: Snm_Re(:), & !< Real SHT coefficient for SHT SAL [Z ~> m]
+ Snm_Im(:) !< Imaginary SHT coefficient for SHT SAL [Z ~> m]
+end type SAL_CS
+
+integer :: id_clock_SAL !< CPU clock for self-attraction and loading
+
+contains
+
+!> This subroutine calculates seawater self-attraction and loading based on sea surface height. This should
+!! be changed into bottom pressure anomaly in the future. Note that the SAL calculation applies to all motions
+!! across the spectrum. Tidal-specific methods that assume periodicity, i.e. iterative and read-in SAL, are
+!! stored in MOM_tidal_forcing module.
+subroutine calc_SAL(eta, eta_sal, G, CS, tmp_scale)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from
+ !! a time-mean geoid [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_sal !< The sea surface height anomaly from
+ !! self-attraction and loading [Z ~> m].
+ type(SAL_CS), intent(inout) :: CS !< The control structure returned by a previous call to SAL_init.
+ real, optional, intent(in) :: tmp_scale !< A rescaling factor to temporarily convert eta
+ !! to MKS units in reproducing sumes [m Z-1 ~> 1]
+
+ ! Local variables
+ integer :: n, m, l
+ integer :: Isq, Ieq, Jsq, Jeq
+ integer :: i, j
+ real :: eta_prop ! The scalar constant of proportionality between eta and eta_sal [nondim]
+
+ call cpu_clock_begin(id_clock_SAL)
+
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+
+ ! use the scalar approximation and/or iterative tidal SAL
+ if (CS%use_sal_scalar .or. CS%use_tidal_sal_prev) then
+ call scalar_SAL_sensitivity(CS, eta_prop)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ eta_sal(i,j) = eta_prop*eta(i,j)
+ enddo ; enddo
+
+ ! use the spherical harmonics method
+ elseif (CS%use_sal_sht) then
+ call spherical_harmonics_forward(G, CS%sht, eta, CS%Snm_Re, CS%Snm_Im, CS%sal_sht_Nd, tmp_scale=tmp_scale)
+
+ ! Multiply scaling factors to each mode
+ do m = 0,CS%sal_sht_Nd
+ l = order2index(m, CS%sal_sht_Nd)
+ do n = m,CS%sal_sht_Nd
+ CS%Snm_Re(l+n-m) = CS%Snm_Re(l+n-m) * CS%Love_Scaling(l+n-m)
+ CS%Snm_Im(l+n-m) = CS%Snm_Im(l+n-m) * CS%Love_Scaling(l+n-m)
+ enddo
+ enddo
+
+ call spherical_harmonics_inverse(G, CS%sht, CS%Snm_Re, CS%Snm_Im, eta_sal, CS%sal_sht_Nd)
+ ! Halo was not calculated in spherical harmonic transforms.
+ call pass_var(eta_sal, G%domain)
+
+ else
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ eta_sal(i,j) = 0.0
+ enddo ; enddo
+ endif
+
+ call cpu_clock_end(id_clock_SAL)
+end subroutine calc_SAL
+
+!> This subroutine calculates the partial derivative of the local geopotential height with the input
+!! sea surface height due to the scalar approximation of self-attraction and loading.
+subroutine scalar_SAL_sensitivity(CS, deta_sal_deta)
+ type(SAL_CS), intent(in) :: CS !< The control structure returned by a previous call to SAL_init.
+ real, intent(out) :: deta_sal_deta !< The partial derivative of eta_sal with
+ !! the local value of eta [nondim].
+
+ if (CS%use_sal_scalar .and. CS%use_tidal_sal_prev) then
+ deta_sal_deta = 2.0*CS%sal_scalar_value
+ elseif (CS%use_sal_scalar .or. CS%use_tidal_sal_prev) then
+ deta_sal_deta = CS%sal_scalar_value
+ else
+ deta_sal_deta = 0.0
+ endif
+end subroutine scalar_SAL_sensitivity
+
+!> This subroutine calculates coefficients of the spherical harmonic modes for self-attraction and loading.
+!! The algorithm is based on the SAL implementation in MPAS-ocean, which was modified by Kristin Barton from
+!! routine written by K. Quinn (March 2010) and modified by M. Schindelegger (May 2017).
+subroutine calc_love_scaling(nlm, rhoW, rhoE, Love_Scaling)
+ integer, intent(in) :: nlm !< Maximum spherical harmonics degree [nondim]
+ real, intent(in) :: rhoW !< The average density of sea water [R ~> kg m-3]
+ real, intent(in) :: rhoE !< The average density of Earth [R ~> kg m-3]
+ real, dimension(:), intent(out) :: Love_Scaling !< Scaling factors for inverse SHT [nondim]
+
+ ! Local variables
+ real, dimension(:), allocatable :: HDat, LDat, KDat ! Love numbers converted in CF reference frames [nondim]
+ real :: H1, L1, K1 ! Temporary variables to store degree 1 Love numbers [nondim]
+ integer :: n_tot ! Size of the stored Love numbers
+ integer :: n, m, l
+
+ n_tot = size(Love_Data, dim=2)
+
+ if (nlm+1 > n_tot) call MOM_error(FATAL, "MOM_tidal_forcing " // &
+ "calc_love_scaling: maximum spherical harmonics degree is larger than " // &
+ "the size of the stored Love numbers in MOM_load_love_number.")
+
+ allocate(HDat(nlm+1), LDat(nlm+1), KDat(nlm+1))
+ HDat(:) = Love_Data(2,1:nlm+1) ; LDat(:) = Love_Data(3,1:nlm+1) ; KDat(:) = Love_Data(4,1:nlm+1)
+
+ ! Convert reference frames from CM to CF
+ if (nlm > 0) then
+ H1 = HDat(2) ; L1 = LDat(2) ; K1 = KDat(2)
+ HDat(2) = ( 2.0 / 3.0) * (H1 - L1)
+ LDat(2) = (-1.0 / 3.0) * (H1 - L1)
+ KDat(2) = (-1.0 / 3.0) * H1 - (2.0 / 3.0) * L1 - 1.0
+ endif
+
+ do m=0,nlm ; do n=m,nlm
+ l = order2index(m,nlm)
+ Love_Scaling(l+n-m) = (3.0 / real(2*n+1)) * (rhoW / rhoE) * (1.0 + KDat(n+1) - HDat(n+1))
+ enddo ; enddo
+end subroutine calc_love_scaling
+
+!> This subroutine initializes the self-attraction and loading control structure.
+subroutine SAL_init(G, US, param_file, CS)
+ type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
+ type(SAL_CS), intent(inout) :: CS !< Self-attraction and loading control structure
+
+ ! Local variables
+# include "version_variable.h"
+ character(len=40) :: mdl = "MOM_self_attr_load" ! This module's name.
+ integer :: lmax ! Total modes of the real spherical harmonics [nondim]
+ real :: rhoW ! The average density of sea water [R ~> kg m-3].
+ real :: rhoE ! The average density of Earth [R ~> kg m-3].
+
+ logical :: calculate_sal
+ logical :: tides, use_tidal_sal_file
+ real :: tide_sal_scalar_value ! Scaling SAL factor [nondim]
+
+ ! Read all relevant parameters and write them to the model log.
+ call log_version(param_file, mdl, version, "")
+
+ call get_param(param_file, '', "TIDES", tides, default=.false., do_not_log=.True.)
+ call get_param(param_file, mdl, "CALCULATE_SAL", calculate_sal, "If true, calculate "//&
+ " self-attraction and loading.", default=tides, do_not_log=.True.)
+ if (.not. calculate_sal) return
+
+ if (tides) then
+ call get_param(param_file, '', "USE_PREVIOUS_TIDES", CS%use_tidal_sal_prev, &
+ default=.false., do_not_log=.True.)
+ call get_param(param_file, '', "TIDAL_SAL_FROM_FILE", use_tidal_sal_file, &
+ default=.false., do_not_log=.True.)
+ endif
+
+ call get_param(param_file, mdl, "SAL_SCALAR_APPROX", CS%use_sal_scalar, &
+ "If true, use the scalar approximation to calculate self-attraction and "//&
+ "loading.", default=tides .and. (.not. use_tidal_sal_file))
+ call get_param(param_file, '', "TIDE_SAL_SCALAR_VALUE", tide_sal_scalar_value, &
+ units="m m-1", default=0.0, do_not_log=.True.)
+ if (tide_sal_scalar_value/=0.0) &
+ call MOM_error(WARNING, "TIDE_SAL_SCALAR_VALUE is a deprecated parameter. "//&
+ "Use SAL_SCALAR_VALUE instead." )
+ call get_param(param_file, mdl, "SAL_SCALAR_VALUE", CS%sal_scalar_value, &
+ "The constant of proportionality between sea surface "//&
+ "height (really it should be bottom pressure) anomalies "//&
+ "and bottom geopotential anomalies. This is only used if "//&
+ "USE_SAL_SCALAR is true or USE_PREVIOUS_TIDES is true.", &
+ default=tide_sal_scalar_value, units="m m-1", &
+ do_not_log=(.not. CS%use_sal_scalar) .and. (.not. CS%use_tidal_sal_prev))
+ call get_param(param_file, mdl, "SAL_HARMONICS", CS%use_sal_sht, &
+ "If true, use the online spherical harmonics method to calculate "//&
+ "self-attraction and loading.", default=.false.)
+ call get_param(param_file, mdl, "SAL_HARMONICS_DEGREE", CS%sal_sht_Nd, &
+ "The maximum degree of the spherical harmonics transformation used for "// &
+ "calculating the self-attraction and loading term.", &
+ default=0, do_not_log=(.not. CS%use_sal_sht))
+ call get_param(param_file, '', "RHO_0", rhoW, default=1035.0, scale=US%kg_m3_to_R, &
+ units="kg m-3", do_not_log=.True.)
+ call get_param(param_file, mdl, "RHO_SOLID_EARTH", rhoE, &
+ "The mean solid earth density. This is used for calculating the "// &
+ "self-attraction and loading term.", units="kg m-3", &
+ default=5517.0, scale=US%kg_m3_to_R, do_not_log=(.not. CS%use_sal_sht))
+
+ if (CS%use_sal_sht) then
+ lmax = calc_lmax(CS%sal_sht_Nd)
+ allocate(CS%Snm_Re(lmax)); CS%Snm_Re(:) = 0.0
+ allocate(CS%Snm_Im(lmax)); CS%Snm_Im(:) = 0.0
+
+ allocate(CS%Love_Scaling(lmax)); CS%Love_Scaling(:) = 0.0
+ call calc_love_scaling(CS%sal_sht_Nd, rhoW, rhoE, CS%Love_Scaling)
+ call spherical_harmonics_init(G, param_file, CS%sht)
+ endif
+
+ id_clock_SAL = cpu_clock_id('(Ocean SAL)', grain=CLOCK_MODULE)
+
+end subroutine SAL_init
+
+!> This subroutine deallocates memory associated with the SAL module.
+subroutine SAL_end(CS)
+ type(SAL_CS), intent(inout) :: CS !< The control structure returned by a previous call
+ !! to SAL_init; it is deallocated here.
+ if (CS%use_sal_sht) then
+ if (allocated(CS%Love_Scaling)) deallocate(CS%Love_Scaling)
+ if (allocated(CS%Snm_Re)) deallocate(CS%Snm_Re)
+ if (allocated(CS%Snm_Im)) deallocate(CS%Snm_Im)
+ call spherical_harmonics_end(CS%sht)
+ endif
+end subroutine SAL_end
+
+!> \namespace self_attr_load
+!!
+!! This module contains methods to calculate self-attraction and loading (SAL) as a function of sea surface height (SSH)
+!! (rather, it should be bottom pressure anomaly). SAL is primarily used for fast evolving processes like tides or
+!! storm surges, but the effect applies to all motions.
+!!
+!! If SAL_SCALAR_APPROX is true, a scalar approximation is applied (Accad and Pekeris 1978) and the SAL is simply
+!! a fraction (set by SAL_SCALAR_VALUE, usually around 10% for global tides) of local SSH . For tides, the scalar
+!! approximation can also be used to iterate the SAL to convergence [see USE_PREVIOUS_TIDES in MOM_tidal_forcing,
+!! Arbic et al. (2004)].
+!!
+!! If SAL_HARMONICS is true, a more accurate online spherical harmonic transforms are used to calculate SAL.
+!! Subroutines in module MOM_spherical_harmonics are called and the degree of spherical harmonic transforms is set by
+!! SAL_HARMONICS_DEGREE. The algorithm is based on SAL calculation in Model for Prediction Across Scales (MPAS)-Ocean
+!! developed by Los Alamos National Laboratory and University of Michigan [Barton et al. (2022) and Brus et al. (2023)].
+!!
+!! References:
+!!
+!! Accad, Y. and Pekeris, C.L., 1978. Solution of the tidal equations for the M2 and S2 tides in the world oceans from a
+!! knowledge of the tidal potential alone. Philosophical Transactions of the Royal Society of London. Series A,
+!! Mathematical and Physical Sciences, 290(1368), pp.235-266.
+!! https://doi.org/10.1098/rsta.1978.0083
+!!
+!! Arbic, B.K., Garner, S.T., Hallberg, R.W. and Simmons, H.L., 2004. The accuracy of surface elevations in forward
+!! global barotropic and baroclinic tide models. Deep Sea Research Part II: Topical Studies in Oceanography, 51(25-26),
+!! pp.3069-3101.
+!! https://doi.org/10.1016/j.dsr2.2004.09.014
+!!
+!! Barton, K.N., Pal, N., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J.J.,
+!! Wirasaet, D. and Schindelegger, M., 2022. Global Barotropic Tide Modeling Using Inline Self‐Attraction and Loading in
+!! MPAS‐Ocean. Journal of Advances in Modeling Earth Systems, 14(11), p.e2022MS003207.
+!! https://doi.org/10.1029/2022MS003207
+!!
+!! Brus, S.R., Barton, K.N., Pal, N., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D.,
+!! Westerink, J.J. and Schindelegger, M., 2023. Scalable self attraction and loading calculations for unstructured ocean
+!! tide models. Ocean Modelling, p.102160.
+!! https://doi.org/10.1016/j.ocemod.2023.102160
+end module MOM_self_attr_load
diff --git a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 b/src/parameterizations/lateral/MOM_spherical_harmonics.F90
index 95a9df808c..26258e6b8e 100644
--- a/src/parameterizations/lateral/MOM_spherical_harmonics.F90
+++ b/src/parameterizations/lateral/MOM_spherical_harmonics.F90
@@ -42,7 +42,7 @@ module MOM_spherical_harmonics
contains
!> Calculates forward spherical harmonics transforms
-subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd)
+subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd, tmp_scale)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(sht_CS), intent(inout) :: CS !< Control structure for SHT
real, dimension(SZI_(G),SZJ_(G)), &
@@ -51,13 +51,20 @@ subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd)
real, intent(out) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) [A]
integer, optional, intent(in) :: Nd !< Maximum degree of the spherical harmonics
!! overriding ndegree in the CS [nondim]
+ real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor to convert
+ !! var to MKS units during the reproducing
+ !! sums [a A-1 ~> 1]
! local variables
- integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nondim]
- integer :: Ltot ! Local copy of the number of spherical harmonics [nondim]
+ integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics
+ integer :: Ltot ! Local copy of the number of spherical harmonics
real, dimension(SZI_(G),SZJ_(G)) :: &
pmn, & ! Current associated Legendre polynomials of degree n and order m [nondim]
pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nondim]
pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nondim]
+ real :: scale ! A rescaling factor to temporarily convert var to MKS units during the
+ ! reproducing sums [a A-1 ~> 1]
+ real :: I_scale ! The inverse of scale [A a-1 ~> 1]
+ real :: sum_tot ! The total of all components output by the reproducing sum in arbitrary units [a]
integer :: i, j, k
integer :: is, ie, js, je, isd, ied, jsd, jed
integer :: m, n, l
@@ -81,12 +88,13 @@ subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd)
do l=1,Ltot ; Snm_Re(l) = 0.0; Snm_Im(l) = 0.0 ; enddo
if (CS%reprod_sum) then
+ scale = 1.0 ; if (present(tmp_scale)) scale = tmp_scale
do m=0,Nmax
l = order2index(m, Nmax)
do j=js,je ; do i=is,ie
- CS%Snm_Re_raw(i,j,l) = var(i,j) * CS%Pmm(i,j,m+1) * CS%cos_lonT_wtd(i,j,m+1)
- CS%Snm_Im_raw(i,j,l) = var(i,j) * CS%Pmm(i,j,m+1) * CS%sin_lonT_wtd(i,j,m+1)
+ CS%Snm_Re_raw(i,j,l) = (scale*var(i,j)) * CS%Pmm(i,j,m+1) * CS%cos_lonT_wtd(i,j,m+1)
+ CS%Snm_Im_raw(i,j,l) = (scale*var(i,j)) * CS%Pmm(i,j,m+1) * CS%sin_lonT_wtd(i,j,m+1)
pmnm2(i,j) = 0.0
pmnm1(i,j) = CS%Pmm(i,j,m+1)
enddo ; enddo
@@ -94,8 +102,8 @@ subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd)
do n = m+1, Nmax ; do j=js,je ; do i=is,ie
pmn(i,j) = &
CS%a_recur(n+1,m+1) * CS%cos_clatT(i,j) * pmnm1(i,j) - CS%b_recur(n+1,m+1) * pmnm2(i,j)
- CS%Snm_Re_raw(i,j,l+n-m) = var(i,j) * pmn(i,j) * CS%cos_lonT_wtd(i,j,m+1)
- CS%Snm_Im_raw(i,j,l+n-m) = var(i,j) * pmn(i,j) * CS%sin_lonT_wtd(i,j,m+1)
+ CS%Snm_Re_raw(i,j,l+n-m) = (scale*var(i,j)) * pmn(i,j) * CS%cos_lonT_wtd(i,j,m+1)
+ CS%Snm_Im_raw(i,j,l+n-m) = (scale*var(i,j)) * pmn(i,j) * CS%sin_lonT_wtd(i,j,m+1)
pmnm2(i,j) = pmnm1(i,j)
pmnm1(i,j) = pmn(i,j)
enddo ; enddo ; enddo
@@ -125,10 +133,15 @@ subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd)
if (id_clock_sht_global_sum>0) call cpu_clock_begin(id_clock_sht_global_sum)
if (CS%reprod_sum) then
- do l=1,Ltot
- Snm_Re(l) = reproducing_sum(CS%Snm_Re_raw(:,:,l))
- Snm_Im(l) = reproducing_sum(CS%Snm_Im_raw(:,:,l))
- enddo
+ sum_tot = reproducing_sum(CS%Snm_Re_raw(:,:,1:Ltot), sums=Snm_Re(1:Ltot))
+ sum_tot = reproducing_sum(CS%Snm_Im_raw(:,:,1:Ltot), sums=Snm_Im(1:Ltot))
+ if (scale /= 1.0) then
+ I_scale = 1.0 / scale
+ do l=1,Ltot
+ Snm_Re(l) = I_scale * Snm_Re(l)
+ Snm_Im(l) = I_scale * Snm_Im(l)
+ enddo
+ endif
else
call sum_across_PEs(Snm_Re, Ltot)
call sum_across_PEs(Snm_Im, Ltot)
@@ -217,7 +230,7 @@ subroutine spherical_harmonics_init(G, param_file, CS)
integer :: is, ie, js, je
integer :: i, j, k
integer :: m, n
- integer :: Nd_tidal_SAL ! Maximum degree for tidal SAL
+ integer :: Nd_SAL ! Maximum degree for SAL
! This include declares and sets the variable "version".
# include "version_variable.h"
character(len=40) :: mdl = "MOM_spherical_harmonics" ! This module's name.
@@ -228,11 +241,8 @@ subroutine spherical_harmonics_init(G, param_file, CS)
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
call log_version(param_file, mdl, version, "")
- call get_param(param_file, mdl, "TIDAL_SAL_SHT_DEGREE", Nd_tidal_SAL, &
- "The maximum degree of the spherical harmonics transformation used for "// &
- "calculating the self-attraction and loading term for tides.", &
- default=0, do_not_log=.true.)
- CS%ndegree = Nd_tidal_SAL
+ call get_param(param_file, mdl, "SAL_HARMONICS_DEGREE", Nd_SAL, "", default=0, do_not_log=.true.)
+ CS%ndegree = Nd_SAL
CS%lmax = calc_lmax(CS%ndegree)
call get_param(param_file, mdl, "SHT_REPRODUCING_SUM", CS%reprod_sum, &
"If true, use reproducing sums (invariant to PE layout) in inverse transform "// &
@@ -243,8 +253,9 @@ subroutine spherical_harmonics_init(G, param_file, CS)
allocate(CS%a_recur(CS%ndegree+1, CS%ndegree+1)); CS%a_recur(:,:) = 0.0
allocate(CS%b_recur(CS%ndegree+1, CS%ndegree+1)); CS%b_recur(:,:) = 0.0
do m=0,CS%ndegree ; do n=m+1,CS%ndegree
+ ! These expressione will give NaNs with 32-bit integers for n > 23170, but this is trapped elsewhere.
CS%a_recur(n+1,m+1) = sqrt(real((2*n-1) * (2*n+1)) / real((n-m) * (n+m)))
- CS%b_recur(n+1,m+1) = sqrt(real((2*n+1) * (n+m-1) * (n-m-1)) / real((n-m) * (n+m) * (2*n-3)))
+ CS%b_recur(n+1,m+1) = sqrt((real(2*n+1) * real((n+m-1) * (n-m-1))) / (real((n-m) * (n+m)) * real(2*n-3)))
enddo ; enddo
! Calculate complex exponential factors
@@ -256,8 +267,8 @@ subroutine spherical_harmonics_init(G, param_file, CS)
do j=js,je ; do i=is,ie
CS%cos_lonT(i,j,m+1) = cos(real(m) * (G%geolonT(i,j)*RADIAN))
CS%sin_lonT(i,j,m+1) = sin(real(m) * (G%geolonT(i,j)*RADIAN))
- CS%cos_lonT_wtd(i,j,m+1) = CS%cos_lonT(i,j,m+1) * G%areaT(i,j) / G%Rad_Earth**2
- CS%sin_lonT_wtd(i,j,m+1) = CS%sin_lonT(i,j,m+1) * G%areaT(i,j) / G%Rad_Earth**2
+ CS%cos_lonT_wtd(i,j,m+1) = CS%cos_lonT(i,j,m+1) * G%areaT(i,j) / G%Rad_Earth_L**2
+ CS%sin_lonT_wtd(i,j,m+1) = CS%sin_lonT(i,j,m+1) * G%areaT(i,j) / G%Rad_Earth_L**2
enddo ; enddo
enddo
@@ -330,7 +341,7 @@ end function order2index
!! Currently, the transforms are for t-cell fields only.
!!
!! This module is stemmed from SAL calculation in Model for Prediction Across Scales (MPAS)-Ocean developed by Los
-!! Alamos National Laboratory and University of Michigan (Barton et al. (2022) and Brus et al. (2022)). The algorithm
+!! Alamos National Laboratory and University of Michigan [Barton et al. (2022) and Brus et al. (2023)]. The algorithm
!! for forward and inverse transforms loosely follows Schaeffer (2013).
!!
!! In forward transform, a two-dimensional physical field can be projected into a series of spherical harmonics. The
@@ -361,20 +372,22 @@ end function order2index
!! array vectorization.
!!
!! The maximum degree of the spherical harmonics is a runtime parameter and the maximum used by all SHT applications.
-!! At the moment, it is only decided by TIDAL_SAL_SHT_DEGREE.
+!! At the moment, it is only decided by SAL_HARMONICS_DEGREE.
!!
!! The forward transforms involve a global summation. Runtime flag SHT_REPRODUCING_SUM controls whether this is done
!! in a bit-wise reproducing way or not.
!!
!! References:
!!
-!! Barton, K.N., Nairita, P., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J.,
-!! Wirasaet, D., and Schindelegger, M., 2022: Performance of Model for Prediction Across Scales (MPAS) Ocean as a
-!! Global Barotropic Tide Model. Journal of Advances in Modeling Earth Systems, in review.
+!! Barton, K.N., Pal, N., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J.J.,
+!! Wirasaet, D. and Schindelegger, M., 2022. Global Barotropic Tide Modeling Using Inline Self‐Attraction and Loading in
+!! MPAS‐Ocean. Journal of Advances in Modeling Earth Systems, 14(11), p.e2022MS003207.
+!! https://doi.org/10.1029/2022MS003207
!!
-!! Brus, S.R., Barton, K.N., Nairita, P., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D.,
-!! Westerink, J., and Schindelegger, M., 2022: Scalable self attraction and loading calculations for unstructured ocean
-!! models. Ocean Modelling, in review.
+!! Brus, S.R., Barton, K.N., Pal, N., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D.,
+!! Westerink, J.J. and Schindelegger, M., 2023. Scalable self attraction and loading calculations for unstructured ocean
+!! tide models. Ocean Modelling, p.102160.
+!! https://doi.org/10.1016/j.ocemod.2023.102160
!!
!! Schaeffer, N., 2013. Efficient spherical harmonic transforms aimed at pseudospectral numerical simulations.
!! Geochemistry, Geophysics, Geosystems, 14(3), pp.751-758.
diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
index f685352b00..89fadd07b2 100644
--- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90
+++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
@@ -14,7 +14,7 @@ module MOM_thickness_diffuse
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
use MOM_io, only : MOM_read_data, slasher
-use MOM_interface_heights, only : find_eta
+use MOM_interface_heights, only : find_eta, thickness_to_dz
use MOM_isopycnal_slopes, only : vert_fill_TS
use MOM_lateral_mixing_coeffs, only : VarMix_CS
use MOM_MEKE_types, only : MEKE_type
@@ -45,9 +45,9 @@ module MOM_thickness_diffuse
real :: Kh_eta_bg !< Background isopycnal height diffusivity [L2 T-1 ~> m2 s-1]
real :: Kh_eta_vel !< Velocity scale that is multiplied by the grid spacing to give
!! the isopycnal height diffusivity [L T-1 ~> m s-1]
- real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim].
- real :: kappa_smooth !< Vertical diffusivity used to interpolate more
- !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1].
+ real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim]
+ real :: kappa_smooth !< Vertical diffusivity used to interpolate more sensible values
+ !! of T & S into thin layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
logical :: thickness_diffuse !< If true, interfaces heights are diffused.
logical :: use_FGNV_streamfn !< If true, use the streamfunction formulation of
!! Ferrari et al., 2010, which effectively emphasizes
@@ -441,7 +441,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp
endif
endif
-
!$OMP do
do K=1,nz+1 ; do j=js,je ; do I=is-1,ie ; int_slope_u(I,j,K) = 0.0 ; enddo ; enddo ; enddo
!$OMP do
@@ -460,6 +459,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp
if (CS%debug) then
call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI, haloshift=0, &
scale=(US%L_to_m**2)*US%s_to_T, scalar_pair=.true.)
+ call uvchksum("Kh_[uv]_CFL", Kh_u_CFL, Kh_v_CFL, G%HI, haloshift=0, &
+ scale=(US%L_to_m**2)*US%s_to_T, scalar_pair=.true.)
+ if (Resoln_scaled) then
+ call uvchksum("Res_fn_[uv]", VarMix%Res_fn_u, VarMix%Res_fn_v, G%HI, haloshift=0, &
+ scale=1.0, scalar_pair=.true.)
+ endif
call uvchksum("int_slope_[uv]", int_slope_u, int_slope_v, G%HI, haloshift=0)
call hchksum(h, "thickness_diffuse_1 h", G%HI, haloshift=1, scale=GV%H_to_m)
call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=US%Z_to_m)
@@ -643,14 +648,17 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! by dt [H L2 T-1 ~> m3 s-1 or kg s-1].
h_frac ! The fraction of the mass in the column above the bottom
! interface of a layer that is within a layer [nondim]. 0 m]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: &
Slope_y_PE, & ! 3D array of neutral slopes at v-points, set equal to Slope (below) [nondim]
hN2_y_PE ! Harmonic mean of thicknesses around the interfaces times the buoyancy frequency
- ! at v-points [L2 Z-1 T-2 ~> m s-2], used for calculating PE release
+ ! at v-points with unit conversion factors [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2],
+ ! used for calculating the potential energy release
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: &
Slope_x_PE, & ! 3D array of neutral slopes at u-points, set equal to Slope (below) [nondim]
hN2_x_PE ! Harmonic mean of thicknesses around the interfaces times the buoyancy frequency
- ! at u-points [L2 Z-1 T-2 ~> m s-2], used for calculating PE release
+ ! at u-points with unit conversion factors [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2],
+ ! used for calculating the potential energy release
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: &
pres, & ! The pressure at an interface [R L2 T-2 ~> Pa].
h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1].
@@ -685,8 +693,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
real :: Work_v(SZI_(G),SZJB_(G)) ! The work done by the isopycnal height diffusion
! integrated over v-point water columns [R Z L4 T-3 ~> W]
real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2].
- real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3]
- ! The calculation is equal to h * S^2 * N^2 * kappa_GM.
+ real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell
+ ! [R Z L2 T-3 ~> W m-2]. The calculation equals rho0 * h * S^2 * N^2 * kappa_GM.
real :: I4dt ! 1 / 4 dt [T-1 ~> s-1].
real :: drdiA, drdiB ! Along layer zonal potential density gradients in the layers above (A)
! and below (B) the interface times the grid spacing [R ~> kg m-3].
@@ -701,60 +709,76 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! [Z R ~> kg m-2].
real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4].
real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2].
- real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]
+ real :: dzg2A, dzg2B ! Squares of geometric mean vertical layer extents [Z2 ~> m2].
+ real :: dzaA, dzaB ! Arithmetic mean vertical layer extents [Z ~> m].
+ real :: dzaL, dzaR ! Temporary vertical layer extents [Z ~> m]
real :: wtA, wtB ! Unnormalized weights of the slopes above and below [H3 ~> m3 or kg3 m-6]
real :: wtL, wtR ! Unnormalized weights of the slopes to the left and right [H3 Z ~> m4 or kg3 m-5]
real :: drdx, drdy ! Zonal and meridional density gradients [R L-1 ~> kg m-4].
real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4].
- real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2].
- real :: c2_h_u(SZIB_(G),SZK_(GV)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2].
- real :: c2_h_v(SZI_(G),SZK_(GV)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2].
- real :: hN2_u(SZIB_(G),SZK_(GV)+1) ! Thickness in m times N2 at interfaces above u-points [L2 Z-1 T-2 ~> m s-2].
- real :: hN2_v(SZI_(G),SZK_(GV)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2].
+ real :: dz_harm ! Harmonic mean layer vertical extent [Z ~> m].
+ real :: c2_dz_u(SZIB_(G),SZK_(GV)+1) ! Wave speed squared divided by dz at u-points times rescaling
+ ! factors from depths to thicknesses [H2 L2 Z-3 T-2 ~> m s-2 or kg m-2 s-2]
+ real :: c2_dz_v(SZI_(G),SZK_(GV)+1) ! Wave speed squared divided by dz at v-points times rescaling
+ ! factors from depths to thicknesses [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2]
+ real :: dzN2_u(SZIB_(G),SZK_(GV)+1) ! Vertical extent times N2 at interfaces above u-points times
+ ! rescaling factors from vertical to horizontal distances [L2 Z-1 T-2 ~> m s-2]
+ real :: dzN2_v(SZI_(G),SZK_(GV)+1) ! Vertical extent times N2 at interfaces above v-points times
+ ! rescaling factors from vertical to horizontal distances [L2 Z-1 T-2 ~> m s-2]
real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning
- ! streamfunction [Z L2 T-1 ~> m3 s-1].
- real :: Sfn_unlim_u(SZIB_(G),SZK_(GV)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1].
- real :: Sfn_unlim_v(SZI_(G),SZK_(GV)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1].
+ ! streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1].
+ real :: Sfn_unlim_u(SZIB_(G),SZK_(GV)+1) ! Volume streamfunction for u-points [Z L2 T-1 ~> m3 s-1]
+ real :: Sfn_unlim_v(SZI_(G),SZK_(GV)+1) ! Volume streamfunction for v-points [Z L2 T-1 ~> m3 s-1]
real :: slope2_Ratio_u(SZIB_(G),SZK_(GV)+1) ! The ratio of the slope squared to slope_max squared [nondim]
real :: slope2_Ratio_v(SZI_(G),SZK_(GV)+1) ! The ratio of the slope squared to slope_max squared [nondim]
real :: Sfn_in_h ! The overturning streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] (note that
! the units are different from other Sfn vars).
- real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a
- ! good thing to use when the slope is so large as to be meaningless [Z L2 T-1 ~> m3 s-1].
+ real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface
+ ! [H L2 T-1 ~> m3 s-1 or kg s-1]. This is a good value to use when the
+ ! slope is so large as to be meaningless, usually due to weak stratification.
real :: Slope ! The slope of density surfaces, calculated in a way that is always
! between -1 and 1 after undoing dimensional scaling, [Z L-1 ~> nondim]
real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8].
real :: I_slope_max2 ! The inverse of slope_max squared [L2 Z-2 ~> nondim].
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
+ real :: hn_2 ! Half of h_neglect [H ~> m or kg m-2].
real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4].
real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost
! in roundoff and can be neglected [Z ~> m].
+ real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2]
real :: G_scale ! The gravitational acceleration times a unit conversion
! factor [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
logical :: use_EOS ! If true, density is calculated from T & S using an equation of state.
logical :: find_work ! If true, find the change in energy due to the fluxes.
integer :: nk_linear ! The number of layers over which the streamfunction goes to 0.
real :: G_rho0 ! g/Rho0 [L2 R-1 Z-1 T-2 ~> m4 kg-1 s-2].
+ real :: Rho_avg ! The in situ density averaged to an interface [R ~> kg m-3]
real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver
! times unit conversion factors [L2 Z-2 T-2 ~> s-2]
+ real :: N2_unlim ! An unlimited estimate of the buoyancy frequency
+ ! times unit conversion factors [L2 Z-2 T-2 ~> s-2]
real :: Tl(5) ! copy of T in local stencil [C ~> degC]
real :: mn_T ! mean of T in local stencil [C ~> degC]
real :: mn_T2 ! mean of T**2 in local stencil [C2 ~> degC2]
real :: hl(5) ! Copy of local stencil of H [H ~> m]
real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1]
+ real :: Z_to_H ! A conversion factor from heights to thicknesses, perhaps based on
+ ! a spatially variable local density [H Z-1 ~> nondim or kg m-3]
real :: Tsgs2(SZI_(G),SZJ_(G),SZK_(GV)) ! Sub-grid temperature variance [C2 ~> degC2]
real :: diag_sfn_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction
! [H L2 T-1 ~> m3 s-1 or kg s-1]
real :: diag_sfn_unlim_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction before
- ! applying limiters [H L2 T-1 ~> m3 s-1 or kg s-1]
+ ! applying limiters [Z L2 T-1 ~> m3 s-1]
real :: diag_sfn_y(SZI_(G),SZJB_(G),SZK_(GV)+1) ! Diagnostic of the y-face streamfunction
! [H L2 T-1 ~> m3 s-1 or kg s-1]
real :: diag_sfn_unlim_y(SZI_(G),SZJB_(G),SZK_(GV)+1) ! Diagnostic of the y-face streamfunction before
+ ! applying limiters [Z L2 T-1 ~> m3 s-1]
! applying limiters [H L2 T-1 ~> m3 s-1 or kg s-1]
real, allocatable :: skeb_gm_work(:,:) ! Temp array to hold GM work for SKEB
real, allocatable :: skeb_ebt_norm2(:,:) ! Used to normalize EBT for SKEB
real :: h_tot ! total depth [H ~> m]
+
logical :: present_slope_x, present_slope_y, calc_derivatives
integer, dimension(2) :: EOSdom_u ! The shifted I-computational domain to use for equation of
! state calculations at u-points.
@@ -771,10 +795,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
I_slope_max2 = 1.0 / (CS%slope_max**2)
G_scale = GV%g_Earth * GV%H_to_Z
- h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2
- dz_neglect = GV%H_subroundoff*GV%H_to_Z
+ h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 ; hn_2 = 0.5*h_neglect
+ dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect**2
G_rho0 = GV%g_Earth / GV%Rho0
- N2_floor = CS%N2_floor*US%Z_to_L**2
+ N2_floor = CS%N2_floor * US%Z_to_L**2
use_EOS = associated(tv%eqn_of_state)
present_slope_x = PRESENT(slope_x)
@@ -802,9 +826,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (use_EOS) then
halo = 1 ! Default halo to fill is 1
- call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo, larger_h_denom=.true.)
+ call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, US, halo, larger_h_denom=.true.)
endif
+ ! Rescale the thicknesses, perhaps using the specific volume.
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+
if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, &
"cg1 must be associated when using FGNV streamfunction.")
@@ -850,20 +877,21 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
EOSdom_h1(:) = EOS_domain(G%HI, halo=1)
!$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, &
- !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, &
- !$OMP h_neglect2,int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, &
- !$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1,diag_sfn_x, &
- !$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,EOSdom_h1,use_stanley,Tsgs2, &
- !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) &
- !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, &
+ !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz,dz_neglect,dz_neglect2, &
+ !$OMP h_neglect2,hn_2,I_slope_max2,int_slope_u,KH_u,uhtot, &
+ !$OMP h_frac,h_avail_rsum,uhD,h_avail,Work_u,CS,slope_x,cg1, &
+ !$OMP diag_sfn_x,diag_sfn_unlim_x,N2_floor,EOSdom_u,EOSdom_h1, &
+ !$OMP use_stanley,Tsgs2,present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) &
+ !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u,G_scale, &
!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, &
- !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, &
+ !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h,N2_unlim, &
!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, &
- !$OMP drdx,mag_grad2,Slope,slope2_Ratio_u,hN2_u, &
- !$OMP Sfn_unlim_u,drdi_u,drdkDe_u,h_harm,c2_h_u, &
+ !$OMP dzg2A,dzg2B,dzaA,dzaB,dz_harm,Z_to_H, &
+ !$OMP drdx,mag_grad2,Slope,slope2_Ratio_u,dzN2_u, &
+ !$OMP Sfn_unlim_u,Rho_avg,drdi_u,drdkDe_u,c2_dz_u, &
!$OMP Sfn_safe,Sfn_est,Sfn_in_h,calc_derivatives)
do j=js,je
- do I=is-1,ie ; hN2_u(I,1) = 0. ; hN2_u(I,nz+1) = 0. ; enddo
+ do I=is-1,ie ; dzN2_u(I,1) = 0. ; dzN2_u(I,nz+1) = 0. ; enddo
do K=nz,2,-1
if (find_work .and. .not.(use_EOS)) then
drdiA = 0.0 ; drdiB = 0.0
@@ -933,9 +961,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect
if (GV%Boussinesq) then
dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z
- else
+ elseif (GV%semi_Boussinesq) then
dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect
dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect
+ else
+ dzaL = 0.5*(dz(i,j,k-1) + dz(i,j,k)) + dz_neglect
+ dzaR = 0.5*(dz(i+1,j,k-1) + dz(i+1,j,k)) + dz_neglect
endif
! Use the harmonic mean thicknesses to weight the horizontal gradients.
! These unnormalized weights have been rearranged to minimize divisions.
@@ -950,10 +981,23 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
haA = 0.5*(h(i,j,k-1) + h(i+1,j,k-1)) + h_neglect
haB = 0.5*(h(i,j,k) + h(i+1,j,k)) + h_neglect
- ! hN2_u is used with the FGNV streamfunction formulation
- hN2_u(I,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * &
- max(drdz*G_rho0, N2_floor)
+ if (GV%Boussinesq) then
+ N2_unlim = drdz*G_rho0
+ else
+ N2_unlim = (GV%g_Earth*GV%RZ_to_H) * &
+ ((wtL * drdkL + wtR * drdkR) / (haL*wtL + haR*wtR))
+ endif
+
+ dzg2A = dz(i,j,k-1)*dz(i+1,j,k-1) + dz_neglect2
+ dzg2B = dz(i,j,k)*dz(i+1,j,k) + dz_neglect2
+ dzaA = 0.5*(dz(i,j,k-1) + dz(i+1,j,k-1)) + dz_neglect
+ dzaB = 0.5*(dz(i,j,k) + dz(i+1,j,k)) + dz_neglect
+ ! dzN2_u is used with the FGNV streamfunction formulation
+ dzN2_u(I,K) = (0.5 * ( dzg2A / dzaA + dzg2B / dzaB )) * max(N2_unlim, N2_floor)
+ if (find_work .and. CS%GM_src_alt) &
+ hN2_x_PE(I,j,k) = (0.5 * ( hg2A / haA + hg2B / haB )) * max(N2_unlim, N2_floor)
endif
+
if (present_slope_x) then
Slope = slope_x(I,j,k)
slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2
@@ -984,11 +1028,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K)
Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max)
- hN2_x_PE(I,j,k) = hN2_u(I,K)
if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope
- ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1].
- Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope)
+ ! Estimate the streamfunction at each interface [H L2 T-1 ~> m3 s-1 or kg s-1].
+ Sfn_unlim_u(I,K) = -(KH_u(I,j,K)*G%dy_Cu(I,j))*Slope
! Avoid moving dense water upslope from below the level of
! the bottom on the receiving side.
@@ -1018,10 +1061,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
endif
if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope
Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope)
- hN2_u(I,K) = GV%g_prime(K)
+ dzN2_u(I,K) = GV%g_prime(K)
endif ! if (use_EOS)
else ! if (k > nk_linear)
- hN2_u(I,K) = N2_floor * dz_neglect
+ dzN2_u(I,K) = N2_floor * dz_neglect
Sfn_unlim_u(I,K) = 0.
endif ! if (k > nk_linear)
if (CS%id_sfn_unlim_x>0) diag_sfn_unlim_x(I,j,K) = Sfn_unlim_u(I,K)
@@ -1030,10 +1073,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (CS%use_FGNV_streamfn) then
do k=1,nz ; do I=is-1,ie ; if (G%OBCmaskCu(I,j)>0.) then
- h_harm = max( h_neglect, &
- 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) )
- c2_h_u(I,k) = CS%FGNV_scale * &
- ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm)
+ dz_harm = max( dz_neglect, &
+ 2. * dz(i,j,k) * dz(i+1,j,k) / ( ( dz(i,j,k) + dz(i+1,j,k) ) + dz_neglect ) )
+ c2_dz_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / dz_harm
endif ; enddo ; enddo
! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010.
@@ -1042,7 +1084,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do K=2,nz
Sfn_unlim_u(I,K) = (1. + CS%FGNV_scale) * Sfn_unlim_u(I,K)
enddo
- call streamfn_solver(nz, c2_h_u(I,:), hN2_u(I,:), Sfn_unlim_u(I,:))
+ call streamfn_solver(nz, c2_dz_u(I,:), dzN2_u(I,:), Sfn_unlim_u(I,:))
else
do K=2,nz
Sfn_unlim_u(I,K) = 0.
@@ -1053,25 +1095,36 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do K=nz,2,-1
do I=is-1,ie
+
+ if (allocated(tv%SpV_avg) .and. (find_work .or. (k > nk_linear)) ) then
+ Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i+1,j,k) + h(i+1,j,k-1))) + 4.0*hn_2 ) / &
+ ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + &
+ ((h(i+1,j,k)+hn_2)*tv%SpV_avg(i+1,j,k) + (h(i+1,j,k-1)+hn_2)*tv%SpV_avg(i+1,j,k-1)) )
+ ! Use an average density to convert the volume streamfunction estimate into a mass streamfunction.
+ Z_to_H = (GV%RZ_to_H*Rho_avg)
+ else
+ Z_to_H = GV%Z_to_H
+ endif
+
if (k > nk_linear) then
if (use_EOS) then
if (uhtot(I,j) <= 0.0) then
! The transport that must balance the transport below is positive.
- Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z
+ Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k))
else ! (uhtot(I,j) > 0.0)
- Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * GV%H_to_Z
+ Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k))
endif
- ! The actual streamfunction at each interface.
- Sfn_est = (Sfn_unlim_u(I,K) + slope2_Ratio_u(I,K)*Sfn_safe) / (1.0 + slope2_Ratio_u(I,K))
- else ! With .not.use_EOS, the layers are constant density.
- Sfn_est = Sfn_unlim_u(I,K)
+ ! Determine the actual streamfunction at each interface.
+ Sfn_est = (Z_to_H*Sfn_unlim_u(I,K) + slope2_Ratio_u(I,K)*Sfn_safe) / (1.0 + slope2_Ratio_u(I,K))
+ else ! When use_EOS is false, the layers are constant density.
+ Sfn_est = Z_to_H*Sfn_unlim_u(I,K)
endif
! Make sure that there is enough mass above to allow the streamfunction
! to satisfy the boundary condition of 0 at the surface.
- Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K))
+ Sfn_in_H = min(max(Sfn_est, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K))
! The actual transport is limited by the mass available in the two
! neighboring grid cells.
@@ -1102,6 +1155,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! else
! sfn_slope_x(I,j,K) = sfn_slope_x(I,j,K+1) * (1.0 - h_frac(i+1,j,k))
! endif
+
endif
uhtot(I,j) = uhtot(I,j) + uhD(I,j,k)
@@ -1113,6 +1167,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! A second order centered estimate is used for the density transferred
! between water columns.
+ if (allocated(tv%SpV_avg)) then
+ G_scale = GV%H_to_RZ * GV%g_Earth / Rho_avg
+ else
+ G_scale = GV%g_Earth * GV%H_to_Z
+ endif
+
Work_u(I,j) = Work_u(I,j) + G_scale * &
( uhtot(I,j) * drdkDe_u(I,K) - &
(uhD(I,j,k) * drdi_u(I,k)) * 0.25 * &
@@ -1125,18 +1185,19 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! Calculate the meridional fluxes and gradients.
- !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, &
- !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, &
+ !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S,dz, &
+ !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,dz_neglect2, &
!$OMP h_neglect2,int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, &
- !$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1,diag_sfn_y, &
- !$OMP diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,Tsgs2, &
- !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) &
+ !$OMP I_slope_max2,vhD,h_avail,Work_v,CS,slope_y,cg1,hn_2,&
+ !$OMP diag_sfn_y,diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,&
+ !$OMP Tsgs2, present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) &
!$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v,S_h,S_hr, &
- !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, &
- !$OMP drho_dT_dT_h,drho_dT_dT_hr, scrap,pres_h,T_h,T_hr, &
+ !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA,G_scale, &
+ !$OMP drho_dT_dT_h,drho_dT_dT_hr,scrap,pres_h,T_h,T_hr, &
!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz,pres_hr, &
- !$OMP drdy,mag_grad2,Slope,slope2_Ratio_v,hN2_v, &
- !$OMP Sfn_unlim_v,drdj_v,drdkDe_v,h_harm,c2_h_v, &
+ !$OMP dzg2A,dzg2B,dzaA,dzaB,dz_harm,Z_to_H, &
+ !$OMP drdy,mag_grad2,Slope,slope2_Ratio_v,dzN2_v,N2_unlim, &
+ !$OMP Sfn_unlim_v,Rho_avg,drdj_v,drdkDe_v,c2_dz_v, &
!$OMP Sfn_safe,Sfn_est,Sfn_in_h,calc_derivatives)
do J=js-1,je
do K=nz,2,-1
@@ -1212,11 +1273,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
hg2R = h(i,j+1,k-1)*h(i,j+1,k) + h_neglect2
haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect
haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect
+
if (GV%Boussinesq) then
dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z
- else
+ elseif (GV%semi_Boussinesq) then
dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect
dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect
+ else
+ dzaL = 0.5*(dz(i,j,k-1) + dz(i,j,k)) + dz_neglect
+ dzaR = 0.5*(dz(i,j+1,k-1) + dz(i,j+1,k)) + dz_neglect
endif
! Use the harmonic mean thicknesses to weight the horizontal gradients.
! These unnormalized weights have been rearranged to minimize divisions.
@@ -1231,9 +1296,22 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
haA = 0.5*(h(i,j,k-1) + h(i,j+1,k-1)) + h_neglect
haB = 0.5*(h(i,j,k) + h(i,j+1,k)) + h_neglect
- ! hN2_v is used with the FGNV streamfunction formulation
- hN2_v(i,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * &
- max(drdz*G_rho0, N2_floor)
+ if (GV%Boussinesq) then
+ N2_unlim = drdz*G_rho0
+ else
+ N2_unlim = (GV%g_Earth*GV%RZ_to_H) * &
+ ((wtL * drdkL + wtR * drdkR) / (haL*wtL + haR*wtR))
+ endif
+
+ dzg2A = dz(i,j,k-1)*dz(i,j+1,k-1) + dz_neglect2
+ dzg2B = dz(i,j,k)*dz(i,j+1,k) + dz_neglect2
+ dzaA = 0.5*(dz(i,j,k-1) + dz(i,j+1,k-1)) + dz_neglect
+ dzaB = 0.5*(dz(i,j,k) + dz(i,j+1,k)) + dz_neglect
+
+ ! dzN2_v is used with the FGNV streamfunction formulation
+ dzN2_v(i,K) = (0.5*( dzg2A / dzaA + dzg2B / dzaB )) * max(N2_unlim, N2_floor)
+ if (find_work .and. CS%GM_src_alt) &
+ hN2_y_PE(i,J,k) = (0.5*( hg2A / haA + hg2B / haB )) * max(N2_unlim, N2_floor)
endif
if (present_slope_y) then
Slope = slope_y(i,J,k)
@@ -1265,10 +1343,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K)
Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max)
- hN2_y_PE(i,J,k) = hN2_v(i,K)
if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope
- ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1].
Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope)
! Avoid moving dense water upslope from below the level of
@@ -1299,10 +1375,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
endif
if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope
Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope)
- hN2_v(i,K) = GV%g_prime(K)
+ dzN2_v(i,K) = GV%g_prime(K)
endif ! if (use_EOS)
else ! if (k > nk_linear)
- hN2_v(i,K) = N2_floor * dz_neglect
+ dzN2_v(i,K) = N2_floor * dz_neglect
Sfn_unlim_v(i,K) = 0.
endif ! if (k > nk_linear)
if (CS%id_sfn_unlim_y>0) diag_sfn_unlim_y(i,J,K) = Sfn_unlim_v(i,K)
@@ -1311,10 +1387,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (CS%use_FGNV_streamfn) then
do k=1,nz ; do i=is,ie ; if (G%OBCmaskCv(i,J)>0.) then
- h_harm = max( h_neglect, &
- 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) )
- c2_h_v(i,k) = CS%FGNV_scale * &
- ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm)
+ dz_harm = max( dz_neglect, &
+ 2. * dz(i,j,k) * dz(i,j+1,k) / ( ( dz(i,j,k) + dz(i,j+1,k) ) + dz_neglect ) )
+ c2_dz_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / dz_harm
endif ; enddo ; enddo
! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010.
@@ -1323,7 +1398,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do K=2,nz
Sfn_unlim_v(i,K) = (1. + CS%FGNV_scale) * Sfn_unlim_v(i,K)
enddo
- call streamfn_solver(nz, c2_h_v(i,:), hN2_v(i,:), Sfn_unlim_v(i,:))
+ call streamfn_solver(nz, c2_dz_v(i,:), dzN2_v(i,:), Sfn_unlim_v(i,:))
else
do K=2,nz
Sfn_unlim_v(i,K) = 0.
@@ -1334,25 +1409,35 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do K=nz,2,-1
do i=is,ie
+ if (allocated(tv%SpV_avg) .and. (find_work .or. (k > nk_linear)) ) then
+ Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i,j+1,k) + h(i,j+1,k-1))) + 4.0*hn_2 ) / &
+ ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + &
+ ((h(i,j+1,k)+hn_2)*tv%SpV_avg(i,j+1,k) + (h(i,j+1,k-1)+hn_2)*tv%SpV_avg(i,j+1,k-1)) )
+ ! Use an average density to convert the volume streamfunction estimate into a mass streamfunction.
+ Z_to_H = (GV%RZ_to_H*Rho_avg)
+ else
+ Z_to_H = GV%Z_to_H
+ endif
+
if (k > nk_linear) then
if (use_EOS) then
if (vhtot(i,J) <= 0.0) then
! The transport that must balance the transport below is positive.
- Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z
+ Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k))
else ! (vhtot(I,j) > 0.0)
- Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * GV%H_to_Z
+ Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k))
endif
- ! The actual streamfunction at each interface.
- Sfn_est = (Sfn_unlim_v(i,K) + slope2_Ratio_v(i,K)*Sfn_safe) / (1.0 + slope2_Ratio_v(i,K))
- else ! With .not.use_EOS, the layers are constant density.
- Sfn_est = Sfn_unlim_v(i,K)
+ ! Find the actual streamfunction at each interface.
+ Sfn_est = (Z_to_H*Sfn_unlim_v(i,K) + slope2_Ratio_v(i,K)*Sfn_safe) / (1.0 + slope2_Ratio_v(i,K))
+ else ! When use_EOS is false, the layers are constant density.
+ Sfn_est = Z_to_H*Sfn_unlim_v(i,K)
endif
! Make sure that there is enough mass above to allow the streamfunction
! to satisfy the boundary condition of 0 at the surface.
- Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K))
+ Sfn_in_H = min(max(Sfn_est, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K))
! The actual transport is limited by the mass available in the two
! neighboring grid cells.
@@ -1393,6 +1478,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! A second order centered estimate is used for the density transferred
! between water columns.
+ if (allocated(tv%SpV_avg)) then
+ G_scale = GV%H_to_RZ * GV%g_Earth / Rho_avg
+ else
+ G_scale = GV%g_Earth * GV%H_to_Z
+ endif
+
Work_v(i,J) = Work_v(i,J) + G_scale * &
( vhtot(i,J) * drdkDe_v(i,K) - &
(vhD(i,J,k) * drdj_v(i,k)) * 0.25 * &
@@ -1409,7 +1500,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do J=js-1,je ; do i=is,ie ; vhD(i,J,1) = -vhtot(i,J) ; enddo ; enddo
else
EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1)
- !$OMP parallel do default(shared) private(pres_u,T_u,S_u,drho_dT_u,drho_dS_u,drdiB)
+ !$OMP parallel do default(shared) private(pres_u,T_u,S_u,drho_dT_u,drho_dS_u,drdiB,G_scale)
do j=js,je
if (use_EOS) then
do I=is-1,ie
@@ -1423,9 +1514,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do I=is-1,ie
uhD(I,j,1) = -uhtot(I,j)
+ G_scale = GV%g_Earth * GV%H_to_Z
if (use_EOS) then
drdiB = drho_dT_u(I) * (T(i+1,j,1)-T(i,j,1)) + &
drho_dS_u(I) * (S(i+1,j,1)-S(i,j,1))
+ if (allocated(tv%SpV_avg)) then
+ G_scale = GV%H_to_RZ * GV%g_Earth * &
+ ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1) + (h(i+1,j,1)+hn_2) * tv%SpV_avg(i+1,j,1)) / &
+ ( (h(i,j,1) + h(i+1,j,1)) + 2.0*hn_2 ) )
+ endif
endif
if (CS%use_GM_work_bug) then
Work_u(I,j) = Work_u(I,j) + G_scale * &
@@ -1440,7 +1537,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
enddo
EOSdom_v(:) = EOS_domain(G%HI)
- !$OMP parallel do default(shared) private(pres_v,T_v,S_v,drho_dT_v,drho_dS_v,drdjB)
+ !$OMP parallel do default(shared) private(pres_v,T_v,S_v,drho_dT_v,drho_dS_v,drdjB,G_scale)
do J=js-1,je
if (use_EOS) then
do i=is,ie
@@ -1454,9 +1551,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do i=is,ie
vhD(i,J,1) = -vhtot(i,J)
+ G_scale = GV%g_Earth * GV%H_to_Z
if (use_EOS) then
drdjB = drho_dT_v(i) * (T(i,j+1,1)-T(i,j,1)) + &
drho_dS_v(i) * (S(i,j+1,1)-S(i,j,1))
+ if (allocated(tv%SpV_avg)) then
+ G_scale = GV%H_to_RZ * GV%g_Earth * &
+ ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1) + (h(i,j+1,1)+hn_2) * tv%SpV_avg(i,j+1,1)) / &
+ ( (h(i,j,1) + h(i,j+1,1)) + 2.0*hn_2 ) )
+ endif
endif
Work_v(i,J) = Work_v(i,J) - G_scale * &
( (vhD(i,J,1) * drdjB) * 0.25 * &
@@ -1492,11 +1595,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (find_work .and. CS%GM_src_alt) then ; if (allocated(MEKE%GM_src)) then
do j=js,je ; do i=is,ie ; do k=nz,1,-1
- PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + &
+ PE_release_h = -0.25 * (GV%H_to_RZ*US%L_to_Z**2) * &
+ (KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + &
Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + &
Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + &
Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k))
- MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_Z**2 * GV%Rho0 * PE_release_h
+ MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h
enddo ; enddo ; enddo
endif ; endif
@@ -1512,16 +1616,18 @@ end subroutine thickness_diffuse_full
!> Tridiagonal solver for streamfunction at interfaces
subroutine streamfn_solver(nk, c2_h, hN2, sfn)
integer, intent(in) :: nk !< Number of layers
- real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers [L2 Z-1 T-2 ~> m s-2]
- real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [L2 Z-1 T-2 ~> m s-2]
- real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z L2 T-1 ~> m3 s-1] or arbitrary units
+ real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers, rescaled to
+ !! [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2]
+ real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces times rescaling factors
+ !! [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2]
+ real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] or arbitrary units
!! On entry, equals diffusivity times slope.
!! On exit, equals the streamfunction.
! Local variables
real :: c1(nk) ! The dependence of the final streamfunction on the values below [nondim]
real :: d1 ! The complement of c1(k) (i.e., 1 - c1(k)) [nondim]
- real :: b_denom ! A term in the denominator of beta [L2 Z-1 T-2 ~> m s-2]
- real :: beta ! The normalization for the pivot [Z T2 L-2 ~> s2 m-1]
+ real :: b_denom ! A term in the denominator of beta [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2]
+ real :: beta ! The normalization for the pivot [Z2 T2 H-1 L-2 ~> s2 m-1 or m2 s2 kg-1]
integer :: k
sfn(1) = 0.
@@ -1608,11 +1714,11 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of
!! the isopycnal slopes are taken directly from
!! the interface slopes without consideration
- !! of density gradients.
+ !! of density gradients [nondim].
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of
!! the isopycnal slopes are taken directly from
!! the interface slopes without consideration
- !! of density gradients.
+ !! of density gradients [nondim].
! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
de_top ! The distances between the top of a layer and the top of the
@@ -2027,10 +2133,6 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS)
real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale
! temperature variance [nondim]
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: MEKE_GEOM_answers_2018 ! If true, use expressions in the MEKE_GEOMETRIC calculation
- ! that recover the answers from the original implementation.
- ! Otherwise, use expressions that satisfy rotational symmetry.
integer :: i, j
CS%initialized = .true.
@@ -2128,7 +2230,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS)
call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, &
"A diapycnal diffusivity that is used to interpolate "//&
"more sensible values of T & S into thin layers.", &
- units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s)
+ units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, &
"If true, use the streamfunction formulation of "//&
"Ferrari et al., 2010, which effectively emphasizes "//&
@@ -2183,22 +2285,12 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "MEKE_GEOMETRIC_2018_ANSWERS", MEKE_GEOM_answers_2018, &
- "If true, use expressions in the MEKE_GEOMETRIC calculation that recover the "//&
- "answers from the original implementation. Otherwise, use expressions that "//&
- "satisfy rotational symmetry.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for MEKE_geometric.
- if (MEKE_GEOM_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.MEKE_GEOM_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "MEKE_GEOMETRIC_ANSWER_DATE", CS%MEKE_GEOM_answer_date, &
"The vintage of the expressions in the MEKE_GEOMETRIC calculation. "//&
"Values below 20190101 recover the answers from the original implementation, "//&
- "while higher values use expressions that satisfy rotational symmetry. "//&
- "If both MEKE_GEOMETRIC_2018_ANSWERS and MEKE_GEOMETRIC_ANSWER_DATE are "//&
- "specified, the latter takes precedence.", default=default_answer_date)
+ "while higher values use expressions that satisfy rotational symmetry.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%MEKE_GEOM_answer_date = max(CS%MEKE_GEOM_answer_date, 20230701)
endif
call get_param(param_file, mdl, "USE_KH_IN_MEKE", CS%Use_KH_in_MEKE, &
diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90
index b2fd8f0ea5..1cd8a45a78 100644
--- a/src/parameterizations/lateral/MOM_tidal_forcing.F90
+++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90
@@ -12,15 +12,11 @@ module MOM_tidal_forcing
use MOM_io, only : field_exists, file_exists, MOM_read_data
use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-)
use MOM_unit_scaling, only : unit_scale_type
-use MOM_spherical_harmonics, only : spherical_harmonics_init, spherical_harmonics_end, order2index, calc_lmax
-use MOM_spherical_harmonics, only : spherical_harmonics_forward, spherical_harmonics_inverse
-use MOM_spherical_harmonics, only : sht_CS
-use MOM_load_love_numbers, only : Love_Data
implicit none ; private
public calc_tidal_forcing, tidal_forcing_init, tidal_forcing_end
-public tidal_forcing_sensitivity
+public calc_tidal_forcing_legacy
! MOM_open_boundary uses the following to set tides on the boundary.
public astro_longitudes_init, eq_phase, nodal_fu, tidal_frequency
@@ -38,18 +34,15 @@ module MOM_tidal_forcing
!> The control structure for the MOM_tidal_forcing module
type, public :: tidal_forcing_CS ; private
- logical :: use_sal_scalar !< If true, use the scalar approximation when
- !! calculating self-attraction and loading.
- logical :: tidal_sal_from_file !< If true, Read the tidal self-attraction
+ logical :: use_tidal_sal_file !< If true, Read the tidal self-attraction
!! and loading from input files, specified
!! by TIDAL_INPUT_FILE.
- logical :: use_prev_tides !< If true, use the SAL from the previous
+ logical :: use_tidal_sal_prev !< If true, use the SAL from the previous
!! iteration of the tides to facilitate convergence.
logical :: use_eq_phase !< If true, tidal forcing is phase-shifted to match
!! equilibrium tide. Set to false if providing tidal phases
!! that have already been shifted by the
!! astronomical/equilibrium argument.
- logical :: tidal_sal_sht !< If true, use online spherical harmonics to calculate SAL
real :: sal_scalar !< The constant of proportionality between sea surface
!! height (really it should be bottom pressure) anomalies
!! and bottom geopotential anomalies [nondim].
@@ -76,15 +69,9 @@ module MOM_tidal_forcing
cosphase_prev(:,:,:), & !< The cosine of the phase of the amphidromes in the previous tidal solutions [nondim].
sinphase_prev(:,:,:), & !< The sine of the phase of the amphidromes in the previous tidal solutions [nondim].
amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m].
- type(sht_CS) :: sht !< Spherical harmonic transforms (SHT) for SAL
- integer :: sal_sht_Nd !< Maximum degree for SHT [nondim]
- real, allocatable :: Love_Scaling(:) !< Love number for each SHT mode [nondim]
- real, allocatable :: Snm_Re(:), & !< Real SHT coefficient for SHT SAL [Z ~> m]
- Snm_Im(:) !< Imaginary SHT coefficient for SHT SAL [Z ~> m]
end type tidal_forcing_CS
integer :: id_clock_tides !< CPU clock for tides
-integer :: id_clock_SAL !< CPU clock for self-attraction and loading
contains
@@ -269,10 +256,8 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS)
character(len=40) :: mdl = "MOM_tidal_forcing" ! This module's name.
character(len=128) :: mesg
character(len=200) :: tidal_input_files(4*MAX_CONSTITUENTS)
+ real :: tide_sal_scalar_value ! The constant of proportionality with the scalar approximation to SAL [nondim]
integer :: i, j, c, is, ie, js, je, isd, ied, jsd, jed, nc
- integer :: lmax ! Total modes of the real spherical harmonics [nondim]
- real :: rhoW ! The average density of sea water [R ~> kg m-3].
- real :: rhoE ! The average density of Earth [R ~> kg m-3].
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
isd = G%isd ; ied = G%ied ; jsd = G%jsd; jed = G%jed
@@ -358,30 +343,26 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS)
return
endif
- call get_param(param_file, mdl, "TIDAL_SAL_FROM_FILE", CS%tidal_sal_from_file, &
+ call get_param(param_file, mdl, "TIDAL_SAL_FROM_FILE", CS%use_tidal_sal_file, &
"If true, read the tidal self-attraction and loading "//&
"from input files, specified by TIDAL_INPUT_FILE. "//&
"This is only used if TIDES is true.", default=.false.)
- call get_param(param_file, mdl, "USE_PREVIOUS_TIDES", CS%use_prev_tides, &
+ call get_param(param_file, mdl, "USE_PREVIOUS_TIDES", CS%use_tidal_sal_prev, &
"If true, use the SAL from the previous iteration of the "//&
"tides to facilitate convergent iteration. "//&
"This is only used if TIDES is true.", default=.false.)
- call get_param(param_file, mdl, "TIDE_USE_SAL_SCALAR", CS%use_sal_scalar, &
- "If true and TIDES is true, use the scalar approximation "//&
- "when calculating self-attraction and loading.", &
- default=.not.CS%tidal_sal_from_file)
- ! If it is being used, sal_scalar MUST be specified in param_file.
- if (CS%use_sal_scalar .or. CS%use_prev_tides) &
- call get_param(param_file, mdl, "TIDE_SAL_SCALAR_VALUE", CS%sal_scalar, &
+ call get_param(param_file, '', "TIDE_SAL_SCALAR_VALUE", tide_sal_scalar_value, &
+ units="m m-1", default=0.0, do_not_log=.True.)
+ if (tide_sal_scalar_value/=0.0) &
+ call MOM_error(WARNING, "TIDE_SAL_SCALAR_VALUE is a deprecated parameter. "//&
+ "Use SAL_SCALAR_VALUE instead." )
+ call get_param(param_file, mdl, "SAL_SCALAR_VALUE", CS%sal_scalar, &
"The constant of proportionality between sea surface "//&
"height (really it should be bottom pressure) anomalies "//&
"and bottom geopotential anomalies. This is only used if "//&
- "TIDES and TIDE_USE_SAL_SCALAR are true.", units="m m-1", &
- fail_if_missing=.true.)
-
- call get_param(param_file, mdl, "TIDAL_SAL_SHT", CS%tidal_sal_sht, &
- "If true, use the online spherical harmonics method to calculate "//&
- "self-attraction and loading term in tides.", default=.false.)
+ "USE_SAL_SCALAR is true or USE_PREVIOUS_TIDES is true.", &
+ default=tide_sal_scalar_value, units="m m-1", &
+ do_not_log=(.not. CS%use_tidal_sal_prev))
if (nc > MAX_CONSTITUENTS) then
write(mesg,'("Increase MAX_CONSTITUENTS in MOM_tidal_forcing.F90 to at least",I3, &
@@ -391,7 +372,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS)
do c=1,4*MAX_CONSTITUENTS ; tidal_input_files(c) = "" ; enddo
- if (CS%tidal_sal_from_file .or. CS%use_prev_tides) then
+ if (CS%use_tidal_sal_file .or. CS%use_tidal_sal_prev) then
call get_param(param_file, mdl, "TIDAL_INPUT_FILE", tidal_input_files, &
"A list of input files for tidal information.", &
default="", fail_if_missing=.true.)
@@ -506,7 +487,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS)
" are true.", units="radians", default=phase0_def(c))
enddo
- if (CS%tidal_sal_from_file) then
+ if (CS%use_tidal_sal_file) then
allocate(CS%cosphasesal(isd:ied,jsd:jed,nc))
allocate(CS%sinphasesal(isd:ied,jsd:jed,nc))
allocate(CS%ampsal(isd:ied,jsd:jed,nc))
@@ -524,7 +505,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS)
enddo
endif
- if (CS%USE_PREV_TIDES) then
+ if (CS%use_tidal_sal_prev) then
allocate(CS%cosphase_prev(isd:ied,jsd:jed,nc))
allocate(CS%sinphase_prev(isd:ied,jsd:jed,nc))
allocate(CS%amp_prev(isd:ied,jsd:jed,nc))
@@ -542,74 +523,10 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS)
enddo
endif
- if (CS%tidal_sal_sht) then
- call get_param(param_file, mdl, "TIDAL_SAL_SHT_DEGREE", CS%sal_sht_Nd, &
- "The maximum degree of the spherical harmonics transformation used for "// &
- "calculating the self-attraction and loading term for tides.", &
- default=0, do_not_log=.not.CS%tidal_sal_sht)
- call get_param(param_file, mdl, "RHO_0", rhoW, &
- "The mean ocean density used with BOUSSINESQ true to "//&
- "calculate accelerations and the mass for conservation "//&
- "properties, or with BOUSSINSEQ false to convert some "//&
- "parameters from vertical units of m to kg m-2.", &
- units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.True.)
- call get_param(param_file, mdl, "RHO_E", rhoE, &
- "The mean solid earth density. This is used for calculating the "// &
- "self-attraction and loading term.", &
- units="kg m-3", default=5517.0, scale=US%kg_m3_to_R, &
- do_not_log=.not.CS%tidal_sal_sht)
- lmax = calc_lmax(CS%sal_sht_Nd)
- allocate(CS%Snm_Re(lmax)); CS%Snm_Re(:) = 0.0
- allocate(CS%Snm_Im(lmax)); CS%Snm_Im(:) = 0.0
-
- allocate(CS%Love_Scaling(lmax)); CS%Love_Scaling(:) = 0.0
- call calc_love_scaling(CS%sal_sht_Nd, rhoW, rhoE, CS%Love_Scaling)
- call spherical_harmonics_init(G, param_file, CS%sht)
- id_clock_SAL = cpu_clock_id('(Ocean SAL)', grain=CLOCK_ROUTINE)
- endif
-
id_clock_tides = cpu_clock_id('(Ocean tides)', grain=CLOCK_MODULE)
end subroutine tidal_forcing_init
-!> This subroutine calculates coefficients of the spherical harmonic modes for self-attraction and loading.
-!! The algorithm is based on the SAL implementation in MPAS-ocean, which was modified by Kristin Barton from
-!! routine written by K. Quinn (March 2010) and modified by M. Schindelegger (May 2017).
-subroutine calc_love_scaling(nlm, rhoW, rhoE, Love_Scaling)
- integer, intent(in) :: nlm !< Maximum spherical harmonics degree [nondim]
- real, intent(in) :: rhoW !< The average density of sea water [R ~> kg m-3]
- real, intent(in) :: rhoE !< The average density of Earth [R ~> kg m-3]
- real, dimension(:), intent(out) :: Love_Scaling !< Scaling factors for inverse SHT [nondim]
-
- ! Local variables
- real, dimension(:), allocatable :: HDat, LDat, KDat ! Love numbers converted in CF reference frames [nondim]
- real :: H1, L1, K1 ! Temporary variables to store degree 1 Love numbers [nondim]
- integer :: n_tot ! Size of the stored Love numbers
- integer :: n, m, l
-
- n_tot = size(Love_Data, dim=2)
-
- if (nlm+1 > n_tot) call MOM_error(FATAL, "MOM_tidal_forcing " // &
- "calc_love_scaling: maximum spherical harmonics degree is larger than " // &
- "the size of the stored Love numbers in MOM_load_love_number.")
-
- allocate(HDat(nlm+1), LDat(nlm+1), KDat(nlm+1))
- HDat(:) = Love_Data(2,1:nlm+1) ; LDat(:) = Love_Data(3,1:nlm+1) ; KDat(:) = Love_Data(4,1:nlm+1)
-
- ! Convert reference frames from CM to CF
- if (nlm > 0) then
- H1 = HDat(2) ; L1 = LDat(2) ; K1 = KDat(2)
- HDat(2) = ( 2.0 / 3.0) * (H1 - L1)
- LDat(2) = (-1.0 / 3.0) * (H1 - L1)
- KDat(2) = (-1.0 / 3.0) * H1 - (2.0 / 3.0) * L1 - 1.0
- endif
-
- do m=0,nlm ; do n=m,nlm
- l = order2index(m,nlm)
- Love_Scaling(l+n-m) = (3.0 / real(2*n+1)) * (rhoW / rhoE) * (1.0 + KDat(n+1) - HDat(n+1))
- enddo ; enddo
-end subroutine calc_love_scaling
-
!> This subroutine finds a named variable in a list of files and reads its
!! values into a domain-decomposed 2-d array
subroutine find_in_files(filenames, varname, array, G, scale)
@@ -643,143 +560,153 @@ subroutine find_in_files(filenames, varname, array, G, scale)
end subroutine find_in_files
-!> This subroutine calculates returns the partial derivative of the local
-!! geopotential height with the input sea surface height due to self-attraction
-!! and loading.
-subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a previous call to tidal_forcing_init.
- real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with
- !! the local value of eta [nondim].
-
- if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then
- deta_tidal_deta = 2.0*CS%SAL_SCALAR
- elseif (CS%USE_SAL_SCALAR .or. CS%USE_PREV_TIDES) then
- deta_tidal_deta = CS%SAL_SCALAR
- else
- deta_tidal_deta = 0.0
- endif
-end subroutine tidal_forcing_sensitivity
-
!> This subroutine calculates the geopotential anomalies that drive the tides,
-!! including self-attraction and loading. Optionally, it also returns the
-!! partial derivative of the local geopotential height with the input sea surface
-!! height. For now, eta and eta_tidal are both geopotential heights in depth
-!! units, but probably the input for eta should really be replaced with the
-!! column mass anomalies.
-subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(time_type), intent(in) :: Time !< The time for the calculation.
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from
- !! a time-mean geoid [Z ~> m].
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height
- !! anomalies [Z ~> m].
- type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- type(tidal_forcing_CS), intent(inout) :: CS !< The control structure returned by a
- !! previous call to tidal_forcing_init.
+!! including tidal self-attraction and loading from previous solutions.
+subroutine calc_tidal_forcing(Time, e_tide_eq, e_tide_sal, G, US, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(time_type), intent(in) :: Time !< The time for the caluculation.
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: e_tide_eq !< The geopotential height anomalies
+ !! due to the equilibrium tides [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: e_tide_sal !< The geopotential height anomalies
+ !! due to the tidal SAL [Z ~> m].
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a
+ !! previous call to tidal_forcing_init.
! Local variables
- real, dimension(SZI_(G),SZJ_(G)) :: eta_sal !< SAL calculated by spherical harmonics
real :: now ! The relative time compared with the tidal reference [T ~> s]
real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m]
real :: cosomegat, sinomegat ! The components of the phase [nondim]
- real :: eta_prop ! The nondimenional constant of proportionality between eta and eta_tidal [nondim]
integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
call cpu_clock_begin(id_clock_tides)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e_tide_eq(i,j) = 0.0
+ e_tide_sal(i,j) = 0.0
+ enddo ; enddo
+
if (CS%nc == 0) then
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; eta_tidal(i,j) = 0.0 ; enddo ; enddo
return
endif
now = US%s_to_T * time_type_to_real(Time - cs%time_ref)
- if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then
- eta_prop = 2.0*CS%SAL_SCALAR
- elseif (CS%USE_SAL_SCALAR .or. CS%USE_PREV_TIDES) then
- eta_prop = CS%SAL_SCALAR
- else
- eta_prop = 0.0
- endif
-
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta_tidal(i,j) = eta_prop*eta(i,j)
- enddo ; enddo
-
do c=1,CS%nc
m = CS%struct(c)
amp_cosomegat = CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c))
amp_sinomegat = CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c))
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + &
+ e_tide_eq(i,j) = e_tide_eq(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + &
amp_sinomegat*CS%sin_struct(i,j,m))
enddo ; enddo
enddo
- if (CS%tidal_sal_from_file) then ; do c=1,CS%nc
+ if (CS%use_tidal_sal_file) then ; do c=1,CS%nc
cosomegat = cos(CS%freq(c)*now)
sinomegat = sin(CS%freq(c)*now)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * &
- (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c))
+ e_tide_sal(i,j) = e_tide_sal(i,j) + CS%ampsal(i,j,c) * &
+ (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c))
enddo ; enddo
enddo ; endif
- if (CS%USE_PREV_TIDES) then ; do c=1,CS%nc
+ if (CS%use_tidal_sal_prev) then ; do c=1,CS%nc
cosomegat = cos(CS%freq(c)*now)
sinomegat = sin(CS%freq(c)*now)
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * &
+ e_tide_sal(i,j) = e_tide_sal(i,j) - CS%sal_scalar * CS%amp_prev(i,j,c) * &
(cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c))
enddo ; enddo
enddo ; endif
- if (CS%tidal_sal_sht) then
- eta_sal(:,:) = 0.0
- call calc_SAL_sht(eta, eta_sal, G, CS)
-
- do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- eta_tidal(i,j) = eta_tidal(i,j) + eta_sal(i,j)
- enddo ; enddo
- endif
call cpu_clock_end(id_clock_tides)
end subroutine calc_tidal_forcing
-!> This subroutine calculates self-attraction and loading using the spherical harmonics method.
-subroutine calc_SAL_sht(eta, eta_sal, G, CS)
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from
- !! a time-mean geoid [Z ~> m].
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_sal !< The sea surface height anomaly from
- !! self-attraction and loading [Z ~> m].
- type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control structure
+!> This subroutine functions the same as calc_tidal_forcing but outputs a field that combines
+!! previously calculated self-attraction and loading (SAL) and tidal forcings, so that old answers
+!! can be preserved bitwise before SAL is separated out as an individual module.
+subroutine calc_tidal_forcing_legacy(Time, e_sal, e_sal_tide, e_tide_eq, e_tide_sal, G, US, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(time_type), intent(in) :: Time !< The time for the caluculation.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: e_sal !< The self-attraction and loading fields
+ !! calculated previously used to
+ !! initialized e_sal_tide [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: e_sal_tide !< The total geopotential height anomalies
+ !! due to both SAL and tidal forcings [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: e_tide_eq !< The geopotential height anomalies
+ !! due to the equilibrium tides [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: e_tide_sal !< The geopotential height anomalies
+ !! due to the tidal SAL [Z ~> m].
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a
+ !! previous call to tidal_forcing_init.
! Local variables
- integer :: n, m, l
+ real :: now ! The relative time compared with the tidal reference [T ~> s]
+ real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m]
+ real :: cosomegat, sinomegat ! The components of the phase [nondim]
+ real :: amp_cossin ! A temporary field that adds cosines and sines [nondim]
+ integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
+ Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
+
+ call cpu_clock_begin(id_clock_tides)
- call cpu_clock_begin(id_clock_SAL)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e_sal_tide(i,j) = 0.0
+ e_tide_eq(i,j) = 0.0
+ e_tide_sal(i,j) = 0.0
+ enddo ; enddo
- call spherical_harmonics_forward(G, CS%sht, eta, CS%Snm_Re, CS%Snm_Im, CS%sal_sht_Nd)
+ if (CS%nc == 0) then
+ return
+ endif
- ! Multiply scaling factors to each mode
- do m = 0,CS%sal_sht_Nd
- l = order2index(m, CS%sal_sht_Nd)
- do n = m,CS%sal_sht_Nd
- CS%Snm_Re(l+n-m) = CS%Snm_Re(l+n-m) * CS%Love_Scaling(l+n-m)
- CS%Snm_Im(l+n-m) = CS%Snm_Im(l+n-m) * CS%Love_Scaling(l+n-m)
- enddo
+ now = US%s_to_T * time_type_to_real(Time - cs%time_ref)
+
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ e_sal_tide(i,j) = e_sal(i,j)
+ enddo ; enddo
+
+ do c=1,CS%nc
+ m = CS%struct(c)
+ amp_cosomegat = CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c))
+ amp_sinomegat = CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c))
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ amp_cossin = (amp_cosomegat*CS%cos_struct(i,j,m) + amp_sinomegat*CS%sin_struct(i,j,m))
+ e_sal_tide(i,j) = e_sal_tide(i,j) + amp_cossin
+ e_tide_eq(i,j) = e_tide_eq(i,j) + amp_cossin
+ enddo ; enddo
enddo
- call spherical_harmonics_inverse(G, CS%sht, CS%Snm_Re, CS%Snm_Im, eta_sal, CS%sal_sht_Nd)
+ if (CS%use_tidal_sal_file) then ; do c=1,CS%nc
+ cosomegat = cos(CS%freq(c)*now)
+ sinomegat = sin(CS%freq(c)*now)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ amp_cossin = CS%ampsal(i,j,c) &
+ * (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c))
+ e_sal_tide(i,j) = e_sal_tide(i,j) + amp_cossin
+ e_tide_sal(i,j) = e_tide_sal(i,j) + amp_cossin
+ enddo ; enddo
+ enddo ; endif
- call pass_var(eta_sal, G%domain)
+ if (CS%use_tidal_sal_prev) then ; do c=1,CS%nc
+ cosomegat = cos(CS%freq(c)*now)
+ sinomegat = sin(CS%freq(c)*now)
+ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
+ amp_cossin = -CS%sal_scalar * CS%amp_prev(i,j,c) &
+ * (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c))
+ e_sal_tide(i,j) = e_sal_tide(i,j) + amp_cossin
+ e_tide_sal(i,j) = e_tide_sal(i,j) + amp_cossin
+ enddo ; enddo
+ enddo ; endif
+ call cpu_clock_end(id_clock_tides)
- call cpu_clock_end(id_clock_SAL)
-end subroutine calc_SAL_sht
+end subroutine calc_tidal_forcing_legacy
!> This subroutine deallocates memory associated with the tidal forcing module.
subroutine tidal_forcing_end(CS)
@@ -796,13 +723,6 @@ subroutine tidal_forcing_end(CS)
if (allocated(CS%cosphase_prev)) deallocate(CS%cosphase_prev)
if (allocated(CS%sinphase_prev)) deallocate(CS%sinphase_prev)
if (allocated(CS%amp_prev)) deallocate(CS%amp_prev)
-
- if (CS%tidal_sal_sht) then
- if (allocated(CS%Love_Scaling)) deallocate(CS%Love_Scaling)
- if (allocated(CS%Snm_Re)) deallocate(CS%Snm_Re)
- if (allocated(CS%Snm_Im)) deallocate(CS%Snm_Im)
- call spherical_harmonics_end(CS%sht)
- endif
end subroutine tidal_forcing_end
!> \namespace tidal_forcing
@@ -823,28 +743,16 @@ end subroutine tidal_forcing_end
!! can be changed at run time by setting variables like TIDE_M2_FREQ,
!! TIDE_M2_AMP and TIDE_M2_PHASE_T0 (for M2).
!!
-!! In addition, the approach to calculating self-attraction and
-!! loading is set at run time. The default is to use the scalar
-!! approximation, with a coefficient TIDE_SAL_SCALAR_VALUE that must
-!! be set in the run-time file (for global runs, 0.094 is typical).
-!! Alternately, TIDAL_SAL_FROM_FILE can be set to read the SAL from
-!! a file containing the results of a previous simulation. To iterate
-!! the SAL to convergence, USE_PREVIOUS_TIDES may be useful (for
-!! details, see Arbic et al., 2004, DSR II). With TIDAL_SAL_FROM_FILE
-!! or USE_PREVIOUS_TIDES,a list of input files must be provided to
-!! describe each constituent's properties from a previous solution.
-!!
-!! This module also contains a method to calculate self-attraction
-!! and loading using spherical harmonic transforms. The algorithm is
-!! based on SAL calculation in Model for Prediction Across Scales
-!! (MPAS)-Ocean developed by Los Alamos National Laboratory and
-!! University of Michigan (Barton et al. (2022) and Brus et al. (2022)).
-!!
-!! Barton, K.N., Nairita, P., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J.,
-!! Wirasaet, D., and Schindelegger, M., 2022: Performance of Model for Prediction Across Scales (MPAS) Ocean as a
-!! Global Barotropic Tide Model. Journal of Advances in Modeling Earth Systems, in review.
-!!
-!! Brus, S.R., Barton, K.N., Nairita, P., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D.,
-!! Westerink, J., and Schindelegger, M., 2022: Scalable self attraction and loading calculations for unstructured ocean
-!! models. Ocean Modelling, in review.
+!! In addition, approaches to calculate self-attraction and loading
+!! due to tides (harmonics of astronomical forcing frequencies)
+!! are provided. TIDAL_SAL_FROM_FILE can be set to read the phase and
+!! amplitude of the tidal SAL. USE_PREVIOUS_TIDES may be useful in
+!! combination with the scalar approximation to iterate the SAL to
+!! convergence (for details, see Arbic et al., 2004, DSR II). With
+!! TIDAL_SAL_FROM_FILE or USE_PREVIOUS_TIDES, a list of input files
+!! must be provided to describe each constituent's properties from
+!! a previous solution. The online SAL calculations that are functions
+!! of SSH (rather should be bottom pressure anmoaly), either a scalar
+!! approximation or with spherical harmonic transforms, are located in
+!! MOM_self_attr_load.
end module MOM_tidal_forcing
diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90
index 2a30f68b42..508362c4cc 100644
--- a/src/parameterizations/vertical/MOM_ALE_sponge.F90
+++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90
@@ -180,15 +180,6 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h,
logical :: use_sponge
logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the remapping answers from 2018. If false, use more
- ! robust forms of the same remapping expressions.
- integer :: default_remap_ans_date ! The default setting for remap_answer_date
- logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding
- ! that recovers the answers from the end of 2018. Otherwise, use
- ! rotationally symmetric forms of the same expressions.
- integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date
integer :: i, j, k, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v
if (associated(CS)) then
@@ -226,39 +217,21 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h,
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- default_remap_ans_date = default_answer_date
- if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231
- if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_remap_ans_date)
- call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, &
- "If true, use the order of arithmetic for horizontal regridding that recovers "//&
- "the answers from the end of 2018. Otherwise, use rotationally symmetric "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for horizontal regridding.
- default_hor_reg_ans_date = default_answer_date
- if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231
- if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%remap_answer_date = max(CS%remap_answer_date, 20230701)
+
call get_param(param_file, mdl, "HOR_REGRID_ANSWER_DATE", CS%hor_regrid_answer_date, &
"The vintage of the order of arithmetic for horizontal regridding. "//&
"Dates before 20190101 give the same answers as the code did in late 2018, "//&
"while later versions add parentheses for rotational symmetry. "//&
- "Dates after 20230101 use reproducing sums for global averages. "//&
- "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_hor_reg_ans_date)
+ "Dates after 20230101 use reproducing sums for global averages.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%hor_regrid_answer_date = max(CS%hor_regrid_answer_date, 20230701)
CS%time_varying_sponges = .false.
CS%nz = GV%ke
@@ -470,15 +443,6 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest
logical :: use_sponge
logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the remapping answers from 2018. If false, use more
- ! robust forms of the same remapping expressions.
- integer :: default_remap_ans_date ! The default setting for remap_answer_date
- logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding
- ! that recovers the answers from the end of 2018. Otherwise, use
- ! rotationally symmetric forms of the same expressions.
- integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date
integer :: i, j, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v
if (associated(CS)) then
@@ -515,41 +479,18 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- default_remap_ans_date = default_answer_date
- if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231
- if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_remap_ans_date)
- call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, &
- "If true, use the order of arithmetic for horizontal regridding that recovers "//&
- "the answers from the end of 2018 and retain a bug in the 3-dimensional mask "//&
- "returned in certain cases. Otherwise, use rotationally symmetric "//&
- "forms of the same expressions and initialize the mask properly.", &
- default=default_2018_answers)
- ! Revise inconsistent default answer dates for horizontal regridding.
- default_hor_reg_ans_date = default_answer_date
- if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231
- if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date)
call get_param(param_file, mdl, "HOR_REGRID_ANSWER_DATE", CS%hor_regrid_answer_date, &
"The vintage of the order of arithmetic for horizontal regridding. "//&
"Dates before 20190101 give the same answers as the code did in late 2018, "//&
"while later versions add parentheses for rotational symmetry. "//&
- "Dates after 20230101 use reproducing sums for global averages. "//&
- "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_hor_reg_ans_date)
+ "Dates after 20230101 use reproducing sums for global averages.", &
+ default=default_answer_date)
call get_param(param_file, mdl, "SPONGE_DATA_ONGRID", CS%spongeDataOngrid, &
"When defined, the incoming sponge data are "//&
"assumed to be on the model grid " , &
diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
index 44b1d720b1..8e95edd563 100644
--- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
@@ -12,6 +12,7 @@ module MOM_CVMix_KPP
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_file_parser, only : openParameterBlock, closeParameterBlock
use MOM_grid, only : ocean_grid_type, isPointInCell
+use MOM_interface_heights, only : thickness_to_dz
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
@@ -536,7 +537,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive)
'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', &
'm2/s', conversion=US%Z2_T_to_m2_s)
CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, &
- 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_T_to_m2_s)
+ 'Diffusivity passed to KPP', 'm2/s', conversion=GV%HZ_T_to_m2_s)
CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, &
'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', &
'm2/s', conversion=US%Z2_T_to_m2_s)
@@ -596,7 +597,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive)
end function KPP_init
!> KPP vertical diffusivity/viscosity and non-local tracer transport
-subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
+subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, &
nonLocalTransHeat, nonLocalTransScalar, Waves, lamult)
! Arguments
@@ -604,18 +605,19 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
type(ocean_grid_type), intent(in) :: G !< Ocean grid
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure.
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP
!! (out) Vertical diffusivity including KPP
- !! [Z2 T-1 ~> m2 s-1]
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP
!! (out) Vertical diffusivity including KPP
- !! [Z2 T-1 ~> m2 s-1]
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP
!! (out) Vertical viscosity including KPP
- !! [Z2 T-1 ~> m2 s-1]
+ !! [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [nondim]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [nondim]
type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence
@@ -623,6 +625,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
! Local variables
integer :: i, j, k ! Loop indices
+ real, dimension(SZI_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m]
real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] (negative in ocean)
real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] (negative in ocean)
real, dimension( GV%ke ) :: z_cell ! Cell center heights referenced to surface [m] (negative in ocean)
@@ -649,8 +652,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m)
call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m*US%s_to_T)
call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0, scale=US%L_to_m**2*US%s_to_T**3)
- call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
nonLocalTrans(:,:) = 0.0
@@ -661,13 +664,17 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
buoy_scale = US%L_to_m**2*US%s_to_T**3
!$OMP parallel do default(none) firstprivate(nonLocalTrans) &
- !$OMP private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, &
+ !$OMP private(surfFricVel, iFaceHeight, hcorr, dh, dz, cellHeight, &
!$OMP surfBuoyFlux, Kdiffusivity, Kviscosity, LangEnhK, sigma, &
!$OMP sigmaRatio, z_inter, z_cell) &
- !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, Kt, &
+ !$OMP shared(G, GV, CS, US, tv, uStar, h, buoy_scale, buoyFlux, Kt, &
!$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, Waves, lamult)
! loop over horizontal points on processor
do j = G%jsc, G%jec
+
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then
! things independent of position within the column
@@ -678,7 +685,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
do k=1,GV%ke
! cell center and cell bottom in meters (negative values in the ocean)
- dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment
+ dh = dz(i,k) ! Nominal thickness to use for increment
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness
@@ -710,9 +717,9 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1]
Kviscosity(:) = 0. ! Viscosity [m2 s-1]
else
- Kdiffusivity(:,1) = US%Z2_T_to_m2_s * Kt(i,j,:)
- Kdiffusivity(:,2) = US%Z2_T_to_m2_s * Ks(i,j,:)
- Kviscosity(:) = US%Z2_T_to_m2_s * Kv(i,j,:)
+ Kdiffusivity(:,1) = GV%HZ_T_to_m2_s * Kt(i,j,:)
+ Kdiffusivity(:,2) = GV%HZ_T_to_m2_s * Ks(i,j,:)
+ Kviscosity(:) = GV%HZ_T_to_m2_s * Kv(i,j,:)
endif
IF (CS%LT_K_ENHANCEMENT) then
@@ -875,16 +882,16 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
if (.not. CS%passiveMode) then
if (CS%KPPisAdditive) then
do k=1, GV%ke+1
- Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1)
- Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2)
- Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kviscosity(k)
+ Kt(i,j,k) = Kt(i,j,k) + GV%m2_s_to_HZ_T * Kdiffusivity(k,1)
+ Ks(i,j,k) = Ks(i,j,k) + GV%m2_s_to_HZ_T * Kdiffusivity(k,2)
+ Kv(i,j,k) = Kv(i,j,k) + GV%m2_s_to_HZ_T * Kviscosity(k)
if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k)
enddo
else ! KPP replaces prior diffusivity when former is non-zero
do k=1, GV%ke+1
- if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1)
- if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2)
- if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m2_s_to_Z2_T * Kviscosity(k)
+ if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = GV%m2_s_to_HZ_T * Kdiffusivity(k,1)
+ if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = GV%m2_s_to_HZ_T * Kdiffusivity(k,2)
+ if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m2_s_to_HZ_T * Kviscosity(k)
if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k)
enddo
endif
@@ -898,8 +905,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, &
call cpu_clock_end(id_clock_KPP_calc)
if (CS%debug) then
- call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
! send diagnostics to post_data
@@ -927,7 +934,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
type(ocean_grid_type), intent(inout) :: G !< Ocean grid
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< potential/cons temp [C ~> degC]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< Salinity [S ~> ppt]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1]
@@ -939,9 +946,12 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement factor [nondim]
! Local variables
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m]
+
! Variables for passing to CVMix routines, often in MKS units
real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars in MKS units [m s-1]
real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3]
+ real, dimension( GV%ke ) :: deltaBuoy ! Change in Buoyancy based on deltaRho [m s-2]
real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2]
real, dimension( GV%ke ) :: surfBuoyFlux2 ! Surface buoyancy flux in MKS units [m2 s-3]
real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim]
@@ -955,7 +965,6 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
real :: Coriolis ! Coriolis parameter at tracer points in MKS units [s-1]
real :: KPP_OBL_depth ! Boundary layer depth calculated by CVMix_kpp_compute_OBL_depth in MKS units [m]
-
! Variables for EOS calculations
real, dimension( 3*GV%ke ) :: rho_1D ! A column of densities [R ~> kg m-3]
real, dimension( 3*GV%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa]
@@ -967,8 +976,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [T-2 ~> s-2]
real :: zBottomMinusOffset ! Height of bottom plus a little bit [Z ~> m]
real :: GoRho ! Gravitational acceleration in MKS units divided by density [m s-2 R-1 ~> m4 kg-1 s-2]
- real :: GoRho_Z_L2 ! Gravitational acceleration divided by density times aspect ratio
- ! rescaling [Z T-2 R-1 ~> m4 kg-1 s-2]
+ real :: GoRho_Z_L2 ! Gravitational acceleration, perhaps divided by density, times aspect ratio
+ ! rescaling [H T-2 R-1 ~> m4 kg-1 s-2 or m s-2]
real :: pRef ! The interface pressure [R L2 T-2 ~> Pa]
real :: Uk, Vk ! Layer velocities relative to their averages in the surface layer [L T-1 ~> m s-1]
real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth [Z ~> m]
@@ -1007,10 +1016,17 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
call cpu_clock_begin(id_clock_KPP_compute_BLD)
! some constants
- GoRho_Z_L2 = US%L_to_Z**2 * GV%g_Earth / GV%Rho0
- GoRho = US%Z_to_m*US%s_to_T**2 * GoRho_Z_L2
+ GoRho = US%Z_to_m*US%s_to_T**2 * (US%L_to_Z**2 * GV%g_Earth / GV%Rho0)
+ if (GV%Boussinesq) then
+ GoRho_Z_L2 = US%L_to_Z**2 * GV%Z_to_H * GV%g_Earth / GV%Rho0
+ else
+ GoRho_Z_L2 = US%L_to_Z**2 * GV%g_Earth * GV%RZ_to_H
+ endif
buoy_scale = US%L_to_m**2*US%s_to_T**3
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, G, GV, US)
+
! loop over horizontal points on processor
!$OMP parallel do default(none) private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, &
!$OMP surfBuoyFlux, U_H, V_H, Coriolis, pRef, SLdepth_0d, vt2_1d, &
@@ -1018,9 +1034,9 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
!$OMP surfHvS, hTot, delH, surftemp, surfsalt, surfu, surfv, &
!$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, N_col, &
!$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_guess, LA, rho_1D, &
- !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2,KPP_OBL_depth, z_cell, &
+ !$OMP deltarho, deltaBuoy, N2_1d, ws_1d, LangEnhVT2,KPP_OBL_depth, z_cell, &
!$OMP z_inter, OBL_depth, BulkRi_1d, zBottomMinusOffset) &
- !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, &
+ !$OMP shared(G, GV, CS, US, uStar, h, dz, buoy_scale, buoyFlux, &
!$OMP Temp, Salt, waves, tv, GoRho, GoRho_Z_L2, u, v, lamult)
do j = G%jsc, G%jec
do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then
@@ -1047,7 +1063,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
do k=1,GV%ke
! cell center and cell bottom in meters (negative values in the ocean)
- dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment
+ dh = dz(i,j,k) ! Nominal thickness to use for increment
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness
@@ -1076,7 +1092,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
do ktmp = 1,ksfc
! SLdepth_0d can be between cell interfaces
- delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_Z )
+ delH = min( max(0.0, SLdepth_0d - hTot), dz(i,j,ktmp) )
! surface layer thickness
hTot = hTot + delH
@@ -1142,7 +1158,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then
MLD_guess = max( CS%MLD_guess_min, abs(CS%OBLdepthprev(i,j) ) )
call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, &
- H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES)
+ dz=dz(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES)
CS%La_SL(i,j) = LA
endif
@@ -1157,8 +1173,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
km1 = max(1, k-1)
kk = 3*(k-1)
deltaRho(k) = rho_1D(kk+2) - rho_1D(kk+1)
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ deltaBuoy(k) = GoRho*(rho_1D(kk+2) - rho_1D(kk+1))
+ else
+ deltaBuoy(k) = (US%Z_to_m*US%s_to_T**2) * (US%L_to_Z**2 * GV%g_Earth) * &
+ ( (rho_1D(kk+2) - rho_1D(kk+1)) / (0.5 * (rho_1D(kk+2) + rho_1D(kk+1))) )
+ endif
N2_1d(k) = (GoRho_Z_L2 * (rho_1D(kk+2) - rho_1D(kk+3)) ) / &
- ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z)
+ ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff))
CS%N(i,j,k) = sqrt( max( N2_1d(k), 0.) )
enddo
N2_1d(GV%ke+1 ) = 0.0
@@ -1212,7 +1234,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
! Calculate Bulk Richardson number from eq (21) of LMD94
BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( &
zt_cntr=z_cell, & ! Depth of cell center [m]
- delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [m s-2]
+ delta_buoy_cntr=deltaBuoy, & ! Bulk buoyancy difference, Br-B(z) [m s-2]
delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2]
ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1]
N_iface=N_col, & ! Buoyancy frequency [s-1]
@@ -1266,7 +1288,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
!BGR consider if LTEnhancement is wanted for diagnostics
if (CS%id_Ws > 0) then
call CVMix_kpp_compute_turbulent_scales( &
- -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate
+ -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate [nondim]
US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m]
surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3]
surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1]
@@ -1306,19 +1328,19 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag)
! BLD smoothing:
- if (CS%n_smooth > 0) call KPP_smooth_BLD(CS, G, GV, US, h)
+ if (CS%n_smooth > 0) call KPP_smooth_BLD(CS, G, GV, US, dz)
end subroutine KPP_compute_BLD
!> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise
-subroutine KPP_smooth_BLD(CS, G, GV, US, h)
+subroutine KPP_smooth_BLD(CS, G, GV, US, dz)
! Arguments
type(KPP_CS), pointer :: CS !< Control structure
type(ocean_grid_type), intent(inout) :: G !< Ocean grid
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
- type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2]
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: dz !< Layer thicknesses [Z ~> m]
! local
real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [Z ~> m]
@@ -1343,7 +1365,7 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h)
OBLdepth_prev = CS%OBLdepth
! apply smoothing on OBL depth
- !$OMP parallel do default(none) shared(G, GV, US, CS, h, OBLdepth_prev) &
+ !$OMP parallel do default(none) shared(G, GV, US, CS, dz, OBLdepth_prev) &
!$OMP private(wc, ww, we, wn, ws, dh, hcorr, cellHeight, iFaceHeight)
do j = G%jsc, G%jec
do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then
@@ -1353,7 +1375,7 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h)
do k=1,GV%ke
! cell center and cell bottom in meters (negative values in the ocean)
- dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment
+ dh = dz(i,j,k) ! Nominal thickness to use for increment
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness
diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90
index e26c061929..19744cb6c5 100644
--- a/src/parameterizations/vertical/MOM_CVMix_conv.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90
@@ -11,6 +11,7 @@ module MOM_CVMix_conv
use MOM_file_parser, only : openParameterBlock, closeParameterBlock
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
@@ -143,15 +144,16 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux)
type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control structure
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl !< Depth of ocean boundary layer [Z ~> m]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- intent(inout) :: Kd !< Diapycnal diffusivity at each interface that
- !! will be incremented here [Z2 T-1 ~> m2 s-1].
+ intent(inout) :: Kd !< Diapycnal diffusivity at each interface
+ !! that will be incremented here
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- intent(inout) :: KV !< Viscosity at each interface that will be
- !! incremented here [Z2 T-1 ~> m2 s-1].
+ intent(inout) :: Kv !< Viscosity at each interface that will be
+ !! incremented here [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
optional, intent(inout) :: Kd_aux !< A second diapycnal diffusivity at each
!! interface that will also be incremented
- !! here [Z2 T-1 ~> m2 s-1].
+ !! here [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
! local variables
real, dimension(SZK_(GV)) :: rho_lwr !< Adiabatic Water Density [kg m-3], this is a dummy
@@ -162,23 +164,27 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux)
real, dimension(SZK_(GV)+1) :: N2 !< Squared buoyancy frequency [s-2]
real, dimension(SZK_(GV)+1) :: kv_col !< Viscosities at interfaces in the column [m2 s-1]
real, dimension(SZK_(GV)+1) :: kd_col !< Diffusivities at interfaces in the column [m2 s-1]
- real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [m]
- real, dimension(SZK_(GV)) :: cellHeight !< Height of cell centers [m]
+ real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [Z ~> m]
+ real, dimension(SZK_(GV)) :: cellHeight !< Height of cell centers [Z ~> m]
+ real, dimension(SZI_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: &
kd_conv, & !< Diffusivity added by convection for diagnostics [Z2 T-1 ~> m2 s-1]
kv_conv, & !< Viscosity added by convection for diagnostics [Z2 T-1 ~> m2 s-1]
N2_3d !< Squared buoyancy frequency for diagnostics [T-2 ~> s-2]
integer :: kOBL !< level of ocean boundary layer extent
- real :: g_o_rho0 ! Gravitational acceleration divided by density times unit conversion factors
- ! [Z s-2 R-1 ~> m4 s-2 kg-1]
+ real :: g_o_rho0 ! Gravitational acceleration, perhaps divided by density, times unit conversion factors
+ ! [H s-2 R-1 ~> m4 s-2 kg-1 or m s-2]
real :: pref ! Interface pressures [R L2 T-2 ~> Pa]
real :: rhok, rhokm1 ! In situ densities of the layers above and below at the interface pressure [R ~> kg m-3]
- real :: hbl_KPP ! The depth of the ocean boundary as used by KPP [m]
- real :: dz ! A thickness [Z ~> m]
+ real :: dh_int ! The distance between layer centers [H ~> m or kg m-2]
real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m]
integer :: i, j, k
- g_o_rho0 = US%L_to_Z**2*US%s_to_T**2 * GV%g_Earth / GV%Rho0
+ if (GV%Boussinesq) then
+ g_o_rho0 = (US%L_to_Z**2*US%s_to_T**2*GV%Z_to_H) * GV%g_Earth / GV%Rho0
+ else
+ g_o_rho0 = (US%L_to_Z**2*US%s_to_T**2*GV%RZ_to_H) * GV%g_Earth
+ endif
! initialize dummy variables
rho_lwr(:) = 0.0 ; rho_1d(:) = 0.0
@@ -191,6 +197,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux)
if (CS%id_kd_conv > 0) Kd_conv(:,:,:) = 0.0
do j = G%jsc, G%jec
+
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
do i = G%isc, G%iec
! skip calling at land points
@@ -205,8 +215,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux)
call calculate_density(tv%t(i,j,k), tv%s(i,j,k), pRef, rhok, tv%eqn_of_state)
call calculate_density(tv%t(i,j,k-1), tv%s(i,j,k-1), pRef, rhokm1, tv%eqn_of_state)
- dz = ((0.5*(h(i,j,k-1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z)
- N2(K) = g_o_rho0 * (rhok - rhokm1) / dz ! Can be negative
+ dh_int = 0.5*(h(i,j,k-1) + h(i,j,k)) + GV%H_subroundoff
+ N2(K) = g_o_rho0 * (rhok - rhokm1) / dh_int ! Can be negative
enddo
@@ -214,17 +224,16 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux)
hcorr = 0.0
! compute heights at cell center and interfaces
do k=1,GV%ke
- dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights
+ dh = dz(i,k) ! Nominal thickness to use for increment, in the units of heights
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness
- cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh
- iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh
+ cellHeight(k) = iFaceHeight(k) - 0.5 * dh
+ iFaceHeight(k+1) = iFaceHeight(k) - dh
enddo
! gets index of the level and interface above hbl
- hbl_KPP = US%Z_to_m*hbl(i,j) ! Convert to the units used by CVMix.
- kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl_KPP)
+ kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl(i,j))
kv_col(:) = 0.0 ; kd_col(:) = 0.0
call CVMix_coeffs_conv(Mdiff_out=kv_col(:), &
@@ -238,18 +247,18 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux)
! Increment the diffusivity outside of the boundary layer.
do K=max(1,kOBL+1),GV%ke+1
- Kd(i,j,K) = Kd(i,j,K) + US%m2_s_to_Z2_T * kd_col(K)
+ Kd(i,j,K) = Kd(i,j,K) + GV%m2_s_to_HZ_T * kd_col(K)
enddo
if (present(Kd_aux)) then
! Increment the other diffusivity outside of the boundary layer.
do K=max(1,kOBL+1),GV%ke+1
- Kd_aux(i,j,K) = Kd_aux(i,j,K) + US%m2_s_to_Z2_T * kd_col(K)
+ Kd_aux(i,j,K) = Kd_aux(i,j,K) + GV%m2_s_to_HZ_T * kd_col(K)
enddo
endif
! Increment the viscosity outside of the boundary layer.
do K=max(1,kOBL+1),GV%ke+1
- Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * kv_col(K)
+ Kv(i,j,K) = Kv(i,j,K) + GV%m2_s_to_HZ_T * kv_col(K)
enddo
! Store 3-d arrays for diagnostics.
@@ -277,8 +286,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux)
! call hchksum(Kd_conv, "MOM_CVMix_conv: Kd_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
! if (CS%id_kv_conv > 0) &
! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
! send diagnostics to post_data
diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90
index 6e2c76ba8d..af17e0287f 100644
--- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90
@@ -35,7 +35,7 @@ module MOM_CVMix_ddiff
real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime [nondim]
real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime [nondim]
real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime [nondim]
- real :: min_thickness !< Minimum thickness allowed [Z ~> m]
+ real :: min_thickness !< Minimum thickness allowed [H ~> m or kg-2]
character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino &
!! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90")
logical :: debug !< If true, turn on debugging
@@ -83,7 +83,7 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.)
call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, &
- units="m", scale=US%m_to_Z, default=0.001, do_not_log=.True.)
+ units="m", scale=GV%m_to_H, default=0.001, do_not_log=.True.)
call openParameterBlock(param_file,'CVMIX_DDIFF')
@@ -150,9 +150,11 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho)
integer, intent(in) :: j !< Meridional grid index to work on.
! Kd_T and Kd_S are intent inout because only one j-row is set here, but they are essentially outputs.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd_T !< Interface double diffusion diapycnal
- !! diffusivity for temp [Z2 T-1 ~> m2 s-1].
+ !! diffusivity for temperature
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd_S !< Interface double diffusion diapycnal
- !! diffusivity for salt [Z2 T-1 ~> m2 s-1].
+ !! diffusivity for salinity
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned
!! by a previous call to CVMix_ddiff_init.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
@@ -160,7 +162,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho)
! Local variables
real, dimension(SZK_(GV)) :: &
- cellHeight, & !< Height of cell centers [m]
+ cellHeight, & !< Height of cell centers relative to the sea surface [H ~> m or kg m-2]
dRho_dT, & !< partial derivatives of density with temperature [R C-1 ~> kg m-3 degC-1]
dRho_dS, & !< partial derivatives of density with salinity [R S-1 ~> kg m-3 ppt-1]
pres_int, & !< pressure at each interface [R L2 T-2 ~> Pa]
@@ -174,8 +176,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho)
Kd1_T, & !< Diapycanal diffusivity of temperature [m2 s-1].
Kd1_S !< Diapycanal diffusivity of salinity [m2 s-1].
- real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [m]
- real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m]
+ real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces relative to the sea surface [H ~> m or kg m-2]
+ real :: dh, hcorr ! Limited thicknesses and a cumulative correction [H ~> m or kg m-2]
integer :: i, k
! initialize dummy variables
@@ -235,16 +237,16 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho)
hcorr = 0.0
! compute heights at cell center and interfaces
do k=1,GV%ke
- dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in height units
+ dh = h(i,j,k) ! Nominal thickness to use for increment, in height units
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness
- cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh
- iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh
+ cellHeight(k) = iFaceHeight(k) - 0.5 * dh
+ iFaceHeight(k+1) = iFaceHeight(k) - dh
enddo
! gets index of the level and interface above hbl
- !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl(i,j))
+ !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, GV%Z_to_H*hbl(i,j))
Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0
call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), &
@@ -254,8 +256,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho)
nlev=GV%ke, &
max_nlev=GV%ke)
do K=1,GV%ke+1
- Kd_T(i,j,K) = US%m2_s_to_Z2_T * Kd1_T(K)
- Kd_S(i,j,K) = US%m2_s_to_Z2_T * Kd1_S(K)
+ Kd_T(i,j,K) = GV%m2_s_to_HZ_T * Kd1_T(K)
+ Kd_S(i,j,K) = GV%m2_s_to_HZ_T * Kd1_S(K)
enddo
! Do not apply mixing due to convection within the boundary layer
diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90
index 708bb7c4fd..829318b606 100644
--- a/src/parameterizations/vertical/MOM_CVMix_shear.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90
@@ -10,6 +10,7 @@ module MOM_CVMix_shear
use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
@@ -66,9 +67,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS )
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2].
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: kd !< The vertical diffusivity at each interface
- !! (not layer!) [Z2 T-1 ~> m2 s-1].
+ !! (not layer!) [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: kv !< The vertical viscosity at each interface
- !! (not layer!) [Z2 T-1 ~> m2 s-1].
+ !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s]
type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous
!! call to CVMix_shear_init.
! Local variables
@@ -76,11 +77,12 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS )
real :: GoRho ! Gravitational acceleration divided by density [Z T-2 R-1 ~> m4 s-2 kg-1]
real :: pref ! Interface pressures [R L2 T-2 ~> Pa]
real :: DU, DV ! Velocity differences [L T-1 ~> m s-1]
- real :: DZ ! Grid spacing around an interface [Z ~> m]
+ real :: dz_int ! Grid spacing around an interface [Z ~> m]
real :: N2 ! Buoyancy frequency at an interface [T-2 ~> s-2]
real :: S2 ! Shear squared at an interface [T-2 ~> s-2]
real :: dummy ! A dummy variable [nondim]
real :: dRho ! Buoyancy differences [Z T-2 ~> m s-2]
+ real, dimension(SZI_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m]
real, dimension(2*(GV%ke)) :: pres_1d ! A column of interface pressures [R L2 T-2 ~> Pa]
real, dimension(2*(GV%ke)) :: temp_1d ! A column of temperatures [C ~> degC]
real, dimension(2*(GV%ke)) :: salt_1d ! A column of salinities [S ~> ppt]
@@ -96,6 +98,10 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS )
epsln = 1.e-10 * GV%m_to_H
do j = G%jsc, G%jec
+
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
do i = G%isc, G%iec
! skip calling for land points
@@ -132,10 +138,14 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS )
kk = 2*(k-1)
DU = u_h(i,j,k) - u_h(i,j,km1)
DV = v_h(i,j,k) - v_h(i,j,km1)
- DRHO = GoRho * (rho_1D(kk+1) - rho_1D(kk+2))
- DZ = (0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z
- N2 = DRHO / DZ
- S2 = US%L_to_Z**2*(DU*DU+DV*DV)/(DZ*DZ)
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ dRho = GoRho * (rho_1D(kk+1) - rho_1D(kk+2))
+ else
+ dRho = (US%L_to_Z**2 * GV%g_Earth) * (rho_1D(kk+1) - rho_1D(kk+2)) / (0.5*(rho_1D(kk+1) + rho_1D(kk+2)))
+ endif
+ dz_int = 0.5*(dz(i,km1) + dz(i,k)) + GV%dZ_subroundoff
+ N2 = DRHO / dz_int
+ S2 = US%L_to_Z**2*(DU*DU + DV*DV) / (dz_int*dz_int)
Ri_Grad(k) = max(0., N2) / max(S2, 1.e-10*US%T_to_s**2)
! fill 3d arrays, if user asks for diagnostics
@@ -176,8 +186,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS )
if (CS%id_ri_grad > 0) CS%ri_grad(i,j,:) = Ri_Grad(:)
do K=1,GV%ke+1
- Kvisc(K) = US%Z2_T_to_m2_s * kv(i,j,K)
- Kdiff(K) = US%Z2_T_to_m2_s * kd(i,j,K)
+ Kvisc(K) = GV%HZ_T_to_m2_s * kv(i,j,K)
+ Kdiff(K) = GV%HZ_T_to_m2_s * kd(i,j,K)
enddo
! Call to CVMix wrapper for computing interior mixing coefficients.
@@ -187,8 +197,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS )
nlev=GV%ke, &
max_nlev=GV%ke)
do K=1,GV%ke+1
- kv(i,j,K) = US%m2_s_to_Z2_T * Kvisc(K)
- kd(i,j,K) = US%m2_s_to_Z2_T * Kdiff(K)
+ kv(i,j,K) = GV%m2_s_to_HZ_T * Kvisc(K)
+ kd(i,j,K) = GV%m2_s_to_HZ_T * Kdiff(K)
enddo
enddo
enddo
@@ -324,9 +334,9 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS)
endif
CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, &
- 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s)
+ 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%HZ_T_to_m2_s)
CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, &
- 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s)
+ 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%HZ_T_to_m2_s)
end function CVMix_shear_init
diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90
index 01f8303ae2..693b9395bd 100644
--- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90
+++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90
@@ -45,15 +45,15 @@ module MOM_bkgnd_mixing
real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the
!! Bryan-Lewis profile [Z ~> m]
real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when
- !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1]
+ !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when
- !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1]
+ !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when
- !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1]
+ !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: bckgrnd_vdc_Banda !< Banda Sea diffusivity (Gordon) when
- !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1]
- real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1]
- real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1]
+ !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: Kd_min !< minimum diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: Kd !< interior diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: omega !< The Earth's rotation rate [T-1 ~> s-1].
real :: N0_2Omega !< ratio of the typical Buoyancy frequency to
!! twice the Earth's rotation period, used with the
@@ -63,10 +63,10 @@ module MOM_bkgnd_mixing
real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of
!! diffusivities with Kd_tanh_lat_fn [nondim]. Valid values
!! are in the range of -2 to 2; 0.4 reproduces CM2M.
- real :: Kd_tot_ml !< The mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1]
+ real :: Kd_tot_ml !< The mixed layer diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
!! when no other physically based mixed layer turbulence
!! parameterization is being used.
- real :: Hmix !< mixed layer thickness [Z ~> m] when no physically based
+ real :: Hmix !< mixed layer thickness [H ~> m or kg m-2] when no physically based
!! ocean surface boundary layer parameterization is used.
logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on
!! latitude, like GFDL CM2.1/CM2M. There is no
@@ -114,8 +114,10 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL
!! surface boundary layer.
! Local variables
- real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set Prandtl
+ real :: Kv ! The interior vertical viscosity [H Z T-1 ~> m2 s-1 or Pa s] - read to set Prandtl
! number unless it is provided as a parameter
+ real :: Kd_z ! The background diapycnal diffusivity in [Z2 T-1 ~> m2 s-1] for use
+ ! in setting the default for other diffusivities.
real :: prandtl_bkgnd_comp ! Kv/CS%Kd [nondim]. Gets compared with user-specified prandtl_bkgnd.
! This include declares and sets the variable "version".
@@ -132,19 +134,20 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL
call log_version(param_file, mdl, version, &
"Adding static vertical background mixing coefficients")
- call get_param(param_file, mdl, "KD", CS%Kd, &
+ call get_param(param_file, mdl, "KD", Kd_z, &
"The background diapycnal diffusivity of density in the "//&
"interior. Zero or the molecular value, ~1e-7 m2 s-1, "//&
"may be used.", default=0.0, units="m2 s-1", scale=US%m2_s_to_Z2_T)
+ CS%Kd = (GV%m2_s_to_HZ_T*US%Z2_T_to_m2_s) * Kd_z
call get_param(param_file, mdl, "KV", Kv, &
"The background kinematic viscosity in the interior. "//&
"The molecular value, ~1e-6 m2 s-1, may be used.", &
- units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.)
+ units="m2 s-1", scale=GV%m2_s_to_HZ_T, fail_if_missing=.true.)
call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, &
"The minimum diapycnal diffusivity.", &
- units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=0.01*Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T)
! The following is needed to set one of the choices of vertical background mixing
@@ -152,11 +155,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL
if (CS%physical_OBL_scheme) then
! Check that Kdml is not set when using bulk mixed layer
call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, &
- units="m2 s-1", default=-1., scale=US%m2_s_to_Z2_T, do_not_log=.true.)
+ units="m2 s-1", default=-1., scale=GV%m2_s_to_HZ_T, do_not_log=.true.)
if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, &
"bkgnd_mixing_init: KDML is a depricated parameter that should not be used.")
call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, &
- units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.)
+ units="m2 s-1", default=-1.0, scale=GV%m2_s_to_HZ_T, do_not_log=.true.)
if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, &
"bkgnd_mixing_init: KD_ML_TOT cannot be set when using a physically based ocean "//&
"boundary layer mixing parameterization.")
@@ -166,13 +169,13 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL
"The total diapcynal diffusivity in the surface mixed layer when there is "//&
"not a physically based parameterization of mixing in the mixed layer, such "//&
"as bulk mixed layer or KPP or ePBL.", &
- units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, do_not_log=.true.)
+ units="m2 s-1", default=Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T, do_not_log=.true.)
if (abs(CS%Kd_tot_ml - CS%Kd) <= 1.0e-15*abs(CS%Kd)) then
call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, &
"If BULKMIXEDLAYER is false, KDML is the elevated "//&
"diapycnal diffusivity in the topmost HMIX of fluid. "//&
"KDML is only used if BULKMIXEDLAYER is false.", &
- units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, do_not_log=.true.)
+ units="m2 s-1", default=Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T, do_not_log=.true.)
if (abs(CS%Kd_tot_ml - CS%Kd) > 1.0e-15*abs(CS%Kd)) &
call MOM_error(WARNING, "KDML is a depricated parameter. Use KD_ML_TOT instead.")
endif
@@ -180,12 +183,12 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL
"The total diapcynal diffusivity in the surface mixed layer when there is "//&
"not a physically based parameterization of mixing in the mixed layer, such "//&
"as bulk mixed layer or KPP or ePBL.", &
- units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, unscale=US%Z2_T_to_m2_s)
+ units="m2 s-1", default=Kd_z*US%Z2_T_to_m2_s, unscale=GV%HZ_T_to_m2_s)
call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, &
"The prescribed depth over which the near-surface "//&
"viscosity and diffusivity are elevated when the bulk "//&
- "mixed layer is not used.", units="m", scale=US%m_to_Z, fail_if_missing=.true.)
+ "mixed layer is not used.", units="m", scale=GV%m_to_H, fail_if_missing=.true.)
endif
call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.)
@@ -228,19 +231,19 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL
call get_param(param_file, mdl, "BCKGRND_VDC1", CS%bckgrnd_vdc1, &
"Background diffusivity (Ledwell) when HORIZ_VARYING_BACKGROUND=True", &
- units="m2 s-1",default = 0.16e-04, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1",default = 0.16e-04, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "BCKGRND_VDC_EQ", CS%bckgrnd_vdc_eq, &
"Equatorial diffusivity (Gregg) when HORIZ_VARYING_BACKGROUND=True", &
- units="m2 s-1",default = 0.01e-04, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1",default = 0.01e-04, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", CS%bckgrnd_vdc_psim, &
"Max. PSI induced diffusivity (MacKinnon) when HORIZ_VARYING_BACKGROUND=True", &
- units="m2 s-1",default = 0.13e-4, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1",default = 0.13e-4, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "BCKGRND_VDC_BAN", CS%bckgrnd_vdc_Banda, &
"Banda Sea diffusivity (Gordon) when HORIZ_VARYING_BACKGROUND=True", &
- units="m2 s-1",default = 1.0e-4, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1",default = 1.0e-4, scale=GV%m2_s_to_HZ_T)
endif
call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, &
@@ -318,12 +321,12 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G,
type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure.
real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< squared buoyancy frequency associated
!! with layers [T-2 ~> s-2]
- real, dimension(SZI_(G),SZK_(GV)), intent(out) :: Kd_lay !< The background diapycnal diffusivity
- !! of each layer [Z2 T-1 ~> m2 s-1].
- real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: Kd_int !< The background diapycnal diffusivity
- !! of each interface [Z2 T-1 ~> m2 s-1].
+ real, dimension(SZI_(G),SZK_(GV)), intent(out) :: Kd_lay !< The background diapycnal diffusivity of each
+ !! layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: Kd_int !< The background diapycnal diffusivity of each
+ !! interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: Kv_bkgnd !< The background vertical viscosity at
- !! each interface [Z2 T-1 ~> m2 s-1]
+ !! each interface [H Z T-1 ~> m2 s-1 or Pa s]
integer, intent(in) :: j !< Meridional grid index
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by
@@ -333,10 +336,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G,
real, dimension(SZK_(GV)+1) :: depth_int !< Distance from surface of the interfaces [m]
real, dimension(SZK_(GV)+1) :: Kd_col !< Diffusivities at the interfaces [m2 s-1]
real, dimension(SZK_(GV)+1) :: Kv_col !< Viscosities at the interfaces [m2 s-1]
- real, dimension(SZI_(G)) :: Kd_sfc !< Surface value of the diffusivity [Z2 T-1 ~> m2 s-1]
- real, dimension(SZI_(G)) :: depth !< Distance from surface of an interface [Z ~> m]
- real :: depth_c !< depth of the center of a layer [Z ~> m]
- real :: I_Hmix !< inverse of fixed mixed layer thickness [Z-1 ~> m-1]
+ real, dimension(SZI_(G)) :: Kd_sfc !< Surface value of the diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real, dimension(SZI_(G)) :: depth !< Distance from surface of an interface [H ~> m or kg m-2]
+ real :: depth_c !< depth of the center of a layer [H ~> m or kg m-2]
+ real :: I_Hmix !< inverse of fixed mixed layer thickness [H-1 ~> m-1 or m2 kg-1]
real :: I_2Omega !< 1/(2 Omega) [T ~> s]
real :: N_2Omega ! The ratio of the stratification to the Earth's rotation rate [nondim]
real :: N02_N2 ! The ratio a reference stratification to the actual stratification [nondim]
@@ -344,8 +347,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G,
real :: deg_to_rad !< factor converting degrees to radians [radians degree-1], pi/180.
real :: abs_sinlat !< absolute value of sine of latitude [nondim]
real :: min_sinlat ! The minimum value of the sine of latitude [nondim]
- real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [Z2 T-1 ~> m2 s-1]
- real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [Z2 T-1 ~> m2 s-1]
+ real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
integer :: i, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -380,11 +383,11 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G,
! Update Kd and Kv.
do K=1,nz+1
- Kv_bkgnd(i,K) = US%m2_s_to_Z2_T*Kv_col(K)
- Kd_int(i,K) = US%m2_s_to_Z2_T*Kd_col(K)
+ Kv_bkgnd(i,K) = GV%m2_s_to_HZ_T * Kv_col(K)
+ Kd_int(i,K) = GV%m2_s_to_HZ_T*Kd_col(K)
enddo
do k=1,nz
- Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_col(K) + Kd_col(K+1))
+ Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * GV%m2_s_to_HZ_T * (Kd_col(K) + Kd_col(K+1))
enddo
enddo ! i loop
@@ -461,10 +464,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G,
if ((.not.CS%physical_OBL_scheme) .and. (CS%Kd /= CS%Kd_tot_ml)) then
! This is a crude way to put in a diffusive boundary layer without an explicit boundary
! layer turbulence scheme. It should not be used for any realistic ocean models.
- I_Hmix = 1.0 / (CS%Hmix + GV%H_subroundoff*GV%H_to_Z)
+ I_Hmix = 1.0 / (CS%Hmix + GV%H_subroundoff)
do i=is,ie ; depth(i) = 0.0 ; enddo
do k=1,nz ; do i=is,ie
- depth_c = depth(i) + 0.5*GV%H_to_Z*h(i,j,k)
+ depth_c = depth(i) + 0.5*h(i,j,k)
if (CS%Kd_via_Kdml_bug) then
! These two lines should update Kd_lay, not Kd_int. They were correctly working on the
! same variables until MOM6 commit 7a818716 (PR#750), which was added on March 26, 2018.
@@ -481,7 +484,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G,
endif
endif
- depth(i) = depth(i) + GV%H_to_Z*h(i,j,k)
+ depth(i) = depth(i) + h(i,j,k)
enddo ; enddo
else ! There is no vertical structure to the background diffusivity.
diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
index 66e2dfa6b2..c7e522eddc 100644
--- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
+++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
@@ -3,19 +3,21 @@ module MOM_bulk_mixed_layer
! This file is part of MOM6. See LICENSE.md for the license.
-use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
+use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
use MOM_diag_mediator, only : time_type, diag_ctrl, diag_update_remap_grids
use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
+use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain
+use MOM_EOS, only : average_specific_vol, calculate_density_derivs
+use MOM_EOS, only : calculate_spec_vol, calculate_specific_vol_derivs
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
-use MOM_forcing_type, only : extractFluxes1d, forcing
+use MOM_forcing_type, only : extractFluxes1d, forcing, find_ustar
use MOM_grid, only : ocean_grid_type
use MOM_opacity, only : absorbRemainingSW, optics_type, extract_optics_slice
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
-use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain
implicit none ; private
@@ -53,7 +55,7 @@ module MOM_bulk_mixed_layer
real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2].
real :: mech_TKE_floor !< A tiny floor on the amount of turbulent kinetic energy that is
!! used when the mixed layer does not yet contain HMIX_MIN fluid
- !! [Z L2 T-2 ~> m3 s-2]. The default is so small that its actual
+ !! [H L2 T-2 ~> m3 s-2 or J m-2]. The default is so small that its actual
!! value is irrelevant, but it is detectably greater than 0.
real :: H_limit_fluxes !< When the total ocean depth is less than this
!! value [H ~> m or kg m-2], scale away all surface forcing to
@@ -95,6 +97,8 @@ module MOM_bulk_mixed_layer
!! shortwave radiation is absorbed is corrected by
!! moving some of the heating upward in the water
!! column. The default is false.
+ logical :: nonBous_energetics !< If true, use non-Boussinesq expressions for the energetic
+ !! calculations used in the bulk mixed layer calculations.
logical :: Resolve_Ekman !< If true, the nkml layers in the mixed layer are
!! chosen to optimally represent the impact of the
!! Ekman transport on the mixed layer TKE budget.
@@ -102,7 +106,7 @@ module MOM_bulk_mixed_layer
logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget
logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff
!! at the river mouths to rivermix_depth
- real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true [Z ~> m].
+ real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true [H ~> m or kg m-2].
logical :: limit_det !< If true, limit the extent of buffer layer
!! detrainment to be consistent with neighbors.
real :: lim_det_dH_sfc !< The fractional limit in the change between grid
@@ -125,17 +129,17 @@ module MOM_bulk_mixed_layer
real :: Allowed_S_chg !< The amount by which salinity is allowed
!! to exceed previous values during detrainment [S ~> ppt]
- ! These are terms in the mixed layer TKE budget, all in [Z L2 T-3 ~> m3 s-3] except as noted.
+ ! These are terms in the mixed layer TKE budget, all in [H L2 T-3 ~> m3 s-3 or W m-2] except as noted.
real, allocatable, dimension(:,:) :: &
ML_depth, & !< The mixed layer depth [H ~> m or kg m-2].
- diag_TKE_wind, & !< The wind source of TKE [Z L2 T-3 ~> m3 s-3].
- diag_TKE_RiBulk, & !< The resolved KE source of TKE [Z L2 T-3 ~> m3 s-3].
- diag_TKE_conv, & !< The convective source of TKE [Z L2 T-3 ~> m3 s-3].
- diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating [Z L2 T-3 ~> m3 s-3].
- diag_TKE_mech_decay, & !< The decay of mechanical TKE [Z L2 T-3 ~> m3 s-3].
- diag_TKE_conv_decay, & !< The decay of convective TKE [Z L2 T-3 ~> m3 s-3].
- diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [Z L2 T-3 ~> m3 s-3].
- diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2 [Z L2 T-3 ~> m3 s-3].
+ diag_TKE_wind, & !< The wind source of TKE [H L2 T-3 ~> m3 s-3 or W m-2].
+ diag_TKE_RiBulk, & !< The resolved KE source of TKE [H L2 T-3 ~> m3 s-3 or W m-2].
+ diag_TKE_conv, & !< The convective source of TKE [H L2 T-3 ~> m3 s-3 or W m-2].
+ diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating [H L2 T-3 ~> m3 s-3 or W m-2].
+ diag_TKE_mech_decay, & !< The decay of mechanical TKE [H L2 T-3 ~> m3 s-3 or W m-2].
+ diag_TKE_conv_decay, & !< The decay of convective TKE [H L2 T-3 ~> m3 s-3 or W m-2].
+ diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [H L2 T-3 ~> m3 s-3 or W m-2].
+ diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2 [H L2 T-3 ~> m3 s-3 or W m-2].
diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer
!! detrainment [R Z L2 T-3 ~> W m-2].
diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only
@@ -191,7 +195,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
type(optics_type), pointer :: optics !< The structure that can be queried for the
!! inverse of the vertical absorption decay
!! scale for penetrating shortwave radiation.
- real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m].
+ real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m]
logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and
!! outgoing surface freshwater fluxes are
!! combined before being applied, instead of
@@ -219,6 +223,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
T, & ! The layer temperatures [C ~> degC].
S, & ! The layer salinities [S ~> ppt].
R0, & ! The potential density referenced to the surface [R ~> kg m-3].
+ SpV0, & ! The specific volume referenced to the surface [R-1 ~> m3 kg-1].
Rcv ! The coordinate variable potential density [R ~> kg m-3].
real, dimension(SZI_(G),SZK_(GV)) :: &
u, & ! The zonal velocity [L T-1 ~> m s-1].
@@ -235,15 +240,23 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
ksort ! The sorted k-index that each original layer goes to.
real, dimension(SZI_(G),SZJ_(G)) :: &
h_miss ! The summed absolute mismatch [H ~> m or kg m-2].
+ real, dimension(SZI_(G),SZJ_(G)) :: &
+ U_star_2d, &! The wind friction velocity, calculated using the Boussinesq reference density or
+ ! the time-evolving surface density in non-Boussinesq mode [Z T-1 ~> m s-1]
+ U_star_H_2d ! The wind friction velocity in thickness-based units, calculated
+ ! using the Boussinesq reference density or the time-evolving
+ ! surface density in non-Boussinesq mode [H T-1 ~> m s-1 or kg m-2 s-1]
real, dimension(SZI_(G)) :: &
TKE, & ! The turbulent kinetic energy available for mixing over a
- ! time step [Z L2 T-2 ~> m3 s-2].
+ ! time step [H L2 T-2 ~> m3 s-2 or J m-2].
Conv_En, & ! The turbulent kinetic energy source due to mixing down to
- ! the depth of free convection [Z L2 T-2 ~> m3 s-2].
+ ! the depth of free convection [H L2 T-2 ~> m3 s-2 or J m-2].
htot, & ! The total depth of the layers being considered for
! entrainment [H ~> m or kg m-2].
R0_tot, & ! The integrated potential density referenced to the surface
! of the layers which are fully entrained [H R ~> kg m-2 or kg2 m-5].
+ SpV0_tot, & ! The integrated specific volume referenced to the surface
+ ! of the layers which are fully entrained [H R-1 ~> m4 kg-1 or m].
Rcv_tot, & ! The integrated coordinate value potential density of the
! layers that are fully entrained [H R ~> kg m-2 or kg2 m-5].
Ttot, & ! The integrated temperature of layers which are fully
@@ -268,14 +281,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
! the coordinate variable, set to P_Ref [R L2 T-2 ~> Pa].
dR0_dT, & ! Partial derivative of the mixed layer potential density with
! temperature [R C-1 ~> kg m-3 degC-1].
+ dSpV0_dT, & ! Partial derivative of the mixed layer specific volume with
+ ! temperature [R-1 C-1 ~> m3 kg-1 degC-1].
dRcv_dT, & ! Partial derivative of the coordinate variable potential
! density in the mixed layer with temperature [R C-1 ~> kg m-3 degC-1].
dR0_dS, & ! Partial derivative of the mixed layer potential density with
! salinity [R S-1 ~> kg m-3 ppt-1].
+ dSpV0_dS, & ! Partial derivative of the mixed layer specific volume with
+ ! salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
dRcv_dS, & ! Partial derivative of the coordinate variable potential
! density in the mixed layer with salinity [R S-1 ~> kg m-3 ppt-1].
+ p_sfc, & ! The sea surface pressure [R L2 T-2 ~> Pa]
+ dp_ml, & ! The pressure change across the mixed layer [R L2 T-2 ~> Pa]
+ SpV_ml, & ! The specific volume averaged across the mixed layer [R-1 ~> m3 kg-1]
TKE_river ! The source of turbulent kinetic energy available for mixing
- ! at rivermouths [Z L2 T-3 ~> m3 s-3].
+ ! at rivermouths [H L2 T-3 ~> m3 s-3 or W m-2].
real, dimension(max(CS%nsw,1),SZI_(G)) :: &
Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated
@@ -291,16 +311,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1].
real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1].
real :: RmixConst ! A combination of constants used in the river mixing energy
- ! calculation [L2 T-2 R-2 ~> m8 s-2 kg-2]
+ ! calculation [H L2 Z-1 T-2 R-2 ~> m8 s-2 kg-2 or m5 s-2 kg-1] or
+ ! [H L2 Z-1 T-2 ~> m2 s-2 or kg m-1 s-2]
real, dimension(SZI_(G)) :: &
dKE_FC, & ! The change in mean kinetic energy due to free convection
- ! [Z L2 T-2 ~> m3 s-2].
+ ! [H L2 T-2 ~> m3 s-2 or J m-2].
h_CA ! The depth to which convective adjustment has gone [H ~> m or kg m-2].
real, dimension(SZI_(G),SZK_(GV)) :: &
dKE_CA, & ! The change in mean kinetic energy due to convective
- ! adjustment [Z L2 T-2 ~> m3 s-2].
+ ! adjustment [H L2 T-2 ~> m3 s-2 or J m-2].
cTKE ! The turbulent kinetic energy source due to convective
- ! adjustment [Z L2 T-2 ~> m3 s-2].
+ ! adjustment [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G),SZJ_(G)) :: &
Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers)
! after entrainment but before any buffer layer detrainment [H ~> m or kg m-2].
@@ -319,8 +340,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
real :: dHsfc, dHD ! Local copies of nondimensional parameters [nondim]
real :: H_nbr ! A minimum thickness based on neighboring thicknesses [H ~> m or kg m-2].
- real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1].
- real :: kU_star ! Ustar times the Von Karman constant [Z T-1 ~> m s-1].
+ real :: absf_x_H ! The absolute value of f times the mixed layer thickness [H T-1 ~> m s-1 or kg m-2 s-1].
+ real :: kU_star ! Ustar times the Von Karman constant [H T-1 ~> m s-1 or kg m-2 s-1].
real :: dt__diag ! A rescaled copy of dt_diag (if present) or dt [T ~> s].
logical :: write_diags ! If true, write out diagnostics with this step.
logical :: reset_diags ! If true, zero out the accumulated diagnostics.
@@ -337,8 +358,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, &
"MOM_mixed_layer: Temperature, salinity and an equation of state "//&
"must now be used.")
- if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, &
- "MOM_mixed_layer: No surface TKE fluxes (ustar) defined in mixedlayer!")
+ if (.not. (associated(fluxes%ustar) .or. associated(fluxes%tau_mag))) call MOM_error(FATAL, &
+ "MOM_mixed_layer: No surface TKE fluxes (ustar or tau_mag) defined in mixedlayer!")
nkmb = CS%nkml+CS%nkbl
Inkml = 1.0 / REAL(CS%nkml)
@@ -412,11 +433,16 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
max_BL_det(:) = -1
EOSdom(:) = EOS_domain(G%HI)
+ ! Extract the friction velocity from the forcing type.
+ call find_ustar(fluxes, tv, U_star_2d, G, GV, US)
+ if (CS%Resolve_Ekman .and. (CS%nkml>1)) &
+ call find_ustar(fluxes, tv, U_star_H_2d, G, GV, US, H_T_units=.true.)
+
!$OMP parallel default(shared) firstprivate(dKE_CA,cTKE,h_CA,max_BL_det,p_ref,p_ref_cv) &
- !$OMP private(h,u,v,h_orig,eps,T,S,opacity_band,d_ea,d_eb,R0,Rcv,ksort, &
- !$OMP dR0_dT,dR0_dS,dRcv_dT,dRcv_dS,htot,Ttot,Stot,TKE,Conv_en, &
+ !$OMP private(h,u,v,h_orig,eps,T,S,opacity_band,d_ea,d_eb,R0,SpV0,Rcv,ksort, &
+ !$OMP dR0_dT,dR0_dS,dRcv_dT,dRcv_dS,dSpV0_dT,dSpV0_dS,htot,Ttot,Stot,TKE,Conv_en, &
!$OMP RmixConst,TKE_river,Pen_SW_bnd,netMassInOut,NetMassOut, &
- !$OMP Net_heat,Net_salt,uhtot,vhtot,R0_tot,Rcv_tot,dKE_FC, &
+ !$OMP Net_heat,Net_salt,uhtot,vhtot,R0_tot,Rcv_tot,SpV0_tot,dKE_FC, &
!$OMP Idecay_len_TKE,cMKE,Hsfc,dHsfc,dHD,H_nbr,kU_Star, &
!$OMP absf_x_H,ebml,eaml)
!$OMP do
@@ -428,7 +454,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H
T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k)
enddo ; enddo
- if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_Z)
+ if (nsw>0) then
+ if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then
+ call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_Z)
+ else
+ call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_RZ, &
+ SpV_avg=tv%SpV_avg)
+ endif
+ endif
do k=1,nz ; do i=is,ie
d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0
@@ -443,26 +476,35 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
do k=1,CS%nkml ; do i=is,ie
p_ref(i) = p_ref(i) + 0.5*(GV%H_to_RZ*GV%g_Earth)*h(i,k)
enddo ; enddo
- call calculate_density_derivs(T(:,1), S(:,1), p_ref, dR0_dT, dR0_dS, tv%eqn_of_state, EOSdom)
+ if (CS%nonBous_energetics) then
+ call calculate_specific_vol_derivs(T(:,1), S(:,1), p_ref, dSpV0_dT, dSpV0_dS, tv%eqn_of_state, EOSdom)
+ do k=1,nz
+ call calculate_spec_vol(T(:,k), S(:,k), p_ref, SpV0(:,k), tv%eqn_of_state, EOSdom)
+ enddo
+ else
+ call calculate_density_derivs(T(:,1), S(:,1), p_ref, dR0_dT, dR0_dS, tv%eqn_of_state, EOSdom)
+ do k=1,nz
+ call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), tv%eqn_of_state, EOSdom)
+ enddo
+ endif
call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, EOSdom)
do k=1,nz
- call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), tv%eqn_of_state, EOSdom)
call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom)
enddo
if (CS%ML_resort) then
if (CS%ML_presort_nz_conv_adj > 0) &
- call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, &
+ call convective_adjustment(h, u, v, R0, SpV0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, &
US, CS, CS%ML_presort_nz_conv_adj)
- call sort_ML(h, R0, eps, G, GV, CS, ksort)
+ call sort_ML(h, R0, SpV0, eps, G, GV, CS, ksort)
else
do k=1,nz ; do i=is,ie ; ksort(i,k) = k ; enddo ; enddo
! Undergo instantaneous entrainment into the buffer layers and mixed layers
! to remove hydrostatic instabilities. Any water that is lighter than
! currently in the mixed or buffer layer is entrained.
- call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS)
+ call convective_adjustment(h, u, v, R0, SpV0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS)
do i=is,ie ; h_CA(i) = h(i,1) ; enddo
endif
@@ -472,18 +514,26 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
! Here we add an additional source of TKE to the mixed layer where river
! is present to simulate unresolved estuaries. The TKE input is diagnosed
! as follows:
- ! TKE_river[Z L2 T-3 ~> m3 s-3] = 0.5*rivermix_depth * g * Irho0**2 * drho_ds *
+ ! TKE_river[H L2 T-3 ~> m3 s-3] = 0.5*rivermix_depth * g * Irho0**2 * drho_ds *
! River*(Samb - Sriver) = CS%mstar*U_star^3
! where River is in units of [R Z T-1 ~> kg m-2 s-1].
! Samb = Ambient salinity at the mouth of the estuary
! rivermix_depth = The prescribed depth over which to mix river inflow
! drho_ds = The gradient of density wrt salt at the ambient surface salinity.
! Sriver = 0 (i.e. rivers are assumed to be pure freshwater)
- RmixConst = 0.5*CS%rivermix_depth * GV%g_Earth * Irho0**2
- do i=is,ie
- TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* &
- (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1))
- enddo
+ if (CS%nonBous_energetics) then
+ RmixConst = -0.5*CS%rivermix_depth * GV%g_Earth
+ do i=is,ie
+ TKE_river(i) = max(0.0, RmixConst * dSpV0_dS(i) * &
+ (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1))
+ enddo
+ else
+ RmixConst = 0.5*CS%rivermix_depth * GV%g_Earth * Irho0**2
+ do i=is,ie
+ TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* &
+ (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1))
+ enddo
+ endif
else
do i=is,ie ; TKE_river(i) = 0.0 ; enddo
endif
@@ -501,8 +551,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
tv, aggregate_FW_forcing)
! This subroutine causes the mixed layer to entrain to depth of free convection.
- call mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, R0_tot, Rcv_tot, &
- u, v, T, S, R0, Rcv, eps, dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, &
+ call mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, R0_tot, SpV0_tot, Rcv_tot, &
+ u, v, T, S, R0, SpV0, Rcv, eps, dR0_dT, dSpV0_dT, dRcv_dT, dR0_dS, dSpV0_dS, dRcv_dS, &
netMassInOut, netMassOut, Net_heat, Net_salt, &
nsw, Pen_SW_bnd, opacity_band, Conv_En, dKE_FC, &
j, ksort, G, GV, US, CS, tv, fluxes, dt, aggregate_FW_forcing)
@@ -513,15 +563,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
! First the TKE at the depth of free convection that is available
! to drive mixing is calculated.
- call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, &
- TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, &
+ call find_starting_TKE(htot, h_CA, fluxes, U_star_2d, Conv_En, cTKE, dKE_FC, dKE_CA, &
+ TKE, TKE_river, Idecay_len_TKE, cMKE, tv, dt, Idt_diag, &
j, ksort, G, GV, US, CS)
! Here the mechanically driven entrainment occurs.
call mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
- R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, dR0_dT, dRcv_dT, &
- cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, &
- Idecay_len_TKE, j, ksort, G, GV, US, CS)
+ R0_tot, SpV0_tot, Rcv_tot, u, v, T, S, R0, SpV0, Rcv, eps, &
+ dR0_dT, dSpV0_dT, dRcv_dT, cMKE, Idt_diag, nsw, Pen_SW_bnd, &
+ opacity_band, TKE, Idecay_len_TKE, j, ksort, G, GV, US, CS)
call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, optics, j, dt, &
CS%H_limit_fluxes, CS%correct_absorption, CS%absorb_all_SW, &
@@ -534,19 +584,46 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
! Calculate the homogeneous mixed layer properties and store them in layer 0.
do i=is,ie ; if (htot(i) > 0.0) then
Ih = 1.0 / htot(i)
- R0(i,0) = R0_tot(i) * Ih ; Rcv(i,0) = Rcv_tot(i) * Ih
+ if (CS%nonBous_energetics) then
+ SpV0(i,0) = SpV0_tot(i) * Ih
+ else
+ R0(i,0) = R0_tot(i) * Ih
+ endif
+ Rcv(i,0) = Rcv_tot(i) * Ih
T(i,0) = Ttot(i) * Ih ; S(i,0) = Stot(i) * Ih
h(i,0) = htot(i)
else ! This may not ever be needed?
- T(i,0) = T(i,1) ; S(i,0) = S(i,1) ; R0(i,0) = R0(i,1) ; Rcv(i,0) = Rcv(i,1)
+ T(i,0) = T(i,1) ; S(i,0) = S(i,1) ; Rcv(i,0) = Rcv(i,1)
+ if (CS%nonBous_energetics) then
+ SpV0(i,0) = SpV0(i,1)
+ else
+ R0(i,0) = R0(i,1)
+ endif
h(i,0) = htot(i)
endif ; enddo
if (write_diags .and. allocated(CS%ML_depth)) then ; do i=is,ie
CS%ML_depth(i,j) = h(i,0) ! Store the diagnostic.
enddo ; endif
- if (associated(Hml)) then ; do i=is,ie
- Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_Z) ! Rescale the diagnostic for output.
- enddo ; endif
+
+ if (associated(Hml)) then
+ ! Return the mixed layerd depth in [Z ~> m].
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do i=is,ie
+ Hml(i,j) = G%mask2dT(i,j) * GV%H_to_Z*h(i,0)
+ enddo
+ else
+ do i=is,ie ; dp_ml(i) = GV%g_Earth * GV%H_to_RZ * h(i,0) ; enddo
+ if (associated(tv%p_surf)) then
+ do i=is,ie ; p_sfc(i) = tv%p_surf(i,j) ; enddo
+ else
+ do i=is,ie ; p_sfc(i) = 0.0 ; enddo
+ endif
+ call average_specific_vol(T(:,0), S(:,0), p_sfc, dp_ml, SpV_ml, tv%eqn_of_state)
+ do i=is,ie
+ Hml(i,j) = G%mask2dT(i,j) * GV%H_to_RZ * SpV_ml(i) * h(i,0)
+ enddo
+ endif
+ endif
! At this point, return water to the original layers, but constrained to
! still be sorted. After this point, all the water that is in massive
@@ -559,8 +636,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
! these unused layers (but not currently in the code).
if (CS%ML_resort) then
- call resort_ML(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), GV%Rlay(:), eps, &
- d_ea, d_eb, ksort, G, GV, CS, dR0_dT, dR0_dS, dRcv_dT, dRcv_dS)
+ call resort_ML(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), SpV0(:,0:), Rcv(:,0:), GV%Rlay(:), eps, &
+ d_ea, d_eb, ksort, G, GV, CS, dR0_dT, dR0_dS, dSpV0_dT, dSpV0_dS, dRcv_dT, dRcv_dS)
endif
if (CS%limit_det .or. (CS%id_Hsfc_max > 0) .or. (CS%id_Hsfc_min > 0)) then
@@ -592,13 +669,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
! from the buffer layer into the interior. These steps might best be
! treated in conjunction.
if (CS%nkbl == 1) then
- call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), &
+ call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), SpV0(:,0:), Rcv(:,0:), &
GV%Rlay(:), dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, &
dRcv_dT, dRcv_dS, max_BL_det)
elseif (CS%nkbl == 2) then
- call mixedlayer_detrain_2(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), &
+ call mixedlayer_detrain_2(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), SpV0(:,0:), Rcv(:,0:), &
GV%Rlay(:), dt, dt__diag, d_ea, j, G, GV, US, CS, &
- dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det)
+ dR0_dT, dR0_dS, dSpV0_dT, dSpV0_dS, dRcv_dT, dRcv_dS, max_BL_det)
else ! CS%nkbl not = 1 or 2
! This code only works with 1 or 2 buffer layers.
call MOM_error(FATAL, "MOM_mixed_layer: CS%nkbl must be 1 or 2 for now.")
@@ -622,14 +699,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C
! as the third piece will then optimally describe mixed layer
! restratification. For nkml>=4 the whole strategy should be revisited.
do i=is,ie
- kU_star = CS%vonKar*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*?
- if (associated(fluxes%ustar_shelf) .and. &
- associated(fluxes%frac_shelf_h)) then
- if (fluxes%frac_shelf_h(i,j) > 0.0) &
- kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + &
- fluxes%frac_shelf_h(i,j) * (CS%vonKar*fluxes%ustar_shelf(i,j))
+ ! Perhaps in the following, u* could be replaced with u*+w*?
+ kU_star = CS%vonKar * U_star_H_2d(i,j)
+ if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
+ if (fluxes%frac_shelf_h(i,j) > 0.0) then
+ if (allocated(tv%SpV_avg)) then
+ kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + &
+ fluxes%frac_shelf_h(i,j) * ((CS%vonKar*fluxes%ustar_shelf(i,j)) / &
+ (GV%H_to_RZ * tv%SpV_avg(i,j,1)))
+ else
+ kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + &
+ fluxes%frac_shelf_h(i,j) * (CS%vonKar*GV%Z_to_H*fluxes%ustar_shelf(i,j))
+ endif
+ endif
endif
- absf_x_H = 0.25 * GV%H_to_Z * h(i,0) * &
+ absf_x_H = 0.25 * h(i,0) * &
((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + &
(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J))))
! If the mixed layer vertical viscosity specification is changed in
@@ -750,7 +834,7 @@ end subroutine bulkmixedlayer
!> This subroutine does instantaneous convective entrainment into the buffer
!! layers and mixed layers to remove hydrostatic instabilities. Any water that
!! is lighter than currently in the mixed- or buffer- layer is entrained.
-subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
+subroutine convective_adjustment(h, u, v, R0, SpV0, Rcv, T, S, eps, d_eb, &
dKE_CA, cTKE, j, G, GV, US, CS, nz_conv)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -762,6 +846,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
!! points [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to
!! surface pressure [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: SpV0 !< Specific volume referenced to
+ !! surface pressure [R-1 ~> m3 kg-1].
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential
!! density [R ~> kg m-3].
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [C ~> degC].
@@ -774,10 +860,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
!! a layer.
real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in
!! kinetic energy due to convective
- !! adjustment [Z L2 T-2 ~> m3 s-2].
+ !! adjustment [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy
!! source due to convective adjustment
- !! [Z L2 T-2 ~> m3 s-2].
+ !! [H L2 T-2 ~> m3 s-2 or J m-2].
integer, intent(in) :: j !< The j-index to work on.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure
@@ -789,6 +875,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
real, dimension(SZI_(G)) :: &
R0_tot, & ! The integrated potential density referenced to the surface
! of the layers which are fully entrained [H R ~> kg m-2 or kg2 m-5].
+ SpV0_tot, & ! The integrated specific volume referenced to the surface
+ ! of the layers which are fully entrained [H R-1 ~> m4 kg-1 or m].
Rcv_tot, & ! The integrated coordinate value potential density of the
! layers that are fully entrained [H R ~> kg m-2 or kg2 m-5].
Ttot, & ! The integrated temperature of layers which are fully
@@ -802,13 +890,14 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2].
real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2].
real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1].
- real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of
+ real :: g_H_2Rho0 ! Half the gravitational acceleration times
! the conversion from H to Z divided by the mean density,
- ! in [L2 Z T-3 H-2 R-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3].
+ ! in [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2].
+ logical :: unstable
integer :: is, ie, nz, i, k, k1, nzc, nkmb
is = G%isc ; ie = G%iec ; nz = GV%ke
- g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0)
+ g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0)
nzc = nz ; if (present(nz_conv)) nzc = nz_conv
nkmb = CS%nkml+CS%nkbl
@@ -820,7 +909,11 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
h_orig_k1(i) = h(i,k1)
KE_orig(i) = 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2)
uhtot(i) = h(i,k1)*u(i,k1) ; vhtot(i) = h(i,k1)*v(i,k1)
- R0_tot(i) = R0(i,k1) * h(i,k1)
+ if (CS%nonBous_energetics) then
+ SpV0_tot(i) = SpV0(i,k1) * h(i,k1)
+ else
+ R0_tot(i) = R0(i,k1) * h(i,k1)
+ endif
cTKE(i,k1) = 0.0 ; dKE_CA(i,k1) = 0.0
Rcv_tot(i) = Rcv(i,k1) * h(i,k1)
@@ -828,15 +921,28 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
enddo
do k=k1+1,nzc
do i=is,ie
- if ((h(i,k) > eps(i,k)) .and. (R0_tot(i) > h(i,k1)*R0(i,k))) then
+ if (CS%nonBous_energetics) then
+ unstable = (SpV0_tot(i) < h(i,k1)*SpV0(i,k))
+ else
+ unstable = (R0_tot(i) > h(i,k1)*R0(i,k))
+ endif
+ if ((h(i,k) > eps(i,k)) .and. unstable) then
h_ent = h(i,k)-eps(i,k)
- cTKE(i,k1) = cTKE(i,k1) + h_ent * g_H2_2Rho0 * &
- (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2
+ if (CS%nonBous_energetics) then
+ ! This and the other energy calculations assume that specific volume is
+ ! conserved during mixing, which ignores certain thermobaric contributions.
+ cTKE(i,k1) = cTKE(i,k1) + 0.5 * h_ent * (GV%g_Earth * GV%H_to_RZ) * &
+ (h(i,k1)*SpV0(i,k) - SpV0_tot(i)) * CS%nstar2
+ SpV0_tot(i) = SpV0_tot(i) + h_ent * SpV0(i,k)
+ else
+ cTKE(i,k1) = cTKE(i,k1) + h_ent * g_H_2Rho0 * &
+ (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2
+ R0_tot(i) = R0_tot(i) + h_ent * R0(i,k)
+ endif
if (k < nkmb) then
cTKE(i,k1) = cTKE(i,k1) + cTKE(i,k)
dKE_CA(i,k1) = dKE_CA(i,k1) + dKE_CA(i,k)
endif
- R0_tot(i) = R0_tot(i) + h_ent * R0(i,k)
KE_orig(i) = KE_orig(i) + 0.5*h_ent* &
(u(i,k)*u(i,k) + v(i,k)*v(i,k))
uhtot(i) = uhtot(i) + h_ent*u(i,k)
@@ -856,10 +962,14 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
! layer in question, if it has entrained.
do i=is,ie ; if (h(i,k1) > h_orig_k1(i)) then
Ih = 1.0 / h(i,k1)
- R0(i,k1) = R0_tot(i) * Ih
+ if (CS%nonBous_energetics) then
+ SpV0(i,k1) = SpV0_tot(i) * Ih
+ else
+ R0(i,k1) = R0_tot(i) * Ih
+ endif
u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih
- dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * &
- (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2)))
+ dKE_CA(i,k1) = dKE_CA(i,k1) + CS%bulk_Ri_convective * &
+ (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))
Rcv(i,k1) = Rcv_tot(i) * Ih
T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih
endif ; enddo
@@ -867,7 +977,11 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, &
! If lower mixed or buffer layers are massless, give them the properties of the
! layer above.
do k=2,min(nzc,nkmb) ; do i=is,ie ; if (h(i,k) == 0.0) then
- R0(i,k) = R0(i,k-1)
+ if (CS%nonBous_energetics) then
+ SpV0(i,k) = SpV0(i,k-1)
+ else
+ R0(i,k) = R0(i,k-1)
+ endif
Rcv(i,k) = Rcv(i,k-1) ; T(i,k) = T(i,k-1) ; S(i,k) = S(i,k-1)
endif ; enddo ; enddo
@@ -877,8 +991,8 @@ end subroutine convective_adjustment
!! convection. The depth of free convection is the shallowest depth at which the
!! fluid is denser than the average of the fluid above.
subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
- R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, &
- dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, &
+ R0_tot, SpV0_tot, Rcv_tot, u, v, T, S, R0, SpV0, Rcv, eps, &
+ dR0_dT, dSpV0_dT, dRcv_dT, dR0_dS, dSpV0_dS, dRcv_dS, &
netMassInOut, netMassOut, Net_heat, Net_salt, &
nsw, Pen_SW_bnd, opacity_band, Conv_En, &
dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt, &
@@ -903,6 +1017,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
!! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential density referenced
!! to 0 pressure [H R ~> kg m-2 or kg2 m-5].
+ real, dimension(SZI_(G)), intent(out) :: SpV0_tot !< The integrated mixed layer specific volume referenced
+ !! to 0 pressure [H R-1 ~> m4 kg-1 or m].
real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate
!! variable potential density [H R ~> kg m-2 or kg2 m-5].
real, dimension(SZI_(G),SZK_(GV)), &
@@ -916,6 +1032,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
real, dimension(SZI_(G),SZK0_(GV)), &
intent(in) :: R0 !< Potential density referenced to
!! surface pressure [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK0_(GV)), &
+ intent(in) :: SpV0 !< Specific volume referenced to
+ !! surface pressure [R-1 ~> m3 kg-1].
real, dimension(SZI_(G),SZK0_(GV)), &
intent(in) :: Rcv !< The coordinate defining potential
!! density [R ~> kg m-3].
@@ -924,10 +1043,14 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
!! that will be left in each layer [H ~> m or kg m-2].
real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to
!! temperature [R C-1 ~> kg m-3 degC-1].
+ real, dimension(SZI_(G)), intent(in) :: dSpV0_dT !< The partial derivative of SpV0 with respect to
+ !! temperature [R-1 C-1 ~> m3 kg-1 degC-1].
real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to
!! temperature [R C-1 ~> kg m-3 degC-1].
real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of R0 with respect to
!! salinity [R S-1 ~> kg m-3 ppt-1].
+ real, dimension(SZI_(G)), intent(in) :: dSpV0_dS !< The partial derivative of SpV0 with respect to
+ !! salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of Rcv with respect to
!! salinity [R S-1 ~> kg m-3 ppt-1].
real, dimension(SZI_(G)), intent(in) :: netMassInOut !< The net mass flux (if non-Boussinesq)
@@ -948,9 +1071,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of
!! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1].
real, dimension(SZI_(G)), intent(out) :: Conv_En !< The buoyant turbulent kinetic energy source
- !! due to free convection [Z L2 T-2 ~> m3 s-2].
+ !! due to free convection [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic
- !! energy due to free convection [Z L2 T-2 ~> m3 s-2].
+ !! energy due to free convection [H L2 T-2 ~> m3 s-2 or J m-2].
integer, intent(in) :: j !< The j-index to work on.
integer, dimension(SZI_(G),SZK_(GV)), &
intent(in) :: ksort !< The density-sorted k-indices.
@@ -986,7 +1109,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
real :: T_precip ! The temperature of the precipitation [C ~> degC].
real :: C1_3, C1_6 ! 1/3 and 1/6 [nondim]
real :: En_fn, Frac, x1 ! Nondimensional temporary variables [nondim].
- real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5].
+ real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5] or [R-1 H ~> m4 kg-1 or m].
real :: dr_ent, dr_comp ! Temporary variables [R H ~> kg m-2 or kg2 m-5].
real :: dr_dh ! The partial derivative of dr_ent with h_ent [R ~> kg m-3].
real :: h_min, h_max ! The minimum and maximum estimates for h_ent [H ~> m or kg m-2]
@@ -994,9 +1117,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
real :: h_evap ! The thickness that is evaporated [H ~> m or kg m-2].
real :: dh_Newt ! The Newton's method estimate of the change in
! h_ent between iterations [H ~> m or kg m-2].
- real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of
+ real :: g_H_2Rho0 ! Half the gravitational acceleration times
! the conversion from H to Z divided by the mean density,
- ! [L2 Z T-3 H-2 R-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3].
+ ! [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2].
real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2].
real :: opacity ! The opacity converted to inverse thickness units [H-1 ~> m-1 or m2 kg-1]
real :: sum_Pen_En ! The potential energy change due to penetrating
@@ -1010,7 +1133,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
Angstrom = GV%Angstrom_H
C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0
- g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0)
+ g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0)
Idt = 1.0 / dt
is = G%isc ; ie = G%iec ; nz = GV%ke
@@ -1054,10 +1177,17 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
Stot(i) = h_ent*S(i,k) + Net_salt(i)
uhtot(i) = u(i,1)*netMassIn(i) + u(i,k)*h_ent
vhtot(i) = v(i,1)*netMassIn(i) + v(i,k)*h_ent
- R0_tot(i) = (h_ent*R0(i,k) + netMassIn(i)*R0(i,1)) + &
+ if (CS%nonBous_energetics) then
+ SpV0_tot(i) = (h_ent*SpV0(i,k) + netMassIn(i)*SpV0(i,1)) + &
+! dSpV0_dT(i)*netMassIn(i)*(T_precip - T(i,1)) + &
+ (dSpV0_dT(i)*(Net_heat(i) + Pen_absorbed) - &
+ dSpV0_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i)))
+ else
+ R0_tot(i) = (h_ent*R0(i,k) + netMassIn(i)*R0(i,1)) + &
! dR0_dT(i)*netMassIn(i)*(T_precip - T(i,1)) + &
(dR0_dT(i)*(Net_heat(i) + Pen_absorbed) - &
dR0_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i)))
+ endif
Rcv_tot(i) = (h_ent*Rcv(i,k) + netMassIn(i)*Rcv(i,1)) + &
! dRcv_dT(i)*netMassIn(i)*(T_precip - T(i,1)) + &
(dRcv_dT(i)*(Net_heat(i) + Pen_absorbed) - &
@@ -1069,7 +1199,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + &
T_precip * netMassIn(i) * GV%H_to_RZ
else ! This is a massless column, but zero out the summed variables anyway for safety.
- htot(i) = 0.0 ; Ttot(i) = 0.0 ; Stot(i) = 0.0 ; R0_tot(i) = 0.0 ; Rcv_tot = 0.0
+ htot(i) = 0.0 ; Ttot(i) = 0.0 ; Stot(i) = 0.0 ; Rcv_tot = 0.0
+ R0_tot(i) = 0.0 ; SpV0_tot(i) = 0.0
uhtot(i) = 0.0 ; vhtot(i) = 0.0 ; Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0
endif ; enddo
@@ -1087,7 +1218,11 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
h(i,k) = h(i,k) - h_ent
d_eb(i,k) = d_eb(i,k) - h_ent
- R0_tot(i) = R0_tot(i) + h_ent*R0(i,k)
+ if (CS%nonBous_energetics) then
+ SpV0_tot(i) = SpV0_tot(i) + h_ent*SpV0(i,k)
+ else
+ R0_tot(i) = R0_tot(i) + h_ent*R0(i,k)
+ endif
uhtot(i) = uhtot(i) + h_ent*u(i,k)
vhtot(i) = vhtot(i) + h_ent*v(i,k)
@@ -1111,7 +1246,11 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
endif
Stot(i) = Stot(i) + h_evap*S(i,k)
- R0_tot(i) = R0_tot(i) + dR0_dS(i)*h_evap*S(i,k)
+ if (CS%nonBous_energetics) then
+ SpV0_tot(i) = SpV0_tot(i) + dSpV0_dS(i)*h_evap*S(i,k)
+ else
+ R0_tot(i) = R0_tot(i) + dR0_dS(i)*h_evap*S(i,k)
+ endif
Rcv_tot(i) = Rcv_tot(i) + dRcv_dS(i)*h_evap*S(i,k)
d_eb(i,k) = d_eb(i,k) - h_evap
@@ -1130,14 +1269,25 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
! The following section calculates how much fluid will be entrained.
h_avail = h(i,k) - eps(i,k)
if (h_avail > 0.0) then
- dr = R0_tot(i) - htot(i)*R0(i,k)
h_ent = 0.0
- dr0 = dr
- do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then
- dr0 = dr0 - (dR0_dT(i)*Pen_SW_bnd(n,i)) * &
- opacity_band(n,i,k)*htot(i)
- endif ; enddo
+ if (CS%nonBous_energetics) then
+ dr = htot(i)*SpV0(i,k) - SpV0_tot(i)
+
+ dr0 = dr
+ do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then
+ dr0 = dr0 + (dSpV0_dT(i)*Pen_SW_bnd(n,i)) * &
+ opacity_band(n,i,k)*htot(i)
+ endif ; enddo
+ else
+ dr = R0_tot(i) - htot(i)*R0(i,k)
+
+ dr0 = dr
+ do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then
+ dr0 = dr0 - (dR0_dT(i)*Pen_SW_bnd(n,i)) * &
+ opacity_band(n,i,k)*htot(i)
+ endif ; enddo
+ endif
! Some entrainment will occur from this layer.
if (dr0 > 0.0) then
@@ -1147,8 +1297,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
! density averaged over the mixed layer and that layer.
opacity = opacity_band(n,i,k)
SW_trans = exp(-h_avail*opacity)
- dr_comp = dr_comp + (dR0_dT(i)*Pen_SW_bnd(n,i)) * &
- ((1.0 - SW_trans) - opacity*(htot(i)+h_avail)*SW_trans)
+ if (CS%nonBous_energetics) then
+ dr_comp = dr_comp - (dSpV0_dT(i)*Pen_SW_bnd(n,i)) * &
+ ((1.0 - SW_trans) - opacity*(htot(i)+h_avail)*SW_trans)
+ else
+ dr_comp = dr_comp + (dR0_dT(i)*Pen_SW_bnd(n,i)) * &
+ ((1.0 - SW_trans) - opacity*(htot(i)+h_avail)*SW_trans)
+ endif
endif ; enddo
if (dr_comp >= 0.0) then
! The entire layer is entrained.
@@ -1165,7 +1320,11 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
h_min = 0.0 ; h_max = h_avail
do n=1,nsw
- r_SW_top(n) = dR0_dT(i) * Pen_SW_bnd(n,i)
+ if (CS%nonBous_energetics) then
+ r_SW_top(n) = -dSpV0_dT(i) * Pen_SW_bnd(n,i)
+ else
+ r_SW_top(n) = dR0_dT(i) * Pen_SW_bnd(n,i)
+ endif
C2(n) = r_SW_top(n) * opacity_band(n,i,k)**2
enddo
do itt=1,10
@@ -1212,27 +1371,40 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
En_fn = ((opacity*htot(i) + 2.0) * &
((1.0-SW_trans) / x1) - 1.0 + SW_trans)
endif
- sum_Pen_En = sum_Pen_En - (dR0_dT(i)*Pen_SW_bnd(n,i)) * En_fn
+ if (CS%nonBous_energetics) then
+ sum_Pen_En = sum_Pen_En + (dSpV0_dT(i)*Pen_SW_bnd(n,i)) * En_fn
+ else
+ sum_Pen_En = sum_Pen_En - (dR0_dT(i)*Pen_SW_bnd(n,i)) * En_fn
+ endif
Pen_absorbed = Pen_absorbed + Pen_SW_bnd(n,i) * (1.0 - SW_trans)
Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans
endif ; enddo
- Conv_En(i) = Conv_En(i) + g_H2_2Rho0 * h_ent * &
- ( (R0_tot(i) - R0(i,k)*htot(i)) + sum_Pen_En )
+ if (CS%nonBous_energetics) then
+ ! This and the other energy calculations assume that specific volume is
+ ! conserved during mixing, which ignores certain thermobaric contributions.
+ Conv_En(i) = Conv_En(i) + 0.5 * (GV%g_Earth * GV%H_to_RZ) * h_ent * &
+ ( (SpV0(i,k)*htot(i) - SpV0_tot(i)) + sum_Pen_En )
+ SpV0_tot(i) = SpV0_tot(i) + (h_ent * SpV0(i,k) + Pen_absorbed*dSpV0_dT(i))
+ else
+ Conv_En(i) = Conv_En(i) + g_H_2Rho0 * h_ent * &
+ ( (R0_tot(i) - R0(i,k)*htot(i)) + sum_Pen_En )
+ R0_tot(i) = R0_tot(i) + (h_ent * R0(i,k) + Pen_absorbed*dR0_dT(i))
+ endif
- R0_tot(i) = R0_tot(i) + (h_ent * R0(i,k) + Pen_absorbed*dR0_dT(i))
Stot(i) = Stot(i) + h_ent * S(i,k)
Ttot(i) = Ttot(i) + (h_ent * T(i,k) + Pen_absorbed)
Rcv_tot(i) = Rcv_tot(i) + (h_ent * Rcv(i,k) + Pen_absorbed*dRcv_dT(i))
endif ! dr0 > 0.0
- if (h_ent > 0.0) then
- if (htot(i) > 0.0) &
+
+ if ((h_ent > 0.0) .and. (htot(i) > 0.0)) &
dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * &
- ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * &
+ ((h_ent) / (htot(i)*(h_ent+htot(i)))) * &
((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2)
+ if (h_ent > 0.0) then
htot(i) = htot(i) + h_ent
h(i,k) = h(i,k) - h_ent
d_eb(i,k) = d_eb(i,k) - h_ent
@@ -1243,7 +1415,6 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
endif
endif
-
endif ! h_avail>0
endif ; enddo ! i loop
enddo ! k loop
@@ -1252,8 +1423,8 @@ end subroutine mixedlayer_convection
!> This subroutine determines the TKE available at the depth of free
!! convection to drive mechanical entrainment.
-subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, &
- TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, &
+subroutine find_starting_TKE(htot, h_CA, fluxes, U_star_2d, Conv_En, cTKE, dKE_FC, dKE_CA, &
+ TKE, TKE_river, Idecay_len_TKE, cMKE, tv, dt, Idt_diag, &
j, ksort, G, GV, US, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -1265,29 +1436,35 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
type(forcing), intent(in) :: fluxes !< A structure containing pointers to any
!! possible forcing fields. Unused fields
!! have NULL pointers.
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: U_star_2d !< The wind friction velocity, calculated
+ !! using the Boussinesq reference density or
+ !! the time-evolving surface density in
+ !! non-Boussinesq mode [Z T-1 ~> m s-1]
real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source
- !! due to free convection [Z L2 T-2 ~> m3 s-2].
+ !! due to free convection [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in
!! kinetic energy due to free convection
- !! [Z L2 T-2 ~> m3 s-2].
+ !! [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G),SZK_(GV)), &
intent(in) :: cTKE !< The buoyant turbulent kinetic energy
!! source due to convective adjustment
- !! [Z L2 T-2 ~> m3 s-2].
+ !! [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G),SZK_(GV)), &
intent(in) :: dKE_CA !< The vertically integrated change in
!! kinetic energy due to convective
- !! adjustment [Z L2 T-2 ~> m3 s-2].
+ !! adjustment [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for
- !! mixing over a time step [Z L2 T-2 ~> m3 s-2].
+ !! mixing over a time step [H L2 T-2 ~> m3 s-2 or J m-2]
real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay
!! scale for TKE [H-1 ~> m-1 or m2 kg-1].
real, dimension(SZI_(G)), intent(in) :: TKE_river !< The source of turbulent kinetic energy
!! available for driving mixing at river mouths
- !! [Z L2 T-3 ~> m3 s-3].
+ !! [H L2 T-3 ~> m3 s-3 or W m-2].
real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in
!! calculating the denominator of MKE_rate,
!! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2].
+ type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any
+ !! available thermodynamic fields.
real, intent(in) :: dt !< The time step [T ~> s].
real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic
!! time interval [T-1 ~> s-1].
@@ -1300,24 +1477,26 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
! convection to drive mechanical entrainment.
! Local variables
- real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z L2 T-2 ~> m3 s-2].
+ real :: dKE_conv ! The change in mean kinetic energy due to all convection [H L2 T-2 ~> m3 s-2 or J m-2].
real :: nstar_FC ! The effective efficiency with which the energy released by
! free convection is converted to TKE, often ~0.2 [nondim].
real :: nstar_CA ! The effective efficiency with which the energy released by
! convective adjustment is converted to TKE, often ~0.2 [nondim].
real :: TKE_CA ! The potential energy released by convective adjustment if
- ! that release is positive [Z L2 T-2 ~> m3 s-2].
+ ! that release is positive [H L2 T-2 ~> m3 s-2 or J m-2].
real :: MKE_rate_CA ! MKE_rate for convective adjustment [nondim], 0 to 1.
real :: MKE_rate_FC ! MKE_rate for free convection [nondim], 0 to 1.
- real :: totEn_Z ! The total potential energy released by convection, [Z3 T-2 ~> m3 s-2].
+ real :: totEn_Z ! The total potential energy released by convection, [H Z2 T-2 ~> m3 s-2 or J m-2].
real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1].
real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim].
real :: absf ! The absolute value of f averaged to thickness points [T-1 ~> s-1].
real :: U_star ! The friction velocity [Z T-1 ~> m s-1].
- real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1].
- real :: wind_TKE_src ! The surface wind source of TKE [Z L2 T-3 ~> m3 s-3].
+ real :: absf_Ustar ! The absolute value of f divided by U_star converted to thickness units [H-1 ~> m-1 or m2 kg-1]
+ real :: wind_TKE_src ! The surface wind source of TKE [H L2 T-3 ~> m3 s-3 or W m-2].
real :: diag_wt ! The ratio of the current timestep to the diagnostic
! timestep (which may include 2 calls) [nondim].
+ real :: H_to_Z ! The thickness to depth conversion factor, which in non-Boussinesq mode is
+ ! based on the layer-averaged specific volume [Z H-1 ~> nondim or m3 kg-1]
integer :: is, ie, nz, i
is = G%isc ; ie = G%iec ; nz = GV%ke
@@ -1325,7 +1504,14 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega
do i=is,ie
- U_star = fluxes%ustar(i,j)
+ U_star = U_star_2d(i,j)
+
+ if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then
+ H_to_Z = GV%H_to_Z
+ else
+ H_to_Z = GV%H_to_RZ * tv%SpV_avg(i,j,1)
+ endif
+
if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
if (fluxes%frac_shelf_h(i,j) > 0.0) &
U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + &
@@ -1333,14 +1519,15 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
endif
if (U_star < CS%ustar_min) U_star = CS%ustar_min
+
if (CS%omega_frac < 1.0) then
absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + &
(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J))))
if (CS%omega_frac > 0.0) &
absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2)
endif
- absf_Ustar = absf / U_star
- Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z
+ absf_Ustar = H_to_Z * absf / U_star
+ Idecay_len_TKE(i) = absf_Ustar * CS%TKE_decay
! The first number in the denominator could be anywhere up to 16. The
! value of 3 was chosen to minimize the time-step dependence of the amount
@@ -1351,9 +1538,9 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
! This equation assumes that small & large scales contribute to mixed layer
! deepening at similar rates, even though small scales are dissipated more
! rapidly (implying they are less efficient).
-! Ih = 1.0/(16.0*CS%vonKar*U_star*dt)
- Ih = GV%H_to_Z/(3.0*CS%vonKar*U_star*dt)
- cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih
+! Ih = H_to_Z / (16.0*CS%vonKar*U_star*dt)
+ Ih = H_to_Z / (3.0*CS%vonKar*U_star*dt)
+ cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = absf_Ustar * Ih
if (Idecay_len_TKE(i) > 0.0) then
exp_kh = exp(-htot(i)*Idecay_len_TKE(i))
@@ -1371,7 +1558,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
if (totEn_Z > 0.0) then
nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * &
- sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z))
+ sqrt(0.5 * dt * (H_to_Z**2*(absf*htot(i))**3) * totEn_Z))
else
nstar_FC = CS%nstar
endif
@@ -1381,7 +1568,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
if (Conv_En(i) > 0.0) then
totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) )
nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * &
- sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z))
+ sqrt(0.5 * dt * (H_to_Z**2*(absf*htot(i))**3) * totEn_Z))
else
nstar_FC = CS%nstar
endif
@@ -1389,7 +1576,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA)
if (TKE_CA > 0.0) then
nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * &
- sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z))
+ sqrt(0.5 * dt * (H_to_Z**2*(absf*h_CA(i))**3) * totEn_Z))
else
nstar_CA = CS%nstar
endif
@@ -1411,15 +1598,25 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA,
dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC
! At this point, it is assumed that cTKE is positive and stored in TKE_CA!
! Note: Removed factor of 2 in u*^3 terms.
- TKE(i) = (dt*CS%mstar)*((US%Z_to_L**2*(U_star*U_Star*U_Star))*exp_kh) + &
- (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA)
+ if (GV%Boussinesq .or. GV%semi_Boussinesq .or. .not.(associated(fluxes%tau_mag))) then
+ TKE(i) = (dt*CS%mstar)*((GV%Z_to_H*US%Z_to_L**2*(U_star*U_Star*U_Star))*exp_kh) + &
+ (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA)
+ else
+ ! Note that GV%Z_to_H*US%Z_to_L**2*U_star**3 = GV%RZ_to_H * US%Z_to_L*fluxes%tau_mag(i,j) * U_star
+ TKE(i) = (dt*CS%mstar) * ((GV%RZ_to_H*US%Z_to_L * fluxes%tau_mag(i,j) * U_star)*exp_kh) + &
+ (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA)
+ endif
if (CS%do_rivermix) then ! Add additional TKE at river mouths
TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh
endif
if (CS%TKE_diagnostics) then
- wind_TKE_src = CS%mstar*(US%Z_to_L**2*U_star*U_Star*U_Star) * diag_wt
+ if (GV%Boussinesq .or. GV%semi_Boussinesq .or. .not.(associated(fluxes%tau_mag))) then
+ wind_TKE_src = CS%mstar*(GV%Z_to_H*US%Z_to_L**2*U_star*U_Star*U_Star) * diag_wt
+ else
+ wind_TKE_src = CS%mstar*(GV%RZ_to_H * US%Z_to_L*fluxes%tau_mag(i,j) * U_star) * diag_wt
+ endif
CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + &
( wind_TKE_src + TKE_river(i) * diag_wt )
CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag
@@ -1438,8 +1635,8 @@ end subroutine find_starting_TKE
!> This subroutine calculates mechanically driven entrainment.
subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
- R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, &
- dR0_dT, dRcv_dT, cMKE, Idt_diag, nsw, &
+ R0_tot, SpV0_tot, Rcv_tot, u, v, T, S, R0, SpV0, Rcv, eps, &
+ dR0_dT, dSpV0_dT, dRcv_dT, cMKE, Idt_diag, nsw, &
Pen_SW_bnd, opacity_band, TKE, &
Idecay_len_TKE, j, ksort, G, GV, US, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
@@ -1462,6 +1659,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
!! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential density
!! referenced to 0 pressure [H R ~> kg m-2 or kg2 m-5].
+ real, dimension(SZI_(G)), intent(inout) :: SpV0_tot !< The integrated mixed layer specific volume referenced
+ !! to 0 pressure [H R-1 ~> m4 kg-1 or m].
real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable
!! potential density [H R ~> kg m-2 or kg2 m-5].
real, dimension(SZI_(G),SZK_(GV)), &
@@ -1475,6 +1674,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
real, dimension(SZI_(G),SZK0_(GV)), &
intent(in) :: R0 !< Potential density referenced to
!! surface pressure [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK0_(GV)), &
+ intent(in) :: SpV0 !< Specific volume referenced to
+ !! surface pressure [R-1 ~> m3 kg-1].
real, dimension(SZI_(G),SZK0_(GV)), &
intent(in) :: Rcv !< The coordinate defining potential
!! density [R ~> kg m-3].
@@ -1483,6 +1685,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
!! that will be left in each layer [H ~> m or kg m-2].
real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to
!! temperature [R C-1 ~> kg m-3 degC-1].
+ real, dimension(SZI_(G)), intent(in) :: dSpV0_dT !< The partial derivative of SpV0 with respect to
+ !! temperature [R-1 C-1 ~> m3 kg-1 degC-1].
real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to
!! temperature [R C-1 ~> kg m-3 degC-1].
real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating the
@@ -1499,7 +1703,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
!! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1].
real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy
!! available for mixing over a time
- !! step [Z L2 T-2 ~> m3 s-2].
+ !! step [H L2 T-2 ~> m3 s-2 or J m-2].
real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1].
integer, intent(in) :: j !< The j-index to work on.
integer, dimension(SZI_(G),SZK_(GV)), &
@@ -1526,18 +1730,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
! conversion from H to m divided by the mean density,
! in [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2].
real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained
- ! [Z L2 T-2 ~> m3 s-2].
+ ! [H L2 T-2 ~> m3 s-2 or J m-2].
real :: dRL ! Work required to mix water from the next layer
! across the mixed layer [L2 T-2 ~> m2 s-2].
real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in
! TKE, divided by layer thickness in m [L2 T-2 ~> m2 s-2].
real :: Cpen1 ! A temporary variable [L2 T-2 ~> m2 s-2].
real :: dMKE ! A temporary variable related to the release of mean
- ! kinetic energy [H Z L2 T-2 ~> m4 s-2 or kg m s-2]
- real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z L2 T-2 ~> m3 s-2].
+ ! kinetic energy [H2 L2 T-2 ~> m4 s-2 or kg2 m-2 s-2]
+ real :: TKE_ent ! The TKE that remains if h_ent were entrained [H L2 T-2 ~> m3 s-2 or J m-2]
real :: TKE_ent1 ! The TKE that would remain, without considering the
- ! release of mean kinetic energy [Z L2 T-2 ~> m3 s-2].
- real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z L2 T-2 H-1 ~> m2 s-2 or m5 s-2 kg-1].
+ ! release of mean kinetic energy [H L2 T-2 ~> m3 s-2 or J m-2]
+ real :: dTKE_dh ! The partial derivative of TKE with h_ent [L2 T-2 ~> m2 s-2]
real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to
! dTKE_dh [L2 T-2 ~> m2 s-2].
real :: EF4_val ! The result of EF4() (see later) [H-1 ~> m-1 or m2 kg-1].
@@ -1570,8 +1774,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
h_avail = h(i,k) - eps(i,k)
if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then
- dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) )
- dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * &
+ if (CS%nonBous_energetics) then
+ dRL = 0.5 * (GV%g_Earth * GV%H_to_RZ) * (SpV0_tot(i) - SpV0(i,k)*htot(i))
+ else
+ dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) )
+ endif
+ dMKE = CS%bulk_Ri_ML * 0.5 * &
((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2)
! Find the TKE that would remain if the entire layer were entrained.
@@ -1610,14 +1818,19 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
Pen_En1 = exp_kh * ((1.0+opacity*htot(i))*f1_x1 + &
opacity*h_avail*f2_x1)
endif
- Pen_En_Contrib = Pen_En_Contrib + &
- (g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i)) * (Pen_En1 - f1_kh)
+ if (CS%nonBous_energetics) then
+ Pen_En_Contrib = Pen_En_Contrib - &
+ (0.5 * (GV%g_Earth * GV%H_to_RZ) * dSpV0_dT(i)*Pen_SW_bnd(n,i)) * (Pen_En1 - f1_kh)
+ else
+ Pen_En_Contrib = Pen_En_Contrib + &
+ (g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i)) * (Pen_En1 - f1_kh)
+ endif
endif ; enddo
HpE = htot(i)+h_avail
MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2))
EF4_val = EF4(htot(i)+h_neglect,h_avail,Idecay_len_TKE(i))
- TKE_full_ent = (exp_kh*TKE(i) - (h_avail*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib)) + &
+ TKE_full_ent = (exp_kh*TKE(i) - h_avail*(dRL*f1_kh + Pen_En_Contrib)) + &
MKE_rate*dMKE*EF4_val
if ((TKE_full_ent >= 0.0) .or. (h_avail+htot(i) <= Hmix_min)) then
! The layer will be fully entrained.
@@ -1626,12 +1839,11 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
if (CS%TKE_diagnostics) then
E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect))
CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + &
- Idt_diag * ((exp_kh-1.0)* TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + &
+ Idt_diag * ((exp_kh-1.0)* TKE(i) + h_ent*dRL*(1.0-f1_kh) + &
MKE_rate*dMKE*(EF4_val-E_HxHpE))
- CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - &
- Idt_diag*(GV%H_to_Z*h_ent)*dRL
+ CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - Idt_diag*h_ent*dRL
CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - &
- Idt_diag*(GV%H_to_Z*h_ent)*Pen_En_Contrib
+ Idt_diag*h_ent*Pen_En_Contrib
CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + &
Idt_diag*MKE_rate*dMKE*E_HxHpE
endif
@@ -1691,21 +1903,25 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
Pen_En1 = exp_kh * ((1.0+opacity*htot(i))*f1_x1 + &
opacity*h_ent*f2_x1)
endif
- Cpen1 = g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i)
+ if (CS%nonBous_energetics) then
+ Cpen1 = -0.5 * (GV%g_Earth * GV%H_to_RZ) * dSpV0_dT(i) * Pen_SW_bnd(n,i)
+ else
+ Cpen1 = g_H_2Rho0 * dR0_dT(i) * Pen_SW_bnd(n,i)
+ endif
Pen_En_Contrib = Pen_En_Contrib + Cpen1*(Pen_En1 - f1_kh)
Pen_dTKE_dh_Contrib = Pen_dTKE_dh_Contrib + &
Cpen1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans)
endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0)
- TKE_ent1 = exp_kh* TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib)
+ TKE_ent1 = exp_kh* TKE(i) - h_ent*(dRL*f1_kh + Pen_En_Contrib)
EF4_val = EF4(htot(i)+h_neglect,h_ent,Idecay_len_TKE(i),dEF4_dh)
HpE = htot(i)+h_ent
MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2))
TKE_ent = TKE_ent1 + dMKE*EF4_val*MKE_rate
! TKE_ent is the TKE that would remain if h_ent were entrained.
- dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*GV%H_to_Z) + &
- Pen_dTKE_dh_Contrib*GV%H_to_Z) + dMKE * MKE_rate* &
+ dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL) + &
+ Pen_dTKE_dh_Contrib) + dMKE * MKE_rate* &
(dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE))
! dh_Newt = -TKE_ent / dTKE_dh
! Bisect if the Newton's method prediction is outside of the bounded range.
@@ -1739,14 +1955,11 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect))
CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + &
- Idt_diag * ((exp_kh-1.0)* TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + &
+ Idt_diag * ((exp_kh-1.0)* TKE(i) + h_ent*dRL*(1.0-f1_kh) + &
dMKE*MKE_rate*(EF4_val-E_HxHpE))
- CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - &
- Idt_diag*(h_ent*GV%H_to_Z)*dRL
- CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - &
- Idt_diag*(h_ent*GV%H_to_Z)*Pen_En_Contrib
- CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + &
- Idt_diag*dMKE*MKE_rate*E_HxHpE
+ CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - Idt_diag*h_ent*dRL
+ CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - Idt_diag*h_ent*Pen_En_Contrib
+ CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + Idt_diag*dMKE*MKE_rate*E_HxHpE
endif
TKE(i) = 0.0
@@ -1760,7 +1973,11 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
endif ; enddo
htot(i) = htot(i) + h_ent
- R0_tot(i) = R0_tot(i) + (h_ent * R0(i,k) + Pen_absorbed*dR0_dT(i))
+ if (CS%nonBous_energetics) then
+ SpV0_tot(i) = SpV0_tot(i) + (h_ent * SpV0(i,k) + Pen_absorbed*dSpV0_dT(i))
+ else
+ R0_tot(i) = R0_tot(i) + (h_ent * R0(i,k) + Pen_absorbed*dR0_dT(i))
+ endif
h(i,k) = h(i,k) - h_ent
d_eb(i,k) = d_eb(i,k) - h_ent
@@ -1779,12 +1996,14 @@ end subroutine mechanical_entrainment
!> This subroutine generates an array of indices that are sorted by layer
!! density.
-subroutine sort_ML(h, R0, eps, G, GV, CS, ksort)
+subroutine sort_ML(h, R0, SpV0, eps, G, GV, CS, ksort)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZI_(G),SZK0_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2].
real, dimension(SZI_(G),SZK0_(GV)), intent(in) :: R0 !< The potential density used to sort
!! the layers [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK0_(GV)), intent(in) :: SpV0 !< Specific volume referenced to
+ !! surface pressure [R-1 ~> m3 kg-1]
real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must
!! remain in each layer [H ~> m or kg m-2].
type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure
@@ -1792,6 +2011,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort)
! Local variables
real :: R0sort(SZI_(G),SZK_(GV)) ! The sorted potential density [R ~> kg m-3]
+ real :: SpV0sort(SZI_(G),SZK_(GV)) ! The sorted specific volume [R-1 ~> m3 kg-1]
integer :: nsort(SZI_(G)) ! The number of layers left to sort
logical :: done_sorting(SZI_(G))
integer :: i, k, ks, is, ie, nz, nkmb
@@ -1810,27 +2030,44 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort)
do k=1,nz ; do i=is,ie ; ksort(i,k) = -1 ; enddo ; enddo
do i=is,ie ; nsort(i) = 0 ; done_sorting(i) = .false. ; enddo
- do k=1,nz ; do i=is,ie ; if (h(i,k) > eps(i,k)) then
- if (done_sorting(i)) then ; ks = nsort(i) ; else
- do ks=nsort(i),1,-1
- if (R0(i,k) >= R0sort(i,ks)) exit
- R0sort(i,ks+1) = R0sort(i,ks) ; ksort(i,ks+1) = ksort(i,ks)
- enddo
- if ((k > nkmb) .and. (ks == nsort(i))) done_sorting(i) = .true.
- endif
- ksort(i,ks+1) = k
- R0sort(i,ks+1) = R0(i,k)
- nsort(i) = nsort(i) + 1
- endif ; enddo ; enddo
+ if (CS%nonBous_energetics) then
+ do k=1,nz ; do i=is,ie ; if (h(i,k) > eps(i,k)) then
+ if (done_sorting(i)) then ; ks = nsort(i) ; else
+ do ks=nsort(i),1,-1
+ if (SpV0(i,k) <= SpV0sort(i,ks)) exit
+ SpV0sort(i,ks+1) = SpV0sort(i,ks) ; ksort(i,ks+1) = ksort(i,ks)
+ enddo
+ if ((k > nkmb) .and. (ks == nsort(i))) done_sorting(i) = .true.
+ endif
+
+ ksort(i,ks+1) = k
+ SpV0sort(i,ks+1) = SpV0(i,k)
+ nsort(i) = nsort(i) + 1
+ endif ; enddo ; enddo
+ else
+ do k=1,nz ; do i=is,ie ; if (h(i,k) > eps(i,k)) then
+ if (done_sorting(i)) then ; ks = nsort(i) ; else
+ do ks=nsort(i),1,-1
+ if (R0(i,k) >= R0sort(i,ks)) exit
+ R0sort(i,ks+1) = R0sort(i,ks) ; ksort(i,ks+1) = ksort(i,ks)
+ enddo
+ if ((k > nkmb) .and. (ks == nsort(i))) done_sorting(i) = .true.
+ endif
+
+ ksort(i,ks+1) = k
+ R0sort(i,ks+1) = R0(i,k)
+ nsort(i) = nsort(i) + 1
+ endif ; enddo ; enddo
+ endif
end subroutine sort_ML
!> This subroutine actually moves properties between layers to achieve a
!! resorted state, with all of the resorted water either moved into the correct
!! interior layers or in the top nkmb layers.
-subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS, &
- dR0_dT, dR0_dS, dRcv_dT, dRcv_dS)
+subroutine resort_ML(h, T, S, R0, SpV0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS, &
+ dR0_dT, dR0_dS, dSpV0_dT, dSpV0_dS, dRcv_dT, dRcv_dS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid
!! structure.
@@ -1840,6 +2077,8 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [S ~> ppt].
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to
!! surface pressure [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: SpV0 !< Specific volume referenced to
+ !! surface pressure [R-1 ~> m3 kg-1]
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining
!! potential density [R ~> kg m-3].
real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each
@@ -1865,6 +2104,10 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
!! potential density referenced
!! to the surface with salinity,
!! [R S-1 ~> kg m-3 ppt-1].
+ real, dimension(SZI_(G)), intent(in) :: dSpV0_dT !< The partial derivative of SpV0 with respect
+ !! to temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ real, dimension(SZI_(G)), intent(in) :: dSpV0_dS !< The partial derivative of SpV0 with respect
+ !! to salinity [R-1 S-1 ~> m3 kg-1 ppt-1]
real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of
!! coordinate defining potential
!! density with potential
@@ -1903,15 +2146,18 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
real :: S_up, S_dn ! Salinities projected to match the target densities of two layers [S ~> ppt]
real :: R0_up, R0_dn ! Potential densities projected to match the target coordinate
! densities of two layers [R ~> kg m-3]
+ real :: SpV0_up, SpV0_dn ! Specific volumes projected to be consistent with the target coordinate
+ ! densities of two layers [R-1 ~> m3 kg-1]
real :: I_hup, I_hdn ! Inverse of the new thicknesses of the two layers [H-1 ~> m-1 or m2 kg-1]
real :: h_to_up, h_to_dn ! Thickness transferred to two layers [H ~> m or kg m-2]
real :: wt_dn ! Fraction of the thickness transferred to the deeper layer [nondim]
real :: dR1, dR2 ! Density difference with the target densities of two layers [R ~> kg m-3]
- real :: dPE, min_dPE ! Values proportional to the potential energy change due to the merging
- ! of a pair of layers [R H2 ~> kg m-1 or kg3 m-6]
+ real :: dPE, min_dPE ! Values proportional to the potential energy change due to the merging of a
+ ! pair of layers [R H2 ~> kg m-1 or kg3 m-7] or [R-1 H2 ~> m5 kg-1 or kg m-1]
real :: hmin, min_hmin ! The thickness of the thinnest layer [H ~> m or kg m-2]
real :: h_tmp(SZK_(GV)) ! A copy of the original layer thicknesses [H ~> m or kg m-2]
real :: R0_tmp(SZK_(GV)) ! A copy of the original layer potential densities [R ~> kg m-3]
+ real :: SpV0_tmp(SZK_(GV)) ! A copy of the original layer specific volumes [R ~> kg m-3]
real :: T_tmp(SZK_(GV)) ! A copy of the original layer temperatures [C ~> degC]
real :: S_tmp(SZK_(GV)) ! A copy of the original layer salinities [S ~> ppt]
real :: Rcv_tmp(SZK_(GV)) ! A copy of the original layer coordinate densities [R ~> kg m-3]
@@ -2013,13 +2259,19 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
T_dn = T(i,k) + dT_dR * dR2
S_dn = S(i,k) + dS_dR * dR2
- R0_up = R0(i,k) + (dT_dR*dR0_dT(i) + dS_dR*dR0_dS(i)) * dR1
- R0_dn = R0(i,k) + (dT_dR*dR0_dT(i) + dS_dR*dR0_dS(i)) * dR2
+ if (CS%nonBous_energetics) then
+ SpV0_up = SpV0(i,k) + (dT_dR*dSpV0_dT(i) + dS_dR*dSpV0_dS(i)) * dR1
+ SpV0_dn = SpV0(i,k) + (dT_dR*dSpV0_dT(i) + dS_dR*dSpV0_dS(i)) * dR2
+
+ ! Make sure the new properties are acceptable, and avoid creating obviously unstable profiles.
+ if ((SpV0_up < SpV0(i,0)) .or. (SpV0_dn < SpV0(i,0))) exit
+ else
+ R0_up = R0(i,k) + (dT_dR*dR0_dT(i) + dS_dR*dR0_dS(i)) * dR1
+ R0_dn = R0(i,k) + (dT_dR*dR0_dT(i) + dS_dR*dR0_dS(i)) * dR2
- ! Make sure the new properties are acceptable.
- if ((R0_up > R0(i,0)) .or. (R0_dn > R0(i,0))) &
- ! Avoid creating obviously unstable profiles.
- exit
+ ! Make sure the new properties are acceptable, and avoid creating obviously unstable profiles.
+ if ((R0_up > R0(i,0)) .or. (R0_dn > R0(i,0))) exit
+ endif
wt_dn = (Rcv(i,k) - RcvTgt(k2-1)) / (RcvTgt(k2) - RcvTgt(k2-1))
h_to_up = (h(i,k)-eps(i,k)) * (1.0 - wt_dn)
@@ -2027,8 +2279,13 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
I_hup = 1.0 / (h(i,k2-1) + h_to_up)
I_hdn = 1.0 / (h(i,k2) + h_to_dn)
- R0(i,k2-1) = (R0(i,k2)*h(i,k2-1) + R0_up*h_to_up) * I_hup
- R0(i,k2) = (R0(i,k2)*h(i,k2) + R0_dn*h_to_dn) * I_hdn
+ if (CS%nonBous_energetics) then
+ SpV0(i,k2-1) = (SpV0(i,k2)*h(i,k2-1) + SpV0_up*h_to_up) * I_hup
+ SpV0(i,k2) = (SpV0(i,k2)*h(i,k2) + SpV0_dn*h_to_dn) * I_hdn
+ else
+ R0(i,k2-1) = (R0(i,k2)*h(i,k2-1) + R0_up*h_to_up) * I_hup
+ R0(i,k2) = (R0(i,k2)*h(i,k2) + R0_dn*h_to_dn) * I_hdn
+ endif
T(i,k2-1) = (T(i,k2)*h(i,k2-1) + T_up*h_to_up) * I_hup
T(i,k2) = (T(i,k2)*h(i,k2) + T_dn*h_to_dn) * I_hdn
@@ -2072,7 +2329,11 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
ks_min = -1 ; min_dPE = 1.0 ; min_hmin = 0.0
do ks=1,nks-1
k1 = ks2(ks) ; k2 = ks2(ks+1)
- dPE = max(0.0, (R0(i,k2)-R0(i,k1)) * h(i,k1) * h(i,k2))
+ if (CS%nonBous_energetics) then
+ dPE = max(0.0, (SpV0(i,k1) - SpV0(i,k2)) * (h(i,k1) * h(i,k2)))
+ else
+ dPE = max(0.0, (R0(i,k2) - R0(i,k1)) * h(i,k1) * h(i,k2))
+ endif
hmin = min(h(i,k1)-eps(i,k1), h(i,k2)-eps(i,k2))
if ((ks_min < 0) .or. (dPE < min_dPE) .or. &
((dPE <= 0.0) .and. (hmin < min_hmin))) then
@@ -2090,7 +2351,11 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
h(i,k_src) = eps(i,k_src)
h(i,k_tgt) = h(i,k_tgt) + h_move
I_hnew = 1.0 / (h(i,k_tgt))
- R0(i,k_tgt) = (R0(i,k_tgt)*h_tgt_old + R0(i,k_src)*h_move) * I_hnew
+ if (CS%nonBous_energetics) then
+ SpV0(i,k_tgt) = (SpV0(i,k_tgt)*h_tgt_old + SpV0(i,k_src)*h_move) * I_hnew
+ else
+ R0(i,k_tgt) = (R0(i,k_tgt)*h_tgt_old + R0(i,k_src)*h_move) * I_hnew
+ endif
T(i,k_tgt) = (T(i,k_tgt)*h_tgt_old + T(i,k_src)*h_move) * I_hnew
S(i,k_tgt) = (S(i,k_tgt)*h_tgt_old + S(i,k_src)*h_move) * I_hnew
@@ -2116,7 +2381,12 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
! Save all the properties of the nkmb layers that might be replaced.
do k=1,nkmb
- h_tmp(k) = h(i,k) ; R0_tmp(k) = R0(i,k)
+ h_tmp(k) = h(i,k)
+ if (CS%nonBous_energetics) then
+ SpV0_tmp(k) = SpV0(i,k)
+ else
+ R0_tmp(k) = R0(i,k)
+ endif
T_tmp(k) = T(i,k) ; S_tmp(k) = S(i,k) ; Rcv_tmp(k) = Rcv(i,k)
h(i,k) = 0.0
@@ -2134,7 +2404,11 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
h_move = h(i,k_src)-eps(i,k_src)
h(i,k_src) = eps(i,k_src)
h(i,k_tgt) = h_move
- R0(i,k_tgt) = R0(i,k_src)
+ if (CS%nonBous_energetics) then
+ SpV0(i,k_tgt) = SpV0(i,k_src)
+ else
+ R0(i,k_tgt) = R0(i,k_src)
+ endif
T(i,k_tgt) = T(i,k_src) ; S(i,k_tgt) = S(i,k_src)
Rcv(i,k_tgt) = Rcv(i,k_src)
@@ -2143,7 +2417,11 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS
d_eb(i,k_tgt) = d_eb(i,k_tgt) + h_move
else
h(i,k_tgt) = h_tmp(k_src)
- R0(i,k_tgt) = R0_tmp(k_src)
+ if (CS%nonBous_energetics) then
+ SpV0(i,k_tgt) = SpV0_tmp(k_src)
+ else
+ R0(i,k_tgt) = R0_tmp(k_src)
+ endif
T(i,k_tgt) = T_tmp(k_src) ; S(i,k_tgt) = S_tmp(k_src)
Rcv(i,k_tgt) = Rcv_tmp(k_src)
@@ -2166,8 +2444,8 @@ end subroutine resort_ML
!> This subroutine moves any water left in the former mixed layers into the
!! two buffer layers and may also move buffer layer water into the interior
!! isopycnal layers.
-subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, US, CS, &
- dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det)
+subroutine mixedlayer_detrain_2(h, T, S, R0, Spv0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, US, CS, &
+ dR0_dT, dR0_dS, dSpV0_dT, dSpV0_dS, dRcv_dT, dRcv_dS, max_BL_det)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2].
@@ -2176,6 +2454,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [S ~> ppt].
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to
!! surface pressure [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: SpV0 !< Specific volume referenced to
+ !! surface pressure [R-1 ~> m3 kg-1]
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential
!! density [R ~> kg m-3].
real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each
@@ -2197,6 +2477,12 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
!! potential density referenced to the
!! surface with salinity
!! [R S-1 ~> kg m-3 ppt-1].
+ real, dimension(SZI_(G)), intent(in) :: dSpV0_dT !< The partial derivative of specific
+ !! volume with respect to temeprature
+ !! [R-1 C-1 ~> m3 kg-1 degC-1]
+ real, dimension(SZI_(G)), intent(in) :: dSpV0_dS !< The partial derivative of specific
+ !! volume with respect to salinity
+ !! [R-1 S-1 ~> m3 kg-1 ppt-1]
real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of
!! coordinate defining potential density
!! with potential temperature,
@@ -2217,6 +2503,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! layers [H ~> m or kg m-2].
real :: R0_to_bl ! The depth integrated amount of R0 that is detrained to the
! buffer layer [H R ~> kg m-2 or kg2 m-5]
+ real :: SpV0_to_bl ! The depth integrated amount of SpV0 that is detrained to the
+ ! buffer layer [H R-1 ~> m4 kg-1 or m]
real :: Rcv_to_bl ! The depth integrated amount of Rcv that is detrained to the
! buffer layer [H R ~> kg m-2 or kg2 m-5]
real :: T_to_bl ! The depth integrated amount of T that is detrained to the
@@ -2235,27 +2523,36 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
real :: stays_min, stays_max ! The minimum and maximum permitted values of
! stays [H ~> m or kg m-2].
+ logical :: intermediate ! True if the water in layer kb1 is intermediate in density
+ ! between the water in kb2 and the water being detrained.
logical :: mergeable_bl ! If true, it is an option to combine the two
! buffer layers and create water that matches
! the target density of an interior layer.
+ logical :: better_to_merge ! True if it is energetically favorable to merge layers
real :: stays_merge ! If the two buffer layers can be combined
! stays_merge is the thickness of the upper
! layer that remains [H ~> m or kg m-2].
real :: stays_min_merge ! The minimum allowed value of stays_merge [H ~> m or kg m-2].
real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0 and Rcv [R H-1 ~> kg m-4 or m-1]
+ real :: dSpV0_2dz ! Half the vertical gradients of SpV0 and Rcv [R-1 H-1 ~> m2 kg-1 or m5 kg-2]
! real :: dT_2dz ! Half the vertical gradient of T [C H-1 ~> degC m-1 or degC m2 kg-1]
! real :: dS_2dz ! Half the vertical gradient of S [S H-1 ~> ppt m-1 or ppt m2 kg-1]
real :: scale_slope ! A nondimensional number < 1 used to scale down
! the slope within the upper buffer layer when
! water MUST be detrained to the lower layer [nondim].
- real :: dPE_extrap ! The potential energy change due to dispersive
+ real :: dPE_extrap_rhoG ! The potential energy change due to dispersive
! advection or mixing layers, divided by
! rho_0*g [H2 ~> m2 or kg2 m-4].
+ real :: dPE_extrapolate ! The potential energy change due to dispersive advection or
+ ! mixing layers [R Z L2 T-2 ~> J m-2].
real :: dPE_det, dPE_merge ! The energy required to mix the detrained water
! into the buffer layer or the merge the two
! buffer layers [R H2 L2 Z-1 T-2 ~> J m-2 or J kg2 m-8].
+ real :: dPE_det_nB, dPE_merge_nB ! The energy required to mix the detrained water
+ ! into the buffer layer or the merge the two
+ ! buffer layers [R Z L2 T-2 ~> J m-2].
real :: h_from_ml ! The amount of additional water that must be
! drawn from the mixed layer [H ~> m or kg m-2].
@@ -2273,8 +2570,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
real :: h2_to_k1, h2_to_k1_rem ! Fluxes of lower buffer layer water to the interior layer that
! is just denser than the lower buffer layer [H ~> m or kg m-2].
- real :: R0_det, T_det, S_det ! Detrained values of R0 [R ~> kg m-3], T [C ~> degC] and S [S ~> ppt]
+ real :: R0_det ! Detrained value of potential density referenced to the surface [R ~> kg m-3]
+ real :: SpV0_det ! Detrained value of specific volume referenced to the surface [R-1 ~> m3 kg-1]
+ real :: T_det, S_det ! Detrained values of temperature [C ~> degC] and salinity [S ~> ppt]
real :: Rcv_stays, R0_stays ! Values of Rcv and R0 that stay in a layer [R ~> kg m-3]
+ real :: SpV0_stays ! Values of SpV0 that stay in a layer [R-1 ~> m3 kg-1]
real :: T_stays, S_stays ! Values of T and S that stay in a layer, [C ~> degC] and S [S ~> ppt]
real :: dSpice_det, dSpice_stays! The spiciness difference between an original
! buffer layer and the water that moves into
@@ -2285,7 +2585,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! moves into an interior layer [R ~> kg m-3].
real :: dSpice_2dz ! The vertical gradient of spiciness used for
! advection [R H-1 ~> kg m-4 or m-1].
-
+ real :: dSpiceSpV_stays ! The specific volume based spiciness difference between an original
+ ! buffer layer and the water that stays in that layer [R-1 ~> m3 kg-1]
+ real :: dSpiceSpV_lim ! A limit on the specific volume based spiciness difference
+ ! between the lower buffer layer and the water that
+ ! moves into an interior layer [R-1 ~> m3 kg-1]
real :: dPE_ratio ! Multiplier of dPE_det at which merging is
! permitted - here (detrainment_per_day/dt)*30
! days? [nondim]
@@ -2295,11 +2599,12 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and
! salinity changes in defining spiciness, in
! [C S-1 ~> degC ppt-1] and [S C-1 ~> ppt degC-1].
- real :: I_denom ! A work variable with units of [S2 R-2 ~> ppt2 m6 kg-2].
+ real :: I_denom ! A work variable with units of [S2 R-2 ~> ppt2 m6 kg-2] or [R2 S2 ~> ppt2 kg2 m-6].
real :: g_2 ! 1/2 g_Earth [L2 Z-1 T-2 ~> m s-2].
real :: Rho0xG ! Rho0 times G_Earth [R L2 Z-1 T-2 ~> kg m-2 s-2].
real :: I2Rho0 ! 1 / (2 Rho0) [R-1 ~> m3 kg-1].
+ real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1].
real :: Idt_H2 ! The square of the conversion from thickness to Z
! divided by the time step [Z2 H-2 T-1 ~> s-1 or m6 kg-2 s-1].
logical :: stable_Rcv ! If true, the buffer layers are stable with
@@ -2315,22 +2620,25 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
real :: Ihk0, Ihk1, Ih12 ! Assorted inverse thickness work variables [H-1 ~> m-1 or m2 kg-1]
real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables [R ~> kg m-3]
real :: dR0, dR21, dRcv ! Assorted density difference work variables [R ~> kg m-3]
+ real :: dSpV0, dSpVk1 ! Assorted specific volume difference work variables [R-1 ~> m3 kg-1]
real :: dRcv_stays, dRcv_det, dRcv_lim ! Assorted densities [R ~> kg m-3]
real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2].
real :: h2_to_k1_lim ! A limit on the thickness that can be detrained to layer k1 [H ~> m or kg m-2]
real :: T_new, T_max, T_min ! Temperature of the detrained water and limits on it [C ~> degC]
real :: S_new, S_max, S_min ! Salinity of the detrained water and limits on it [S ~> ppt]
-
+ logical :: stable
integer :: i, k, k0, k1, is, ie, nz, kb1, kb2, nkmb
+
is = G%isc ; ie = G%iec ; nz = GV%ke
kb1 = CS%nkml+1; kb2 = CS%nkml+2
nkmb = CS%nkml+CS%nkbl
h_neglect = GV%H_subroundoff
g_2 = 0.5 * GV%g_Earth
Rho0xG = GV%Rho0 * GV%g_Earth
+ Idt_diag = 1.0 / dt_diag
Idt_H2 = GV%H_to_Z**2 / dt_diag
- I2Rho0 = 0.5 / (GV%Rho0)
+ I2Rho0 = 0.5 / GV%Rho0
Angstrom = GV%Angstrom_H
! This is hard coding of arbitrary and dimensional numbers.
@@ -2350,12 +2658,16 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! As coded this has the k and i loop orders switched, but k is CS%nkml is
! often just 1 or 2, so this seems like it should not be a problem, especially
! since it means that a number of variables can now be scalars, not arrays.
- h_to_bl = 0.0 ; R0_to_bl = 0.0
+ h_to_bl = 0.0 ; R0_to_bl = 0.0 ; SpV0_to_bl = 0.0
Rcv_to_bl = 0.0 ; T_to_bl = 0.0 ; S_to_bl = 0.0
do k=1,CS%nkml ; if (h(i,k) > 0.0) then
h_to_bl = h_to_bl + h(i,k)
- R0_to_bl = R0_to_bl + R0(i,k)*h(i,k)
+ if (CS%nonBous_energetics) then
+ SpV0_to_bl = SpV0_to_bl + SpV0(i,k)*h(i,k)
+ else
+ R0_to_bl = R0_to_bl + R0(i,k)*h(i,k)
+ endif
Rcv_to_bl = Rcv_to_bl + Rcv(i,k)*h(i,k)
T_to_bl = T_to_bl + T(i,k)*h(i,k)
@@ -2364,8 +2676,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
d_ea(i,k) = d_ea(i,k) - h(i,k)
h(i,k) = 0.0
endif ; enddo
- if (h_to_bl > 0.0) then ; R0_det = R0_to_bl / h_to_bl
- else ; R0_det = R0(i,0) ; endif
+
+ if (CS%nonBous_energetics) then
+ if (h_to_bl > 0.0) then ; SpV0_det = SpV0_to_bl / h_to_bl
+ else ; SpV0_det = SpV0(i,0) ; endif
+ else
+ if (h_to_bl > 0.0) then ; R0_det = R0_to_bl / h_to_bl
+ else ; R0_det = R0(i,0) ; endif
+ endif
! This code does both downward detrainment from both the mixed layer and the
! buffer layers.
@@ -2390,8 +2708,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
h_min_bl = MIN(CS%Hbuffer_min, CS%Hbuffer_rel_min*h(i,0))
stable_Rcv = .true.
- if (((R0(i,kb2)-R0(i,kb1)) * (Rcv(i,kb2)-Rcv(i,kb1)) <= 0.0)) &
- stable_Rcv = .false.
+ if (CS%nonBous_energetics) then
+ if (((SpV0(i,kb1)-SpV0(i,kb2)) * (Rcv(i,kb2)-Rcv(i,kb1)) <= 0.0)) stable_Rcv = .false.
+ else
+ if (((R0(i,kb2)-R0(i,kb1)) * (Rcv(i,kb2)-Rcv(i,kb1)) <= 0.0)) stable_Rcv = .false.
+ endif
h1 = h(i,kb1) ; h2 = h(i,kb2)
@@ -2406,26 +2727,36 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! are not meaningful, but may later be used to determine the properties of
! waters moving into the lower buffer layer. So the properties of the
! lower buffer layer are set to be between those of the upper buffer layer
- ! and the next denser interior layer, measured by R0. This probably does
+ ! and the next denser interior layer, measured by R0 or SpV0. This probably does
! not happen very often, so I am not too worried about the inefficiency of
! the following loop.
do k1=kb2+1,nz ; if (h(i,k1) > 2.0*Angstrom) exit ; enddo
- R0(i,kb2) = R0(i,kb1)
-
Rcv(i,kb2) = Rcv(i,kb1) ; T(i,kb2) = T(i,kb1) ; S(i,kb2) = S(i,kb1)
+ if (CS%nonBous_energetics) then
+ SpV0(i,kb2) = SpV0(i,kb1)
+ if (k1 <= nz) then ; if (SpV0(i,k1) <= SpV0(i,kb1)) then
+ SpV0(i,kb2) = 0.5*(SpV0(i,kb1)+SpV0(i,k1))
- if (k1 <= nz) then ; if (R0(i,k1) >= R0(i,kb1)) then
- R0(i,kb2) = 0.5*(R0(i,kb1)+R0(i,k1))
+ Rcv(i,kb2) = 0.5*(Rcv(i,kb1)+Rcv(i,k1))
+ T(i,kb2) = 0.5*(T(i,kb1)+T(i,k1))
+ S(i,kb2) = 0.5*(S(i,kb1)+S(i,k1))
+ endif ; endif
+ else
+ R0(i,kb2) = R0(i,kb1)
+
+ if (k1 <= nz) then ; if (R0(i,k1) >= R0(i,kb1)) then
+ R0(i,kb2) = 0.5*(R0(i,kb1)+R0(i,k1))
- Rcv(i,kb2) = 0.5*(Rcv(i,kb1)+Rcv(i,k1))
- T(i,kb2) = 0.5*(T(i,kb1)+T(i,k1))
- S(i,kb2) = 0.5*(S(i,kb1)+S(i,k1))
- endif ; endif
+ Rcv(i,kb2) = 0.5*(Rcv(i,kb1)+Rcv(i,k1))
+ T(i,kb2) = 0.5*(T(i,kb1)+T(i,k1))
+ S(i,kb2) = 0.5*(S(i,kb1)+S(i,k1))
+ endif ; endif
+ endif
endif ! (h2 = 0 && h1 > 0)
- dPE_extrap = 0.0 ; dPE_merge = 0.0
+ dPE_extrap_rhoG = 0.0 ; dPE_extrapolate = 0.0 ; dPE_merge = 0.0 ; dPE_merge_nB = 0.0
mergeable_bl = .false.
if ((h1 > 0.0) .and. (h2 > 0.0) .and. (h_to_bl > 0.0) .and. &
(stable_Rcv)) then
@@ -2442,12 +2773,23 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! into the lower one, each with an energy change that equals that required
! to mix the detrained water with the upper buffer layer.
h1_avail = h1 - MAX(0.0,h_min_bl-h_to_bl)
- if ((k1<=nz) .and. (h2 > h_min_bl) .and. (h1_avail > 0.0) .and. &
- (R0(i,kb1) < R0(i,kb2)) .and. (h_to_bl*R0(i,kb1) > R0_to_bl)) then
- dRk1 = (RcvTgt(k1) - Rcv(i,kb2)) * (R0(i,kb2) - R0(i,kb1)) / &
- (Rcv(i,kb2) - Rcv(i,kb1))
- b1 = dRk1 / (R0(i,kb2) - R0(i,kb1))
+ if (CS%nonBous_energetics) then
+ intermediate = (SpV0(i,kb1) > SpV0(i,kb2)) .and. (h_to_bl*SpV0(i,kb1) < SpV0_to_bl)
+ else
+ intermediate = (R0(i,kb1) < R0(i,kb2)) .and. (h_to_bl*R0(i,kb1) > R0_to_bl)
+ endif
+
+ if ((k1<=nz) .and. (h2 > h_min_bl) .and. (h1_avail > 0.0) .and. intermediate) then
+ if (CS%nonBous_energetics) then
+ dSpVk1 = (RcvTgt(k1) - Rcv(i,kb2)) * (SpV0(i,kb2) - SpV0(i,kb1)) / &
+ (Rcv(i,kb2) - Rcv(i,kb1))
+ b1 = (RcvTgt(k1) - Rcv(i,kb2)) / (Rcv(i,kb2) - Rcv(i,kb1))
+ else
+ dRk1 = (RcvTgt(k1) - Rcv(i,kb2)) * (R0(i,kb2) - R0(i,kb1)) / &
+ (Rcv(i,kb2) - Rcv(i,kb1))
+ b1 = dRk1 / (R0(i,kb2) - R0(i,kb1))
! b1 = RcvTgt(k1) - Rcv(i,kb2)) / (Rcv(i,kb2) - Rcv(i,kb1))
+ endif
! Apply several limits to the detrainment.
! Entrain less than the mass in h2, and keep the base of the buffer
@@ -2457,8 +2799,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! buffer layers with upwind advection from the layer above.
if (h2_to_k1*(h1_avail + b1*(h1_avail + h2)) > h2*h1_avail) &
h2_to_k1 = (h2*h1_avail) / (h1_avail + b1*(h1_avail + h2))
- if (h2_to_k1*(dRk1 * h2) > (h_to_bl*R0(i,kb1) - R0_to_bl) * h1) &
- h2_to_k1 = (h_to_bl*R0(i,kb1) - R0_to_bl) * h1 / (dRk1 * h2)
+
+ if (CS%nonBous_energetics) then
+ if (h2_to_k1*(dSpVk1 * h2) < (h_to_bl*SpV0(i,kb1) - SpV0_to_bl) * h1) &
+ h2_to_k1 = (h_to_bl*SpV0(i,kb1) - SpV0_to_bl) * h1 / (dSpVk1 * h2)
+ else
+ if (h2_to_k1*(dRk1 * h2) > (h_to_bl*R0(i,kb1) - R0_to_bl) * h1) &
+ h2_to_k1 = (h_to_bl*R0(i,kb1) - R0_to_bl) * h1 / (dRk1 * h2)
+ endif
if ((k1==kb2+1) .and. (CS%BL_extrap_lim > 0.)) then
! Simply do not detrain very light water into the lightest isopycnal
@@ -2500,9 +2848,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
(dT_dS_gauge * dRcv_dT(i) * dRcv + dRcv_dS(i) * dSpice_det)
S_det = S(i,kb2) + I_denom * &
(dRcv_dS(i) * dRcv - dT_dS_gauge * dRcv_dT(i) * dSpice_det)
- ! The detrained values of R0 are based on changes in T and S.
- R0_det = R0(i,kb2) + (T_det-T(i,kb2)) * dR0_dT(i) + &
- (S_det-S(i,kb2)) * dR0_dS(i)
+
+ ! The detrained values of R0 or SpV0 are based on changes in T and S.
+ if (CS%nonBous_energetics) then
+ SpV0_det = SpV0(i,kb2) + (T_det-T(i,kb2)) * dSpV0_dT(i) + &
+ (S_det-S(i,kb2)) * dSpV0_dS(i)
+ else
+ R0_det = R0(i,kb2) + (T_det-T(i,kb2)) * dR0_dT(i) + &
+ (S_det-S(i,kb2)) * dR0_dS(i)
+ endif
if (CS%BL_extrap_lim >= 0.) then
! Only do this detrainment if the new layer's temperature and salinity
@@ -2544,10 +2898,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
h1_to_h2*S(i,kb1)) * Ih2f
S(i,k1) = ((h(i,k1)+h_neglect)*S(i,k1) + h2_to_k1*S_det) * Ihk1
- ! Changes in R0 are based on changes in T and S.
- R0(i,kb2) = ((h(i,kb2)*R0(i,kb2) - h2_to_k1*R0_det) + &
- h1_to_h2*R0(i,kb1)) * Ih2f
- R0(i,k1) = ((h(i,k1)+h_neglect)*R0(i,k1) + h2_to_k1*R0_det) * Ihk1
+ ! Changes in R0 or SpV0 are based on changes in T and S.
+ if (CS%nonBous_energetics) then
+ SpV0(i,kb2) = ((h(i,kb2)*SpV0(i,kb2) - h2_to_k1*SpV0_det) + h1_to_h2*SpV0(i,kb1)) * Ih2f
+ SpV0(i,k1) = ((h(i,k1)+h_neglect)*SpV0(i,k1) + h2_to_k1*SpV0_det) * Ihk1
+ else
+ R0(i,kb2) = ((h(i,kb2)*R0(i,kb2) - h2_to_k1*R0_det) + h1_to_h2*R0(i,kb1)) * Ih2f
+ R0(i,k1) = ((h(i,k1)+h_neglect)*R0(i,k1) + h2_to_k1*R0_det) * Ihk1
+ endif
h(i,kb1) = h(i,kb1) - h1_to_h2 ; h1 = h(i,kb1)
h(i,kb2) = (h(i,kb2) - h2_to_k1) + h1_to_h2 ; h2 = h(i,kb2)
@@ -2568,8 +2926,13 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
k0 = k1-1
dR1 = RcvTgt(k0)-Rcv(i,kb1) ; dR2 = Rcv(i,kb2)-RcvTgt(k0)
- if ((k0>kb2) .and. (dR1 > 0.0) .and. (h1 > h_min_bl) .and. &
- (h2*dR2 < h1*dR1) .and. (R0(i,kb2) > R0(i,kb1))) then
+ if (CS%nonBous_energetics) then
+ stable = (SpV0(i,kb2) < SpV0(i,kb1))
+ else
+ stable = (R0(i,kb2) > R0(i,kb1))
+ endif
+
+ if ((k0>kb2) .and. (dR1 > 0.0) .and. (h1 > h_min_bl) .and. (h2*dR2 < h1*dR1) .and. stable) then
! An interior isopycnal layer (k0) is intermediate in density between
! the two buffer layers, and there can be detrainment. The entire
! lower buffer layer is combined with a portion of the upper buffer
@@ -2578,12 +2941,20 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
((dR1+dR2)*h1 + dR1*(h1+h2) + &
sqrt((dR2*h1-dR1*h2)**2 + 4*(h1+h2)*h2*(dR1+dR2)*dR2))
- stays_min_merge = MAX(h_min_bl, 2.0*h_min_bl - h_to_bl, &
- h1 - (h1+h2)*(R0(i,kb1) - R0_det) / (R0(i,kb2) - R0(i,kb1)))
- if ((stays_merge > stays_min_merge) .and. &
- (stays_merge + h2_to_k1_rem >= h1 + h2)) then
- mergeable_bl = .true.
- dPE_merge = g_2*(R0(i,kb2)-R0(i,kb1))*(h1-stays_merge)*(h2-stays_merge)
+ if (CS%nonBous_energetics) then
+ stays_min_merge = MAX(h_min_bl, 2.0*h_min_bl - h_to_bl, &
+ h1 - (h1+h2)*(SpV0(i,kb1) - SpV0_det) / (SpV0(i,kb2) - SpV0(i,kb1)))
+ if ((stays_merge > stays_min_merge) .and. (stays_merge + h2_to_k1_rem >= h1 + h2)) then
+ mergeable_bl = .true.
+ dPE_merge_nB = g_2*GV%H_to_RZ**2*(SpV0(i,kb1)-SpV0(i,kb2)) * ((h1-stays_merge)*(h2-stays_merge))
+ endif
+ else
+ stays_min_merge = MAX(h_min_bl, 2.0*h_min_bl - h_to_bl, &
+ h1 - (h1+h2)*(R0(i,kb1) - R0_det) / (R0(i,kb2) - R0(i,kb1)))
+ if ((stays_merge > stays_min_merge) .and. (stays_merge + h2_to_k1_rem >= h1 + h2)) then
+ mergeable_bl = .true.
+ dPE_merge = g_2*(R0(i,kb2)-R0(i,kb1)) * (h1-stays_merge)*(h2-stays_merge)
+ endif
endif
endif
@@ -2624,9 +2995,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
(dT_dS_gauge * dRcv_dT(i) * dRcv + dRcv_dS(i) * dSpice_det)
S_det = S(i,kb2) + I_denom * &
(dRcv_dS(i) * dRcv - dT_dS_gauge * dRcv_dT(i) * dSpice_det)
- ! The detrained values of R0 are based on changes in T and S.
- R0_det = R0(i,kb2) + (T_det-T(i,kb2)) * dR0_dT(i) + &
- (S_det-S(i,kb2)) * dR0_dS(i)
+ ! The detrained values of R0 or SpV0 are based on changes in T and S.
+ if (CS%nonBous_energetics) then
+ SpV0_det = SpV0(i,kb2) + (T_det-T(i,kb2)) * dSpV0_dT(i) + &
+ (S_det-S(i,kb2)) * dSpV0_dS(i)
+ else
+ R0_det = R0(i,kb2) + (T_det-T(i,kb2)) * dR0_dT(i) + &
+ (S_det-S(i,kb2)) * dR0_dS(i)
+ endif
! Now that the properties of the detrained water are known,
! potentially limit the amount of water that is detrained to
@@ -2692,9 +3068,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
S(i,kb2) = (h2*S(i,kb2) - h2_to_k1*S_det) * Ih2f
S(i,k1) = ((h(i,k1)+h_neglect)*S(i,k1) + h2_to_k1*S_det) * Ihk1
- ! Changes in R0 are based on changes in T and S.
- R0(i,kb2) = (h2*R0(i,kb2) - h2_to_k1*R0_det) * Ih2f
- R0(i,k1) = ((h(i,k1)+h_neglect)*R0(i,k1) + h2_to_k1*R0_det) * Ihk1
+ ! Changes in R0 or SpV0 are based on changes in T and S.
+ if (CS%nonBous_energetics) then
+ SpV0(i,kb2) = (h2*SpV0(i,kb2) - h2_to_k1*SpV0_det) * Ih2f
+ SpV0(i,k1) = ((h(i,k1)+h_neglect)*SpV0(i,k1) + h2_to_k1*SpV0_det) * Ihk1
+ else
+ R0(i,kb2) = (h2*R0(i,kb2) - h2_to_k1*R0_det) * Ih2f
+ R0(i,k1) = ((h(i,k1)+h_neglect)*R0(i,k1) + h2_to_k1*R0_det) * Ihk1
+ endif
else
! h2==h2_to_k1 can happen if dR2b = 0 exactly, but this is very
! unlikely. In this case the entirety of layer kb2 is detrained.
@@ -2704,13 +3085,22 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
Rcv(i,k1) = (h(i,k1)*Rcv(i,k1) + h2*Rcv(i,kb2)) * Ihk1
T(i,k1) = (h(i,k1)*T(i,k1) + h2*T(i,kb2)) * Ihk1
S(i,k1) = (h(i,k1)*S(i,k1) + h2*S(i,kb2)) * Ihk1
- R0(i,k1) = (h(i,k1)*R0(i,k1) + h2*R0(i,kb2)) * Ihk1
+ if (CS%nonBous_energetics) then
+ SpV0(i,k1) = (h(i,k1)*SpV0(i,k1) + h2*SpV0(i,kb2)) * Ihk1
+ else
+ R0(i,k1) = (h(i,k1)*R0(i,k1) + h2*R0(i,kb2)) * Ihk1
+ endif
endif
h(i,k1) = h(i,k1) + h2_to_k1
h(i,kb2) = h(i,kb2) - h2_to_k1 ; h2 = h(i,kb2)
- ! dPE_extrap should be positive here.
- dPE_extrap = I2Rho0*(R0_det-R0(i,kb2))*h2_to_k1*h2
+ ! dPE_extrap_rhoG should be positive here.
+ if (CS%nonBous_energetics) then
+ dPE_extrap_rhoG = 0.5*(SpV0(i,kb2)-SpV0_det) * (h2_to_k1*h2) / SpV0(i,k1)
+ dPE_extrapolate = 0.5*GV%g_Earth*GV%H_to_RZ**2*(SpV0(i,kb2)-SpV0_det) * (h2_to_k1*h2)
+ else
+ dPE_extrap_rhoG = I2Rho0*(R0_det-R0(i,kb2))*h2_to_k1*h2
+ endif
d_ea(i,kb2) = d_ea(i,kb2) - h2_to_k1
d_ea(i,k1) = d_ea(i,k1) + h2_to_k1
@@ -2737,9 +3127,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
Ihdet = 0.0 ; if (h_to_bl > 0.0) Ihdet = 1.0 / h_to_bl
Ih1f = 1.0 / (h_det_to_h1 + h_ml_to_h1)
- R0(i,kb2) = ((h2*R0(i,kb2) + h1*R0(i,kb1)) + &
- (h_det_to_h2*R0_to_bl*Ihdet + h_ml_to_h2*R0(i,0))) * Ih
- R0(i,kb1) = (h_det_to_h1*R0_to_bl*Ihdet + h_ml_to_h1*R0(i,0)) * Ih1f
+ if (CS%nonBous_energetics) then
+ SpV0(i,kb2) = ((h2*SpV0(i,kb2) + h1*SpV0(i,kb1)) + &
+ (h_det_to_h2*SpV0_to_bl*Ihdet + h_ml_to_h2*SpV0(i,0))) * Ih
+ SpV0(i,kb1) = (h_det_to_h1*SpV0_to_bl*Ihdet + h_ml_to_h1*SpV0(i,0)) * Ih1f
+ else
+ R0(i,kb2) = ((h2*R0(i,kb2) + h1*R0(i,kb1)) + &
+ (h_det_to_h2*R0_to_bl*Ihdet + h_ml_to_h2*R0(i,0))) * Ih
+ R0(i,kb1) = (h_det_to_h1*R0_to_bl*Ihdet + h_ml_to_h1*R0(i,0)) * Ih1f
+ endif
Rcv(i,kb2) = ((h2*Rcv(i,kb2) + h1*Rcv(i,kb1)) + &
(h_det_to_h2*Rcv_to_bl*Ihdet + h_ml_to_h2*Rcv(i,0))) * Ih
@@ -2763,18 +3159,30 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
if (allocated(CS%diag_PE_detrain) .or. allocated(CS%diag_PE_detrain2)) then
- R0_det = R0_to_bl*Ihdet
- s1en = g_2 * Idt_H2 * ( ((R0(i,kb2)-R0(i,kb1))*h1*h2 + &
- h_det_to_h2*( (R0(i,kb1)-R0_det)*h1 + (R0(i,kb2)-R0_det)*h2 ) + &
- h_ml_to_h2*( (R0(i,kb2)-R0(i,0))*h2 + (R0(i,kb1)-R0(i,0))*h1 + &
- (R0_det-R0(i,0))*h_det_to_h2 ) + &
- h_det_to_h1*h_ml_to_h1*(R0_det-R0(i,0))) - 2.0*GV%Rho0*dPE_extrap )
+ if (CS%nonBous_energetics) then
+ SpV0_det = SpV0_to_bl*Ihdet
+ s1en = Idt_diag * ( -GV%H_to_RZ**2 * g_2 * ((SpV0(i,kb2)-SpV0(i,kb1))*h1*h2 + &
+ h_det_to_h2*( (SpV0(i,kb1)-SpV0_det)*h1 + (SpV0(i,kb2)-SpV0_det)*h2 ) + &
+ h_ml_to_h2*( (SpV0(i,kb2)-SpV0(i,0))*h2 + (SpV0(i,kb1)-SpV0(i,0))*h1 + &
+ (SpV0_det-SpV0(i,0))*h_det_to_h2 ) + &
+ h_det_to_h1*h_ml_to_h1*(SpV0_det-SpV0(i,0))) - dPE_extrapolate )
+
+ if (allocated(CS%diag_PE_detrain2)) &
+ CS%diag_PE_detrain2(i,j) = CS%diag_PE_detrain2(i,j) + s1en + Idt_diag*dPE_extrapolate
+ else
+ R0_det = R0_to_bl*Ihdet
+ s1en = g_2 * Idt_H2 * ( ((R0(i,kb2)-R0(i,kb1))*h1*h2 + &
+ h_det_to_h2*( (R0(i,kb1)-R0_det)*h1 + (R0(i,kb2)-R0_det)*h2 ) + &
+ h_ml_to_h2*( (R0(i,kb2)-R0(i,0))*h2 + (R0(i,kb1)-R0(i,0))*h1 + &
+ (R0_det-R0(i,0))*h_det_to_h2 ) + &
+ h_det_to_h1*h_ml_to_h1*(R0_det-R0(i,0))) - 2.0*GV%Rho0*dPE_extrap_rhoG )
+
+ if (allocated(CS%diag_PE_detrain2)) &
+ CS%diag_PE_detrain2(i,j) = CS%diag_PE_detrain2(i,j) + s1en + Idt_H2*Rho0xG*dPE_extrap_rhoG
+ endif
if (allocated(CS%diag_PE_detrain)) &
CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + s1en
-
- if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
- CS%diag_PE_detrain2(i,j) + s1en + Idt_H2*Rho0xG*dPE_extrap
endif
elseif ((h_to_bl > 0.0) .or. (h1 < h_min_bl) .or. (h2 < h_min_bl)) then
@@ -2786,8 +3194,18 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
if (h_from_ml > 0.0) then
! Some water needs to be moved from the mixed layer so that the upper
! (and perhaps lower) buffer layers exceed their minimum thicknesses.
- dPE_extrap = dPE_extrap - I2Rho0*h_from_ml*(R0_to_bl - R0(i,0)*h_to_bl)
- R0_to_bl = R0_to_bl + h_from_ml*R0(i,0)
+ if (CS%nonBous_energetics) then
+ ! The choice of which specific volume to use in the denominator could be revisited.
+ ! dPE_extrap_rhoG = dPE_extrap_rhoG + 0.5*h_from_ml*(SpV0_to_bl - SpV0(i,0)*h_to_bl) / SpV0(i,0)
+ dPE_extrap_rhoG = dPE_extrap_rhoG + 0.5*h_from_ml*(SpV0_to_bl - SpV0(i,0)*h_to_bl) * &
+ ( (h_to_bl + h_from_ml) / (SpV0_to_bl + h_from_ml*SpV0(i,0)) )
+ dPE_extrapolate = dPE_extrapolate + 0.5*GV%g_Earth*GV%H_to_RZ**2 * &
+ h_from_ml*(SpV0_to_bl - SpV0(i,0)*h_to_bl)
+ SpV0_to_bl = SpV0_to_bl + h_from_ml*SpV0(i,0)
+ else
+ dPE_extrap_rhoG = dPE_extrap_rhoG - I2Rho0*h_from_ml*(R0_to_bl - R0(i,0)*h_to_bl)
+ R0_to_bl = R0_to_bl + h_from_ml*R0(i,0)
+ endif
Rcv_to_bl = Rcv_to_bl + h_from_ml*Rcv(i,0)
T_to_bl = T_to_bl + h_from_ml*T(i,0)
S_to_bl = S_to_bl + h_from_ml*S(i,0)
@@ -2799,8 +3217,13 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
! The absolute value should be unnecessary and 1e9 is just a large number.
b1 = 1.0e9
- if (R0(i,kb2) - R0(i,kb1) > 1.0e-9*abs(R0(i,kb1) - R0_det)) &
- b1 = abs(R0(i,kb1) - R0_det) / (R0(i,kb2) - R0(i,kb1))
+ if (CS%nonBous_energetics) then
+ if (SpV0(i,kb1) - SpV0(i,kb2) > 1.0e-9*abs(SpV0_det - SpV0(i,kb1))) &
+ b1 = abs(SpV0_det - SpV0(i,kb1)) / (SpV0(i,kb1) - SpV0(i,kb2))
+ else
+ if (R0(i,kb2) - R0(i,kb1) > 1.0e-9*abs(R0(i,kb1) - R0_det)) &
+ b1 = abs(R0(i,kb1) - R0_det) / (R0(i,kb2) - R0(i,kb1))
+ endif
stays_min = MAX((1.0-b1)*h1 - b1*h2, 0.0, h_min_bl - h_to_bl)
stays_max = h1 - MAX(h_min_bl-h2,0.0)
@@ -2820,9 +3243,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
if (s2 < 0.0) then
! The energy released by detrainment from the lower buffer layer can be
! used to mix water from the upper buffer layer into the lower one.
- s3sq = I_ya*MAX(bh0*h1-dPE_extrap, 0.0)
+ s3sq = I_ya*MAX(bh0*h1-dPE_extrap_rhoG, 0.0)
else
- s3sq = I_ya*(bh0*h1-MIN(dPE_extrap,0.0))
+ s3sq = I_ya*(bh0*h1-MIN(dPE_extrap_rhoG,0.0))
endif
if (s3sq == 0.0) then
@@ -2860,10 +3283,17 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
endif
endif
- dPE_det = g_2*((R0(i,kb1)*h_to_bl - R0_to_bl)*stays + &
- (R0(i,kb2)-R0(i,kb1)) * (h1-stays) * &
- (h2 - scale_slope*stays*((h1+h2)+h_to_bl)/(h1+h2)) ) - &
- Rho0xG*dPE_extrap
+ if (CS%nonBous_energetics) then
+ dPE_det_nB = -g_2*GV%H_to_RZ**2*((SpV0(i,kb1)*h_to_bl - SpV0_to_bl)*stays + &
+ (SpV0(i,kb2)-SpV0(i,kb1)) * (h1-stays) * &
+ (h2 - scale_slope*stays*((h1+h2)+h_to_bl)/(h1+h2)) ) - &
+ dPE_extrapolate
+ else
+ dPE_det = g_2*((R0(i,kb1)*h_to_bl - R0_to_bl)*stays + &
+ (R0(i,kb2)-R0(i,kb1)) * (h1-stays) * &
+ (h2 - scale_slope*stays*((h1+h2)+h_to_bl)/(h1+h2)) ) - &
+ Rho0xG*dPE_extrap_rhoG
+ endif
if (dPE_time_ratio*h_to_bl > h_to_bl+h(i,0)) then
dPE_ratio = (h_to_bl+h(i,0)) / h_to_bl
@@ -2871,7 +3301,13 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
dPE_ratio = dPE_time_ratio
endif
- if ((mergeable_bl) .and. (num_events*dPE_ratio*dPE_det > dPE_merge)) then
+ if (CS%nonBous_energetics) then
+ better_to_merge = (num_events*dPE_ratio*dPE_det_nB > dPE_merge_nB)
+ else
+ better_to_merge = (num_events*dPE_ratio*dPE_det > dPE_merge)
+ endif
+
+ if (mergeable_bl .and. better_to_merge) then
! It is energetically preferable to merge the two buffer layers, detrain
! them into interior layer (k0), move the remaining upper buffer layer
! water into the lower buffer layer, and detrain undiluted into the
@@ -2898,8 +3334,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
I_denom = 1.0 / (dRcv_dS(i)**2 + (dT_dS_gauge*dRcv_dT(i))**2)
dSpice_2dz = (dS_dT_gauge*dRcv_dS(i)*(T(i,kb1)-T(i,kb2)) - &
dT_dS_gauge*dRcv_dT(i)*(S(i,kb1)-S(i,kb2))) * Ih12
- dSpice_lim = (dS_dT_gauge*dR0_dS(i)*(T_to_bl-T(i,kb1)*h_to_bl) - &
- dT_dS_gauge*dR0_dT(i)*(S_to_bl-S(i,kb1)*h_to_bl)) / h_to_bl
+ if (CS%nonBous_energetics) then
+ ! Use the specific volume differences to limit the coordinate density change.
+ dSpice_lim = -Rcv(i,kb1) * (dS_dT_gauge*dSpV0_dS(i)*(T_to_bl-T(i,kb1)*h_to_bl) - &
+ dT_dS_gauge*dSpV0_dT(i)*(S_to_bl-S(i,kb1)*h_to_bl)) / (SpV0(i,kb1) * h_to_bl)
+ else
+ dSpice_lim = (dS_dT_gauge*dR0_dS(i)*(T_to_bl-T(i,kb1)*h_to_bl) - &
+ dT_dS_gauge*dR0_dT(i)*(S_to_bl-S(i,kb1)*h_to_bl)) / h_to_bl
+ endif
if (dSpice_lim * dSpice_2dz <= 0.0) dSpice_2dz = 0.0
if (stays > 0.0) then
@@ -2912,15 +3354,20 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
(dT_dS_gauge * dRcv_dT(i) * dRcv_stays + dRcv_dS(i) * dSpice_stays)
S_stays = S(i,kb1) + I_denom * &
(dRcv_dS(i) * dRcv_stays - dT_dS_gauge * dRcv_dT(i) * dSpice_stays)
- ! The values of R0 are based on changes in T and S.
- R0_stays = R0(i,kb1) + (T_stays-T(i,kb1)) * dR0_dT(i) + &
- (S_stays-S(i,kb1)) * dR0_dS(i)
+ ! The values of R0 or SpV0 are based on changes in T and S.
+ if (CS%nonBous_energetics) then
+ SpV0_stays = SpV0(i,kb1) + (T_stays-T(i,kb1)) * dSpV0_dT(i) + &
+ (S_stays-S(i,kb1)) * dSpV0_dS(i)
+ else
+ R0_stays = R0(i,kb1) + (T_stays-T(i,kb1)) * dR0_dT(i) + &
+ (S_stays-S(i,kb1)) * dR0_dS(i)
+ endif
else
! Limit the spiciness of the water that moves into the lower buffer layer.
if (abs(dSpice_lim) < abs(dSpice_2dz*h1_to_k0)) &
dSpice_2dz = dSpice_lim/h1_to_k0
! These will be multiplied by 0 later.
- T_stays = 0.0 ; S_stays = 0.0 ; R0_stays = 0.0
+ T_stays = 0.0 ; S_stays = 0.0 ; R0_stays = 0.0 ; SpV0_stays = 0.0
endif
dSpice_det = - dSpice_2dz*(stays + h1_to_h2)
@@ -2928,9 +3375,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
(dT_dS_gauge * dRcv_dT(i) * dRcv_det + dRcv_dS(i) * dSpice_det)
S_det = S(i,kb1) + I_denom * &
(dRcv_dS(i) * dRcv_det - dT_dS_gauge * dRcv_dT(i) * dSpice_det)
- ! The values of R0 are based on changes in T and S.
- R0_det = R0(i,kb1) + (T_det-T(i,kb1)) * dR0_dT(i) + &
- (S_det-S(i,kb1)) * dR0_dS(i)
+ ! The values of R0 or SpV0 are based on changes in T and S.
+ if (CS%nonBous_energetics) then
+ SpV0_det = SpV0(i,kb1) + (T_det-T(i,kb1)) * dSpV0_dT(i) + &
+ (S_det-S(i,kb1)) * dSpV0_dS(i)
+ else
+ R0_det = R0(i,kb1) + (T_det-T(i,kb1)) * dR0_dT(i) + &
+ (S_det-S(i,kb1)) * dR0_dS(i)
+ endif
T(i,k0) = ((h1_to_k0*T_det + h2*T(i,kb2)) + h(i,k0)*T(i,k0)) * Ihk0
T(i,kb2) = (h1*T(i,kb1) - stays*T_stays - h1_to_k0*T_det) * Ih2f
@@ -2940,29 +3392,40 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
S(i,kb2) = (h1*S(i,kb1) - stays*S_stays - h1_to_k0*S_det) * Ih2f
S(i,kb1) = (S_to_bl + stays*S_stays) * Ih1f
- R0(i,k0) = ((h1_to_k0*R0_det + h2*R0(i,kb2)) + h(i,k0)*R0(i,k0)) * Ihk0
- R0(i,kb2) = (h1*R0(i,kb1) - stays*R0_stays - h1_to_k0*R0_det) * Ih2f
- R0(i,kb1) = (R0_to_bl + stays*R0_stays) * Ih1f
+ if (CS%nonBous_energetics) then
+ SpV0(i,k0) = ((h1_to_k0*SpV0_det + h2*SpV0(i,kb2)) + h(i,k0)*SpV0(i,k0)) * Ihk0
+ SpV0(i,kb2) = (h1*SpV0(i,kb1) - stays*SpV0_stays - h1_to_k0*SpV0_det) * Ih2f
+ SpV0(i,kb1) = (SpV0_to_bl + stays*SpV0_stays) * Ih1f
+ else
+ R0(i,k0) = ((h1_to_k0*R0_det + h2*R0(i,kb2)) + h(i,k0)*R0(i,k0)) * Ihk0
+ R0(i,kb2) = (h1*R0(i,kb1) - stays*R0_stays - h1_to_k0*R0_det) * Ih2f
+ R0(i,kb1) = (R0_to_bl + stays*R0_stays) * Ih1f
+ endif
! ! The following is 2nd-order upwind advection without limiters.
! dT_2dz = (T(i,kb1) - T(i,kb2)) * Ih12
! T(i,k0) = (h1_to_k0*(T(i,kb1) - dT_2dz*(stays+h1_to_h2)) + &
! h2*T(i,kb2) + h(i,k0)*T(i,k0)) * Ihk0
! T(i,kb2) = T(i,kb1) + dT_2dz*(h1_to_k0-stays)
-! T(i,kb1) = (T_to_bl + stays*(T(i,kb1) + &
-! dT_2dz*(h1_to_k0 + h1_to_h2))) * Ih1f
+! T(i,kb1) = (T_to_bl + stays*(T(i,kb1) + dT_2dz*(h1_to_k0 + h1_to_h2))) * Ih1f
! dS_2dz = (S(i,kb1) - S(i,kb2)) * Ih12
! S(i,k0) = (h1_to_k0*(S(i,kb1) - dS_2dz*(stays+h1_to_h2)) + &
! h2*S(i,kb2) + h(i,k0)*S(i,k0)) * Ihk0
! S(i,kb2) = S(i,kb1) + dS_2dz*(h1_to_k0-stays)
-! S(i,kb1) = (S_to_bl + stays*(S(i,kb1) + &
-! dS_2dz*(h1_to_k0 + h1_to_h2))) * Ih1f
-! dR0_2dz = (R0(i,kb1) - R0(i,kb2)) * Ih12
-! R0(i,k0) = (h1_to_k0*(R0(i,kb1) - dR0_2dz*(stays+h1_to_h2)) + &
-! h2*R0(i,kb2) + h(i,k0)*R0(i,k0)) * Ihk0
-! R0(i,kb2) = R0(i,kb1) + dR0_2dz*(h1_to_k0-stays)
-! R0(i,kb1) = (R0_to_bl + stays*(R0(i,kb1) + &
-! dR0_2dz*(h1_to_k0 + h1_to_h2))) * Ih1f
+! S(i,kb1) = (S_to_bl + stays*(S(i,kb1) + dS_2dz*(h1_to_k0 + h1_to_h2))) * Ih1f
+! if (CS%nonBous_energetics) then
+! dSpV0_2dz = (SpV0(i,kb1) - SpV0(i,kb2)) * Ih12
+! SpV0(i,k0) = (h1_to_k0*(SpV0(i,kb1) - dSpV0_2dz*(stays+h1_to_h2)) + &
+! h2*SpV0(i,kb2) + h(i,k0)*SpV0(i,k0)) * Ihk0
+! SpV0(i,kb2) = SpV0(i,kb1) + dSpV0_2dz*(h1_to_k0-stays)
+! SpV0(i,kb1) = (SpV0_to_bl + stays*(SpV0(i,kb1) + dSpV0_2dz*(h1_to_k0 + h1_to_h2))) * Ih1f
+! else
+! dR0_2dz = (R0(i,kb1) - R0(i,kb2)) * Ih12
+! R0(i,k0) = (h1_to_k0*(R0(i,kb1) - dR0_2dz*(stays+h1_to_h2)) + &
+! h2*R0(i,kb2) + h(i,k0)*R0(i,k0)) * Ihk0
+! R0(i,kb2) = R0(i,kb1) + dR0_2dz*(h1_to_k0-stays)
+! R0(i,kb1) = (R0_to_bl + stays*(R0(i,kb1) + dR0_2dz*(h1_to_k0 + h1_to_h2))) * Ih1f
+! endif
d_ea(i,kb1) = (d_ea(i,kb1) + h_to_bl) + (stays - h1)
d_ea(i,kb2) = d_ea(i,kb2) + (h1_to_h2 - h2)
@@ -2971,10 +3434,17 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
h(i,kb1) = stays + h_to_bl
h(i,kb2) = h1_to_h2
h(i,k0) = h(i,k0) + (h1_to_k0 + h2)
- if (allocated(CS%diag_PE_detrain)) &
- CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_merge
- if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
- CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap)
+ if (CS%nonBous_energetics) then
+ if (allocated(CS%diag_PE_detrain)) &
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_diag*dPE_merge_nB
+ if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
+ CS%diag_PE_detrain2(i,j) + Idt_diag*(dPE_det_nB + dPE_extrapolate)
+ else
+ if (allocated(CS%diag_PE_detrain)) &
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_merge
+ if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
+ CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap_rhoG)
+ endif
else ! Not mergeable_bl.
! There is no further detrainment from the buffer layers, and the
! upper buffer layer water is distributed optimally between the
@@ -2982,37 +3452,64 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
h1_to_h2 = h1 - stays
Ih1f = 1.0 / (h_to_bl + stays) ; Ih2f = 1.0 / (h2 + h1_to_h2)
Ih = 1.0 / (h1 + h2)
- dR0_2dz = (R0(i,kb1) - R0(i,kb2)) * Ih
- R0(i,kb2) = (h2*R0(i,kb2) + h1_to_h2*(R0(i,kb1) - &
- scale_slope*dR0_2dz*stays)) * Ih2f
- R0(i,kb1) = (R0_to_bl + stays*(R0(i,kb1) + &
- scale_slope*dR0_2dz*h1_to_h2)) * Ih1f
-
- ! Use 2nd order upwind advection of spiciness, limited by the value
- ! in the detrained water to determine the detrained temperature and
- ! salinity.
- dR0 = scale_slope*dR0_2dz*h1_to_h2
- dSpice_stays = (dS_dT_gauge*dR0_dS(i)*(T(i,kb1)-T(i,kb2)) - &
- dT_dS_gauge*dR0_dT(i)*(S(i,kb1)-S(i,kb2))) * &
- scale_slope*h1_to_h2 * Ih
- if (h_to_bl > 0.0) then
- dSpice_lim = (dS_dT_gauge*dR0_dS(i)*(T_to_bl-T(i,kb1)*h_to_bl) - &
- dT_dS_gauge*dR0_dT(i)*(S_to_bl-S(i,kb1)*h_to_bl)) /&
- h_to_bl
+ if (CS%nonBous_energetics) then
+ dSpV0_2dz = (SpV0(i,kb1) - SpV0(i,kb2)) * Ih
+ SpV0(i,kb2) = (h2*SpV0(i,kb2) + h1_to_h2*(SpV0(i,kb1) - scale_slope*dSpV0_2dz*stays)) * Ih2f
+ SpV0(i,kb1) = (SpV0_to_bl + stays*(SpV0(i,kb1) + scale_slope*dSpV0_2dz*h1_to_h2)) * Ih1f
else
- dSpice_lim = dS_dT_gauge*dR0_dS(i)*(T(i,0)-T(i,kb1)) - &
- dT_dS_gauge*dR0_dT(i)*(S(i,0)-S(i,kb1))
+ dR0_2dz = (R0(i,kb1) - R0(i,kb2)) * Ih
+ R0(i,kb2) = (h2*R0(i,kb2) + h1_to_h2*(R0(i,kb1) - scale_slope*dR0_2dz*stays)) * Ih2f
+ R0(i,kb1) = (R0_to_bl + stays*(R0(i,kb1) + scale_slope*dR0_2dz*h1_to_h2)) * Ih1f
endif
- if (dSpice_stays*dSpice_lim <= 0.0) then
- dSpice_stays = 0.0
- elseif (abs(dSpice_stays) > abs(dSpice_lim)) then
- dSpice_stays = dSpice_lim
+
+ ! Use 2nd order upwind advection of spiciness, limited by the value in the
+ ! detrained water to determine the detrained temperature and salinity.
+ if (CS%nonBous_energetics) then
+ dSpV0 = scale_slope*dSpV0_2dz*h1_to_h2
+ dSpiceSpV_stays = (dS_dT_gauge*dSpV0_dS(i)*(T(i,kb1)-T(i,kb2)) - &
+ dT_dS_gauge*dSpV0_dT(i)*(S(i,kb1)-S(i,kb2))) * &
+ scale_slope*h1_to_h2 * Ih
+ if (h_to_bl > 0.0) then
+ dSpiceSpV_lim = (dS_dT_gauge*dSpV0_dS(i)*(T_to_bl-T(i,kb1)*h_to_bl) - &
+ dT_dS_gauge*dSpV0_dT(i)*(S_to_bl-S(i,kb1)*h_to_bl)) / h_to_bl
+ else
+ dSpiceSpV_lim = dS_dT_gauge*dSpV0_dS(i)*(T(i,0)-T(i,kb1)) - &
+ dT_dS_gauge*dSpV0_dT(i)*(S(i,0)-S(i,kb1))
+ endif
+ if (dSpiceSpV_stays*dSpiceSpV_lim <= 0.0) then
+ dSpiceSpV_stays = 0.0
+ elseif (abs(dSpiceSpV_stays) > abs(dSpiceSpV_lim)) then
+ dSpiceSpV_stays = dSpiceSpV_lim
+ endif
+ I_denom = 1.0 / (dSpV0_dS(i)**2 + (dT_dS_gauge*dSpV0_dT(i))**2)
+ T_stays = T(i,kb1) + dT_dS_gauge * I_denom * &
+ (dT_dS_gauge * dSpV0_dT(i) * dSpV0 + dSpV0_dS(i) * dSpiceSpV_stays)
+ S_stays = S(i,kb1) + I_denom * &
+ (dSpV0_dS(i) * dSpV0 - dT_dS_gauge * dSpV0_dT(i) * dSpiceSpV_stays)
+ else
+ dR0 = scale_slope*dR0_2dz*h1_to_h2
+ dSpice_stays = (dS_dT_gauge*dR0_dS(i)*(T(i,kb1)-T(i,kb2)) - &
+ dT_dS_gauge*dR0_dT(i)*(S(i,kb1)-S(i,kb2))) * &
+ scale_slope*h1_to_h2 * Ih
+ if (h_to_bl > 0.0) then
+ dSpice_lim = (dS_dT_gauge*dR0_dS(i)*(T_to_bl-T(i,kb1)*h_to_bl) - &
+ dT_dS_gauge*dR0_dT(i)*(S_to_bl-S(i,kb1)*h_to_bl)) / h_to_bl
+ else
+ dSpice_lim = dS_dT_gauge*dR0_dS(i)*(T(i,0)-T(i,kb1)) - &
+ dT_dS_gauge*dR0_dT(i)*(S(i,0)-S(i,kb1))
+ endif
+ if (dSpice_stays*dSpice_lim <= 0.0) then
+ dSpice_stays = 0.0
+ elseif (abs(dSpice_stays) > abs(dSpice_lim)) then
+ dSpice_stays = dSpice_lim
+ endif
+ I_denom = 1.0 / (dR0_dS(i)**2 + (dT_dS_gauge*dR0_dT(i))**2)
+ T_stays = T(i,kb1) + dT_dS_gauge * I_denom * &
+ (dT_dS_gauge * dR0_dT(i) * dR0 + dR0_dS(i) * dSpice_stays)
+ S_stays = S(i,kb1) + I_denom * &
+ (dR0_dS(i) * dR0 - dT_dS_gauge * dR0_dT(i) * dSpice_stays)
endif
- I_denom = 1.0 / (dR0_dS(i)**2 + (dT_dS_gauge*dR0_dT(i))**2)
- T_stays = T(i,kb1) + dT_dS_gauge * I_denom * &
- (dT_dS_gauge * dR0_dT(i) * dR0 + dR0_dS(i) * dSpice_stays)
- S_stays = S(i,kb1) + I_denom * &
- (dR0_dS(i) * dR0 - dT_dS_gauge * dR0_dT(i) * dSpice_stays)
+
! The detrained values of Rcv are based on changes in T and S.
Rcv_stays = Rcv(i,kb1) + (T_stays-T(i,kb1)) * dRcv_dT(i) + &
(S_stays-S(i,kb1)) * dRcv_dS(i)
@@ -3047,10 +3544,19 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j,
h(i,kb1) = stays + h_to_bl
h(i,kb2) = h(i,kb2) + h1_to_h2
- if (allocated(CS%diag_PE_detrain)) &
- CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_det
- if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
- CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap)
+ if (CS%nonBous_energetics) then
+ if (allocated(CS%diag_PE_detrain)) &
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_diag*dPE_det_nB
+ if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
+ CS%diag_PE_detrain2(i,j) + Idt_diag*(dPE_det_nB + dPE_extrapolate)
+ else
+ ! Recasting dPE_det into the same units as dPE_det_nB changes these diagnostics slightly
+ ! in some cases for reasons that are not understood.
+ if (allocated(CS%diag_PE_detrain)) &
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_det
+ if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = &
+ CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap_rhoG)
+ endif
endif
endif ! End of detrainment...
@@ -3061,7 +3567,7 @@ end subroutine mixedlayer_detrain_2
!> This subroutine moves any water left in the former mixed layers into the
!! single buffer layers and may also move buffer layer water into the interior
!! isopycnal layers.
-subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_eb, &
+subroutine mixedlayer_detrain_1(h, T, S, R0, SpV0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_eb, &
j, G, GV, US, CS, dRcv_dT, dRcv_dS, max_BL_det)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
@@ -3071,6 +3577,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [S ~> ppt].
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to
!! surface pressure [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: SpV0 !< Specific volume referenced to
+ !! surface pressure [R-1 ~> m3 kg]
real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential
!! density [R ~> kg m-3].
real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each
@@ -3115,18 +3623,26 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
! extrapolating [S R-1 ~> ppt m3 kg-1]
real :: dRml ! The density range within the extent of the mixed layers [R ~> kg m-3]
real :: dR0_dRcv ! The relative changes in the potential density and the coordinate density [nondim]
+ real :: dSpV0_dRcv ! The relative changes in the specific volume and the coordinate density [R-2 ~> m6 kg-2]
real :: I_denom ! A work variable [S2 R-2 ~> ppt2 m6 kg-2].
real :: Sdown ! The salinity of the detrained water [S ~> ppt]
real :: Tdown ! The temperature of the detrained water [C ~> degC]
real :: dt_Time ! The timestep divided by the detrainment timescale [nondim].
- real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the
+ real :: g_H_2Rho0dt ! Half the gravitational acceleration times the
! conversion from H to m divided by the mean density times the time
- ! step [L2 Z T-3 H-2 R-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3].
+ ! step [L2 T-3 H-1 R-1 ~> m4 s-3 kg-1 or m7 s-3 kg-2].
real :: g_H2_2dt ! Half the gravitational acceleration times the square of the
! conversion from H to Z divided by the diagnostic time step
! [L2 Z H-2 T-3 ~> m s-3 or m7 kg-2 s-3].
+ real :: nB_g_H_2dt ! Half the gravitational acceleration times the conversion from
+ ! H to RZ divided by the diagnostic time step
+ ! [L2 R H-1 T-3 ~> kg m s-3 or m4 s-3].
+ real :: nB_gRZ_H2_2dt ! Half the gravitational acceleration times the conversion from
+ ! H to RZ squared divided by the diagnostic time step
+ ! [L2 R2 Z H-2 T-3 ~> kg2 m-2 s-3 or m4 s-3].
real :: x1 ! A temporary work variable [various]
logical :: splittable_BL(SZI_(G)), orthogonal_extrap
+ logical :: must_unmix
integer :: i, is, ie, k, k1, nkmb, nz
is = G%isc ; ie = G%iec ; nz = GV%ke
@@ -3135,24 +3651,45 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
"CS%nkbl must be 1 in mixedlayer_detrain_1.")
dt_Time = dt / CS%BL_detrain_time
- g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag)
- g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag)
+
+ if (CS%nonBous_energetics) then
+ nB_g_H_2dt = (GV%g_Earth * GV%H_to_RZ) / (2.0 * dt_diag)
+ nB_gRZ_H2_2dt = GV%H_to_RZ * nB_g_H_2dt
+ else
+ g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag)
+ g_H_2Rho0dt = g_H2_2dt * GV%RZ_to_H
+ endif
! Move detrained water into the buffer layer.
do k=1,CS%nkml
do i=is,ie ; if (h(i,k) > 0.0) then
Ih = 1.0 / (h(i,nkmb) + h(i,k))
- if (CS%TKE_diagnostics) &
- CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + &
- g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
- if (allocated(CS%diag_PE_detrain)) &
- CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + &
- g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
- if (allocated(CS%diag_PE_detrain2)) &
- CS%diag_PE_detrain2(i,j) = CS%diag_PE_detrain2(i,j) + &
- g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
-
- R0(i,nkmb) = (R0(i,nkmb)*h(i,nkmb) + R0(i,k)*h(i,k)) * Ih
+
+ if (CS%nonBous_energetics) then
+ if (CS%TKE_diagnostics) &
+ CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) - &
+ nB_g_H_2dt * (h(i,k) * h(i,nkmb)) * (SpV0(i,nkmb) - SpV0(i,k))
+ if (allocated(CS%diag_PE_detrain)) &
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) - &
+ nB_gRZ_H2_2dt * (h(i,k) * h(i,nkmb)) * (SpV0(i,nkmb) - SpV0(i,k))
+ if (allocated(CS%diag_PE_detrain2)) &
+ CS%diag_PE_detrain2(i,j) = CS%diag_PE_detrain2(i,j) - &
+ nB_gRZ_H2_2dt * (h(i,k) * h(i,nkmb)) * (SpV0(i,nkmb) - SpV0(i,k))
+
+ SpV0(i,nkmb) = (SpV0(i,nkmb)*h(i,nkmb) + SpV0(i,k)*h(i,k)) * Ih
+ else
+ if (CS%TKE_diagnostics) &
+ CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + &
+ g_H_2Rho0dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
+ if (allocated(CS%diag_PE_detrain)) &
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + &
+ g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
+ if (allocated(CS%diag_PE_detrain2)) &
+ CS%diag_PE_detrain2(i,j) = CS%diag_PE_detrain2(i,j) + &
+ g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k))
+
+ R0(i,nkmb) = (R0(i,nkmb)*h(i,nkmb) + R0(i,k)*h(i,k)) * Ih
+ endif
Rcv(i,nkmb) = (Rcv(i,nkmb)*h(i,nkmb) + Rcv(i,k)*h(i,k)) * Ih
T(i,nkmb) = (T(i,nkmb)*h(i,nkmb) + T(i,k)*h(i,k)) * Ih
S(i,nkmb) = (S(i,nkmb)*h(i,nkmb) + S(i,k)*h(i,k)) * Ih
@@ -3182,11 +3719,24 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
! the released buoyancy. With multiple buffer layers, much more
! graceful options are available.
do i=is,ie ; if (h(i,nkmb) > 0.0) then
- if ((R0(i,0) < R0(i,nz)) .and. (R0(i,nz) < R0(i,nkmb))) then
- if ((R0(i,nz)-R0(i,0))*h(i,0) > (R0(i,nkmb)-R0(i,nz))*h(i,nkmb)) then
- detrain(i) = (R0(i,nkmb)-R0(i,nz))*h(i,nkmb) / (R0(i,nkmb)-R0(i,0))
+ if (CS%nonBous_energetics) then
+ must_unmix = (SpV0(i,0) > SpV0(i,nz)) .and. (SpV0(i,nz) > SpV0(i,nkmb))
+ else
+ must_unmix = (R0(i,0) < R0(i,nz)) .and. (R0(i,nz) < R0(i,nkmb))
+ endif
+ if (must_unmix) then
+ if (CS%nonBous_energetics) then
+ if ((SpV0(i,0)-SpV0(i,nz))*h(i,0) > (SpV0(i,nz)-SpV0(i,nkmb))*h(i,nkmb)) then
+ detrain(i) = (SpV0(i,nz)-SpV0(i,nkmb))*h(i,nkmb) / (SpV0(i,0)-SpV0(i,nkmb))
+ else
+ detrain(i) = (SpV0(i,0)-SpV0(i,nz))*h(i,0) / (SpV0(i,0)-SpV0(i,nkmb))
+ endif
else
- detrain(i) = (R0(i,nz)-R0(i,0))*h(i,0) / (R0(i,nkmb)-R0(i,0))
+ if ((R0(i,nz)-R0(i,0))*h(i,0) > (R0(i,nkmb)-R0(i,nz))*h(i,nkmb)) then
+ detrain(i) = (R0(i,nkmb)-R0(i,nz))*h(i,nkmb) / (R0(i,nkmb)-R0(i,0))
+ else
+ detrain(i) = (R0(i,nz)-R0(i,0))*h(i,0) / (R0(i,nkmb)-R0(i,0))
+ endif
endif
d_eb(i,CS%nkml) = d_eb(i,CS%nkml) + detrain(i)
@@ -3194,12 +3744,22 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
d_eb(i,nkmb) = d_eb(i,nkmb) - detrain(i)
d_ea(i,nkmb) = d_ea(i,nkmb) + detrain(i)
- if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = &
- CS%diag_PE_detrain(i,j) + g_H2_2dt * detrain(i)* &
- (h(i,0) + h(i,nkmb)) * (R0(i,nkmb) - R0(i,0))
- x1 = R0(i,0)
- R0(i,0) = R0(i,0) - detrain(i)*(R0(i,0)-R0(i,nkmb)) / h(i,0)
- R0(i,nkmb) = R0(i,nkmb) - detrain(i)*(R0(i,nkmb)-x1) / h(i,nkmb)
+ if (CS%nonBous_energetics) then
+ if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = &
+ CS%diag_PE_detrain(i,j) - nB_gRZ_H2_2dt * detrain(i)* &
+ (h(i,0) + h(i,nkmb)) * (SpV0(i,nkmb) - SpV0(i,0))
+ x1 = SpV0(i,0)
+ SpV0(i,0) = SpV0(i,0) - detrain(i)*(SpV0(i,0)-SpV0(i,nkmb)) / h(i,0)
+ SpV0(i,nkmb) = SpV0(i,nkmb) - detrain(i)*(SpV0(i,nkmb)-x1) / h(i,nkmb)
+ else
+ if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = &
+ CS%diag_PE_detrain(i,j) + g_H2_2dt * detrain(i)* &
+ (h(i,0) + h(i,nkmb)) * (R0(i,nkmb) - R0(i,0))
+ x1 = R0(i,0)
+ R0(i,0) = R0(i,0) - detrain(i)*(R0(i,0)-R0(i,nkmb)) / h(i,0)
+ R0(i,nkmb) = R0(i,nkmb) - detrain(i)*(R0(i,nkmb)-x1) / h(i,nkmb)
+ endif
+
x1 = Rcv(i,0)
Rcv(i,0) = Rcv(i,0) - detrain(i)*(Rcv(i,0)-Rcv(i,nkmb)) / h(i,0)
Rcv(i,nkmb) = Rcv(i,nkmb) - detrain(i)*(Rcv(i,nkmb)-x1) / h(i,nkmb)
@@ -3247,9 +3807,13 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
else ; orthogonal_extrap = .true. ; endif
endif
- if ((R0(i,0) >= R0(i,k1)) .or. (Rcv(i,0) >= Rcv(i,nkmb))) cycle
- ! In this case there is an inversion of in-situ density relative to
- ! the coordinate variable. Do not detrain from the buffer layer.
+ ! Check for the case when there is an inversion of in-situ density relative to
+ ! the coordinate variable. Do not detrain from the buffer layer in this case.
+ if (CS%nonBous_energetics) then
+ if ((SpV0(i,0) <= SpV0(i,k1)) .or. (Rcv(i,0) >= Rcv(i,nkmb))) cycle
+ else
+ if ((R0(i,0) >= R0(i,k1)) .or. (Rcv(i,0) >= Rcv(i,nkmb))) cycle
+ endif
if (orthogonal_extrap) then
! 36 here is a typical oceanic value of (dR/dS) / (dR/dT) - it says
@@ -3262,20 +3826,33 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
dT_dR = (T(i,0) - T(i,k1)) / (Rcv(i,0) - Rcv(i,k1))
dS_dR = (S(i,0) - S(i,k1)) / (Rcv(i,0) - Rcv(i,k1))
endif
- dRml = dt_Time * (R0(i,nkmb) - R0(i,0)) * &
- (Rcv(i,0) - Rcv(i,k1)) / (R0(i,0) - R0(i,k1))
- ! Once again, there is an apparent density inversion in Rcv.
- if (dRml < 0.0) cycle
- dR0_dRcv = (R0(i,0) - R0(i,k1)) / (Rcv(i,0) - Rcv(i,k1))
+
+ if (CS%nonBous_energetics) then
+ dRml = dt_Time * (SpV0(i,0) - SpV0(i,nkmb)) * &
+ (Rcv(i,0) - Rcv(i,k1)) / (SpV0(i,k1) - SpV0(i,0))
+ if (dRml < 0.0) cycle ! Once again, there is an apparent density inversion in Rcv.
+ dSpV0_dRcv = (SpV0(i,0) - SpV0(i,k1)) / (Rcv(i,0) - Rcv(i,k1))
+ else
+ dRml = dt_Time * (R0(i,nkmb) - R0(i,0)) * &
+ (Rcv(i,0) - Rcv(i,k1)) / (R0(i,0) - R0(i,k1))
+ if (dRml < 0.0) cycle ! Once again, there is an apparent density inversion in Rcv.
+ dR0_dRcv = (R0(i,0) - R0(i,k1)) / (Rcv(i,0) - Rcv(i,k1))
+ endif
if ((Rcv(i,nkmb) - dRml < RcvTgt(k)) .and. (max_det_rem(i) > h(i,nkmb))) then
! In this case, the buffer layer is split into two isopycnal layers.
- detrain(i) = h(i,nkmb)*(Rcv(i,nkmb) - RcvTgt(k)) / &
- (RcvTgt(k+1) - RcvTgt(k))
+ detrain(i) = h(i,nkmb) * (Rcv(i,nkmb) - RcvTgt(k)) / &
+ (RcvTgt(k+1) - RcvTgt(k))
- if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = &
- CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * &
- (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - RcvTgt(k)) * dR0_dRcv
+ if (allocated(CS%diag_PE_detrain)) then
+ if (CS%nonBous_energetics) then
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + nB_gRZ_H2_2dt * detrain(i) * &
+ (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - RcvTgt(k)) * dSpV0_dRcv
+ else
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * &
+ (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - RcvTgt(k)) * dR0_dRcv
+ endif
+ endif
Tdown = detrain(i) * (T(i,nkmb) + dT_dR*(RcvTgt(k+1)-Rcv(i,nkmb)))
T(i,k) = (h(i,k) * T(i,k) + &
@@ -3322,9 +3899,15 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e
h(i,k+1) = h(i,k+1) + detrain(i)
h(i,nkmb) = h(i,nkmb) - detrain(i)
- if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = &
- CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * dR0_dRcv * &
- (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - Rcv(i,nkmb) + dRml)
+ if (allocated(CS%diag_PE_detrain)) then
+ if (CS%nonBous_energetics) then
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + nB_gRZ_H2_2dt * detrain(i) * dSpV0_dRcv * &
+ (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - Rcv(i,nkmb) + dRml)
+ else
+ CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * dR0_dRcv * &
+ (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - Rcv(i,nkmb) + dRml)
+ endif
+ endif
endif
endif ! (RcvTgt(k) <= Rcv(i,nkmb))
endif ! splittable_BL
@@ -3368,7 +3951,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS)
character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name.
real :: omega_frac_dflt ! The default value for ML_OMEGA_FRAC [nondim]
real :: ustar_min_dflt ! The default value for BML_USTAR_MIN [Z T-1 ~> m s-1]
- real :: Hmix_min_z ! The default value of HMIX_MIN [Z ~> m]
+ real :: Hmix_min_z ! HMIX_MIN in units of vertical extent [Z ~> m], used to set other defaults
integer :: isd, ied, jsd, jed
logical :: use_temperature, use_omega
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -3427,12 +4010,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, "HMIX_MIN", Hmix_min_Z, &
"The minimum mixed layer depth if the mixed layer depth "//&
"is determined dynamically.", units="m", default=0.0, scale=US%m_to_Z)
- CS%Hmix_min = GV%Z_to_H * Hmix_min_Z
+ CS%Hmix_min = GV%m_to_H * (US%Z_to_m * Hmix_min_Z)
call get_param(param_file, mdl, "MECH_TKE_FLOOR", CS%mech_TKE_floor, &
"A tiny floor on the amount of turbulent kinetic energy that is used when "//&
"the mixed layer does not yet contain HMIX_MIN fluid. The default is so "//&
"small that its actual value is irrelevant, so long as it is greater than 0.", &
- units="m3 s-2", default=1.0e-150, scale=US%m_to_Z*US%m_s_to_L_T**2, &
+ units="m3 s-2", default=1.0e-150, scale=GV%m_to_H*US%m_s_to_L_T**2, &
do_not_log=(Hmix_min_Z<=0.0))
call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, &
@@ -3509,7 +4092,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS)
"layers before sorting when ML_RESORT is true.", &
units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA.
! This gives a minimum decay scale that is typically much less than Angstrom.
- ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff)
+ ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_Z + GV%dZ_subroundoff)
call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, &
"The minimum value of ustar that should be used by the "//&
"bulk mixed layer model in setting vertical TKE decay "//&
@@ -3517,6 +4100,11 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS)
units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=US%m_to_Z*US%T_to_s)
if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.")
+ call get_param(param_file, mdl, "BML_NONBOUSINESQ", CS%nonBous_energetics, &
+ "If true, use non-Boussinesq expressions for the energetic calculations "//&
+ "used in the bulk mixed layer calculations.", &
+ default=.not.(GV%Boussinesq.or.GV%semi_Boussinesq))
+
call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, &
"If true, the NKML>1 layers in the mixed layer are "//&
"chosen to optimally represent the impact of the Ekman "//&
@@ -3535,7 +4123,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS)
if (CS%do_rivermix) &
call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, &
"The depth to which rivers are mixed if DO_RIVERMIX is "//&
- "defined.", units="m", default=0.0, scale=US%m_to_Z)
+ "defined.", units="m", default=0.0, scale=GV%m_to_H)
call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, &
"If true, use the fluxes%runoff_Hflx field to set the "//&
"heat carried by runoff, instead of using SST*CP*liq_runoff.", &
@@ -3552,28 +4140,28 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS)
Time, 'Surface mixed layer depth', 'm', conversion=GV%H_to_m)
CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, &
Time, 'Wind-stirring source of mixed layer TKE', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, &
Time, 'Mean kinetic energy source of mixed layer TKE', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, &
Time, 'Convective source of mixed layer TKE', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, &
Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, &
Time, 'TKE consumed by mixing that deepens the mixed layer', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, &
Time, 'Mechanical energy decay sink of mixed layer TKE', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, &
Time, 'Convective energy decay sink of mixed layer TKE', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, &
Time, 'Spurious source of mixed layer TKE from sigma2', &
- 'm3 s-3', conversion=US%Z_to_m*(US%L_to_m**2)*(US%s_to_T**3))
+ 'm3 s-3', conversion=GV%H_to_m*(US%L_to_m**2)*(US%s_to_T**3))
CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, &
Time, 'Spurious source of potential energy from mixed layer detrainment', &
'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2)
diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90
index 3096fe72cd..6fdfdd5936 100644
--- a/src/parameterizations/vertical/MOM_diabatic_aux.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90
@@ -15,6 +15,7 @@ module MOM_diabatic_aux
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint
use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_interpolate, only : init_external_field, time_interp_external, time_interp_external_init
use MOM_interpolate, only : external_field
use MOM_io, only : slasher
@@ -31,8 +32,8 @@ module MOM_diabatic_aux
public diabatic_aux_init, diabatic_aux_end
public make_frazil, adjust_salt, differential_diffuse_T_S, triDiagTS, triDiagTS_Eulerian
-public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut, set_pen_shortwave
-public diagnoseMLDbyEnergy
+public find_uv_at_h, applyBoundaryFluxesInOut, set_pen_shortwave
+public diagnoseMLDbyEnergy, diagnoseMLDbyDensityDifference
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
@@ -67,7 +68,12 @@ module MOM_diabatic_aux
!! e-folding depth of incoming shortwave radiation.
type(external_field) :: sbc_chl !< A handle used in time interpolation of
!! chlorophyll read from a file.
- logical :: chl_from_file !< If true, chl_a is read from a file.
+ logical :: chl_from_file !< If true, chl_a is read from a file.
+ logical :: do_brine_plume !< If true, insert salt flux below the surface according to
+ !! a parameterization by \cite Nguyen2009.
+ integer :: brine_plume_n !< The exponent in the brine plume parameterization.
+ real :: plume_strength !< Fraction of the available brine to take to the bottom of the mixed
+ !! layer [nondim].
type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
type(diag_ctrl), pointer :: diag !< Structure used to regulate timing of diagnostic output
@@ -224,7 +230,7 @@ end subroutine make_frazil
!> This subroutine applies double diffusion to T & S, assuming no diapycnal mass
!! fluxes, using a simple tridiagonal solver.
-subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV)
+subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, tv, dt, G, GV)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
@@ -234,13 +240,15 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV)
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: S !< Salinity [PSU] or [gSalt/kg], generically [S ~> ppt].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- intent(inout) :: Kd_T !< The extra diffusivity of temperature due to
+ intent(in) :: Kd_T !< The extra diffusivity of temperature due to
!! double diffusion relative to the diffusivity of
- !! diffusivity of density [Z2 T-1 ~> m2 s-1].
+ !! density [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(in) :: Kd_S !< The extra diffusivity of salinity due to
!! double diffusion relative to the diffusivity of
- !! diffusivity of density [Z2 T-1 ~> m2 s-1].
+ !! density [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any
+ !! available thermodynamic fields.
real, intent(in) :: dt !< Time increment [T ~> s].
! local variables
@@ -248,6 +256,7 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV)
b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2].
d1_T, d1_S ! Variables used by the tridiagonal solvers [nondim].
real, dimension(SZI_(G),SZK_(GV)) :: &
+ dz, & ! Height change across layers [Z ~> m]
c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2].
real, dimension(SZI_(G),SZK_(GV)+1) :: &
mix_T, mix_S ! Mixing distances in both directions across each interface [H ~> m or kg m-2].
@@ -255,20 +264,27 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV)
! added to ensure positive definiteness [H ~> m or kg m-2].
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
- real :: I_h_int ! The inverse of the thickness associated with an interface [H-1 ~> m-1 or m2 kg-1].
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m].
+ real :: I_dz_int ! The inverse of the height scale associated with an interface [Z-1 ~> m-1].
real :: b_denom_T ! The first term in the denominator for the expression for b1_T [H ~> m or kg m-2].
real :: b_denom_S ! The first term in the denominator for the expression for b1_S [H ~> m or kg m-2].
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
h_neglect = GV%H_subroundoff
+ dz_neglect = GV%dZ_subroundoff
!$OMP parallel do default(private) shared(is,ie,js,je,h,h_neglect,dt,Kd_T,Kd_S,G,GV,T,S,nz)
do j=js,je
+
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
do i=is,ie
- I_h_int = 1.0 / (0.5 * (h(i,j,1) + h(i,j,2)) + h_neglect)
- mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%Z_to_H**2) * I_h_int
- mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%Z_to_H**2) * I_h_int
+ I_dz_int = 1.0 / (0.5 * (dz(i,1) + dz(i,2)) + dz_neglect)
+ mix_T(i,2) = (dt * Kd_T(i,j,2)) * I_dz_int
+ mix_S(i,2) = (dt * Kd_S(i,j,2)) * I_dz_int
h_tr = h(i,j,1) + h_neglect
b1_T(i) = 1.0 / (h_tr + mix_T(i,2))
@@ -280,9 +296,9 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV)
enddo
do k=2,nz-1 ; do i=is,ie
! Calculate the mixing across the interface below this layer.
- I_h_int = 1.0 / (0.5 * (h(i,j,k) + h(i,j,k+1)) + h_neglect)
- mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%Z_to_H**2) * I_h_int
- mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%Z_to_H**2) * I_h_int
+ I_dz_int = 1.0 / (0.5 * (dz(i,k) + dz(i,k+1)) + dz_neglect)
+ mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1))) * I_dz_int
+ mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1))) * I_dz_int
c1_T(i,k) = mix_T(i,K) * b1_T(i)
c1_S(i,k) = mix_S(i,K) * b1_S(i)
@@ -682,19 +698,22 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US,
! Local variables
real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [R ~> kg m-3].
real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures [R L2 T-2 ~> Pa].
- real, dimension(SZI_(G)) :: H_subML, dH_N2 ! Summed thicknesses used in N2 calculation [H ~> m].
+ real, dimension(SZI_(G)) :: H_subML, dH_N2 ! Summed thicknesses used in N2 calculation [H ~> m or kg m-2]
+ real, dimension(SZI_(G)) :: dZ_N2 ! Summed vertical distance used in N2 calculation [Z ~> m]
real, dimension(SZI_(G)) :: T_subML, T_deeper ! Temperatures used in the N2 calculation [C ~> degC].
real, dimension(SZI_(G)) :: S_subML, S_deeper ! Salinities used in the N2 calculation [S ~> ppt].
real, dimension(SZI_(G)) :: rho_subML, rho_deeper ! Densities used in the N2 calculation [R ~> kg m-3].
- real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m].
+ real, dimension(SZI_(G),SZK_(GV)) :: dZ_2d ! Layer thicknesses in depth units [Z ~> m]
+ real, dimension(SZI_(G)) :: dZ, dZm1 ! Layer thicknesses associated with interfaces [Z ~> m]
real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixed layer depth [R ~> kg m-3].
real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m].
real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [T-2 ~> s-2].
real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2].
logical, dimension(SZI_(G)) :: N2_region_set ! If true, all necessary values for calculating N2
! have been stored already.
- real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [Z T-2 R-1 ~> m4 s-2 kg-1].
- real :: dH_subML ! Depth below ML over which to diagnose stratification [H ~> m].
+ real :: gE_Rho0 ! The gravitational acceleration, sometimes divided by the Boussinesq
+ ! reference density [H T-2 R-1 ~> m4 s-2 kg-1 or m s-2].
+ real :: dZ_sub_ML ! Depth below ML over which to diagnose stratification [Z ~> m]
real :: aFac ! A nondimensional factor [nondim]
real :: ddRho ! A density difference [R ~> kg m-3]
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
@@ -706,7 +725,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US,
if (present(id_N2subML)) then
if (present(dz_subML)) then
id_N2 = id_N2subML
- dH_subML = GV%Z_to_H*dz_subML
+ dZ_sub_ML = dz_subML
else
call MOM_error(FATAL, "When the diagnostic of the subML stratification is "//&
"requested by providing id_N2_subML to diagnoseMLDbyDensityDifference, "//&
@@ -714,29 +733,32 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US,
endif
endif
- gE_rho0 = US%L_to_Z**2*GV%g_Earth / GV%Rho0
+ gE_rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%H_to_RZ
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
pRef_MLD(:) = 0.0
EOSdom(:) = EOS_domain(G%HI)
do j=js,je
- do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_Z ; enddo ! Depth of center of surface layer
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dZ_2d, j, G, GV)
+
+ do i=is,ie ; dZ(i) = 0.5 * dZ_2d(i,1) ; enddo ! Depth of center of surface layer
call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, EOSdom)
do i=is,ie
deltaRhoAtK(i) = 0.
MLD(i,j) = 0.
if (id_N2>0) then
subMLN2(i,j) = 0.0
- H_subML(i) = h(i,j,1) ; dH_N2(i) = 0.0
+ H_subML(i) = h(i,j,1) ; dH_N2(i) = 0.0 ; dZ_N2(i) = 0.0
T_subML(i) = 0.0 ; S_subML(i) = 0.0 ; T_deeper(i) = 0.0 ; S_deeper(i) = 0.0
N2_region_set(i) = (G%mask2dT(i,j)<0.5) ! Only need to work on ocean points.
endif
enddo
do k=2,nz
do i=is,ie
- dKm1(i) = dK(i) ! Depth of center of layer K-1
- dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_Z ! Depth of center of layer K
+ dZm1(i) = dZ(i) ! Depth of center of layer K-1
+ dZ(i) = dZ(i) + 0.5 * ( dZ_2d(i,k) + dZ_2d(i,k-1) ) ! Depth of center of layer K
enddo
! Prepare to calculate stratification, N2, immediately below the mixed layer by finding
@@ -746,15 +768,18 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US,
if (MLD(i,j) == 0.0) then ! Still in the mixed layer.
H_subML(i) = H_subML(i) + h(i,j,k)
elseif (.not.N2_region_set(i)) then ! This block is below the mixed layer, but N2 has not been found yet.
- if (dH_N2(i) == 0.0) then ! Record the temperature, salinity, pressure, immediately below the ML
+ if (dZ_N2(i) == 0.0) then ! Record the temperature, salinity, pressure, immediately below the ML
T_subML(i) = tv%T(i,j,k) ; S_subML(i) = tv%S(i,j,k)
H_subML(i) = H_subML(i) + 0.5 * h(i,j,k) ! Start midway through this layer.
dH_N2(i) = 0.5 * h(i,j,k)
- elseif (dH_N2(i) + h(i,j,k) < dH_subML) then
+ dZ_N2(i) = 0.5 * dz_2d(i,k)
+ elseif (dZ_N2(i) + dZ_2d(i,k) < dZ_sub_ML) then
dH_N2(i) = dH_N2(i) + h(i,j,k)
+ dZ_N2(i) = dZ_N2(i) + dz_2d(i,k)
else ! This layer includes the base of the region where N2 is calculated.
T_deeper(i) = tv%T(i,j,k) ; S_deeper(i) = tv%S(i,j,k)
dH_N2(i) = dH_N2(i) + 0.5 * h(i,j,k)
+ dZ_N2(i) = dZ_N2(i) + 0.5 * dz_2d(i,k)
N2_region_set(i) = .true.
endif
endif
@@ -770,18 +795,18 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US,
if ((MLD(i,j) == 0.) .and. (ddRho > 0.) .and. &
(deltaRhoAtKm1(i) < densityDiff) .and. (deltaRhoAtK(i) >= densityDiff)) then
aFac = ( densityDiff - deltaRhoAtKm1(i) ) / ddRho
- MLD(i,j) = dK(i) * aFac + dKm1(i) * (1. - aFac)
+ MLD(i,j) = (dZ(i) * aFac + dZm1(i) * (1. - aFac))
endif
if (id_SQ > 0) MLD2(i,j) = MLD(i,j)**2
enddo ! i-loop
enddo ! k-loop
do i=is,ie
- if ((MLD(i,j) == 0.) .and. (deltaRhoAtK(i) < densityDiff)) MLD(i,j) = dK(i) ! Assume mixing to the bottom
+ if ((MLD(i,j) == 0.) .and. (deltaRhoAtK(i) < densityDiff)) MLD(i,j) = dZ(i) ! Mixing goes to the bottom
enddo
if (id_N2>0) then ! Now actually calculate stratification, N2, below the mixed layer.
do i=is,ie ; pRef_N2(i) = (GV%g_Earth * GV%H_to_RZ) * (H_subML(i) + 0.5*dH_N2(i)) ; enddo
- ! if ((.not.N2_region_set(i)) .and. (dH_N2(i) > 0.5*dH_subML)) then
+ ! if ((.not.N2_region_set(i)) .and. (dZ_N2(i) > 0.5*dZ_sub_ML)) then
! ! Use whatever stratification we can, measured over whatever distance is available?
! T_deeper(i) = tv%T(i,j,nz) ; S_deeper(i) = tv%S(i,j,nz)
! N2_region_set(i) = .true.
@@ -789,7 +814,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US,
call calculate_density(T_subML, S_subML, pRef_N2, rho_subML, tv%eqn_of_state, EOSdom)
call calculate_density(T_deeper, S_deeper, pRef_N2, rho_deeper, tv%eqn_of_state, EOSdom)
do i=is,ie ; if ((G%mask2dT(i,j) > 0.0) .and. N2_region_set(i)) then
- subMLN2(i,j) = gE_rho0 * (rho_deeper(i) - rho_subML(i)) / (GV%H_to_z * dH_N2(i))
+ subMLN2(i,j) = gE_rho0 * (rho_deeper(i) - rho_subML(i)) / dH_N2(i)
endif ; enddo
endif
enddo ! j-loop
@@ -838,9 +863,9 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
! Local variables
real, dimension(SZI_(G),SZJ_(G),3) :: MLD ! Diagnosed mixed layer depth [Z ~> m].
real, dimension(SZK_(GV)+1) :: Z_int ! Depths of the interfaces from the surface [Z ~> m]
- real, dimension(SZK_(GV)) :: dZ ! Layer thicknesses in depth units [Z ~> m]
- real, dimension(SZK_(GV)) :: Rho_c ! A column of layer densities [R ~> kg m-3]
- real, dimension(SZK_(GV)) :: pRef_MLD ! The reference pressure for the mixed layer
+ real, dimension(SZI_(G),SZK_(GV)) :: dZ ! Layer thicknesses in depth units [Z ~> m]
+ real, dimension(SZI_(G),SZK_(GV)) :: Rho_c ! Columns of layer densities [R ~> kg m-3]
+ real, dimension(SZI_(G)) :: pRef_MLD ! The reference pressure for the mixed layer
! depth calculation [R L2 T-2 ~> Pa]
real, dimension(3) :: PE_threshold ! The energy threshold divided by g [R Z2 ~> kg m-1]
@@ -875,6 +900,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
real :: Fgx ! The mixing energy difference from the target [R Z2 ~> kg m-1]
real :: Fpx ! The derivative of Fgx with x [R Z ~> kg m-2]
+ integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
integer :: IT, iM
integer :: i, j, is, ie, js, je, k, nz
@@ -888,15 +914,23 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
PE_threshold(iM) = Mixing_Energy(iM) / (US%L_to_Z**2*GV%g_Earth)
enddo
- do j=js,je ; do i=is,ie
- if (G%mask2dT(i,j) > 0.0) then
+ MLD(:,:,:) = 0.0
- call calculate_density(tv%T(i,j,:), tv%S(i,j,:), pRef_MLD, rho_c, tv%eqn_of_state)
+ EOSdom(:) = EOS_domain(G%HI)
+
+ do j=js,je
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
+ do k=1,nz
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,K), pRef_MLD, rho_c(:,k), tv%eqn_of_state, EOSdom)
+ enddo
+
+ do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
Z_int(1) = 0.0
do k=1,nz
- DZ(k) = h(i,j,k) * GV%H_to_Z
- Z_int(K+1) = Z_int(K) - DZ(k)
+ Z_int(K+1) = Z_int(K) - dZ(i,k)
enddo
do iM=1,3
@@ -912,11 +946,11 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
do k=1,nz
! This is the unmixed PE cumulative sum from top down
- PE = PE + 0.5 * rho_c(k) * (Z_int(K)**2 - Z_int(K+1)**2)
+ PE = PE + 0.5 * Rho_c(i,k) * (Z_int(K)**2 - Z_int(K+1)**2)
! This is the depth and integral of density
- H_ML_TST = H_ML + DZ(k)
- RhoDZ_ML_TST = RhoDZ_ML + rho_c(k) * DZ(k)
+ H_ML_TST = H_ML + dZ(i,k)
+ RhoDZ_ML_TST = RhoDZ_ML + Rho_c(i,k) * dZ(i,k)
! The average density assuming all layers including this were mixed
Rho_ML = RhoDZ_ML_TST/H_ML_TST
@@ -936,8 +970,8 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
R1 = RhoDZ_ML / H_ML ! The density of the mixed layer (not including this layer)
D1 = H_ML ! The thickness of the mixed layer (not including this layer)
- R2 = rho_c(k) ! The density of this layer
- D2 = DZ(k) ! The thickness of this layer
+ R2 = Rho_c(i,k) ! The density of this layer
+ D2 = dZ(i,k) ! The thickness of this layer
! This block could be used to calculate the function coefficients if
! we don't reference all values to a surface designated as z=0
@@ -964,7 +998,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
Cc2 = R2 * (D - C)
! First guess for an iteration using Newton's method
- X = DZ(k) * 0.5
+ X = dZ(i,k) * 0.5
IT=0
do while(IT<10)!We can iterate up to 10 times
@@ -996,7 +1030,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
if (abs(Fgx) > PE_Threshold(iM) * PE_Threshold_fraction) then
X2 = X - Fgx / Fpx
IT = IT + 1
- if (X2 < 0. .or. X2 > DZ(k)) then
+ if (X2 < 0. .or. X2 > dZ(i,k)) then
! The iteration seems to be robust, but we need to do something *if*
! things go wrong... How should we treat failed iteration?
! Present solution: Stop trying to compute and just say we can't mix this layer.
@@ -1015,10 +1049,8 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr)
enddo
MLD(i,j,iM) = H_ML
enddo
- else
- MLD(i,j,:) = 0.0
- endif
- enddo ; enddo
+ endif ; enddo
+ enddo
if (id_MLD(1) > 0) call post_data(id_MLD(1), MLD(:,:,1), diagPtr)
if (id_MLD(2) > 0) call post_data(id_MLD(2), MLD(:,:,2), diagPtr)
@@ -1032,7 +1064,7 @@ end subroutine diagnoseMLDbyEnergy
subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, tv, &
aggregate_FW_forcing, evap_CFL_limit, &
minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, &
- SkinBuoyFlux )
+ SkinBuoyFlux, MLD)
type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux
type(ocean_grid_type), intent(in) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
@@ -1062,6 +1094,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
!! salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
real, dimension(SZI_(G),SZJ_(G)), &
optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3].
+ real, pointer, dimension(:,:), optional :: MLD !< Mixed layer depth for brine plumes [Z ~> m]
! Local variables
integer, parameter :: maxGroundings = 5
@@ -1097,12 +1130,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
SurfPressure, & ! Surface pressure (approximated as 0.0) [R L2 T-2 ~> Pa]
dRhodT, & ! change in density per change in temperature [R C-1 ~> kg m-3 degC-1]
dRhodS, & ! change in density per change in salinity [R S-1 ~> kg m-3 ppt-1]
+ dSpV_dT, & ! Partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ dSpV_dS, & ! Partial derivative of specific volume with to salinity [R-1 S-1 ~> m3 kg-1 ppt-1]
netheat_rate, & ! netheat but for dt=1 [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate)
! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
- netMassInOut_rate! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1]
+ netMassInOut_rate, & ! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1]
+ mixing_depth, & ! The mixing depth for brine plumes [H ~> m or kg m-2]
+ MLD_H, & ! The mixed layer depth for brine plumes in thickness units [H ~> m or kg m-2]
+ MLD_Z, & ! Running sum of distance from the surface for finding MLD_H [Z ~> m]
+ total_h ! Total thickness of the water column [H ~> m or kg m-2]
real, dimension(SZI_(G), SZK_(GV)) :: &
h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2]
+ ! dz, & ! Layer thicknesses in depth units [Z ~> m]
T2d, & ! A 2-d copy of the layer temperatures [C ~> degC]
pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within
! a layer [R Z3 T-2 ~> J m-2]
@@ -1125,11 +1165,18 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
! in units of [Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2].
real :: GoRho ! g_Earth times a unit conversion factor divided by density
! [Z T-2 R-1 ~> m4 s-2 kg-1]
+ real :: g_conv ! The gravitational acceleration times the conversion factors from non-Boussinesq
+ ! thickness units to mass per units area [R Z2 H-1 T-2 ~> kg m-2 s-2 or m s-2]
logical :: calculate_energetics ! If true, calculate the energy required to mix the newly added
! water over the topmost grid cell, assuming that the fluxes of heat and salt
! and rejected brine are initially applied in vanishingly thin layers at the
! top of the layer before being mixed throughout the layer.
logical :: calculate_buoyancy ! If true, calculate the surface buoyancy flux.
+ real :: dK(SZI_(G)) ! Depth of the layer center in thickness units [H ~> m or kg m-2]
+ real :: A_brine(SZI_(G)) ! Constant [H-(n+1) ~> m-(n+1) or m(2n+2) kg-(n+1)].
+ real :: fraction_left_brine ! Fraction of the brine that has not been applied yet [nondim]
+ real :: plume_fraction ! Fraction of the brine that is applied to a layer [nondim]
+ real :: plume_flux ! Brine flux to move downwards [S H ~> ppt m or ppt kg m-2]
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
integer :: i, j, is, ie, js, je, k, nz, nb
character(len=45) :: mesg
@@ -1137,6 +1184,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
Idt = 1.0 / dt
+ plume_flux = 0.0
calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS))
calculate_buoyancy = present(SkinBuoyFlux)
@@ -1156,6 +1204,17 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0
endif
+ if (CS%do_brine_plume .and. .not. associated(MLD)) then
+ call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//&
+ "Brine plume parameterization requires a mixed-layer depth,\n"//&
+ "currently coming from the energetic PBL scheme.")
+ endif
+ if (CS%do_brine_plume .and. .not. associated(fluxes%salt_left_behind)) then
+ call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//&
+ "Brine plume parameterization requires DO_BRINE_PLUME\n"//&
+ "to be turned on in SIS2 as well as MOM6.")
+ endif
+
! H_limit_fluxes is used by extractFluxes1d to scale down fluxes if the total
! depth of the ocean is vanishing. It does not (yet) handle a value of zero.
! To accommodate vanishing upper layers, we need to allow for an instantaneous
@@ -1171,18 +1230,20 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
!$OMP H_limit_fluxes,numberOfGroundings,iGround,jGround,&
!$OMP nonPenSW,hGrounding,CS,Idt,aggregate_FW_forcing, &
!$OMP minimum_forcing_depth,evap_CFL_limit,dt,EOSdom, &
- !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho, &
+ !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho,&
!$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2, &
- !$OMP EnthalpyConst) &
+ !$OMP EnthalpyConst,MLD) &
!$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, &
!$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, &
- !$OMP IforcingDepthScale, &
+ !$OMP IforcingDepthScale,g_conv,dSpV_dT,dSpV_dS, &
!$OMP dThickness,dTemp,dSalt,hOld,Ithickness, &
!$OMP netMassIn,pres,d_pres,p_lay,dSV_dT_2d, &
!$OMP netmassinout_rate,netheat_rate,netsalt_rate, &
!$OMP drhodt,drhods,pen_sw_bnd_rate, &
- !$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst) &
- !$OMP firstprivate(SurfPressure)
+ !$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst, &
+ !$OMP mixing_depth,A_brine,fraction_left_brine, &
+ !$OMP plume_fraction,dK,MLD_H,MLD_Z,total_h) &
+ !$OMP firstprivate(SurfPressure,plume_flux)
do j=js,je
! Work in vertical slices for efficiency
@@ -1217,7 +1278,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
! Nothing more is done on this j-slice if there is no buoyancy forcing.
if (.not.associated(fluxes%sw)) cycle
- if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%Z_to_H))
+ if (nsw>0) then
+ if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then
+ call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=GV%H_to_Z)
+ else
+ call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=GV%H_to_RZ, &
+ SpV_avg=tv%SpV_avg)
+ endif
+ endif
! The surface forcing is contained in the fluxes type.
! We aggregate the thermodynamic forcing for a time step into the following:
@@ -1298,6 +1366,31 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
! ocean (and corresponding outward heat content), and ignoring penetrative SW.
! B/ update mass, salt, temp from mass leaving ocean.
! C/ update temp due to penetrative SW
+ if (CS%do_brine_plume) then
+ ! Find the plume mixing depth.
+ if (GV%Boussinesq .or. .not.allocated(tv%SpV_avg)) then
+ do i=is,ie ; MLD_H(i) = GV%Z_to_H * MLD(i,j) ; total_h(i) = 0.0 ; enddo
+ do k=1,nz ; do i=is,ie ; total_h(i) = total_h(i) + h(i,j,k) ; enddo ; enddo
+ else
+ do i=is,ie ; MLD_H(i) = 0.0 ; MLD_Z(i) = 0.0 ; total_h(i) = 0.0 ; enddo
+ do k=1,nz ; do i=is,ie
+ total_h(i) = total_h(i) + h(i,j,k)
+ if (MLD_Z(i) + GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) < MLD(i,j)) then
+ MLD_H(i) = MLD_H(i) + h(i,j,k)
+ MLD_Z(i) = MLD_Z(i) + GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)
+ elseif (MLD_Z(i) < MLD(i,j)) then ! This is the last layer in the mixed layer
+ MLD_H(i) = MLD_H(i) + GV%RZ_to_H * (MLD(i,j) - MLD_Z(i)) / tv%SpV_avg(i,j,k)
+ MLD_Z(i) = MLD(i,j)
+ endif
+ enddo ; enddo
+ endif
+ do i=is,ie
+ mixing_depth(i) = min( max(MLD_H(i) - minimum_forcing_depth, minimum_forcing_depth), &
+ max(total_h(i), GV%angstrom_h) ) + GV%H_subroundoff
+ A_brine(i) = (CS%brine_plume_n + 1) / (mixing_depth(i) ** (CS%brine_plume_n + 1))
+ enddo
+ endif
+
do i=is,ie
if (G%mask2dT(i,j) > 0.) then
@@ -1343,6 +1436,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
! Sriver = 0 (i.e. rivers are assumed to be pure freshwater)
if (GV%Boussinesq) then
RivermixConst = -0.5*(CS%rivermix_depth*dt) * ( US%L_to_Z**2*GV%g_Earth ) * GV%Rho0
+ elseif (allocated(tv%SpV_avg)) then
+ RivermixConst = -0.5*(CS%rivermix_depth*dt) * ( US%L_to_Z**2*GV%g_Earth ) / tv%SpV_avg(i,j,1)
else
RivermixConst = -0.5*(CS%rivermix_depth*dt) * GV%Rho0 * ( US%L_to_Z**2*GV%g_Earth )
endif
@@ -1370,8 +1465,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
enddo ! k=1,1
! B/ Update mass, salt, temp from mass leaving ocean and other fluxes of heat and salt.
+ fraction_left_brine = 1.0
do k=1,nz
-
! Place forcing into this layer if this layer has nontrivial thickness.
! For layers thin relative to 1/IforcingDepthScale, then distribute
! forcing into deeper layers.
@@ -1386,6 +1481,32 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
fractionOfForcing = -evap_CFL_limit*h2d(i,k)/netMassOut(i)
endif
+ if (CS%do_brine_plume .and. associated(fluxes%salt_left_behind)) then
+ if (fluxes%salt_left_behind(i,j) > 0 .and. fraction_left_brine > 0.0) then
+ ! Place forcing into this layer by depth for brine plume parameterization.
+ if (k == 1) then
+ dK(i) = 0.5 * h(i,j,k) ! Depth of center of layer K
+ plume_flux = - (1000.0*US%ppt_to_S * (CS%plume_strength * fluxes%salt_left_behind(i,j))) * GV%RZ_to_H
+ plume_fraction = 1.0
+ else
+ dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) ! Depth of center of layer K
+ plume_flux = 0.0
+ endif
+ if (dK(i) <= mixing_depth(i) .and. fraction_left_brine > 0.0) then
+ plume_fraction = min(fraction_left_brine, (A_brine(i) * dK(i)**CS%brine_plume_n) * h(i,j,k))
+ else
+ IforcingDepthScale = 1. / max(GV%H_subroundoff, minimum_forcing_depth - netMassOut(i) )
+ ! plume_fraction = fraction_left_brine, unless h2d is less than IforcingDepthScale.
+ plume_fraction = min(fraction_left_brine, h2d(i,k)*IforcingDepthScale)
+ endif
+ fraction_left_brine = fraction_left_brine - plume_fraction
+ plume_flux = plume_flux + plume_fraction * (1000.0*US%ppt_to_S * (CS%plume_strength * &
+ fluxes%salt_left_behind(i,j))) * GV%RZ_to_H
+ else
+ plume_flux = 0.0
+ endif
+ endif
+
! Change in state due to forcing
dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) )
@@ -1430,7 +1551,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
endif
Ithickness = 1.0/h2d(i,k) ! Inverse of new thickness
T2d(i,k) = (hOld*T2d(i,k) + dTemp)*Ithickness
- tv%S(i,j,k) = (hOld*tv%S(i,j,k) + dSalt)*Ithickness
+ tv%S(i,j,k) = (hOld*tv%S(i,j,k) + dSalt + plume_flux)*Ithickness
elseif (h2d(i,k) < 0.0) then ! h2d==0 is a special limit that needs no extra handling
call forcing_SinglePointPrint(fluxes,G,i,j,'applyBoundaryFluxesInOut (h<0)')
write(0,*) 'applyBoundaryFluxesInOut(): lon,lat=',G%geoLonT(i,j),G%geoLatT(i,j)
@@ -1548,31 +1669,45 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
! 1) Answers will change due to round-off
! 2) Be sure to save their values BEFORE fluxes are used.
if (Calculate_Buoyancy) then
- drhodt(:) = 0.0
- drhods(:) = 0.0
netPen_rate(:) = 0.0
! Sum over bands and attenuate as a function of depth.
! netPen_rate is the netSW as a function of depth, but only the surface value is used here,
! in which case the values of dt, h, optics and H_limit_fluxes are irrelevant. Consider
! writing a shorter and simpler variant to handle this very limited case.
- ! call sumSWoverBands(G, GV, US, h2d(:,:), optics_nbands(optics), optics, j, dt, &
+ ! Find the vertical distances across layers.
+ ! call thickness_to_dz(h, tv, dz, j, G, GV)
+ ! call sumSWoverBands(G, GV, US, h2d, dz, optics_nbands(optics), optics, j, dt, &
! H_limit_fluxes, .true., pen_SW_bnd_rate, netPen)
do i=is,ie ; do nb=1,nsw ; netPen_rate(i) = netPen_rate(i) + pen_SW_bnd_rate(nb,i) ; enddo ; enddo
- ! Density derivatives
- if (associated(tv%p_surf)) then ; do i=is,ie ; SurfPressure(i) = tv%p_surf(i,j) ; enddo ; endif
- call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, dRhodT, dRhodS, &
- tv%eqn_of_state, EOSdom)
! 1. Adjust netSalt to reflect dilution effect of FW flux
! 2. Add in the SW heating for purposes of calculating the net
! surface buoyancy flux affecting the top layer.
! 3. Convert to a buoyancy flux, excluding penetrating SW heating
! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL.
- do i=is,ie
- SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * &
- (dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + &
- dRhodT(i) * ( netHeat_rate(i) + netPen_rate(i)) ) ! [Z2 T-3 ~> m2 s-3]
- enddo
+ if (associated(tv%p_surf)) then ; do i=is,ie ; SurfPressure(i) = tv%p_surf(i,j) ; enddo ; endif
+
+ if ((.not.GV%Boussinesq) .and. (.not.GV%semi_Boussinesq)) then
+ g_conv = GV%g_Earth * GV%H_to_RZ * US%L_to_Z**2
+
+ ! Specific volume derivatives
+ call calculate_specific_vol_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, dSpV_dT, dSpV_dS, &
+ tv%eqn_of_state, EOS_domain(G%HI))
+ do i=is,ie
+ SkinBuoyFlux(i,j) = g_conv * &
+ (dSpV_dS(i) * ( netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + &
+ dSpV_dT(i) * ( netHeat_rate(i) + netPen_rate(i)) ) ! [Z2 T-3 ~> m2 s-3]
+ enddo
+ else
+ ! Density derivatives
+ call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, dRhodT, dRhodS, &
+ tv%eqn_of_state, EOSdom)
+ do i=is,ie
+ SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * &
+ (dRhodS(i) * ( netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + &
+ dRhodT(i) * ( netHeat_rate(i) + netPen_rate(i)) ) ! [Z2 T-3 ~> m2 s-3]
+ enddo
+ endif
endif
enddo ! j-loop finish
@@ -1698,6 +1833,16 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori
CS%use_calving_heat_content = .false.
endif
+ call get_param(param_file, mdl, "DO_BRINE_PLUME", CS%do_brine_plume, &
+ "If true, use a brine plume parameterization from "//&
+ "Nguyen et al., 2009.", default=.false.)
+ call get_param(param_file, mdl, "BRINE_PLUME_EXPONENT", CS%brine_plume_n, &
+ "If using the brine plume parameterization, set the integer exponent.", &
+ default=5, do_not_log=.not.CS%do_brine_plume)
+ call get_param(param_file, mdl, "BRINE_PLUME_FRACTION", CS%plume_strength, &
+ "Fraction of the available brine to mix down using the brine plume parameterization.", &
+ units="nondim", default=1.0, do_not_log=.not.CS%do_brine_plume)
+
if (useALEalgorithm) then
CS%id_createdH = register_diag_field('ocean_model',"created_H",diag%axesT1, &
Time, "The volume flux added to stop the ocean from drying out and becoming negative in depth", &
diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90
index 1bc29ee16f..097628c032 100644
--- a/src/parameterizations/vertical/MOM_diabatic_driver.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90
@@ -12,8 +12,9 @@ module MOM_diabatic_driver
use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used
use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS
use MOM_diabatic_aux, only : make_frazil, adjust_salt, differential_diffuse_T_S, triDiagTS
-use MOM_diabatic_aux, only : triDiagTS_Eulerian, find_uv_at_h, diagnoseMLDbyDensityDifference
-use MOM_diabatic_aux, only : applyBoundaryFluxesInOut, diagnoseMLDbyEnergy, set_pen_shortwave
+use MOM_diabatic_aux, only : triDiagTS_Eulerian, find_uv_at_h
+use MOM_diabatic_aux, only : applyBoundaryFluxesInOut, set_pen_shortwave
+use MOM_diabatic_aux, only : diagnoseMLDbyDensityDifference, diagnoseMLDbyEnergy
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : post_product_sum_u, post_product_sum_v
use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids
@@ -36,15 +37,15 @@ module MOM_diabatic_driver
use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg
use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint
use MOM_file_parser, only : get_param, log_version, param_file_type, read_param
-use MOM_forcing_type, only : forcing, MOM_forcing_chksum
+use MOM_forcing_type, only : forcing, MOM_forcing_chksum, find_ustar
use MOM_forcing_type, only : calculateBuoyancyFlux2d, forcing_SinglePointPrint
use MOM_geothermal, only : geothermal_entraining, geothermal_in_place
use MOM_geothermal, only : geothermal_init, geothermal_end, geothermal_CS
use MOM_grid, only : ocean_grid_type
use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init
use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type
-use MOM_interface_heights, only : find_eta, calc_derived_thermo
-use MOM_internal_tides, only : propagate_int_tide
+use MOM_interface_heights, only : find_eta, calc_derived_thermo, thickness_to_dz
+use MOM_internal_tides, only : propagate_int_tide, register_int_tide_restarts
use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS
use MOM_kappa_shear, only : kappa_shear_is_used
use MOM_CVMix_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate
@@ -55,6 +56,7 @@ module MOM_diabatic_driver
use MOM_opacity, only : absorbRemainingSW, optics_type, optics_nbands
use MOM_open_boundary, only : ocean_OBC_type
use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS
+use MOM_restart, only : MOM_restart_CS
use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE
use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end
use MOM_set_diffusivity, only : set_diffusivity_CS
@@ -80,6 +82,7 @@ module MOM_diabatic_driver
public extract_diabatic_member
public adiabatic
public adiabatic_driver_init
+public register_diabatic_restarts
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
@@ -145,17 +148,20 @@ module MOM_diabatic_driver
!! diffusivity of Kd_min_tr (see below) were operating.
real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that
!! will allow for explicitly specified bottom fluxes
- !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at
- !! least sqrt(Kd_BBL_tr*dt) over the same distance.
+ !! [H2 T-1 ~> m2 s-1 or kg2 m-4 s-2]. The entrainment at the
+ !! bottom is at least sqrt(Kd_BBL_tr*dt) over the same distance.
real :: Kd_min_tr !< A minimal diffusivity that should always be
!! applied to tracers, especially in massless layers
- !! near the bottom [Z2 T-1 ~> m2 s-1].
+ !! near the bottom [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: minimum_forcing_depth !< The smallest depth over which heat and freshwater
!! fluxes are applied [H ~> m or kg m-2].
real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be
!! evaporated in one time-step [nondim].
integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that
!! must be valid for the diffusivity calculations.
+ integer :: halo_diabatic = 0 !< The temperature, salinity, specific volume and thickness
+ !! halo size that must be valid for the diabatic calculations,
+ !! including vertical mixing and internal tide propagation.
logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport
logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers.
logical :: debug !< If true, write verbose checksums for debugging purposes.
@@ -170,8 +176,6 @@ module MOM_diabatic_driver
real :: MLD_En_vals(3) !< Energy values for energy mixed layer diagnostics [R Z3 T-2 ~> J m-2]
!>@{ Diagnostic IDs
- integer :: id_cg1 = -1 ! diagnostic handle for mode-1 speed
- integer, allocatable, dimension(:) :: id_cn ! diagnostic handle for all mode speeds
integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic
integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1
integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1
@@ -227,12 +231,13 @@ module MOM_diabatic_driver
type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module
type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module
type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module
+ type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module
+
type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control structure
type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control structure
type(energetic_PBL_CS) :: ePBL !< Energetic PBL control structure
type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control structure
type(geothermal_CS) :: geothermal !< Geothermal control structure
- type(int_tide_CS) :: int_tide !< Internal tide control structure
type(opacity_CS) :: opacity !< Opacity control structure
type(regularize_layers_CS) :: regularize_layers !< Regularize layer control structure
@@ -351,7 +356,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp)
call cpu_clock_begin(id_clock_set_diffusivity)
- call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp, OBC=OBC)
+ call set_BBL_TKE(u, v, h, tv, fluxes, visc, G, GV, US, CS%set_diff_CSp, OBC=OBC)
call cpu_clock_end(id_clock_set_diffusivity)
! Frazil formation keeps the temperature above the freezing point.
@@ -386,8 +391,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, &
call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, &
CS%int_tide_input_CSp)
- call propagate_int_tide(h, tv, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, &
- CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide)
+ call propagate_int_tide(h, tv, CS%int_tide_input%Nb, CS%int_tide_input%Rho_bot, dt, &
+ G, GV, US, CS%int_tide_input_CSp, CS%int_tide_CSp)
+
if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)")
endif ! end CS%use_int_tides
@@ -530,6 +536,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
! local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
h_orig, & ! Initial layer thicknesses [H ~> m or kg m-2]
+ dz, & ! The vertical distance between interfaces around a layer [Z ~> m]
dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]
dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2].
@@ -543,18 +550,19 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
! salinity and passive tracers [H ~> m or kg m-2]
ent_t, & ! The diffusive coupling across interfaces within one time step for
! temperature [H ~> m or kg m-2]
- Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1]
- Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1]
- Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1]
+ Kd_int, & ! diapycnal diffusivity of interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_heat, & ! diapycnal diffusivity of heat [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Kd_extra_T , & ! The extra diffusivity of temperature due to double diffusion relative to
- ! Kd_int [Z2 T-1 ~> m2 s-1].
+ ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to
- ! Kd_int [Z2 T-1 ~> m2 s-1].
- Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]
+ ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
real, dimension(SZI_(G),SZJ_(G)) :: &
+ U_star, & ! The friction velocity [Z T-1 ~> m s-1].
SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL
logical, dimension(SZI_(G)) :: &
@@ -562,14 +570,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
! sufficiently thick that the no-flux boundary conditions have not restricted
! the entrainment - usually sqrt(Kd*dt).
- real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected [H ~> m or kg m-2]
- real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m]
+ real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2]
real :: add_ent ! Entrainment that needs to be added when mixing tracers [H ~> m or kg m-2]
- real :: I_hval ! The inverse of the thicknesses averaged to interfaces [H-1 ~> m-1 or m2 kg-1]
+ real :: I_dzval ! The inverse of the thicknesses averaged to interfaces [Z-1 ~> m-1]
real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is
! coupled to the bottom within a timestep [H ~> m or kg m-2]
- real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1].
+ real :: Kd_add_here ! An added diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2].
real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2]
@@ -580,7 +588,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect
+ dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect*dz_neglect
+
Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0
showCallTree = callTree_showQuery()
@@ -638,7 +647,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0)
call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US)
- call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
! Set diffusivities for heat and salt separately
@@ -659,8 +668,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
endif
if (CS%debug) then
- call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
call cpu_clock_begin(id_clock_kpp)
@@ -673,20 +682,23 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
! unlike other instances where the fluxes are integrated in time over a time-step.
call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, &
CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux)
- ! The KPP scheme calculates boundary layer diffusivities and non-local transport.
+ ! Determine the friction velocity, perhaps using the evovling surface density.
+ call find_ustar(fluxes, tv, U_star, G, GV, US)
+
+ ! The KPP scheme calculates boundary layer diffusivities and non-local transport.
if ( associated(fluxes%lamult) ) then
call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, &
- fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult)
+ U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult)
- call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
- Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult)
+ call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, &
+ Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult)
else
call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, &
- fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves)
+ U_star, CS%KPP_buoy_flux, Waves=Waves)
- call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
- Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves)
+ call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, &
+ Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves)
endif
if (associated(Hml)) then
@@ -719,8 +731,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0)
call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after KPP", tv, G, US)
- call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, &
scale=US%C_to_degC*GV%H_to_m*US%s_to_T)
call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, &
@@ -751,7 +763,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
if (CS%double_diffuse .and. associated(tv%T)) then
call cpu_clock_begin(id_clock_differential_diff)
- call differential_diffuse_T_S(h, tv%T, tv%S, Kd_extra_T, Kd_extra_S, dt, G, GV)
+ call differential_diffuse_T_S(h, tv%T, tv%S, Kd_extra_T, Kd_extra_S, tv, dt, G, GV)
call cpu_clock_end(id_clock_differential_diff)
if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)")
@@ -775,15 +787,18 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_shear)
endif
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, G, GV, US)
+
! This block sets ent_t and ent_s from h and Kd_int.
do j=js,je ; do i=is,ie
ent_s(i,j,1) = 0.0 ; ent_s(i,j,nz+1) = 0.0
ent_t(i,j,1) = 0.0 ; ent_t(i,j,nz+1) = 0.0
enddo ; enddo
- !$OMP parallel do default(shared) private(I_hval)
+ !$OMP parallel do default(shared) private(I_dzval)
do K=2,nz ; do j=js,je ; do i=is,ie
- I_hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k)))
- ent_s(i,j,K) = (GV%Z_to_H**2) * dt * I_hval * Kd_int(i,j,K)
+ I_dzval = 1.0 / (dz_neglect + 0.5*(dz(i,j,k-1) + dz(i,j,k)))
+ ent_s(i,j,K) = dt * I_dzval * Kd_int(i,j,K)
ent_t(i,j,K) = ent_s(i,j,K)
enddo ; enddo ; enddo
if (showCallTree) call callTree_waypoint("done setting ent_s and ent_t from Kd_int (diabatic)")
@@ -814,18 +829,23 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
skinbuoyflux(:,:) = 0.0
call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, &
- optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, &
- CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux)
+ optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, &
+ CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD=visc%MLD)
if (CS%debug) then
- call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_m)
- call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_m)
+ call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_mks)
+ call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_mks)
call hchksum(cTKE, "after applyBoundaryFluxes cTKE", G%HI, haloshift=0, &
scale=US%RZ3_T3_to_W_m2*US%T_to_s)
call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, &
scale=US%kg_m3_to_R*US%degC_to_C)
call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS", G%HI, haloshift=0, &
scale=US%kg_m3_to_R*US%ppt_to_S)
+ call hchksum(h, "after applyBoundaryFluxes h", G%HI, haloshift=0, scale=GV%H_to_mks)
+ call hchksum(tv%T, "after applyBoundaryFluxes tv%T", G%HI, haloshift=0, scale=US%C_to_degC)
+ call hchksum(tv%S, "after applyBoundaryFluxes tv%S", G%HI, haloshift=0, scale=US%S_to_ppt)
+ call hchksum(SkinBuoyFlux, "after applyBdryFlux SkinBuoyFlux", G%HI, haloshift=0, &
+ scale=US%Z_to_m**2*US%s_to_T**3)
endif
call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US)
@@ -846,6 +866,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
call pass_var(visc%sfc_buoy_flx, G%domain, halo=1)
endif
+ ! Find the vertical distances across layers, which may have been modified by the net surface flux
+ call thickness_to_dz(h, tv, dz, G, GV, US)
+
! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL.
do K=2,nz ; do j=js,je ; do i=is,ie
if (CS%ePBL_is_additive) then
@@ -856,7 +879,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), CS%ePBL_Prandtl*Kd_ePBL(i,j,K))
endif
- Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect)
+ Ent_int = Kd_add_here * dt / (0.5*(dz(i,j,k-1) + dz(i,j,k)) + dz_neglect)
ent_s(i,j,K) = ent_s(i,j,K) + Ent_int
Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here
@@ -869,13 +892,16 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
if (CS%debug) then
call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_m)
call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_m)
- call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
else
call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, &
optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, &
- CS%evap_CFL_limit, CS%minimum_forcing_depth)
+ CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD=visc%MLD)
+
+ ! Find the vertical distances across layers, which may have been modified by the net surface flux
+ call thickness_to_dz(h, tv, dz, G, GV, US)
endif ! endif for CS%use_energetic_PBL
@@ -1002,7 +1028,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
call cpu_clock_begin(id_clock_tracers)
if (CS%mix_boundary_tracer_ALE) then
- Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr)
+ Tr_ea_BBL = sqrt(dt * CS%Kd_BBL_tr)
!$OMP parallel do default(shared) private(htot,in_boundary,add_ent)
do j=js,je
@@ -1021,8 +1047,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
! in the calculation of the fluxes in the first place. Kd_min_tr
! should be much less than the values that have been set in Kd_int,
! perhaps a molecular diffusivity.
- add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * &
- ((h(i,j,k-1)+h(i,j,k)+h_neglect) / (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - &
+ add_ent = ((dt * CS%Kd_min_tr)) * &
+ ((dz(i,j,k-1)+dz(i,j,k)+dz_neglect) / (dz(i,j,k-1)*dz(i,j,k)+dz_neglect2)) - &
0.5*(ent_s(i,j,K) + ent_s(i,j,K))
if (htot(i) < Tr_ea_BBL) then
add_ent = max(0.0, add_ent, (Tr_ea_BBL - htot(i)) - ent_s(i,j,K))
@@ -1034,8 +1060,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
endif
if (CS%double_diffuse) then ; if (Kd_extra_S(i,j,k) > 0.0) then
- add_ent = ((dt * Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / &
- (0.5 * (h(i,j,k-1) + h(i,j,k)) + h_neglect)
+ add_ent = (dt * Kd_extra_S(i,j,k)) / &
+ (0.5 * (dz(i,j,k-1) + dz(i,j,k)) + dz_neglect)
ent_s(i,j,K) = ent_s(i,j,K) + add_ent
endif ; endif
enddo ; enddo
@@ -1045,8 +1071,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
!$OMP parallel do default(shared) private(add_ent)
do k=nz,2,-1 ; do j=js,je ; do i=is,ie
if (Kd_extra_S(i,j,k) > 0.0) then
- add_ent = ((dt * Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / &
- (0.5 * (h(i,j,k-1) + h(i,j,k)) + h_neglect)
+ add_ent = (dt * Kd_extra_S(i,j,k)) / &
+ (0.5 * (dz(i,j,k-1) + dz(i,j,k)) + dz_neglect)
else
add_ent = 0.0
endif
@@ -1126,6 +1152,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
! local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
h_orig, & ! Initial layer thicknesses [H ~> m or kg m-2]
+ dz, & ! The vertical distance between interfaces around a layer [Z ~> m]
dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]
dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2].
@@ -1140,33 +1167,33 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
ent_t, & ! The diffusive coupling across interfaces within one time step for
! temperature [H ~> m or kg m-2]
Kd_heat, & ! diapycnal diffusivity of heat or the smaller of the diapycnal diffusivities of
- ! heat and salt [Z2 T-1 ~> m2 s-1]
- Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1]
+ ! heat and salt [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Kd_extra_T , & ! The extra diffusivity of temperature due to double diffusion relative to
- ! Kd_int returned from set_diffusivity [Z2 T-1 ~> m2 s-1].
+ ! Kd_int returned from set_diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to
- ! Kd_int returned from set_diffusivity [Z2 T-1 ~> m2 s-1].
- Kd_ePBL, & ! boundary layer or convective diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]
+ ! Kd_int returned from set_diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_ePBL, & ! boundary layer or convective diapycnal diffusivities at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
real, dimension(SZI_(G),SZJ_(G)) :: &
+ U_star, & ! The friction velocity [Z T-1 ~> m s-1].
SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL
logical, dimension(SZI_(G)) :: &
in_boundary ! True if there are no massive layers below, where massive is defined as
! sufficiently thick that the no-flux boundary conditions have not restricted
! the entrainment - usually sqrt(Kd*dt).
-
- real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected [H ~> m or kg m-2]
- real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m]
+ real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2]
real :: add_ent ! Entrainment that needs to be added when mixing tracers [H ~> m or kg m-2]
- real :: I_hval ! The inverse of the thicknesses averaged to interfaces [H-1 ~> m-1 or m2 kg-1]
+ real :: I_dzval ! The inverse of the thicknesses averaged to interfaces [Z-1 ~> m-1]
real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is
! coupled to the bottom within a timestep [H ~> m or kg m-2]
real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2].
- real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1].
+ real :: Kd_add_here ! An added diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real :: Idt ! The inverse time step [T-1 ~> s-1]
logical :: showCallTree ! If true, show the call tree
@@ -1174,7 +1201,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
- h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect
+ dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect*dz_neglect
+
Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0
ent_s(:,:,:) = 0.0 ; ent_t(:,:,:) = 0.0
@@ -1235,7 +1263,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0)
call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US)
- call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
! Store the diagnosed typical diffusivity at interfaces.
@@ -1257,8 +1285,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
endif
if (CS%debug) then
- call hchksum(Kd_heat, "after double diffuse Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd_salt, "after double diffuse Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_heat, "after double diffuse Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kd_salt, "after double diffuse Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
if (CS%useKPP) then
@@ -1276,18 +1304,21 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, &
CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux)
+ ! Determine the friction velocity, perhaps using the evovling surface density.
+ call find_ustar(fluxes, tv, U_star, G, GV, US)
+
! The KPP scheme calculates boundary layer diffusivities and non-local transport.
if ( associated(fluxes%lamult) ) then
call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, &
- fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult)
+ U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult)
- call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
+ call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, &
Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult)
else
call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, &
- fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves)
+ U_star, CS%KPP_buoy_flux, Waves=Waves)
- call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
+ call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, &
Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves)
endif
@@ -1307,8 +1338,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0)
call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after KPP", tv, G, US)
- call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, &
scale=US%C_to_degC*GV%H_to_m*US%s_to_T)
call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, &
@@ -1360,7 +1391,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
skinbuoyflux(:,:) = 0.0
call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, &
optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, &
- CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux)
+ CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD=visc%MLD)
if (CS%debug) then
call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_m)
@@ -1408,13 +1439,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
if (CS%debug) then
call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_m)
call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_m)
- call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
else
call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, &
optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, &
- CS%evap_CFL_limit, CS%minimum_forcing_depth)
+ CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD=visc%MLD)
endif ! endif for CS%use_energetic_PBL
@@ -1464,17 +1495,20 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
enddo ; enddo ; enddo
endif
+ ! Find the vertical distances across layers, which may have been modified by the net surface flux
+ call thickness_to_dz(h, tv, dz, G, GV, US)
+
! set ent_t=dt*Kd_heat/h_int and est_s=dt*Kd_salt/h_int on interfaces for use in the tridiagonal solver.
do j=js,je ; do i=is,ie
ent_t(i,j,1) = 0. ; ent_t(i,j,nz+1) = 0.
ent_s(i,j,1) = 0. ; ent_s(i,j,nz+1) = 0.
enddo ; enddo
- !$OMP parallel do default(shared) private(I_hval)
+ !$OMP parallel do default(shared) private(I_dzval)
do K=2,nz ; do j=js,je ; do i=is,ie
- I_hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k)))
- ent_t(i,j,K) = (GV%Z_to_H**2) * dt * I_hval * Kd_heat(i,j,k)
- ent_s(i,j,K) = (GV%Z_to_H**2) * dt * I_hval * Kd_salt(i,j,k)
+ I_dzval = 1.0 / (dz_neglect + 0.5*(dz(i,j,k-1) + dz(i,j,k)))
+ ent_t(i,j,K) = dt * I_dzval * Kd_heat(i,j,k)
+ ent_s(i,j,K) = dt * I_dzval * Kd_salt(i,j,k)
enddo ; enddo ; enddo
if (showCallTree) call callTree_waypoint("done setting ent_t and ent_t from Kd_heat and " //&
"Kd_salt (diabatic_ALE)")
@@ -1505,14 +1539,14 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
call diag_update_remap_grids(CS%diag)
! Diagnose the diapycnal diffusivities and other related quantities.
- if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag)
- if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag)
- if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag)
+ if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag)
+ if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag)
+ if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag)
- if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ent_t(:,:,1:nz), CS%diag)
- if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, ent_t(:,:,2:nz+1), CS%diag)
- if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ent_s(:,:,1:nz), CS%diag)
- if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, ent_s(:,:,2:nz+1), CS%diag)
+ if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ent_t(:,:,1:nz), CS%diag)
+ if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, ent_t(:,:,2:nz+1), CS%diag)
+ if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ent_s(:,:,1:nz), CS%diag)
+ if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, ent_s(:,:,2:nz+1), CS%diag)
Idt = 1.0 / dt
if (CS%id_Tdif > 0) then
@@ -1540,7 +1574,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
call cpu_clock_begin(id_clock_tracers)
if (CS%mix_boundary_tracer_ALE) then
- Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr)
+ Tr_ea_BBL = sqrt(dt * CS%Kd_BBL_tr)
!$OMP parallel do default(shared) private(htot,in_boundary,add_ent)
do j=js,je
do i=is,ie
@@ -1554,8 +1588,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
! bottom, add some mixing of tracers between these layers. This flux is based on the
! harmonic mean of the two thicknesses, following what is done in layered mode. Kd_min_tr
! should be much less than the values in Kd_salt, perhaps a molecular diffusivity.
- add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * &
- ((h(i,j,k-1)+h(i,j,k) + h_neglect) / (h(i,j,k-1)*h(i,j,k) + h_neglect2)) - &
+ add_ent = (dt * CS%Kd_min_tr) * &
+ ((dz(i,j,k-1)+dz(i,j,k) + dz_neglect) / (dz(i,j,k-1)*dz(i,j,k) + dz_neglect2)) - &
ent_s(i,j,K)
if (htot(i) < Tr_ea_BBL) then
add_ent = max(0.0, add_ent, (Tr_ea_BBL - htot(i)) - ent_s(i,j,K))
@@ -1646,15 +1680,19 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
! one time step [H ~> m or kg m-2]
eb, & ! amount of fluid entrained from the layer below within
! one time step [H ~> m or kg m-2]
- Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1]
+ Kd_lay, & ! diapycnal diffusivity of layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
h_orig, & ! initial layer thicknesses [H ~> m or kg m-2]
+ dz, & ! The vertical distance between interfaces around a layer [Z ~> m]
hold, & ! layer thickness before diapycnal entrainment, and later the initial
! layer thicknesses (if a mixed layer is used) [H ~> m or kg m-2]
+ dz_old, & ! The initial vertical distance between interfaces around a layer
+ ! or the distance before entrainment [Z ~> m]
u_h, & ! Zonal velocities at thickness points after entrainment [L T-1 ~> m s-1]
v_h, & ! Meridional velocities at thickness points after entrainment [L T-1 ~> m s-1]
temp_diag, & ! Diagnostic array of previous temperatures [C ~> degC]
saln_diag ! Diagnostic array of previous salinity [S ~> ppt]
real, dimension(SZI_(G),SZJ_(G)) :: &
+ U_star, & ! The friction velocity [Z T-1 ~> m s-1].
Rcv_ml ! Coordinate density of mixed layer [R ~> kg m-3], used for applying sponges
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: &
@@ -1665,13 +1703,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
! homogenize tracers in massless layers near the boundaries [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: &
- Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1]
- Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1]
- Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1]
+ Kd_int, & ! diapycnal diffusivity of interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_heat, & ! diapycnal diffusivity of heat [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Kd_extra_T , & ! The extra diffusivity of temperature due to double diffusion relative to
- ! Kd_int [Z2 T-1 ~> m2 s-1].
+ ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to
- ! Kd_int [Z2 T-1 ~> m2 s-1].
+ ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
Tadv_flx, & ! advective diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]
Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
@@ -1697,7 +1735,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2]
- real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m]
+ real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2]
real :: net_ent ! The net of ea-eb at an interface [H ~> m or kg m-2]
real :: add_ent ! Entrainment that needs to be added when mixing tracers [H ~> m or kg m-2]
real :: eaval ! eaval is 2*ea at velocity grid points [H ~> m or kg m-2]
@@ -1724,7 +1764,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
nkmb = GV%nk_rho_varies
- h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect
+ h_neglect = GV%H_subroundoff
+ dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect*dz_neglect
Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0
@@ -1852,8 +1893,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0)
call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US)
- call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
@@ -1885,17 +1926,20 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
enddo ; enddo ; enddo
endif
+ ! Determine the friction velocity, perhaps using the evovling surface density.
+ call find_ustar(fluxes, tv, U_star, G, GV, US)
+
if ( associated(fluxes%lamult) ) then
call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, &
- fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult)
+ U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult)
- call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
+ call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, &
Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult)
else
call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, &
- fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves)
+ U_star, CS%KPP_buoy_flux, Waves=Waves)
- call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, &
+ call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, &
Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves)
endif
@@ -1930,8 +1974,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0)
call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after KPP", tv, G, US)
- call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux
endif ! endif for KPP
@@ -1973,7 +2017,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
if (CS%double_diffuse .and. associated(tv%T)) then
call cpu_clock_begin(id_clock_differential_diff)
- call differential_diffuse_T_S(h, tv%T, tv%S, Kd_extra_T, Kd_extra_S, dt, G, GV)
+ call differential_diffuse_T_S(h, tv%T, tv%S, Kd_extra_T, Kd_extra_S, tv, dt, G, GV)
call cpu_clock_end(id_clock_differential_diff)
if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)")
if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US)
@@ -2300,8 +2344,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
! mixing of passive tracers from massless boundary layers to interior
call cpu_clock_begin(id_clock_tracers)
+
+ ! Find the vertical distances across layers.
+ if (CS%mix_boundary_tracers .or. CS%double_diffuse) &
+ call thickness_to_dz(h, tv, dz, G, GV, US)
+ if (CS%double_diffuse) &
+ call thickness_to_dz(hold, tv, dz_old, G, GV, US)
+
if (CS%mix_boundary_tracers) then
- Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr)
+ Tr_ea_BBL = sqrt(dt * CS%Kd_BBL_tr)
!$OMP parallel do default(shared) private(htot,in_boundary,add_ent)
do j=js,je
do i=is,ie
@@ -2320,9 +2371,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
! in the calculation of the fluxes in the first place. Kd_min_tr
! should be much less than the values that have been set in Kd_lay,
! perhaps a molecular diffusivity.
- add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * &
- ((h(i,j,k-1)+h(i,j,k)+h_neglect) / &
- (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - &
+ add_ent = (dt * CS%Kd_min_tr) * &
+ ((dz(i,j,k-1) + dz(i,j,k) + dz_neglect) / &
+ (dz(i,j,k-1)*dz(i,j,k) + dz_neglect2)) - &
0.5*(ea(i,j,k) + eb(i,j,k-1))
if (htot(i) < Tr_ea_BBL) then
add_ent = max(0.0, add_ent, &
@@ -2337,9 +2388,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k)
endif
if (CS%double_diffuse) then ; if (Kd_extra_S(i,j,K) > 0.0) then
- add_ent = ((dt * Kd_extra_S(i,j,K)) * GV%Z_to_H**2) / &
- (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + &
- h_neglect)
+ add_ent = (dt * Kd_extra_S(i,j,K)) / &
+ (0.25 * ((dz(i,j,k-1) + dz(i,j,k)) + (dz_old(i,j,k-1) + dz_old(i,j,k))) + dz_neglect)
ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent
eatr(i,j,k) = eatr(i,j,k) + add_ent
endif ; endif
@@ -2361,9 +2411,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
!$OMP parallel do default(shared) private(add_ent)
do k=nz,2,-1 ; do j=js,je ; do i=is,ie
if (Kd_extra_S(i,j,K) > 0.0) then
- add_ent = ((dt * Kd_extra_S(i,j,K)) * GV%Z_to_H**2) / &
- (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + &
- h_neglect)
+ add_ent = (dt * Kd_extra_S(i,j,K)) / &
+ (0.25 * ((dz(i,j,k-1) + dz(i,j,k)) + (dz_old(i,j,k-1) + dz_old(i,j,k))) + dz_neglect)
else
add_ent = 0.0
endif
@@ -2398,9 +2447,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), &
tv%eqn_of_state, EOSdom)
enddo
- call apply_sponge(h, dt, G, GV, US, ea, eb, CS%sponge_CSp, Rcv_ml)
+ call apply_sponge(h, tv, dt, G, GV, US, ea, eb, CS%sponge_CSp, Rcv_ml)
else
- call apply_sponge(h, dt, G, GV, US, ea, eb, CS%sponge_CSp)
+ call apply_sponge(h, tv, dt, G, GV, US, ea, eb, CS%sponge_CSp)
endif
call cpu_clock_end(id_clock_sponge)
if (CS%debug) then
@@ -2616,7 +2665,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit,
! Constants within diabatic_CS
if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit
if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth
- if (present(diabatic_halo)) diabatic_halo = CS%halo_TS_diff
+ if (present(diabatic_halo)) diabatic_halo = CS%halo_diabatic
if (present(use_KPP)) use_KPP = CS%use_KPP
end subroutine extract_diabatic_member
@@ -2938,7 +2987,7 @@ end subroutine adiabatic_driver_init
!> This routine initializes the diabatic driver module.
subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, diag, &
ADp, CDp, CS, tracer_flow_CSp, sponge_CSp, &
- ALE_sponge_CSp, oda_incupd_CSp)
+ ALE_sponge_CSp, oda_incupd_CSp, int_tide_CSp)
type(time_type), target :: Time !< model time
type(ocean_grid_type), intent(inout) :: G !< model grid structure
type(verticalGrid_type), intent(in) :: GV !< model vertical grid structure
@@ -2956,6 +3005,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di
type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< pointer to the ALE sponge module control structure
type(oda_incupd_CS), pointer :: oda_incupd_CSp !< pointer to the ocean data assimilation incremental
!! update module control structure
+ type(int_tide_CS), pointer :: int_tide_CSp !< pointer to the internal tide structure
! Local variables
real :: Kd ! A diffusivity used in the default for other tracer diffusivities [Z2 T-1 ~> m2 s-1]
@@ -2990,6 +3040,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di
if (associated(sponge_CSp)) CS%sponge_CSp => sponge_CSp
if (associated(ALE_sponge_CSp)) CS%ALE_sponge_CSp => ALE_sponge_CSp
if (associated(oda_incupd_CSp)) CS%oda_incupd_CSp => oda_incupd_CSp
+ if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp
CS%useALEalgorithm = useALEalgorithm
CS%use_bulkmixedlayer = (GV%nkml > 0)
@@ -3090,12 +3141,14 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di
"A minimal diffusivity that should always be applied to "//&
"tracers, especially in massless layers near the bottom. "//&
"The default is 0.1*KD.", &
- units="m2 s-1", default=0.1*Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=0.1*Kd*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, &
"A bottom boundary layer tracer diffusivity that will "//&
"allow for explicitly specified bottom fluxes. The "//&
"entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) "//&
- "over the same distance.", units="m2 s-1", default=0., scale=US%m2_s_to_Z2_T)
+ "over the same distance.", &
+ units="m2 s-1", default=0., scale=GV%m2_s_to_HZ_T*(US%Z_to_m*GV%m_to_H))
+ ! The scaling factor here is usually equivalent to GV%m2_s_to_HZ_T*GV%Z_to_H.
endif
call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, &
@@ -3242,19 +3295,19 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di
endif
CS%id_Kd_int = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, &
- 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
if (CS%use_energetic_PBL) then
CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, &
- 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
endif
CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, &
- 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, &
+ 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s, &
cmor_field_name='difvho', &
cmor_standard_name='ocean_vertical_heat_diffusivity', &
cmor_long_name='Ocean vertical heat diffusivity')
CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, &
- 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, &
+ 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s, &
cmor_field_name='difvso', &
cmor_standard_name='ocean_vertical_salt_diffusivity', &
cmor_long_name='Ocean vertical salt diffusivity')
@@ -3453,15 +3506,20 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di
if (CS%use_int_tides) then
call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, &
CS%int_tide_input)
- call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide)
+ call internal_tides_init(Time, G, GV, US, param_file, diag, int_tide_CSp)
endif
+ !if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp
+
physical_OBL_scheme = (CS%use_bulkmixedlayer .or. CS%use_KPP .or. CS%use_energetic_PBL)
! initialize module for setting diffusivities
- call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide, &
+ call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide_CSp, &
halo_TS=CS%halo_TS_diff, double_diffuse=CS%double_diffuse, &
physical_OBL_scheme=physical_OBL_scheme)
+ CS%halo_diabatic = CS%halo_TS_diff
+ if (CS%use_int_tides) CS%halo_diabatic = max(CS%halo_TS_diff, 2)
+
if (CS%useKPP .and. (CS%double_diffuse .and. .not.CS%use_CVMix_ddiff)) &
call MOM_error(FATAL, 'diabatic_driver_init: DOUBLE_DIFFUSION (old method) does not work '//&
'with KPP. Please set DOUBLE_DIFFUSION=False and USE_CVMIX_DDIFF=True.')
@@ -3514,6 +3572,25 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di
end subroutine diabatic_driver_init
+!> Routine to register restarts, pass-through to children modules
+subroutine register_diabatic_restarts(G, US, param_file, int_tide_CSp, restart_CSp)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
+ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ type(int_tide_CS), pointer :: int_tide_CSp !< Internal tide control structure
+ type(MOM_restart_CS), pointer :: restart_CSp !< MOM restart control structure
+
+ logical :: use_int_tides
+
+ use_int_tides=.false.
+
+ call read_param(param_file, "INTERNAL_TIDES", use_int_tides)
+
+ if (use_int_tides) then
+ call register_int_tide_restarts(G, US, param_file, int_tide_CSp, restart_CSp)
+ endif
+
+end subroutine register_diabatic_restarts
!> Routine to close the diabatic driver module
subroutine diabatic_driver_end(CS)
diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90
index bbc4c9bf96..7ca432fea4 100644
--- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90
+++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90
@@ -6,13 +6,14 @@ module MOM_diapyc_energy_req
!! \author By Robert Hallberg, May 2015
use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data, register_diag_field
+use MOM_EOS, only : calculate_specific_vol_derivs, calculate_density
use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe
-use MOM_file_parser, only : get_param, log_version, param_file_type
-use MOM_grid, only : ocean_grid_type
-use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : thermo_var_ptrs
-use MOM_verticalGrid, only : verticalGrid_type
-use MOM_EOS, only : calculate_specific_vol_derivs, calculate_density
+use MOM_file_parser, only : get_param, log_version, param_file_type
+use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
+use MOM_unit_scaling, only : unit_scale_type
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
implicit none ; private
@@ -59,20 +60,25 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int)
real, intent(in) :: dt !< The amount of time covered by this call [T ~> s].
type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure.
real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), &
- optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 T-1 ~> m2 s-1].
+ optional, intent(in) :: Kd_int !< Interface diffusivities [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
! Local variables
real, dimension(GV%ke) :: &
T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities [C ~> degC] and [S ~> ppt].
- h_col ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2].
+ h_col, & ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2].
+ dz_col ! dz_col is a column of vertical distances across layers at tracer points [Z ~> m]
+ real, dimension( G%isd:G%ied,GV%ke) :: &
+ dz_2d ! A 2-d slice of the vertical distance across layers [Z ~> m]
real, dimension(GV%ke+1) :: &
- Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1].
+ Kd, & ! A column of diapycnal diffusivities at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2].
+ real :: dz_h_int ! The ratio of the vertical distances across the layers surrounding an interface
+ ! over the layer thicknesses [H Z-1 ~> nonodim or kg m-3]
real :: ustar ! The local friction velocity [Z T-1 ~> m s-1]
real :: absf ! The absolute value of the Coriolis parameter [T-1 ~> s-1]
real :: htot ! The sum of the thicknesses [H ~> m or kg m-2].
real :: energy_Kd ! The energy used by diapycnal mixing [R Z L2 T-3 ~> W m-2].
- real :: tmp1 ! A temporary array [H Z ~> m2 or kg m-1]
+ real :: tmp1 ! A temporary array [H2 ~> m2 or kg2 m-6]
integer :: i, j, k, is, ie, js, je, nz
logical :: may_print
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -84,36 +90,56 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int)
"Module must be initialized before it is used.")
!$OMP do
- do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
- if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then
- do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*Kd_int(i,j,K) ; enddo
- else
- htot = 0.0 ; h_top(1) = 0.0
+ do j=js,je
+ call thickness_to_dz(h_3d, tv, dz_2d, j, G, GV)
+
+ do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
+
do k=1,nz
T0(k) = tv%T(i,j,k) ; S0(k) = tv%S(i,j,k)
h_col(k) = h_3d(i,j,k)
- h_top(K+1) = h_top(K) + h_col(k)
- enddo
- htot = h_top(nz+1)
- h_bot(nz+1) = 0.0
- do k=nz,1,-1
- h_bot(K) = h_bot(K+1) + h_col(k)
+ dz_col(k) = dz_2d(i,k)
enddo
- ustar = 0.01*US%m_to_Z*US%T_to_s ! Change this to being an input parameter?
- absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + &
- (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))))
- Kd(1) = 0.0 ; Kd(nz+1) = 0.0
- do K=2,nz
- tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z
- Kd(K) = CS%test_Kh_scaling * &
- ustar * CS%VonKar * (tmp1*ustar) / (absf*tmp1 + htot*ustar)
- enddo
- endif
- may_print = is_root_PE() .and. (i==ie) .and. (j==je)
- call diapyc_energy_req_calc(h_col, T0, S0, Kd, energy_Kd, dt, tv, G, GV, US, &
- may_print=may_print, CS=CS)
- endif ; enddo ; enddo
+ if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then
+ do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*Kd_int(i,j,K) ; enddo
+ else
+ htot = 0.0 ; h_top(1) = 0.0
+ do k=1,nz
+ h_top(K+1) = h_top(K) + h_col(k)
+ enddo
+ htot = h_top(nz+1)
+
+ h_bot(nz+1) = 0.0
+ do k=nz,1,-1
+ h_bot(K) = h_bot(K+1) + h_col(k)
+ enddo
+
+ ustar = 0.01*US%m_to_Z*US%T_to_s ! Change this to being an input parameter?
+ absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + &
+ (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))))
+ Kd(1) = 0.0 ; Kd(nz+1) = 0.0
+ if (GV%Boussinesq) then
+ do K=2,nz
+ tmp1 = h_top(K) * h_bot(K)
+ Kd(K) = CS%test_Kh_scaling * &
+ ustar * CS%VonKar * (tmp1*ustar) / (absf*GV%H_to_Z*tmp1 + htot*ustar)
+ enddo
+ else
+ do K=2,nz
+ tmp1 = h_top(K) * h_bot(K)
+ dz_h_int = (dz_2d(j,k-1) + dz_2d(j,k) + GV%dz_subroundoff) / &
+ (h_3d(i,j,k-1) + h_3d(i,j,k) + GV%H_subroundoff)
+ Kd(K) = CS%test_Kh_scaling * &
+ ustar * CS%VonKar * (tmp1*ustar) / (dz_h_int*absf*tmp1 + htot*ustar)
+ enddo
+ endif
+ endif
+ may_print = is_root_PE() .and. (i==ie) .and. (j==je)
+ call diapyc_energy_req_calc(h_col, dz_col, T0, S0, Kd, energy_Kd, dt, tv, G, GV, US, &
+ may_print=may_print, CS=CS)
+ endif ; enddo
+ enddo
end subroutine diapyc_energy_req_test
@@ -123,17 +149,19 @@ end subroutine diapyc_energy_req_test
!! 4 different ways, all of which should be equivalent, but reports only one.
!! The various estimates are taken because they will later be used as templates
!! for other bits of code
-subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
+subroutine diapyc_energy_req_calc(h_in, dz_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
G, GV, US, may_print, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment,
- !! [H ~> m or kg m-2].
+ !! [H ~> m or kg m-2]
+ real, dimension(GV%ke), intent(in) :: dz_in !< Vertical distance across layers before
+ !! entrainment [Z ~> m]
real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [C ~> degC].
real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities [S ~> ppt].
real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, intent(in) :: dt !< The amount of time covered by this call [T ~> s].
real, intent(out) :: energy_Kd !< The column-integrated rate of energy
!! consumption by diapycnal diffusion [R Z L2 T-3 ~> W m-2].
@@ -157,11 +185,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
dSV_dT, & ! Partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1].
dSV_dS, & ! Partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
T0, S0, & ! Initial temperatures and salinities [C ~> degC] and [S ~> ppt].
- Te, Se, & ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt]
- Te_a, Se_a, & ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt]
- Te_b, Se_b, & ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt]
Tf, Sf, & ! New final values of the temperatures and salinities [C ~> degC] and [S ~> ppt].
- dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change [C ~> degC] and [S ~> ppt].
Th_a, & ! An effective temperature times a thickness in the layer above, including implicit
! mixing effects with other yet higher layers [C H ~> degC m or degC kg m-2].
Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit
@@ -210,8 +234,18 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
! in the denominator of b1 in an upward-oriented tridiagonal solver.
c1_a, & ! c1_a is used by a downward-oriented tridiagonal solver [nondim].
c1_b, & ! c1_b is used by an upward-oriented tridiagonal solver [nondim].
- h_tr ! h_tr is h at tracer points with a h_neglect added to
+ h_tr, & ! h_tr is h at tracer points with a h_neglect added to
! ensure positive definiteness [H ~> m or kg m-2].
+ dz_tr ! dz_tr is dz at tracer points with dz_neglect added to
+ ! ensure positive definiteness [Z ~> m]
+ ! Note that the following arrays have extra (ficticious) layers above or below the
+ ! water column for code convenience
+ real, dimension(0:GV%ke+1) :: &
+ Te, Se ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt]
+ real, dimension(0:GV%ke) :: &
+ Te_a, Se_a ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt]
+ real, dimension(GV%ke+1) :: &
+ Te_b, Se_b ! Running incomplete estimates of the new temperatures and salinities [C ~> degC] and [S ~> ppt]
real, dimension(GV%ke+1) :: &
pres, & ! Interface pressures [R L2 T-2 ~> Pa].
pres_Z, & ! The hydrostatic interface pressure, which is used to relate
@@ -238,10 +272,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
real :: dKd ! The change in the value of Kddt_h [H ~> m or kg m-2].
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
- real :: dTe_term ! A diffusivity-independent term related to the temperature
- ! change in the layer below the interface [C H ~> degC m or degC kg m-2].
- real :: dSe_term ! A diffusivity-independent term related to the salinity
- ! change in the layer below the interface [S H ~> ppt m or ppt kg m-2].
real :: Kddt_h_guess ! A guess of the final value of Kddt_h [H ~> m or kg m-2].
real :: dMass ! The mass per unit area within a layer [R Z ~> kg m-2].
real :: dPres ! The hydrostatic pressure change across a layer [R L2 T-2 ~> Pa].
@@ -251,10 +281,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
real :: ColHt_cor ! The correction to PE_chg that is made due to a net
! change in the column height [R L2 Z T-2 ~> J m-2].
real :: htot ! A running sum of thicknesses [H ~> m or kg m-2].
- real :: dTe_t2 ! Temporary arrays with integrated temperature changes [C H ~> degC m or degC kg m-2]
- real :: dSe_t2 ! Temporary arrays with integrated salinity changes [S H ~> ppt m or ppt kg m-2]
- real :: dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes [C ~> degC].
- real :: dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes [S ~> ppt].
+ real :: dztot ! A running sum of vertical distances across layers [Z ~> m]
logical :: do_print
! The following are a bunch of diagnostic arrays for debugging purposes.
@@ -282,7 +309,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
integer :: k, nz, itt, k_cent
logical :: surface_BL, bottom_BL, central, halves, debug
- logical :: old_PE_calc
nz = GV%ke
h_neglect = GV%H_subroundoff
@@ -298,11 +324,13 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0
dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0
- htot = 0.0 ; pres(1) = 0.0 ; pres_Z(1) = 0.0 ; Z_int(1) = 0.0
+ htot = 0.0 ; dztot = 0.0 ; pres(1) = 0.0 ; pres_Z(1) = 0.0 ; Z_int(1) = 0.0
do k=1,nz
T0(k) = T_in(k) ; S0(k) = S_in(k)
h_tr(k) = h_in(k)
+ dz_tr(k) = dz_in(k)
htot = htot + h_tr(k)
+ dztot = dztot + dz_tr(k)
pres(K+1) = pres(K) + (GV%g_Earth * GV%H_to_RZ) * h_tr(k)
pres_Z(K+1) = pres(K+1)
p_lay(k) = 0.5*(pres(K) + pres(K+1))
@@ -310,15 +338,23 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
enddo
do k=1,nz
h_tr(k) = max(h_tr(k), 1e-15*htot)
+ dz_tr(k) = max(dz_tr(k), 1e-15*dztot)
enddo
! Introduce a diffusive flux variable, Kddt_h(K) = ea(k) = eb(k-1)
Kddt_h(1) = 0.0 ; Kddt_h(nz+1) = 0.0
do K=2,nz
- Kddt_h(K) = min((GV%Z_to_H**2*dt)*Kd(k) / (0.5*(h_tr(k-1) + h_tr(k))), 1e3*htot)
+ Kddt_h(K) = min(dt * Kd(k) / (0.5*(dz_tr(k-1) + dz_tr(k))), 1e3*dztot)
enddo
+ ! Zero out the temperature and salinity estimates in the extra (ficticious) layers.
+ ! The actual values set here are irrelevant (so long as they are not NaNs) because they
+ ! are always multiplied by a zero value of Kddt_h reflecting the no-flux boundary condition.
+ Te(0) = 0.0 ; Se(0) = 0.0 ; Te(nz+1) = 0.0 ; Se(nz+1) = 0.0
+ Te_a(0) = 0.0 ; Se_a(0) = 0.0
+ Te_b(nz+1) = 0.0 ; Se_b(nz+1) = 0.0
+
! Solve the tridiagonal equations for new temperatures.
call calculate_specific_vol_derivs(T0, S0, p_lay, dSV_dT, dSV_dS, tv%eqn_of_state)
@@ -337,7 +373,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
PE_chg_k(:,:) = 0.0 ; ColHt_cor_k(:,:) = 0.0
if (surface_BL) then ! This version is appropriate for a surface boundary layer.
- old_PE_calc = .false.
! Set up values appropriate for no diffusivity.
do k=1,nz
@@ -353,71 +388,32 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
! on how much energy is available.
! Precalculate some temporary expressions that are independent of Kddt_h_guess.
- if (old_PE_calc) then
- if (K==2) then
- dT_km1_t2 = (T0(k)-T0(k-1))
- dS_km1_t2 = (S0(k)-S0(k-1))
- dTe_t2 = 0.0 ; dSe_t2 = 0.0
- else
- dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2))
- dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2))
- dT_km1_t2 = (T0(k)-T0(k-1)) - &
- (Kddt_h(K-1) / hp_a(k-1)) * ((T0(k-2) - T0(k-1)) + dTe(k-2))
- dS_km1_t2 = (S0(k)-S0(k-1)) - &
- (Kddt_h(K-1) / hp_a(k-1)) * ((S0(k-2) - S0(k-1)) + dSe(k-2))
- endif
- dTe_term = dTe_t2 + hp_a(k-1) * (T0(k-1)-T0(k))
- dSe_term = dSe_t2 + hp_a(k-1) * (S0(k-1)-S0(k))
- else
- if (K<=2) then
- Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
- else
- Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)
- Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)
- endif
- Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
- endif
+ Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)
+ Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)
+ Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
! Find the energy change due to a guess at the strength of diffusion at interface K.
Kddt_h_guess = Kddt_h(K)
- if (old_PE_calc) then
- call find_PE_chg_orig(Kddt_h_guess, h_tr(k), hp_a(k-1), &
- dTe_term, dSe_term, dT_km1_t2, dS_km1_t2, &
- dT_to_dPE(k), dS_to_dPE(k), dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), &
- pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), &
- dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
- PE_chg_k(k,1), dPEa_dKd(k))
- else
- call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
- Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
- dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
- pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
- dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_chg_k(K,1), dPEc_dKd=dPEa_dKd(K), &
- ColHt_cor=ColHt_cor_k(K,1))
- endif
+ call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
+ Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
+ dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
+ pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
+ dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
+ PE_chg=PE_chg_k(K,1), dPEc_dKd=dPEa_dKd(K), &
+ PE_ColHt_cor=ColHt_cor_k(K,1))
if (debug) then
do itt=1,5
Kddt_h_guess = (1.0+0.01*(itt-3))*Kddt_h(K)
- if (old_PE_calc) then
- call find_PE_chg_orig(Kddt_h_guess, h_tr(k), hp_a(k-1), &
- dTe_term, dSe_term, dT_km1_t2, dS_km1_t2, &
- dT_to_dPE(k), dS_to_dPE(k), dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), &
- pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), &
- dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
- PE_chg=PE_chg(itt))
- else
- call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
- Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
- dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
- pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
- dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_chg(itt))
- endif
+ call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
+ Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
+ dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
+ pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
+ dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
+ PE_chg=PE_chg(itt))
enddo
! Compare with a 4th-order finite difference estimate.
dPEa_dKd_est(k) = (4.0*(PE_chg(4)-Pe_chg(2))/(0.02*Kddt_h(K)) - &
@@ -434,17 +430,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
b1 = 1.0 / (hp_a(k-1) + Kddt_h(K))
c1_a(K) = Kddt_h(K) * b1
- if (k==2) then
- Te(1) = b1*(h_tr(1)*T0(1))
- Se(1) = b1*(h_tr(1)*S0(1))
- else
- Te(k-1) = b1 * (h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2))
- Se(k-1) = b1 * (h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2))
- endif
- if (old_PE_calc) then
- dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 )
- dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 )
- endif
+ Te(k-1) = b1 * (h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2))
+ Se(k-1) = b1 * (h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2))
hp_a(k) = h_tr(k) + (hp_a(k-1) * b1) * Kddt_h(K)
dT_to_dPE_a(k) = dT_to_dPE(k) + c1_a(K)*dT_to_dPE_a(k-1)
@@ -457,10 +444,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
b1 = 1.0 / (hp_a(nz))
Tf(nz) = b1 * (h_tr(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1))
Sf(nz) = b1 * (h_tr(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1))
- if (old_PE_calc) then
- dTe(nz) = b1 * Kddt_h(nz) * ((T0(nz-1)-T0(nz)) + dTe(nz-1))
- dSe(nz) = b1 * Kddt_h(nz) * ((S0(nz-1)-S0(nz)) + dSe(nz-1))
- endif
do k=nz-1,1,-1
Tf(k) = Te(k) + c1_a(K+1)*Tf(k+1)
@@ -483,7 +466,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
endif
if (bottom_BL) then ! This version is appropriate for a bottom boundary layer.
- old_PE_calc = .false.
! Set up values appropriate for no diffusivity.
do k=1,nz
@@ -499,71 +481,32 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
! on how much energy is available.
! Precalculate some temporary expressions that are independent of Kddt_h_guess.
- if (old_PE_calc) then
- if (K==nz) then
- dT_k_t2 = (T0(k-1)-T0(k))
- dS_k_t2 = (S0(k-1)-S0(k))
- dTe_t2 = 0.0 ; dSe_t2 = 0.0
- else
- dTe_t2 = Kddt_h(K+1) * ((T0(k+1) - T0(k)) + dTe(k+1))
- dSe_t2 = Kddt_h(K+1) * ((S0(k+1) - S0(k)) + dSe(k+1))
- dT_k_t2 = (T0(k-1)-T0(k)) - &
- (Kddt_h(k+1)/ hp_b(k)) * ((T0(k+1) - T0(k)) + dTe(k+1))
- dS_k_t2 = (S0(k-1)-S0(k)) - &
- (Kddt_h(k+1)/ hp_b(k)) * ((S0(k+1) - S0(k)) + dSe(k+1))
- endif
- dTe_term = dTe_t2 + hp_b(k) * (T0(k)-T0(k-1))
- dSe_term = dSe_t2 + hp_b(k) * (S0(k)-S0(k-1))
- else
- Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
- if (K>=nz) then
- Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
- else
- Th_b(k) = h_tr(k) * T0(k) + Kddt_h(K+1) * Te(k+1)
- Sh_b(k) = h_tr(k) * S0(k) + Kddt_h(k+1) * Se(k+1)
- endif
- endif
+ Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
+ Th_b(k) = h_tr(k) * T0(k) + Kddt_h(K+1) * Te(k+1)
+ Sh_b(k) = h_tr(k) * S0(k) + Kddt_h(K+1) * Se(k+1)
! Find the energy change due to a guess at the strength of diffusion at interface K.
Kddt_h_guess = Kddt_h(K)
- if (old_PE_calc) then
- call find_PE_chg_orig(Kddt_h_guess, h_tr(k-1), hp_b(k), &
- dTe_term, dSe_term, dT_k_t2, dS_k_t2, &
- dT_to_dPE(k-1), dS_to_dPE(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
- pres_Z(K), dT_to_dColHt(k-1), dS_to_dColHt(k-1), &
- dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_chg_k(K,2), dPEc_dKd=dPEb_dKd(K))
- else
- call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
- Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
- dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
- pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
- dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_chg_k(K,2), dPEc_dKd=dPEb_dKd(K), &
- ColHt_cor=ColHt_cor_k(K,2))
- endif
+ call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
+ Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
+ dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
+ pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
+ dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
+ PE_chg=PE_chg_k(K,2), dPEc_dKd=dPEb_dKd(K), &
+ PE_ColHt_cor=ColHt_cor_k(K,2))
if (debug) then
! Compare with a 4th-order finite difference estimate.
do itt=1,5
Kddt_h_guess = (1.0+0.01*(itt-3))*Kddt_h(K)
- if (old_PE_calc) then
- call find_PE_chg_orig(Kddt_h_guess, h_tr(k-1), hp_b(k), &
- dTe_term, dSe_term, dT_k_t2, dS_k_t2, &
- dT_to_dPE(k-1), dS_to_dPE(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
- pres_Z(K), dT_to_dColHt(k-1), dS_to_dColHt(k-1), &
+ call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
+ Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
+ dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
+ pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
PE_chg=PE_chg(itt))
- else
- call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), &
- Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
- dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
- pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
- dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_chg(itt))
- endif
enddo
dPEb_dKd_est(k) = (4.0*(PE_chg(4)-Pe_chg(2))/(0.02*Kddt_h(K)) - &
@@ -580,17 +523,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
b1 = 1.0 / (hp_b(k) + Kddt_h(K))
c1_b(K) = Kddt_h(K) * b1
- if (k==nz) then
- Te(nz) = b1* (h_tr(nz)*T0(nz))
- Se(nz) = b1* (h_tr(nz)*S0(nz))
- else
- Te(k) = b1 * (h_tr(k) * T0(k) + Kddt_h(K+1) * Te(k+1))
- Se(k) = b1 * (h_tr(k) * S0(k) + Kddt_h(k+1) * Se(k+1))
- endif
- if (old_PE_calc) then
- dTe(k) = b1 * ( Kddt_h(K)*(T0(k-1)-T0(k)) + dTe_t2 )
- dSe(k) = b1 * ( Kddt_h(K)*(S0(k-1)-S0(k)) + dSe_t2 )
- endif
+
+ Te(k) = b1 * (h_tr(k) * T0(k) + Kddt_h(K+1) * Te(k+1))
+ Se(k) = b1 * (h_tr(k) * S0(k) + Kddt_h(K+1) * Se(k+1))
hp_b(k-1) = h_tr(k-1) + (hp_b(k) * b1) * Kddt_h(K)
dT_to_dPE_b(k-1) = dT_to_dPE(k-1) + c1_b(K)*dT_to_dPE_b(k)
@@ -603,10 +538,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
b1 = 1.0 / (hp_b(1))
Tf(1) = b1 * (h_tr(1) * T0(1) + Kddt_h(2) * Te(2))
Sf(1) = b1 * (h_tr(1) * S0(1) + Kddt_h(2) * Se(2))
- if (old_PE_calc) then
- dTe(1) = b1 * Kddt_h(2) * ((T0(2)-T0(1)) + dTe(2))
- dSe(1) = b1 * Kddt_h(2) * ((S0(2)-S0(1)) + dSe(2))
- endif
do k=2,nz
Tf(k) = Te(k) + c1_b(K)*Tf(k-1)
@@ -644,12 +575,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
do K=2,nz ! Loop over interior interfaces.
! First calculate some terms that are independent of the change in Kddt_h(K).
Kd0 = 0.0 ! This might need to be changed - it is the already applied value of Kddt_h(K).
- if (K<=2) then
- Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
- else
- Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te_a(k-2)
- Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se_a(k-2)
- endif
+
+ Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te_a(k-2)
+ Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se_a(k-2)
Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
Kddt_h_a(K) = 0.0 ; if (K < K_cent) Kddt_h_a(K) = Kddt_h(K)
@@ -660,19 +588,15 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_change, ColHt_cor=ColHt_cor)
+ PE_chg=PE_change, PE_ColHt_cor=ColHt_cor)
PE_chg_k(K,3) = PE_change
ColHt_cor_k(K,3) = ColHt_cor
b1 = 1.0 / (hp_a(k-1) + Kddt_h_a(K))
c1_a(K) = Kddt_h_a(K) * b1
- if (k==2) then
- Te_a(1) = b1*(h_tr(1)*T0(1))
- Se_a(1) = b1*(h_tr(1)*S0(1))
- else
- Te_a(k-1) = b1 * (h_tr(k-1) * T0(k-1) + Kddt_h_a(K-1) * Te_a(k-2))
- Se_a(k-1) = b1 * (h_tr(k-1) * S0(k-1) + Kddt_h_a(K-1) * Se_a(k-2))
- endif
+
+ Te_a(k-1) = b1 * (h_tr(k-1) * T0(k-1) + Kddt_h_a(K-1) * Te_a(k-2))
+ Se_a(k-1) = b1 * (h_tr(k-1) * S0(k-1) + Kddt_h_a(K-1) * Se_a(k-2))
hp_a(k) = h_tr(k) + (hp_a(k-1) * b1) * Kddt_h_a(K)
dT_to_dPE_a(k) = dT_to_dPE(k) + c1_a(K)*dT_to_dPE_a(k-1)
@@ -686,18 +610,13 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
do K=nz,2,-1 ! Loop over interior interfaces.
! First calculate some terms that are independent of the change in Kddt_h(K).
Kd0 = 0.0 ! This might need to be changed - it is the already applied value of Kddt_h(K).
-! if (K<=2) then
- Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
-! else
-! Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te_a(k-2)
-! Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se_a(k-2)
-! endif
- if (K>=nz) then
- Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
- else
- Th_b(k) = h_tr(k) * T0(k) + Kddt_h(K+1) * Te_b(k+1)
- Sh_b(k) = h_tr(k) * S0(k) + Kddt_h(k+1) * Se_b(k+1)
- endif
+
+ Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
+! Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te_a(k-2)
+! Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se_a(k-2)
+
+ Th_b(k) = h_tr(k) * T0(k) + Kddt_h(K+1) * Te_b(k+1)
+ Sh_b(k) = h_tr(k) * S0(k) + Kddt_h(K+1) * Se_b(k+1)
Kddt_h_b(K) = 0.0 ; if (K > K_cent) Kddt_h_b(K) = Kddt_h(K)
dKd = Kddt_h_b(K)
@@ -707,19 +626,15 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_change, ColHt_cor=ColHt_cor)
+ PE_chg=PE_change, PE_ColHt_cor=ColHt_cor)
PE_chg_k(K,3) = PE_chg_k(K,3) + PE_change
ColHt_cor_k(K,3) = ColHt_cor_k(K,3) + ColHt_cor
b1 = 1.0 / (hp_b(k) + Kddt_h_b(K))
c1_b(K) = Kddt_h_b(K) * b1
- if (k==nz) then
- Te_b(k) = b1 * (h_tr(k)*T0(k))
- Se_b(k) = b1 * (h_tr(k)*S0(k))
- else
- Te_b(k) = b1 * (h_tr(k) * T0(k) + Kddt_h_b(K+1) * Te_b(k+1))
- Se_b(k) = b1 * (h_tr(k) * S0(k) + Kddt_h_b(k+1) * Se_b(k+1))
- endif
+
+ Te_b(k) = b1 * (h_tr(k) * T0(k) + Kddt_h_b(K+1) * Te_b(k+1))
+ Se_b(k) = b1 * (h_tr(k) * S0(k) + Kddt_h_b(K+1) * Se_b(k+1))
hp_b(k-1) = h_tr(k-1) + (hp_b(k) * b1) * Kddt_h_b(K)
dT_to_dPE_b(k-1) = dT_to_dPE(k-1) + c1_b(K)*dT_to_dPE_b(k)
@@ -734,18 +649,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
! First calculate some terms that are independent of the change in Kddt_h(K).
Kd0 = 0.0 ! This might need to be changed - it is the already applied value of Kddt_h(K).
- if (K<=2) then
- Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
- else
- Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te_a(k-2)
- Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se_a(k-2)
- endif
- if (K>=nz) then
- Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
- else
- Th_b(k) = h_tr(k) * T0(k) + Kddt_h(K+1) * Te_b(k+1)
- Sh_b(k) = h_tr(k) * S0(k) + Kddt_h(k+1) * Se_b(k+1)
- endif
+
+ Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kddt_h(K-1) * Te_a(k-2)
+ Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kddt_h(K-1) * Se_a(k-2)
+ Th_b(k) = h_tr(k) * T0(k) + Kddt_h(K+1) * Te_b(k+1)
+ Sh_b(k) = h_tr(k) * S0(k) + Kddt_h(K+1) * Se_b(k+1)
dKd = Kddt_h(K)
@@ -754,7 +662,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_change, ColHt_cor=ColHt_cor)
+ PE_chg=PE_change, PE_ColHt_cor=ColHt_cor)
PE_chg_k(K,3) = PE_chg_k(K,3) + PE_change
ColHt_cor_k(K,3) = ColHt_cor_k(K,3) + ColHt_cor
@@ -820,16 +728,12 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
enddo
! Calculate the dependencies on layers above.
- Kddt_h_a(1) = 0.0
do K=2,nz ! Loop over interior interfaces.
! First calculate some terms that are independent of the change in Kddt_h(K).
Kd0 = Kd_so_far(K)
- if (K<=2) then
- Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
- else
- Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kd_so_far(K-1) * Te(k-2)
- Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kd_so_far(K-1) * Se(k-2)
- endif
+
+ Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kd_so_far(K-1) * Te(k-2)
+ Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kd_so_far(K-1) * Se(k-2)
Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
dKd = 0.5 * Kddt_h(K) - Kd_so_far(K)
@@ -839,7 +743,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_change, ColHt_cor=ColHt_cor)
+ PE_chg=PE_change, PE_ColHt_cor=ColHt_cor)
PE_chg_k(K,4) = PE_change
ColHt_cor_k(K,4) = ColHt_cor
@@ -848,13 +752,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
b1 = 1.0 / (hp_a(k-1) + Kd_so_far(K))
c1_a(K) = Kd_so_far(K) * b1
- if (k==2) then
- Te(1) = b1*(h_tr(1)*T0(1))
- Se(1) = b1*(h_tr(1)*S0(1))
- else
- Te(k-1) = b1 * (h_tr(k-1) * T0(k-1) + Kd_so_far(K-1) * Te(k-2))
- Se(k-1) = b1 * (h_tr(k-1) * S0(k-1) + Kd_so_far(K-1) * Se(k-2))
- endif
+
+ Te(k-1) = b1 * (h_tr(k-1) * T0(k-1) + Kd_so_far(K-1) * Te(k-2))
+ Se(k-1) = b1 * (h_tr(k-1) * S0(k-1) + Kd_so_far(K-1) * Se(k-2))
hp_a(k) = h_tr(k) + (hp_a(k-1) * b1) * Kd_so_far(K)
dT_to_dPE_a(k) = dT_to_dPE(k) + c1_a(K)*dT_to_dPE_a(k-1)
@@ -867,18 +767,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
do K=nz,2,-1 ! Loop over interior interfaces.
! First calculate some terms that are independent of the change in Kddt_h(K).
Kd0 = Kd_so_far(K)
- if (K<=2) then
- Th_a(k-1) = h_tr(k-1) * T0(k-1) ; Sh_a(k-1) = h_tr(k-1) * S0(k-1)
- else
- Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kd_so_far(K-1) * Te(k-2)
- Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kd_so_far(K-1) * Se(k-2)
- endif
- if (K>=nz) then
- Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k)
- else
- Th_b(k) = h_tr(k) * T0(k) + Kd_so_far(K+1) * Te(k+1)
- Sh_b(k) = h_tr(k) * S0(k) + Kd_so_far(k+1) * Se(k+1)
- endif
+
+ Th_a(k-1) = h_tr(k-1) * T0(k-1) + Kd_so_far(K-1) * Te(k-2)
+ Sh_a(k-1) = h_tr(k-1) * S0(k-1) + Kd_so_far(K-1) * Se(k-2)
+ Th_b(k) = h_tr(k) * T0(k) + Kd_so_far(K+1) * Te(k+1)
+ Sh_b(k) = h_tr(k) * S0(k) + Kd_so_far(k+1) * Se(k+1)
dKd = Kddt_h(K) - Kd_so_far(K)
@@ -887,7 +780,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
- PE_chg=PE_change, ColHt_cor=ColHt_cor)
+ PE_chg=PE_change, PE_ColHt_cor=ColHt_cor)
PE_chg_k(K,4) = PE_chg_k(K,4) + PE_change
ColHt_cor_k(K,4) = ColHt_cor_k(K,4) + ColHt_cor
@@ -897,13 +790,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
b1 = 1.0 / (hp_b(k) + Kd_so_far(K))
c1_b(K) = Kd_so_far(K) * b1
- if (k==nz) then
- Te(k) = b1 * (h_tr(k)*T0(k))
- Se(k) = b1 * (h_tr(k)*S0(k))
- else
- Te(k) = b1 * (h_tr(k) * T0(k) + Kd_so_far(K+1) * Te(k+1))
- Se(k) = b1 * (h_tr(k) * S0(k) + Kd_so_far(k+1) * Se(k+1))
- endif
+
+ Te(k) = b1 * (h_tr(k) * T0(k) + Kd_so_far(K+1) * Te(k+1))
+ Se(k) = b1 * (h_tr(k) * S0(k) + Kd_so_far(k+1) * Se(k+1))
hp_b(k-1) = h_tr(k-1) + (hp_b(k) * b1) * Kd_so_far(K)
dT_to_dPE_b(k-1) = dT_to_dPE(k-1) + c1_b(K)*dT_to_dPE_b(k)
@@ -962,7 +851,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
do K=2,nz
call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), &
pres(K), rho_here, tv%eqn_of_state)
- N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * &
+ N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*(dz_tr(k-1) + dz_tr(k)))) * &
( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + &
0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) )
enddo
@@ -973,7 +862,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
do K=2,nz
call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), &
pres(K), rho_here, tv%eqn_of_state)
- N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * &
+ N2(K) = ((US%L_to_Z**2*GV%g_Earth) * rho_here / (0.5*(dz_tr(k-1) + dz_tr(k)))) * &
( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + &
0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) )
enddo
@@ -984,11 +873,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, &
end subroutine diapyc_energy_req_calc
!> This subroutine calculates the change in potential energy and or derivatives
-!! for several changes in an interfaces's diapycnal diffusivity times a timestep.
+!! for several changes in an interface's diapycnal diffusivity times a timestep.
subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
dT_to_dPE_a, dS_to_dPE_a, dT_to_dPE_b, dS_to_dPE_b, &
pres_Z, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, &
- PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor)
+ PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, PE_ColHt_cor)
real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times
!! the time step and divided by the average of the
!! thicknesses around the interface [H ~> m or kg m-2].
@@ -1016,22 +905,22 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
!! below, including implicit mixing effects with other
!! yet lower layers [S H ~> ppt m or ppt kg m-2].
real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
- !! a layer's temperature change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the temperatures of all the layers above [R Z L2 T-2 C-1 ~> J m-2 degC-1].
+ !! a layer's temperature change to the change in column potential
+ !! energy, including all implicit diffusive changes in the
+ !! temperatures of all the layers above [R Z L2 T-2 C-1 ~> J m-2 degC-1].
real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
- !! a layer's salinity change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the salinities of all the layers above [R Z L2 T-2 S-1 ~> J m-2 ppt-1].
+ !! a layer's salinity change to the change in column potential
+ !! energy, including all implicit diffusive changes in the
+ !! salinities of all the layers above [R Z L2 T-2 S-1 ~> J m-2 ppt-1].
real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
- !! a layer's temperature change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the temperatures of all the layers below [R Z L2 T-2 C-1 ~> J m-2 degC-1].
+ !! a layer's temperature change to the change in column potential
+ !! energy, including all implicit diffusive changes in the
+ !! temperatures of all the layers below [R Z L2 T-2 C-1 ~> J m-2 degC-1].
real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
- !! a layer's salinity change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the salinities of all the layers below [R Z L2 T-2 S-1 ~> J m-2 ppt-1].
- real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate
+ !! a layer's salinity change to the change in column potential
+ !! energy, including all implicit diffusive changes in the
+ !! salinities of all the layers below [R Z L2 T-2 S-1 ~> J m-2 ppt-1].
+ real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which relates
!! the changes in column thickness to the energy that is radiated
!! as gravity waves and unavailable to drive mixing [R L2 T-2 ~> J m-3].
real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating
@@ -1051,8 +940,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
!! height, including all implicit diffusive changes
!! in the salinities of all the layers below [Z S-1 ~> m ppt-1].
- real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying
- !! Kddt_h at the present interface [R Z L2 T-2 ~> J m-2].
+ real, intent(out) :: PE_chg !< The change in column potential energy from applying
+ !! Kddt_h at the present interface [R Z L2 T-2 ~> J m-2].
real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h,
!! [R Z L2 T-2 H-1 ~> J m-3 or J kg-1].
real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could
@@ -1060,17 +949,18 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
!! present interface [R Z L2 T-2 ~> J m-2].
real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the
!! limit where Kddt_h = 0 [R Z L2 T-2 H-1 ~> J m-3 or J kg-1].
- real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net
+ real, optional, intent(out) :: PE_ColHt_cor !< The correction to PE_chg that is made due to a net
!! change in the column height [R Z L2 T-2 ~> J m-2].
+ ! Local variables
real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2].
real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4].
real :: dT_c ! The core term in the expressions for the temperature changes [C H2 ~> degC m2 or degC kg2 m-4].
- real :: dS_c ! The core term in the expressions for the salinity changes [S H2 ~> psu m2 or psu kg2 m-4].
+ real :: dS_c ! The core term in the expressions for the salinity changes [S H2 ~> ppt m2 or ppt kg2 m-4].
real :: PEc_core ! The diffusivity-independent core term in the expressions
- ! for the potential energy changes [R L2 T-2 ~> J m-3].
+ ! for the potential energy changes [H3 R Z L2 T-2 ~> J m or J kg3 m-8].
real :: ColHt_core ! The diffusivity-independent core term in the expressions
- ! for the column height changes [R L2 T-2 ~> J m-3].
+ ! for the column height changes [H3 Z ~> m4 or kg3 m-5].
real :: ColHt_chg ! The change in the column height [Z ~> m].
real :: y1_3 ! A local temporary term in [H-3 ~> m-3 or m6 kg-3].
real :: y1_4 ! A local temporary term in [H-4 ~> m-4 or m8 kg-4].
@@ -1078,7 +968,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
! The expression for the change in potential energy used here is derived
! from the expression for the final estimates of the changes in temperature
! and salinities, and then extensively manipulated to get it into its most
- ! succint form. The derivation is not necessarily obvious, but it demonstrably
+ ! succinct form. The derivation is not necessarily obvious, but it demonstrably
! works by comparison with separate calculations of the energy changes after
! the tridiagonal solver for the final changes in temperature and salinity are
! applied.
@@ -1092,18 +982,14 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
ColHt_core = hp_b * (dT_to_dColHt_a * dT_c + dS_to_dColHt_a * dS_c) - &
hp_a * (dT_to_dColHt_b * dT_c + dS_to_dColHt_b * dS_c)
- if (present(PE_chg)) then
- ! Find the change in column potential energy due to the change in the
- ! diffusivity at this interface by dKddt_h.
- y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps))
- PE_chg = PEc_core * y1_3
- ColHt_chg = ColHt_core * y1_3
- if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg
- if (present(ColHt_cor)) ColHt_cor = -pres_Z * min(ColHt_chg, 0.0)
- elseif (present(ColHt_cor)) then
- y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps))
- ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0)
- endif
+ ! Find the change in column potential energy due to the change in the
+ ! diffusivity at this interface by dKddt_h.
+ y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps))
+ PE_chg = PEc_core * y1_3
+ ColHt_chg = ColHt_core * y1_3
+ if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg
+
+ if (present(PE_ColHt_cor)) PE_ColHt_cor = -pres_Z * min(ColHt_chg, 0.0)
if (present(dPEc_dKd)) then
! Find the derivative of the potential energy change with dKddt_h.
@@ -1132,164 +1018,6 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
end subroutine find_PE_chg
-!> This subroutine calculates the change in potential energy and or derivatives
-!! for several changes in an interfaces's diapycnal diffusivity times a timestep
-!! using the original form used in the first version of ePBL.
-subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, &
- dT_km1_t2, dS_km1_t2, dT_to_dPE_k, dS_to_dPE_k, &
- dT_to_dPEa, dS_to_dPEa, pres_Z, dT_to_dColHt_k, &
- dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, &
- PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0)
- real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and
- !! divided by the average of the thicknesses around the
- !! interface [H ~> m or kg m-2].
- real, intent(in) :: h_k !< The thickness of the layer below the interface [H ~> m or kg m-2].
- real, intent(in) :: b_den_1 !< The first term in the denominator of the pivot
- !! for the tridiagonal solver, given by h_k plus a term that
- !! is a fraction (determined from the tridiagonal solver) of
- !! Kddt_h for the interface above [H ~> m or kg m-2].
- real, intent(in) :: dTe_term !< A diffusivity-independent term related to the temperature change
- !! in the layer below the interface [C H ~> degC m or degC kg m-2].
- real, intent(in) :: dSe_term !< A diffusivity-independent term related to the salinity change
- !! in the layer below the interface [S H ~> ppt m or ppt kg m-2].
- real, intent(in) :: dT_km1_t2 !< A diffusivity-independent term related to the
- !! temperature change in the layer above the interface [C ~> degC].
- real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the
- !! salinity change in the layer above the interface [S ~> ppt].
- real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate
- !! the changes in column thickness to the energy that is radiated
- !! as gravity waves and unavailable to drive mixing [R L2 T-2 ~> J m-3].
- real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
- !! a layer's temperature change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the temperatures of all the layers below [R Z L2 T-2 C-1 ~> J m-2 degC-1].
- real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
- !! a layer's salinity change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the salinities of all the layers below [R Z L2 T-2 S-1 ~> J m-2 ppt-1].
- real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
- !! a layer's temperature change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the temperatures of all the layers above [R Z L2 T-2 C-1 ~> J m-2 degC-1].
- real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
- !! a layer's salinity change to the change in column
- !! potential energy, including all implicit diffusive changes
- !! in the salinities of all the layers above [R Z L2 T-2 S-1 ~> J m-2 ppt-1].
- real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating
- !! a layer's temperature change to the change in column
- !! height, including all implicit diffusive changes
- !! in the temperatures of all the layers below [Z C-1 ~> m degC-1].
- real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating
- !! a layer's salinity change to the change in column
- !! height, including all implicit diffusive changes
- !! in the salinities of all the layers below [Z S-1 ~> m ppt-1].
- real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating
- !! a layer's temperature change to the change in column
- !! height, including all implicit diffusive changes
- !! in the temperatures of all the layers above [Z C-1 ~> m degC-1].
- real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating
- !! a layer's salinity change to the change in column
- !! height, including all implicit diffusive changes
- !! in the salinities of all the layers above [Z S-1 ~> m ppt-1].
-
- real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying
- !! Kddt_h at the present interface [R Z L2 T-2 ~> J m-2].
- real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h,
- !! [R Z L2 T-2 H-1 ~> J m-3 or J kg-1].
- real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could
- !! be realized by applying a huge value of Kddt_h at the
- !! present interface [R Z L2 T-2 ~> J m-2].
- real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the
- !! limit where Kddt_h = 0 [R Z L2 T-2 H-1 ~> J m-3 or J kg-1].
-
-! This subroutine determines the total potential energy change due to mixing
-! at an interface, including all of the implicit effects of the prescribed
-! mixing at interfaces above. Everything here is derived by careful manipulation
-! of the robust tridiagonal solvers used for tracers by MOM6. The results are
-! positive for mixing in a stably stratified environment.
-! The comments describing these arguments are for a downward mixing pass, but
-! this routine can also be used for an upward pass with the sense of direction
-! reversed.
-
- real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
- real :: b1Kd ! Temporary array [nondim]
- real :: ColHt_chg ! The change in column thickness [Z ~> m].
- real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m].
- real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1]
- real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [C ~> degC]
- real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [S ~> ppt]
- real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2]
- real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2]
- real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes
- ! per unit change in Kddt_h [C H-1 ~> degC m-1 or degC m2 kg-1]
- real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes
- ! per unit change in Kddt_h [S H-1 ~> ppt m-1 or ppt m2 kg-1]
-
- b1 = 1.0 / (b_den_1 + Kddt_h)
- b1Kd = Kddt_h*b1
-
- ! Start with the temperature change in layer k-1 due to the diffusivity at
- ! interface K without considering the effects of changes in layer k.
-
- ! Calculate the change in PE due to the diffusion at interface K
- ! if Kddt_h(K+1) = 0.
- I_Kr_denom = 1.0 / (h_k*b_den_1 + (b_den_1 + h_k)*Kddt_h)
-
- dT_k = (Kddt_h*I_Kr_denom) * dTe_term
- dS_k = (Kddt_h*I_Kr_denom) * dSe_term
-
- if (present(PE_chg)) then
- ! Find the change in energy due to diffusion with strength Kddt_h at this interface.
- ! Increment the temperature changes in layer k-1 due the changes in layer k.
- dT_km1 = b1Kd * ( dT_k + dT_km1_t2 )
- dS_km1 = b1Kd * ( dS_k + dS_km1_t2 )
-
- PE_chg = (dT_to_dPE_k * dT_k + dT_to_dPEa * dT_km1) + &
- (dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1)
- ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + &
- (dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1)
- if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg
- endif
-
- if (present(dPEc_dKd)) then
- ! Find the derivatives of the temperature and salinity changes with Kddt_h.
- dKr_dKd = (h_k*b_den_1) * I_Kr_denom**2
-
- ddT_k_dKd = dKr_dKd * dTe_term
- ddS_k_dKd = dKr_dKd * dSe_term
- ddT_km1_dKd = (b1**2 * b_den_1) * ( dT_k + dT_km1_t2 ) + b1Kd * ddT_k_dKd
- ddS_km1_dKd = (b1**2 * b_den_1) * ( dS_k + dS_km1_t2 ) + b1Kd * ddS_k_dKd
-
- ! Calculate the partial derivative of Pe_chg with Kddt_h.
- dPEc_dKd = (dT_to_dPE_k * ddT_k_dKd + dT_to_dPEa * ddT_km1_dKd) + &
- (dS_to_dPE_k * ddS_k_dKd + dS_to_dPEa * ddS_km1_dKd)
- dColHt_dKd = (dT_to_dColHt_k * ddT_k_dKd + dT_to_dColHta * ddT_km1_dKd) + &
- (dS_to_dColHt_k * ddS_k_dKd + dS_to_dColHta * ddS_km1_dKd)
- if (dColHt_dKd < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * dColHt_dKd
- endif
-
- if (present(dPE_max)) then
- ! This expression is the limit of PE_chg for infinite Kddt_h.
- dPE_max = (dT_to_dPEa * dT_km1_t2 + dS_to_dPEa * dS_km1_t2) + &
- ((dT_to_dPE_k + dT_to_dPEa) * dTe_term + &
- (dS_to_dPE_k + dS_to_dPEa) * dSe_term) / (b_den_1 + h_k)
- dColHt_max = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) + &
- ((dT_to_dColHt_k + dT_to_dColHta) * dTe_term + &
- (dS_to_dColHt_k + dS_to_dColHta) * dSe_term) / (b_den_1 + h_k)
- if (dColHt_max < 0.0) dPE_max = dPE_max - pres_Z*dColHt_max
- endif
-
- if (present(dPEc_dKd_0)) then
- ! This expression is the limit of dPEc_dKd for Kddt_h = 0.
- dPEc_dKd_0 = (dT_to_dPEa * dT_km1_t2 + dS_to_dPEa * dS_km1_t2) / (b_den_1) + &
- (dT_to_dPE_k * dTe_term + dS_to_dPE_k * dSe_term) / (h_k*b_den_1)
- dColHt_dKd = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) / (b_den_1) + &
- (dT_to_dColHt_k * dTe_term + dS_to_dColHt_k * dSe_term) / (h_k*b_den_1)
- if (dColHt_dKd < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z*dColHt_dKd
- endif
-
-end subroutine find_PE_chg_orig
-
!> Initialize parameters and allocate memory associated with the diapycnal energy requirement module.
subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS)
type(time_type), intent(in) :: Time !< model time
diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90
index 641816513c..1a59b177bd 100644
--- a/src/parameterizations/vertical/MOM_energetic_PBL.F90
+++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90
@@ -3,19 +3,20 @@ module MOM_energetic_PBL
! This file is part of MOM6. See LICENSE.md for the license.
-use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
-use MOM_coms, only : EFP_type, real_to_EFP, EFP_to_real, operator(+), assignment(=), EFP_sum_across_PEs
-use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
-use MOM_diag_mediator, only : time_type, diag_ctrl
-use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
-use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg
-use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
-use MOM_forcing_type, only : forcing
-use MOM_grid, only : ocean_grid_type
+use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
+use MOM_coms, only : EFP_type, real_to_EFP, EFP_to_real, operator(+), assignment(=), EFP_sum_across_PEs
+use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
+use MOM_diag_mediator, only : time_type, diag_ctrl
+use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
+use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg
+use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
+use MOM_forcing_type, only : forcing
+use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_string_functions, only : uppercase
-use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : thermo_var_ptrs
-use MOM_verticalGrid, only : verticalGrid_type
+use MOM_unit_scaling, only : unit_scale_type
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
use MOM_wave_interface, only : wave_parameters_CS, Get_Langmuir_Number
use MOM_stochastics, only : stochastic_CS
@@ -75,7 +76,7 @@ module MOM_energetic_PBL
!! boundary layer thickness [nondim]. The default is 0, but a
!! value of 0.1 might be better justified by observations.
real :: MLD_tol !< A tolerance for determining the boundary layer thickness when
- !! Use_MLD_iteration is true [H ~> m or kg m-2].
+ !! Use_MLD_iteration is true [Z ~> m].
real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL [Z ~> m].
!! The default (0) does not set a minimum.
@@ -107,7 +108,7 @@ module MOM_energetic_PBL
!/ mstar_scheme == 0
real :: fixed_mstar !< Mstar is the ratio of the friction velocity cubed to the TKE available to
- !! drive entrainment, nondimensional. This quantity is the vertically
+ !! drive entrainment [nondim]. This quantity is the vertically
!! integrated shear production minus the vertically integrated
!! dissipation of TKE produced by shear. This value is used if the option
!! for using a fixed mstar is used.
@@ -169,7 +170,7 @@ module MOM_energetic_PBL
!! timing of diagnostic output.
real, allocatable, dimension(:,:) :: &
- ML_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m].
+ ML_depth !< The mixed layer depth determined by active mixing in ePBL [H ~> m or kg m-2]
! These are terms in the mixed layer TKE budget, all in [R Z3 T-3 ~> W m-2 = kg s-3].
real, allocatable, dimension(:,:) :: &
diag_TKE_wind, & !< The wind source of TKE [R Z3 T-3 ~> W m-2].
@@ -277,7 +278,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
real, intent(in) :: dt !< Time increment [T ~> s].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control structure
real, dimension(SZI_(G),SZJ_(G)), &
intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3].
@@ -309,6 +310,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
! Local variables
real, dimension(SZI_(G),SZK_(GV)) :: &
h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2].
+ dz_2d, & ! A 2-d slice of the vertical distance across layers [Z ~> m].
T_2d, & ! A 2-d slice of the layer temperatures [C ~> degC].
S_2d, & ! A 2-d slice of the layer salinities [S ~> ppt].
TKE_forced_2d, & ! A 2-d slice of TKE_forced [R Z3 T-2 ~> J m-2].
@@ -317,9 +319,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1].
v_2d ! A 2-d slice of the meridional velocity [L T-1 ~> m s-1].
real, dimension(SZI_(G),SZK_(GV)+1) :: &
- Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
+ Kd_2d ! A 2-d version of the diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZK_(GV)) :: &
h, & ! The layer thickness [H ~> m or kg m-2].
+ dz, & ! The vertical distance across layers [Z ~> m].
T0, & ! The initial layer temperatures [C ~> degC].
S0, & ! The initial layer salinities [S ~> ppt].
dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1].
@@ -328,17 +331,25 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
u, & ! The zonal velocity [L T-1 ~> m s-1].
v ! The meridional velocity [L T-1 ~> m s-1].
real, dimension(SZK_(GV)+1) :: &
- Kd, & ! The diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
+ Kd, & ! The diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
mixvel, & ! A turbulent mixing velocity [Z T-1 ~> m s-1].
- mixlen ! A turbulent mixing length [Z ~> m].
+ mixlen, & ! A turbulent mixing length [Z ~> m].
+ SpV_dt ! Specific volume interpolated to interfaces divided by dt or 1.0 / (dt * Rho0)
+ ! times conversion factors in [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1],
+ ! used to convert local TKE into a turbulence velocity cubed.
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
real :: absf ! The absolute value of f [T-1 ~> s-1].
real :: U_star ! The surface friction velocity [Z T-1 ~> m s-1].
real :: U_Star_Mean ! The surface friction without gustiness [Z T-1 ~> m s-1].
+ real :: mech_TKE ! The mechanically generated turbulent kinetic energy available for mixing over a
+ ! timestep before the application of the efficiency in mstar [R Z3 T-2 ~> J m-2]
+ real :: I_rho ! The inverse of the Boussinesq reference density times a ratio of scaling
+ ! factors [Z L-1 R-1 ~> m3 kg-1]
+ real :: I_dt ! The Adcroft reciprocal of the timestep [T-1 ~> s-1]
real :: B_Flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
- real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m].
+ real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]
type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics.
@@ -351,18 +362,22 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, &
"energetic_PBL: Temperature, salinity and an equation of state "//&
"must now be used.")
- if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, &
- "energetic_PBL: No surface TKE fluxes (ustar) defined in fluxes type!")
+ if (.not.(associated(fluxes%ustar) .or. associated(fluxes%tau_mag))) call MOM_error(FATAL, &
+ "energetic_PBL: No surface friction velocity (ustar or tau_mag) defined in fluxes type.")
+ if ((.not.GV%Boussinesq) .and. (.not.associated(fluxes%tau_mag))) call MOM_error(FATAL, &
+ "energetic_PBL: No surface wind stress magnitude defined in fluxes type in non-Boussinesq mode.")
if (CS%use_LT .and. .not.associated(Waves)) call MOM_error(FATAL, &
"energetic_PBL: The Waves control structure must be associated if CS%use_LT "//&
"(i.e., USE_LA_LI2016 or EPBL_LT) is True.")
h_neglect = GV%H_subroundoff
+ I_rho = US%L_to_Z * GV%H_to_Z * GV%RZ_to_H ! == US%L_to_Z / GV%Rho0 ! This is not used when fully non-Boussinesq.
+ I_dt = 0.0 ; if (dt > 0.0) I_dt = 1.0 / dt
! Zero out diagnostics before accumulation.
if (CS%TKE_diagnostics) then
-!!OMP parallel do default(none) shared(is,ie,js,je,CS)
+ !!OMP parallel do default(none) shared(is,ie,js,je,CS)
do j=js,je ; do i=is,ie
CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0
CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0
@@ -373,8 +388,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0
! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0
-!!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, &
-!!OMP CS,G,GV,US,fluxes,TKE_forced,dSV_dT,dSV_dS,Kd_int)
+ !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt,I_dt, &
+ !!OMP CS,G,GV,US,fluxes,TKE_forced,dSV_dT,dSV_dS,Kd_int)
do j=js,je
! Copy the thicknesses and other fields to 2-d arrays.
do k=1,nz ; do i=is,ie
@@ -383,6 +398,15 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
TKE_forced_2d(i,k) = TKE_forced(i,j,k)
dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k)
enddo ; enddo
+ call thickness_to_dz(h_3d, tv, dz_2d, j, G, GV)
+
+ ! Set the inverse density used to translating local TKE into a turbulence velocity
+ SpV_dt(:) = 0.0
+ if ((dt > 0.0) .and. GV%Boussinesq .or. .not.allocated(tv%SpV_avg)) then
+ do K=1,nz+1
+ SpV_dt(K) = (US%Z_to_m**3*US%s_to_T**3) / (dt*GV%Rho0)
+ enddo
+ endif
! Determine the initial mech_TKE and conv_PErel, including the energy required
! to mix surface heating through the topmost cell, the energy released by mixing
@@ -394,15 +418,37 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
! Copy the thicknesses and other fields to 1-d arrays.
do k=1,nz
- h(k) = h_2d(i,k) + GV%H_subroundoff ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k)
+ h(k) = h_2d(i,k) + GV%H_subroundoff ; dz(k) = dz_2d(i,k) + GV%dZ_subroundoff
+ u(k) = u_2d(i,k) ; v(k) = v_2d(i,k)
T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) ; TKE_forcing(k) = TKE_forced_2d(i,k)
dSV_dT_1d(k) = dSV_dT_2d(i,k) ; dSV_dS_1d(k) = dSV_dS_2d(i,k)
enddo
do K=1,nz+1 ; Kd(K) = 0.0 ; enddo
! Make local copies of surface forcing and process them.
- u_star = fluxes%ustar(i,j)
- u_star_Mean = fluxes%ustar_gustless(i,j)
+ if (associated(fluxes%ustar) .and. (GV%Boussinesq .or. .not.associated(fluxes%tau_mag))) then
+ u_star = fluxes%ustar(i,j)
+ u_star_Mean = fluxes%ustar_gustless(i,j)
+ mech_TKE = dt * GV%Rho0 * u_star**3
+ elseif (allocated(tv%SpV_avg)) then
+ u_star = sqrt(US%L_to_Z*fluxes%tau_mag(i,j) * tv%SpV_avg(i,j,1))
+ u_star_Mean = sqrt(US%L_to_Z*fluxes%tau_mag_gustless(i,j) * tv%SpV_avg(i,j,1))
+ mech_TKE = dt * u_star * US%L_to_Z*fluxes%tau_mag(i,j)
+ else
+ u_star = sqrt(fluxes%tau_mag(i,j) * I_rho)
+ u_star_Mean = sqrt(US%L_to_Z*fluxes%tau_mag_gustless(i,j) * I_rho)
+ mech_TKE = dt * GV%Rho0 * u_star**3
+ ! The line above is equivalent to: mech_TKE = dt * u_star * US%L_to_Z*fluxes%tau_mag(i,j)
+ endif
+
+ if (allocated(tv%SpV_avg) .and. .not.GV%Boussinesq) then
+ SpV_dt(1) = (US%Z_to_m**3*US%s_to_T**3) * tv%SpV_avg(i,j,1) * I_dt
+ do K=2,nz
+ SpV_dt(K) = (US%Z_to_m**3*US%s_to_T**3) * 0.5*(tv%SpV_avg(i,j,k-1) + tv%SpV_avg(i,j,k)) * I_dt
+ enddo
+ SpV_dt(nz+1) = (US%Z_to_m**3*US%s_to_T**3) * tv%SpV_avg(i,j,nz) * I_dt
+ endif
+
B_flux = buoy_flux(i,j)
if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
if (fluxes%frac_shelf_h(i,j) > 0.0) &
@@ -421,16 +467,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS
! Perhaps provide a first guess for MLD based on a stored previous value.
MLD_io = -1.0
- if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j)
+ if (CS%MLD_iteration_guess .and. (CS%ML_depth(i,j) > 0.0)) MLD_io = CS%ML_depth(i,j)
if (stoch_CS%pert_epbl) then ! stochastics are active
- call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, &
- u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, &
+ call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt, TKE_forcing, B_flux, absf, &
+ u_star, u_star_mean, mech_TKE, dt, MLD_io, Kd, mixvel, mixlen, GV, &
US, CS, eCD, Waves, G, i, j, &
TKE_gen_stoch=stoch_CS%epbl1_wts(i,j), TKE_diss_stoch=stoch_CS%epbl2_wts(i,j))
else
- call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, &
- u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, &
+ call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt, TKE_forcing, B_flux, absf, &
+ u_star, u_star_mean, mech_TKE, dt, MLD_io, Kd, mixvel, mixlen, GV, &
US, CS, eCD, Waves, G, i, j)
endif
@@ -499,12 +545,13 @@ end subroutine energetic_PBL
!> This subroutine determines the diffusivities from the integrated energetics
!! mixed layer model for a single column of water.
-subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, &
- u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, &
+subroutine ePBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, TKE_forcing, B_flux, absf, &
+ u_star, u_star_mean, mech_TKE_in, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, &
Waves, G, i, j, TKE_gen_stoch, TKE_diss_stoch)
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
+ real, dimension(SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m].
real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points
!! [L T-1 ~> m s-1].
real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points
@@ -517,6 +564,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
!! [R-1 C-1 ~> m3 kg-1 degC-1].
real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific
!! volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
+ real, dimension(SZK_(GV)+1), intent(in) :: SpV_dt !< Specific volume interpolated to interfaces
+ !! divided by dt or 1.0 / (dt * Rho0) times conversion
+ !! factors in [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1],
+ !! used to convert local TKE into a turbulence velocity.
real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the
!! forcing that has been applied to each layer
!! [R Z3 T-2 ~> J m-2].
@@ -525,12 +576,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1].
real, intent(in) :: u_star_mean !< The surface friction velocity without any
!! contribution from unresolved gustiness [Z T-1 ~> m s-1].
+ real, intent(in) :: mech_TKE_in !< The mechanically generated turbulent
+ !! kinetic energy available for mixing over a time
+ !! step before the application of the efficiency
+ !! in mstar. [R Z3 T-2 ~> J m-2].
real, intent(inout) :: MLD_io !< A first guess at the mixed layer depth on input, and
- !! the calculated mixed layer depth on output [Z ~> m].
+ !! the calculated mixed layer depth on output [Z ~> m]
real, intent(in) :: dt !< Time increment [T ~> s].
real, dimension(SZK_(GV)+1), &
intent(out) :: Kd !< The diagnosed diffusivities at interfaces
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZK_(GV)+1), &
intent(out) :: mixvel !< The mixing velocity scale used in Kd
!! [Z T-1 ~> m s-1].
@@ -569,11 +624,12 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
real :: conv_PErel ! The potential energy that has been convectively released
! during this timestep [R Z3 T-2 ~> J m-2]. A portion nstar_FC
! of conv_PErel is available to drive mixing.
- real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2].
+ real :: htot ! The total thickness of the layers above an interface [H ~> m or kg m-2].
+ real :: dztot ! The total depth of the layers above an interface [Z ~> m].
real :: uhtot ! The depth integrated zonal velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]
real :: vhtot ! The depth integrated meridional velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]
real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1].
- real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2].
+ real :: dz_sum ! The total thickness of the water column [Z ~> m].
real, dimension(SZK_(GV)) :: &
dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes
@@ -613,6 +669,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
MixLen_shape, & ! A nondimensional shape factor for the mixing length that
! gives it an appropriate asymptotic value at the bottom of
! the boundary layer [nondim].
+ h_dz_int, & ! The ratio of the layer thicknesses over the vertical distances
+ ! across the layers surrounding an interface [H Z-1 ~> nondim or kg m-3]
Kddt_h ! The diapycnal diffusivity times a timestep divided by the
! average thicknesses around a layer [H ~> m or kg m-2].
real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
@@ -621,6 +679,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
! in the denominator of b1 in a downward-oriented tridiagonal solver.
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m].
real :: dMass ! The mass per unit area within a layer [Z R ~> kg m-2].
real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa = J m-3].
real :: dMKE_max ! The maximum amount of mean kinetic energy that could be
@@ -631,28 +691,25 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
! of a layer and the thickness of the water above, used in
! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1].
- real :: dt_h ! The timestep divided by the averages of the thicknesses around
- ! a layer, times a thickness conversion factor [H T Z-2 ~> s m-1 or kg s m-4].
- real :: h_bot ! The distance from the bottom [H ~> m or kg m-2].
- real :: h_rsum ! The running sum of h from the top [H ~> m or kg m-2].
- real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1].
- real :: I_MLD ! The inverse of the current value of MLD [H-1 ~> m-1 or m2 kg-1].
- real :: h_tt ! The distance from the surface or up to the next interface
+ real :: dt_h ! The timestep divided by the averages of the vertical distances around
+ ! a layer [T Z-1 ~> s m-1].
+ real :: dz_bot ! The distance from the bottom [Z ~> m].
+ real :: dz_rsum ! The running sum of dz from the top [Z ~> m].
+ real :: I_dzsum ! The inverse of dz_sum [Z-1 ~> m-1].
+ real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1].
+ real :: dz_tt ! The distance from the surface or up to the next interface
! that did not exhibit turbulent mixing from this scheme plus
- ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2].
- real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2].
+ ! a surface mixing roughness length given by dz_tt_min [Z ~> m].
+ real :: dz_tt_min ! A surface roughness length [Z ~> m].
real :: C1_3 ! = 1/3 [nondim]
- real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1].
- ! This is used convert TKE back into ustar^3 for use in a cube root.
real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1].
real :: mstar_total ! The value of mstar used in ePBL [nondim]
real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic)
- real :: MLD_output ! The mixed layer depth output from this routine [H ~> m or kg m-2].
+ real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]
real :: LA ! The value of the Langmuir number [nondim]
real :: LAmod ! The modified Langmuir number by convection [nondim]
- real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a
- ! conversion factor from H to Z [Z H-1 ~> nondim or m3 kg-1].
+ real :: hbs_here ! The local minimum of hb_hs and MixLen_shape [nondim]
real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim].
real :: TKE_reduc ! The fraction by which TKE and other energy fields are
! reduced to support mixing [nondim]. between 0 and 1.
@@ -671,7 +728,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
real :: dPE_conv ! The convective change in column potential energy [R Z3 T-2 ~> J m-2].
real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [R Z3 T-2 ~> J m-2].
real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
- real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
+ real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [R Z3 T-2 ~> J m-2]
real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided
! by the average thicknesses around a layer [H ~> m or kg m-2].
@@ -700,15 +757,14 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
logical :: sfc_disconnect ! If true, any turbulence has become disconnected
! from the surface.
-! The following are only used for diagnostics.
+ ! The following is only used for diagnostics.
real :: I_dtdiag ! = 1.0 / dt [T-1 ~> s-1].
!----------------------------------------------------------------------
!/BGR added Aug24,2016 for adding iteration to get boundary layer depth
! - needed to compute new mixing length.
- real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [H ~> m or kg m-2].
- real :: MLD_guess_Z ! A guessed mixed layer depth, converted to height units [Z ~> m]
- real :: min_MLD, max_MLD ! Iteration bounds on MLD [H ~> m or kg m-2], which are adjusted at each step
+ real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m]
+ real :: min_MLD, max_MLD ! Iteration bounds on MLD [Z ~> m], which are adjusted at each step
! - These are initialized based on surface/bottom
! 1. The iteration guesses a value (possibly from prev step or neighbor).
! 2. The iteration checks if value is converged, too shallow, or too deep.
@@ -721,8 +777,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
! manner giving a usable guess. When it does fail, it is due to convection
! within the boundary layer. Likely, a new method e.g. surface_disconnect,
! can improve this.
- real :: dMLD_min ! The change in diagnosed mixed layer depth when the guess is min_MLD [H ~> m or kg m-2]
- real :: dMLD_max ! The change in diagnosed mixed layer depth when the guess is max_MLD [H ~> m or kg m-2]
+ real :: dMLD_min ! The change in diagnosed mixed layer depth when the guess is min_MLD [Z ~> m]
+ real :: dMLD_max ! The change in diagnosed mixed layer depth when the guess is max_MLD [Z ~> m]
logical :: OBL_converged ! Flag for convergence of MLD
integer :: OBL_it ! Iteration counter
@@ -756,16 +812,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
calc_Te = (debug .or. (.not.CS%orig_PE_calc))
h_neglect = GV%H_subroundoff
+ dz_neglect = GV%dZ_subroundoff
C1_3 = 1.0 / 3.0
I_dtdiag = 1.0 / dt
max_itt = 20
- h_tt_min = 0.0
- I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = (US%Z_to_m**3*US%s_to_T**3) / (dt*GV%Rho0)
+ dz_tt_min = 0.0
vstar_unit_scale = US%m_to_Z * US%T_to_s
- MLD_guess = MLD_io*GV%Z_to_H
+ MLD_guess = MLD_io
! Determine the initial mech_TKE and conv_PErel, including the energy required
! to mix surface heating through the topmost cell, the energy released by mixing
@@ -788,29 +844,39 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
pres_Z(K+1) = pres_Z(K) + dPres
enddo
- ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs).
- h_sum = H_neglect ; do k=1,nz ; h_sum = h_sum + h(k) ; enddo
- I_hs = 0.0 ; if (h_sum > 0.0) I_hs = 1.0 / h_sum
- h_bot = 0.0
+ ! Determine the total thickness (dz_sum) and the fractional distance from the bottom (hb_hs).
+ dz_sum = dz_neglect ; do k=1,nz ; dz_sum = dz_sum + dz(k) ; enddo
+ I_dzsum = 0.0 ; if (dz_sum > 0.0) I_dzsum = 1.0 / dz_sum
+ dz_bot = 0.0
hb_hs(nz+1) = 0.0
do k=nz,1,-1
- h_bot = h_bot + h(k)
- hb_hs(K) = h_bot * I_hs
+ dz_bot = dz_bot + dz(k)
+ hb_hs(K) = dz_bot * I_dzsum
enddo
- MLD_output = h(1)
+ MLD_output = dz(1)
!/The following lines are for the iteration over MLD
! max_MLD will initialized as ocean bottom depth
- max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(k) ; enddo
+ max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + dz(k) ; enddo
! min_MLD will be initialized to 0.
min_MLD = 0.0
! Set values of the wrong signs to indicate that these changes are not based on valid estimates
- dMLD_min = -1.0*GV%m_to_H ; dMLD_max = 1.0*GV%m_to_H
+ dMLD_min = -1.0*US%m_to_Z ; dMLD_max = 1.0*US%m_to_Z
! If no first guess is provided for MLD, try the middle of the water column
if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD)
+ if (GV%Boussinesq) then
+ do K=1,nz+1 ; h_dz_int(K) = GV%Z_to_H ; enddo
+ else
+ h_dz_int(1) = (h(1) + h_neglect) / (dz(1) + dz_neglect)
+ do K=2,nz
+ h_dz_int(K) = (h(k-1) + h(k) + h_neglect) / (dz(k-1) + dz(k) + dz_neglect)
+ enddo
+ h_dz_int(nz+1) = (h(nz) + h_neglect) / (dz(nz) + dz_neglect)
+ endif
+
! Iterate to determine a converged EPBL depth.
OBL_converged = .false.
do OBL_it=1,CS%Max_MLD_Its
@@ -822,26 +888,26 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif
! Reset ML_depth
- MLD_output = h(1)
+ MLD_output = dz(1)
sfc_connected = .true.
!/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3
- MLD_guess_z = GV%H_to_Z*MLD_guess ! Convert MLD from thickness to height coordinates for these calls
if (CS%Use_LT) then
- call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess_z), u_star_mean, i, j, h, Waves, &
+ call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, dz, Waves, &
U_H=u, V_H=v)
- call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_guess_z, absf, &
+ call find_mstar(CS, US, B_flux, u_star, MLD_guess, absf, &
MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,&
mstar_LT=mstar_LT)
else
- call find_mstar(CS, US, B_flux, u_star, u_star_mean, MLD_guess_z, absf, mstar_total)
+ call find_mstar(CS, US, B_flux, u_star, MLD_guess, absf, mstar_total)
endif
!/ Apply MStar to get mech_TKE
if ((CS%answer_date < 20190101) .and. (CS%mstar_scheme==Use_Fixed_MStar)) then
mech_TKE = (dt*MSTAR_total*GV%Rho0) * u_star**3
else
- mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3)
+ mech_TKE = MSTAR_total * mech_TKE_in
+ ! mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3)
endif
! stochastically perturb mech_TKE in the UFS
if (present(TKE_gen_stoch)) mech_TKE = mech_TKE*TKE_gen_stoch
@@ -888,16 +954,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
! Reduce the mixing length based on MLD, with a quadratic
! expression that follows KPP.
I_MLD = 1.0 / MLD_guess
- h_rsum = 0.0
+ dz_rsum = 0.0
MixLen_shape(1) = 1.0
do K=2,nz+1
- h_rsum = h_rsum + h(k-1)
+ dz_rsum = dz_rsum + dz(k-1)
if (CS%MixLenExponent==2.0) then
MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
- (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent
+ (max(0.0, (MLD_guess - dz_rsum)*I_MLD) )**2 ! CS%MixLenExponent
else
MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
- (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent
+ (max(0.0, (MLD_guess - dz_rsum)*I_MLD) )**CS%MixLenExponent
endif
enddo
endif
@@ -907,7 +973,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
dT_to_dPE_a(1) = dT_to_dPE(1) ; dT_to_dColHt_a(1) = dT_to_dColHt(1)
dS_to_dPE_a(1) = dS_to_dPE(1) ; dS_to_dColHt_a(1) = dS_to_dColHt(1)
- htot = h(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1)
+ htot = h(1) ; dztot = dz(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1)
if (debug) then
mech_TKE_k(1) = mech_TKE ; conv_PErel_k(1) = conv_PErel
@@ -922,7 +988,11 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
! different rates. The following form is often used for mechanical
! stirring from the surface, perhaps due to breaking surface gravity
! waves and wind-driven turbulence.
- Idecay_len_TKE = (CS%TKE_decay * absf / u_star) * GV%H_to_Z
+ if (GV%Boussinesq) then
+ Idecay_len_TKE = (CS%TKE_decay * absf / u_star) * GV%H_to_Z
+ else
+ Idecay_len_TKE = (CS%TKE_decay * absf) / (h_dz_int(K) * u_star)
+ endif
exp_kh = 1.0
if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE)
if (CS%TKE_diagnostics) &
@@ -950,9 +1020,14 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
if (CS%nstar * conv_PErel > 0.0) then
! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based
! on a curve fit from the data of Wang (GRL, 2003).
- ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot)**3 / conv_PErel)
- nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * &
- sqrt(0.5 * dt * GV%Rho0 * (absf*(htot*GV%H_to_Z))**3 * conv_PErel))
+ ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*dztot)**3 / conv_PErel)
+ if (GV%Boussinesq) then
+ nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * &
+ sqrt(0.5 * dt * GV%Rho0 * (absf*dztot)**3 * conv_PErel))
+ else
+ nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * &
+ sqrt(0.5 * dt * GV%H_to_RZ * (absf**3 * (dztot**2 * htot)) * conv_PErel))
+ endif
endif
if (debug) nstar_k(K) = nstar_FC
@@ -995,7 +1070,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2))
endif
endif
- dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum)
+ dt_h = dt / max(0.5*(dz(k-1)+dz(k)), 1e-15*dz_sum)
! This tests whether the layers above and below this interface are in
! a convectively stable configuration, without considering any effects of
@@ -1082,26 +1157,26 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
! At this point, Kddt_h(K) will be unknown because its value may depend
! on how much energy is available. mech_TKE might be negative due to
! contributions from TKE_forced.
- h_tt = htot + h_tt_min
+ dz_tt = dztot + dz_tt_min
TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel
if (TKE_here > 0.0) then
if (CS%wT_scheme==wT_from_cRoot_TKE) then
- vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3
+ vstar = CS%vstar_scale_fac * vstar_unit_scale * (SpV_dt(K)*TKE_here)**C1_3
elseif (CS%wT_scheme==wT_from_RH18) then
- Surface_Scale = max(0.05, 1.0 - htot / MLD_guess)
+ Surface_Scale = max(0.05, 1.0 - dztot / MLD_guess)
vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + &
- vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)
+ vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*SpV_dt(K))**C1_3)
endif
- hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K))
- mixlen(K) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / &
- ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar))
+ hbs_here = min(hb_hs(K), MixLen_shape(K))
+ mixlen(K) = MAX(CS%min_mix_len, ((dz_tt*hbs_here)*vstar) / &
+ ((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar))
!Note setting Kd_guess0 to vstar * CS%vonKar * mixlen(K) here will
! change the answers. Therefore, skipping that.
if (.not.CS%Use_MLD_iteration) then
- Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / &
- ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)
+ Kd_guess0 = (h_dz_int(K)*vstar) * CS%vonKar * ((dz_tt*hbs_here)*vstar) / &
+ ((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar)
else
- Kd_guess0 = vstar * CS%vonKar * mixlen(K)
+ Kd_guess0 = (h_dz_int(K)*vstar) * CS%vonKar * mixlen(K)
endif
else
vstar = 0.0 ; Kd_guess0 = 0.0
@@ -1135,22 +1210,22 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max)
if (TKE_here > 0.0) then
if (CS%wT_scheme==wT_from_cRoot_TKE) then
- vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3
+ vstar = CS%vstar_scale_fac * vstar_unit_scale * (SpV_dt(K)*TKE_here)**C1_3
elseif (CS%wT_scheme==wT_from_RH18) then
- Surface_Scale = max(0.05, 1. - htot / MLD_guess)
+ Surface_Scale = max(0.05, 1. - dztot / MLD_guess)
vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + &
- vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)
+ vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*SpV_dt(K))**C1_3)
endif
- hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K))
- mixlen(K) = max(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / &
- ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar))
+ hbs_here = min(hb_hs(K), MixLen_shape(K))
+ mixlen(K) = max(CS%min_mix_len, ((dz_tt*hbs_here)*vstar) / &
+ ((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar))
if (.not.CS%Use_MLD_iteration) then
! Note again (as prev) that using mixlen here
! instead of redoing the computation will change answers...
- Kd(K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / &
- ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)
+ Kd(K) = (h_dz_int(K)*vstar) * CS%vonKar * ((dz_tt*hbs_here)*vstar) / &
+ ((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar)
else
- Kd(K) = vstar * CS%vonKar * mixlen(K)
+ Kd(K) = (h_dz_int(K)*vstar) * CS%vonKar * mixlen(K)
endif
else
vstar = 0.0 ; Kd(K) = 0.0
@@ -1190,7 +1265,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag
endif
if (sfc_connected) then
- MLD_output = MLD_output + h(k)
+ MLD_output = MLD_output + dz(k)
endif
Kddt_h(K) = Kd(K) * dt_h
@@ -1214,7 +1289,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
mech_TKE = TKE_reduc*(mech_TKE + MKE_src)
conv_PErel = TKE_reduc*conv_PErel
if (sfc_connected) then
- MLD_output = MLD_output + h(k)
+ MLD_output = MLD_output + dz(k)
endif
elseif (tot_TKE == 0.0) then
@@ -1314,8 +1389,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag
endif
- if (sfc_connected) MLD_output = MLD_output + &
- (PE_chg / (PE_chg_g0)) * h(k)
+ if (sfc_connected) MLD_output = MLD_output + (PE_chg / (PE_chg_g0)) * dz(k)
tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0
sfc_disconnect = .true.
@@ -1345,11 +1419,13 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
uhtot = u(k)*h(k)
vhtot = v(k)*h(k)
htot = h(k)
+ dztot = dz(k)
sfc_connected = .false.
else
uhtot = uhtot + u(k)*h(k)
vhtot = vhtot + v(k)*h(k)
htot = htot + h(k)
+ dztot = dztot + dz(k)
endif
if (calc_Te) then
@@ -1410,7 +1486,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
! Taking the occasional step with MLD_output empirically helps to converge faster.
if ((dMLD_min > 0.0) .and. (dMLD_max < 0.0) .and. (OBL_it > 2) .and. (mod(OBL_it-1,4) > 0)) then
! Both bounds have valid change estimates and are probably in the range of possible outputs.
- MLD_Guess = (dMLD_min*max_MLD - dMLD_max*min_MLD) / (dMLD_min - dMLD_max)
+ MLD_guess = (dMLD_min*max_MLD - dMLD_max*min_MLD) / (dMLD_min - dMLD_max)
elseif ((MLD_found > min_MLD) .and. (MLD_found < max_MLD)) then
! The output MLD_found is an interesting guess, as it likely to bracket the true solution
! along with the previous value of MLD_guess and to be close to the solution.
@@ -1434,7 +1510,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs
eCD%LA = 0.0 ; eCD%LAmod = 0.0 ; eCD%mstar = mstar_total ; eCD%mstar_LT = 0.0
endif
- MLD_io = GV%H_to_Z*MLD_output
+ MLD_io = MLD_output
end subroutine ePBL_column
@@ -1740,13 +1816,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, &
end subroutine find_PE_chg_orig
!> This subroutine finds the Mstar value for ePBL
-subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,&
+subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, &
BLD, Abs_Coriolis, MStar, Langmuir_Number,&
MStar_LT, Convect_Langmuir_Number)
type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1]
- real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1]
+ real, intent(in) :: UStar !< ustar including gustiness [Z T-1 ~> m s-1]
real, intent(in) :: Abs_Coriolis !< absolute value of the Coriolis parameter [T-1 ~> s-1]
real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3]
real, intent(in) :: BLD !< boundary layer depth [Z ~> m]
@@ -1921,17 +1996,18 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units)
type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure
type(ocean_grid_type), intent(in) :: G !< Grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [Z ~> m] or other units
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [Z ~> m]
+ !! or other units
real, optional, intent(in) :: m_to_MLD_units !< A conversion factor from meters
- !! to the desired units for MLD, sometimes [m Z-1 ~> 1]
+ !! to the desired units for MLD, sometimes [Z m-1 ~> 1]
! Local variables
real :: scale ! A dimensional rescaling factor, often [nondim] or [m Z-1 ~> 1]
- integer :: i,j
+ integer :: i, j
scale = 1.0 ; if (present(m_to_MLD_units)) scale = US%Z_to_m * m_to_MLD_units
do j=G%jsc,G%jec ; do i=G%isc,G%iec
- MLD(i,j) = scale*CS%ML_Depth(i,j)
+ MLD(i,j) = scale*CS%ML_depth(i,j)
enddo ; enddo
end subroutine energetic_PBL_get_MLD
@@ -1956,10 +2032,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS)
integer :: isd, ied, jsd, jed
integer :: mstar_mode, LT_enhance, wT_mode
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
logical :: use_temperature, use_omega
logical :: use_la_windsea
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -2000,23 +2072,13 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "EPBL_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for horizontal viscosity.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "EPBL_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the energetic "//&
"PBL calculations. Values below 20190101 recover the answers from the "//&
"end of 2018, while higher values use updated and more robust forms of the "//&
- "same expressions. If both EPBL_2018_ANSWERS and EPBL_ANSWER_DATE are "//&
- "specified, the latter takes precedence.", default=default_answer_date)
-
+ "same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, &
"If true, the ePBL code uses the original form of the "//&
@@ -2159,7 +2221,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, &
"The tolerance for the iteratively determined mixed "//&
"layer depth. This is only used with USE_MLD_ITERATION.", &
- units="meter", default=1.0, scale=GV%m_to_H, do_not_log=.not.CS%Use_MLD_iteration)
+ units="meter", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%Use_MLD_iteration)
call get_param(param_file, mdl, "EPBL_MLD_BISECTION", CS%MLD_bisection, &
"If true, use bisection with the iterative determination of the self-consistent "//&
"mixed layer depth. Otherwise use the false position after a maximum and minimum "//&
@@ -2320,7 +2382,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS)
!/ Logging parameters
! This gives a minimum decay scale that is typically much less than Angstrom.
- CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff)
+ CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%dZ_subroundoff)
call log_param(param_file, mdl, "!EPBL_USTAR_MIN", CS%ustar_min, &
"The (tiny) minimum friction velocity used within the "//&
"ePBL code, derived from OMEGA and ANGSTROM.", &
diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90
index 51a28db0e9..de13322652 100644
--- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90
+++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90
@@ -5,14 +5,15 @@ module MOM_entrain_diffusive
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : diag_ctrl, time_type
+use MOM_EOS, only : calculate_density, calculate_density_derivs
+use MOM_EOS, only : calculate_specific_vol_derivs, EOS_domain
use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
-use MOM_file_parser, only : get_param, log_version, param_file_type
-use MOM_forcing_type, only : forcing
-use MOM_grid, only : ocean_grid_type
-use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : thermo_var_ptrs
-use MOM_verticalGrid, only : verticalGrid_type
-use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain
+use MOM_file_parser, only : get_param, log_version, param_file_type
+use MOM_forcing_type, only : forcing
+use MOM_grid, only : ocean_grid_type
+use MOM_unit_scaling, only : unit_scale_type
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
implicit none ; private
@@ -73,15 +74,14 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
intent(out) :: eb !< The amount of fluid entrained from the layer
!! below within this time step [H ~> m or kg m-2].
integer, dimension(SZI_(G),SZJ_(G)), &
- optional, intent(inout) :: kb_out !< The index of the lightest layer denser than
+ intent(inout) :: kb_out !< The index of the lightest layer denser than
!! the buffer layer.
- ! At least one of the two following arguments must be present.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers
- !! [Z2 T-1 ~> m2 s-1].
+ intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces
- !! [Z2 T-1 ~> m2 s-1].
+ intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
! This subroutine calculates ea and eb, the rates at which a layer entrains
! from the layers above and below. The entrainment rates are proportional to
@@ -112,7 +112,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
real, allocatable, dimension(:,:,:) :: &
Kd_eff, & ! The effective diffusivity that actually applies to each
! layer after the effects of boundary conditions are
- ! considered [Z2 T-1 ~> m2 s-1].
+ ! considered [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
diff_work ! The work actually done by diffusion across each
! interface [R Z3 T-3 ~> W m-2]. Sum vertically for the total work.
@@ -174,16 +174,20 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
grats ! 2*(2 + ds_k+1 / ds_k + ds_k / ds_k+1) =
! 4*ds_Lay*(1/ds_k + 1/ds_k+1). [nondim]
- real :: dRHo ! The change in locally referenced potential density between
- ! the layers above and below an interface [R ~> kg m-3].
+ real :: dRho ! The change in locally referenced potential density between
+ ! the layers above and below an interface [R ~> kg m-3]
+ real :: dSpV ! The change in locally referenced specific volume between
+ ! the layers above and below an interface [R-1 ~> m3 kg-1]
real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors
- ! [Z3 H-2 T-3 ~> m s-3 or m7 kg-2 s-3].
+ ! [Z3 H-2 T-3 or R2 Z3 H-2 T-3 ~> m s-3].
real, dimension(SZI_(G)) :: &
pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa].
T_eos, S_eos, & ! The potential temperature and salinity at which to
! evaluate dRho_dT and dRho_dS [C ~> degC] and [S ~> ppt].
- dRho_dT, dRho_dS ! The partial derivatives of potential density with temperature and
- ! salinity, [R C-1 ~> kg m-3 degC-1] and [R S-1 ~> kg m-3 ppt-1].
+ dRho_dT, & ! The partial derivative of potential density with temperature [R C-1 ~> kg m-3 degC-1]
+ dRho_dS, & ! The partial derivative of potential density with salinity [R S-1 ~> kg m-3 ppt-1]
+ dSpV_dT, & ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ dSpV_dS ! The partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]
real :: tolerance ! The tolerance within which E must be converged [H ~> m or kg m-2].
real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2].
@@ -199,7 +203,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2].
real :: h1 ! The layer thickness after entrainment through the
! interface below is taken into account [H ~> m or kg m-2].
- real :: Idt ! The inverse of the time step [T-1 ~> s-1].
+ real :: Idt ! The inverse of the time step [Z H-1 T-1 ~> s-1 or m3 kg-1 s-1].
logical :: do_any
logical :: do_entrain_eakb ! True if buffer layer is entrained
@@ -217,9 +221,6 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
if (.not. CS%initialized) call MOM_error(FATAL, &
"MOM_entrain_diffusive: Module must be initialized before it is used.")
- if (.not.(present(Kd_Lay) .or. present(Kd_int))) call MOM_error(FATAL, &
- "MOM_entrain_diffusive: Either Kd_Lay or Kd_int must be present in call.")
-
if ((.not.CS%bulkmixedlayer .and. .not.associated(fluxes%buoy)) .and. &
(associated(fluxes%lprec) .or. associated(fluxes%evap) .or. &
associated(fluxes%sens) .or. associated(fluxes%sw))) then
@@ -254,43 +255,34 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
endif
EOSdom(:) = EOS_domain(G%HI)
- !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,US,dt,CS,h,tv, &
- !$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, &
- !$OMP ea,eb,Kd_int,Kd_eff,EOSdom,diff_work,g_2dt, kb_out) &
- !$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min) &
- !$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, &
- !$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, &
- !$OMP zeros,maxF_kb,maxF,ea_kbp1,eakb,Sref, &
- !$OMP maxF_correct,do_any,do_entrain_eakb, &
- !$OMP err_min_eakb0,err_max_eakb0,eakb_maxF, &
- !$OMP min_eakb,err_eakb0,F,minF,hm,fk,F_kb_maxent,&
- !$OMP F_kb,is1,ie1,kb_min_act,dFdfm_kb,b1,dFdfm, &
- !$OMP Fprev,fm,fr,c1,reiterate,eb_kmb,did_i, &
- !$OMP h_avail,h_guess,dS_kb,Rcv,F_cor,dS_kb_eff, &
- !$OMP Rho_cor,ea_cor,h1,Idt,Kd_here,pressure, &
- !$OMP T_eos,S_eos,dRho_dT,dRho_dS,dRho,dS_anom_lim)
+ !$OMP parallel do default(private) shared(is,ie,js,je,nz,Kd_Lay,G,GV,US,dt,CS,h,tv, &
+ !$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, &
+ !$OMP ea,eb,Kd_int,Kd_eff,EOSdom,diff_work,g_2dt, kb_out) &
+ !$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min)
do j=js,je
do i=is,ie ; kb(i) = 1 ; enddo
- if (present(Kd_Lay)) then
+ if (allocated(tv%SpV_avg)) then
do k=1,nz ; do i=is,ie
- dtKd(i,k) = GV%Z_to_H**2 * (dt * Kd_lay(i,j,k))
+ dtKd(i,k) = GV%RZ_to_H * (dt * Kd_lay(i,j,k)) / tv%SpV_avg(i,j,k)
enddo ; enddo
- if (present(Kd_int)) then
- do K=1,nz+1 ; do i=is,ie
- dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K))
- enddo ; enddo
- else
- do K=2,nz ; do i=is,ie
- dtKd_int(i,K) = GV%Z_to_H**2 * (0.5 * dt * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)))
- enddo ; enddo
- endif
- else ! Kd_int must be present, or there already would have been an error.
+ do i=is,ie
+ dtKd_int(i,1) = GV%RZ_to_H * (dt * Kd_int(i,j,1)) / tv%SpV_avg(i,j,1)
+ dtKd_int(i,nz+1) = GV%RZ_to_H * (dt * Kd_int(i,j,nz+1)) / tv%SpV_avg(i,j,nz)
+ enddo
+ ! Use the mass-weighted average specific volume to translate thicknesses to verti distances.
+ do K=2,nz ; do i=is,ie
+ dtKd_int(i,K) = GV%RZ_to_H * (dt * Kd_int(i,j,K)) * &
+ ( (h(i,j,k-1) + h(i,j,k) + 2.0*h_neglect) / &
+ ((h(i,j,k-1)+h_neglect) * tv%SpV_avg(i,j,k-1) + &
+ (h(i,j,k)+h_neglect) * tv%SpV_avg(i,j,k)) )
+ enddo ; enddo
+ else
do k=1,nz ; do i=is,ie
- dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt * (Kd_int(i,j,K)+Kd_int(i,j,K+1)))
+ dtKd(i,k) = GV%Z_to_H * (dt * Kd_lay(i,j,k))
enddo ; enddo
- dO K=1,nz+1 ; do i=is,ie
- dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K))
+ do K=1,nz+1 ; do i=is,ie
+ dtKd_int(i,K) = GV%Z_to_H * (dt * Kd_int(i,j,K))
enddo ; enddo
endif
@@ -298,9 +290,15 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
do i=is,ie ; ds_dsp1(i,nz) = 0.0 ; enddo
do i=is,ie ; dsp1_ds(i,nz) = 0.0 ; enddo
- do k=2,nz-1 ; do i=is,ie
- ds_dsp1(i,k) = GV%g_prime(k) / GV%g_prime(k+1)
- enddo ; enddo
+ if (GV%Boussinesq .or. GV%Semi_Boussinesq) then
+ do k=2,nz-1 ; do i=is,ie
+ ds_dsp1(i,k) = GV%g_prime(k) / GV%g_prime(k+1)
+ enddo ; enddo
+ else ! Use a mathematically equivalent form that avoids any dependency on RHO_0.
+ do k=2,nz-1 ; do i=is,ie
+ ds_dsp1(i,k) = (GV%Rlay(k) - GV%Rlay(k-1)) / (GV%Rlay(k+1) - GV%Rlay(k))
+ enddo ; enddo
+ endif
if (CS%bulkmixedlayer) then
! This subroutine determines the averaged entrainment across each
@@ -393,9 +391,16 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
maxF(i,1) = 0.0
htot(i) = h(i,j,1) - Angstrom
enddo
- if (associated(fluxes%buoy)) then ; do i=is,ie
- maxF(i,1) = GV%Z_to_H * (dt*fluxes%buoy(i,j)) / GV%g_prime(2)
- enddo ; endif
+ if (associated(fluxes%buoy) .and. GV%Boussinesq) then
+ do i=is,ie
+ maxF(i,1) = GV%Z_to_H * (dt*fluxes%buoy(i,j)) / GV%g_prime(2)
+ enddo
+ elseif (associated(fluxes%buoy)) then
+ do i=is,ie
+ maxF(i,1) = (GV%RZ_to_H * 0.5*(GV%Rlay(1) + GV%Rlay(2)) * (dt*fluxes%buoy(i,j))) / &
+ GV%g_prime(2)
+ enddo
+ endif
endif
! The following code calculates the maximum flux, maxF, for the interior
@@ -819,7 +824,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
endif ! associated(tv%eqn_of_state))
if (CS%id_Kd > 0) then
- Idt = GV%H_to_Z**2 / dt
+ Idt = (GV%H_to_m*US%m_to_Z) / dt
do k=2,nz-1 ; do i=is,ie
if (k 0) then
- g_2dt = 0.5 * GV%H_to_Z**2*US%L_to_Z**2 * (GV%g_Earth / dt)
+ if (GV%Boussinesq .or. .not.associated(tv%eqn_of_state)) then
+ g_2dt = 0.5 * GV%H_to_Z**2 * US%L_to_Z**2 * (GV%g_Earth / dt)
+ else
+ g_2dt = 0.5 * GV%H_to_RZ**2 * US%L_to_Z**2 * (GV%g_Earth / dt)
+ endif
do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo
if (associated(tv%eqn_of_state)) then
if (associated(fluxes%p_surf)) then
@@ -854,23 +863,44 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, &
S_eos(i) = 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k))
endif
enddo
- call calculate_density_derivs(T_EOS, S_EOS, pressure, dRho_dT, dRho_dS, &
- tv%eqn_of_state, EOSdom)
- do i=is,ie
- if ((k>kmb) .and. (kkmb) .and. (kkmb) .and. (k ppt].
real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL).
- real, intent(in) :: Kddt_smooth !< A smoothing vertical
- !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4].
+ real, intent(in) :: Kddt_smooth !< A smoothing vertical diffusivity
+ !! times a timestep [H Z ~> m2 or kg m-1].
integer, intent(in) :: halo !< Halo width over which to compute
! Local variables
real, dimension(SZI_(G),SZK_(GV)+1) :: &
dRho_dT, & ! The derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
dRho_dS ! The derivative of density with salinity [R S-1 ~> kg m-3 ppt-1].
- real :: h_neglect, h0 ! A thickness that is so small it is usually lost
+ real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
+ real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state.
real, dimension(SZI_(G),SZK0_(G)) :: &
@@ -90,15 +92,17 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth,
if (.not.associated(tv%eqn_of_state)) return
h_neglect = GV%H_subroundoff
- mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H)
- h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect
+ mix_len = (1.0e20 * nz) * (G%max_depth * US%Z_to_m * GV%m_to_H)
do j=js,je
mix(:,:) = 0.0 ; d_b(:,:) = 1.0
! These would be Te_b(:,:) = tv%T(:,j,:), etc., but the values are not used
Te_b(:,:) = 0.0 ; Se_b(:,:) = 0.0
- call smoothed_dRdT_dRdS(h, tv, Kddt_smooth, dRho_dT, dRho_dS, G, GV, US, j, p_surf, halo)
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV, halo_size=halo)
+
+ call smoothed_dRdT_dRdS(h, dz, tv, Kddt_smooth, dRho_dT, dRho_dS, G, GV, US, j, p_surf, halo)
do i=is,ie
do_i(i) = (G%mask2dT(i,j) > 0.0)
@@ -306,14 +310,16 @@ end function is_unstable
!> Returns the partial derivatives of locally referenced potential density with
!! temperature and salinity after the properties have been smoothed with a small
!! constant diffusivity.
-subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, halo)
+subroutine smoothed_dRdT_dRdS(h, dz, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, halo)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: dz !< Height change across layers [Z ~> m]
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
- real, intent(in) :: Kddt !< A diffusivity times a time increment [H2 ~> m2 or kg2 m-4].
+ real, intent(in) :: Kddt !< A diffusivity times a time increment [H Z ~> m2 or kg m-1].
real, dimension(SZI_(G),SZK_(GV)+1), &
intent(out) :: dR_dT !< Derivative of locally referenced
!! potential density with temperature [R C-1 ~> kg m-3 degC-1]
@@ -336,8 +342,9 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h
real :: pres(SZI_(G)) ! Interface pressures [R L2 T-2 ~> Pa].
real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures [C ~> degC]
real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities [S ~> ppt]
- real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4].
- real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses,
+ real :: kap_dt_x2 ! The product of 2*kappa*dt [H Z ~> m2 or kg m-1].
+ real :: dz_neglect, h0 ! A negligible vertical distances [Z ~> m]
+ real :: h_neglect ! A negligible thickness to allow for zero thicknesses
! [H ~> m or kg m-2].
real :: h_tr ! The thickness at tracer points, plus h_neglect [H ~> m or kg m-2].
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
@@ -347,6 +354,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h
nz = GV%ke
h_neglect = GV%H_subroundoff
+ dz_neglect = GV%dz_subroundoff
kap_dt_x2 = 2.0*Kddt
if (Kddt <= 0.0) then
@@ -354,9 +362,9 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h
T_f(i,k) = tv%T(i,j,k) ; S_f(i,k) = tv%S(i,j,k)
enddo ; enddo
else
- h0 = 1.0e-16*sqrt(Kddt) + h_neglect
+ h0 = 1.0e-16*sqrt(GV%H_to_m*US%m_to_Z*Kddt) + dz_neglect
do i=is,ie
- mix(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0)
+ mix(i,2) = kap_dt_x2 / ((dz(i,1)+dz(i,2)) + h0)
h_tr = h(i,j,1) + h_neglect
b1(i) = 1.0 / (h_tr + mix(i,2))
@@ -365,7 +373,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h
S_f(i,1) = (b1(i)*h_tr)*tv%S(i,j,1)
enddo
do k=2,nz-1 ; do i=is,ie
- mix(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0)
+ mix(i,K+1) = kap_dt_x2 / ((dz(i,k)+dz(i,k+1)) + h0)
c1(i,k) = mix(i,K) * b1(i)
h_tr = h(i,j,k) + h_neglect
diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90
index 7ec612f141..7280106125 100644
--- a/src/parameterizations/vertical/MOM_internal_tide_input.F90
+++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90
@@ -11,10 +11,13 @@ module MOM_int_tide_input
use MOM_debugging, only : hchksum
use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
+use MOM_file_parser, only : read_param
use MOM_forcing_type, only : forcing
use MOM_grid, only : ocean_grid_type
use MOM_io, only : slasher, vardesc, MOM_read_data
+use MOM_interface_heights, only : thickness_to_dz, find_rho_bottom
use MOM_isopycnal_slopes, only : vert_fill_TS
+use MOM_string_functions, only : extractWord
use MOM_time_manager, only : time_type, set_time, operator(+), operator(<=)
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d
@@ -26,6 +29,7 @@ module MOM_int_tide_input
#include
public set_int_tide_input, int_tide_input_init, int_tide_input_end
+public get_input_TKE, get_barotropic_tidal_vel
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
@@ -41,10 +45,15 @@ module MOM_int_tide_input
real :: TKE_itide_max !< Maximum Internal tide conversion
!! available to mix above the BBL [R Z3 T-3 ~> W m-2]
real :: kappa_fill !< Vertical diffusivity used to interpolate sensible values
- !! of T & S into thin layers [Z2 T-1 ~> m2 s-1].
+ !! of T & S into thin layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+
+ real, allocatable, dimension(:,:,:) :: TKE_itidal_coef
+ !< The time-invariant field that enters the TKE_itidal input calculation noting that the
+ !! stratification and perhaps density are time-varying [R Z4 H-1 T-2 ~> J m-2 or J m kg-1].
+ real, allocatable, dimension(:,:,:) :: &
+ TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean [R Z3 T-3 ~> W m-2].
+ tideamp !< The amplitude of the tidal velocities [Z T-1 ~> m s-1].
- real, allocatable, dimension(:,:) :: TKE_itidal_coef
- !< The time-invariant field that enters the TKE_itidal input calculation [R Z3 T-2 ~> J m-2].
character(len=200) :: inputdir !< The directory for input files.
logical :: int_tide_source_test !< If true, apply an arbitrary generation site
@@ -57,20 +66,21 @@ module MOM_int_tide_input
integer :: int_tide_source_i !< I Location of generation site
integer :: int_tide_source_j !< J Location of generation site
logical :: int_tide_use_glob_ij !< Use global indices for generation site
+ integer :: nFreq = 0 !< The number of internal tide frequency bands
!>@{ Diagnostic IDs
- integer :: id_TKE_itidal_itide = -1, id_Nb = -1, id_N2_bot = -1
+ integer, allocatable, dimension(:) :: id_TKE_itidal_itide
+ integer :: id_Nb = -1, id_N2_bot = -1
!>@}
end type int_tide_input_CS
!> This type is used to exchange fields related to the internal tides.
type, public :: int_tide_input_type
real, allocatable, dimension(:,:) :: &
- TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean [R Z3 T-3 ~> W m-2].
h2, & !< The squared topographic roughness height [Z2 ~> m2].
- tideamp, & !< The amplitude of the tidal velocities [Z T-1 ~> m s-1].
- Nb !< The bottom stratification [T-1 ~> s-1].
+ Nb, & !< The bottom stratification [T-1 ~> s-1].
+ Rho_bot !< The bottom density or the Boussinesq reference density [R ~> kg m-3].
end type int_tide_input_type
contains
@@ -90,9 +100,12 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS)
!! to the internal tide sources.
real, intent(in) :: dt !< The time increment [T ~> s].
type(int_tide_input_CS), pointer :: CS !< This module's control structure.
+
! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
N2_bot ! The bottom squared buoyancy frequency [T-2 ~> s-2].
+ real, dimension(SZI_(G),SZJ_(G)) :: &
+ Rho_bot ! The average near-bottom density or the Boussinesq reference density [R ~> kg m-3].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
T_f, S_f ! The temperature and salinity in [C ~> degC] and [S ~> ppt] with the values in
@@ -104,6 +117,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS)
integer :: i, j, is, ie, js, je, nz, isd, ied, jsd, jed
integer :: i_global, j_global
+ integer :: fr
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -118,51 +132,64 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS)
! Smooth the properties through massless layers.
if (use_EOS) then
- call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt, T_f, S_f, G, GV, larger_h_denom=.true.)
+ call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt, T_f, S_f, G, GV, US, larger_h_denom=.true.)
endif
- call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot)
+ call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot, Rho_bot)
avg_enabled = query_averaging_enabled(CS%diag, time_end=time_end)
- !$OMP parallel do default(shared)
- do j=js,je ; do i=is,ie
- itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j))
- itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max)
- enddo ; enddo
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ !$OMP parallel do default(shared)
+ do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie
+ itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j))
+ CS%TKE_itidal_input(i,j,fr) = min(GV%Z_to_H*CS%TKE_itidal_coef(i,j,fr)*itide%Nb(i,j), CS%TKE_itide_max)
+ enddo ; enddo ; enddo
+ else
+ !$OMP parallel do default(shared)
+ do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie
+ itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j))
+ itide%Rho_bot(i,j) = G%mask2dT(i,j) * Rho_bot(i,j)
+ CS%TKE_itidal_input(i,j,fr) = min((GV%RZ_to_H*Rho_bot(i,j)) * CS%TKE_itidal_coef(i,j,fr)*itide%Nb(i,j), &
+ CS%TKE_itide_max)
+ enddo ; enddo ; enddo
+ endif
if (CS%int_tide_source_test) then
- itide%TKE_itidal_input(:,:) = 0.0
+ CS%TKE_itidal_input(:,:,:) = 0.0
if (time_end <= CS%time_max_source) then
if (CS%int_tide_use_glob_ij) then
- do j=js,je ; do i=is,ie
+ do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie
i_global = i + G%idg_offset
j_global = j + G%jdg_offset
if ((i_global == CS%int_tide_source_i) .and. (j_global == CS%int_tide_source_j)) then
- itide%TKE_itidal_input(i,j) = 1.0*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3
+ CS%TKE_itidal_input(i,j,fr) = 1.0*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3
endif
- enddo ; enddo
+ enddo ; enddo ; enddo
else
- do j=js,je ; do i=is,ie
+ do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie
! Input an arbitrary energy point source.id_
if (((G%geoLonCu(I-1,j)-CS%int_tide_source_x) * (G%geoLonBu(I,j)-CS%int_tide_source_x) <= 0.0) .and. &
((G%geoLatCv(i,J-1)-CS%int_tide_source_y) * (G%geoLatCv(i,j)-CS%int_tide_source_y) <= 0.0)) then
- itide%TKE_itidal_input(i,j) = 1.0*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3
+ CS%TKE_itidal_input(i,j,fr) = 1.0*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3
endif
- enddo ; enddo
+ enddo ; enddo ; enddo
endif
endif
endif
if (CS%debug) then
call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0, scale=US%s_to_T**2)
- call hchksum(itide%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0, &
+ call hchksum(CS%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0, &
scale=US%RZ3_T3_to_W_m2)
endif
call enable_averages(dt, time_end, CS%diag)
- if (CS%id_TKE_itidal_itide > 0) call post_data(CS%id_TKE_itidal_itide, itide%TKE_itidal_input, CS%diag)
+ do fr=1,CS%nFreq
+ if (CS%id_TKE_itidal_itide(fr) > 0) call post_data(CS%id_TKE_itidal_itide(fr), &
+ CS%TKE_itidal_input(isd:ied,jsd:jed,fr), CS%diag)
+ enddo
if (CS%id_Nb > 0) call post_data(CS%id_Nb, itide%Nb, CS%diag)
if (CS%id_N2_bot > 0 ) call post_data(CS%id_N2_bot, N2_bot, CS%diag)
@@ -171,7 +198,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS)
end subroutine set_int_tide_input
!> Estimates the near-bottom buoyancy frequency (N^2).
-subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot)
+subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot, rho_bot)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -186,55 +213,62 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot)
type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy frequency at the
!! ocean bottom [T-2 ~> s-2].
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: rho_bot !< The average density near the ocean
+ !! bottom [R ~> kg m-3]
! Local variables
real, dimension(SZI_(G),SZK_(GV)+1) :: &
+ pres, & ! The pressure at each interface [R L2 T-2 ~> Pa].
dRho_int ! The unfiltered density differences across interfaces [R ~> kg m-3].
+ real, dimension(SZI_(G),SZK_(GV)) :: dz ! Layer thicknesses in depth units [Z ~> m]
real, dimension(SZI_(G)) :: &
- pres, & ! The pressure at each interface [R L2 T-2 ~> Pa].
Temp_int, & ! The temperature at each interface [C ~> degC]
Salin_int, & ! The salinity at each interface [S ~> ppt]
drho_bot, & ! The density difference at the bottom of a layer [R ~> kg m-3]
h_amp, & ! The amplitude of topographic roughness [Z ~> m].
- hb, & ! The depth below a layer [Z ~> m].
- z_from_bot, & ! The height of a layer center above the bottom [Z ~> m].
+ hb, & ! The thickness of the water column below the midpoint of a layer [H ~> m or kg m-2]
+ z_from_bot, & ! The distance of a layer center from the bottom [Z ~> m]
dRho_dT, & ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1].
- real :: dz_int ! The thickness associated with an interface [Z ~> m].
- real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq
- ! density [Z T-2 R-1 ~> m4 s-2 kg-1].
+ real :: dz_int ! The vertical extent of water associated with an interface [Z ~> m]
+ real :: G_Rho0 ! The gravitational acceleration, sometimes divided by the Boussinesq
+ ! density [H T-2 R-1 ~> m4 s-2 kg-1 or m s-2].
logical :: do_i(SZI_(G)), do_any
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
- G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%Rho0
+ G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%H_to_RZ
EOSdom(:) = EOS_domain(G%HI)
! Find the (limited) density jump across each interface.
do i=is,ie
dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0
enddo
-!$OMP parallel do default(none) shared(is,ie,js,je,nz,tv,fluxes,G,GV,US,h,T_f,S_f, &
-!$OMP h2,N2_bot,G_Rho0,EOSdom) &
-!$OMP private(pres,Temp_Int,Salin_Int,dRho_dT,dRho_dS, &
-!$OMP hb,dRho_bot,z_from_bot,do_i,h_amp, &
-!$OMP do_any,dz_int) &
-!$OMP firstprivate(dRho_int)
+
+ !$OMP parallel do default(none) shared(is,ie,js,je,nz,tv,fluxes,G,GV,US,h,T_f,S_f, &
+ !$OMP h2,N2_bot,rho_bot,G_Rho0,EOSdom) &
+ !$OMP private(pres,Temp_Int,Salin_Int,dRho_dT,dRho_dS, &
+ !$OMP dz,hb,dRho_bot,z_from_bot,do_i,h_amp,do_any,dz_int) &
+ !$OMP firstprivate(dRho_int)
do j=js,je
+
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
if (associated(tv%eqn_of_state)) then
if (associated(fluxes%p_surf)) then
- do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo
+ do i=is,ie ; pres(i,1) = fluxes%p_surf(i,j) ; enddo
else
- do i=is,ie ; pres(i) = 0.0 ; enddo
+ do i=is,ie ; pres(i,1) = 0.0 ; enddo
endif
do K=2,nz
do i=is,ie
- pres(i) = pres(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1)
+ pres(i,K) = pres(i,K-1) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1)
Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1))
Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1))
enddo
- call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:), dRho_dS(:), &
+ call calculate_density_derivs(Temp_int, Salin_int, pres(:,K), dRho_dT(:), dRho_dS(:), &
tv%eqn_of_state, EOSdom)
do i=is,ie
dRho_int(i,K) = max(dRho_dT(i)*(T_f(i,j,k) - T_f(i,j,k-1)) + &
@@ -250,7 +284,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot)
! Find the bottom boundary layer stratification.
do i=is,ie
hb(i) = 0.0 ; dRho_bot(i) = 0.0
- z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz)
+ z_from_bot(i) = 0.5*dz(i,nz)
do_i(i) = (G%mask2dT(i,j) > 0.0)
h_amp(i) = sqrt(h2(i,j))
enddo
@@ -258,16 +292,16 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot)
do k=nz,2,-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1))
+ dz_int = 0.5*(dz(i,k) + dz(i,k-1))
z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above
- hb(i) = hb(i) + dz_int
+ hb(i) = hb(i) + 0.5*(h(i,j,k) + h(i,j,k-1))
dRho_bot(i) = dRho_bot(i) + dRho_int(i,K)
if (z_from_bot(i) > h_amp(i)) then
if (k>2) then
! Always include at least one full layer.
- hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2))
+ hb(i) = hb(i) + 0.5*(h(i,j,k-1) + h(i,j,k-2))
dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1)
endif
do_i(i) = .false.
@@ -283,10 +317,51 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot)
N2_bot(i,j) = (G_Rho0 * dRho_bot(i)) / hb(i)
else ; N2_bot(i,j) = 0.0 ; endif
enddo
+
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ do i=is,ie
+ rho_bot(i,j) = GV%Rho0
+ enddo
+ else
+ ! Average the density over the envelope of the topography.
+ call find_rho_bottom(h, dz, pres, h_amp, tv, j, G, GV, US, Rho_bot(:,j))
+ endif
enddo
end subroutine find_N2_bottom
+!> Returns TKE_itidal_input
+subroutine get_input_TKE(G, TKE_itidal_input, nFreq, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in).
+ real, dimension(SZI_(G),SZJ_(G),nFreq), &
+ intent(out) :: TKE_itidal_input !< The energy input to the internal waves [R Z3 T-3 ~> W m-2].
+ integer, intent(in) :: nFreq !< number of frequencies
+ type(int_tide_input_CS), target :: CS !< A pointer that is set to point to the control
+ !! structure for the internal tide input module.
+ integer :: i,j,fr
+
+ do fr=1,nFreq ; do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ TKE_itidal_input(i,j,fr) = CS%TKE_itidal_input(i,j,fr)
+ enddo ; enddo ; enddo
+
+end subroutine get_input_TKE
+
+!> Returns barotropic tidal velocities
+subroutine get_barotropic_tidal_vel(G, vel_btTide, nFreq, CS)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in).
+ real, dimension(SZI_(G),SZJ_(G),nFreq), &
+ intent(out) :: vel_btTide !< Barotropic velocity read from file [L T-1 ~> m s-1].
+ integer, intent(in) :: nFreq !< number of frequencies
+ type(int_tide_input_CS), target :: CS !< A pointer that is set to point to the control
+ !! structure for the internal tide input module.
+ integer :: i,j,fr
+
+ do fr=1,nFreq ; do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ vel_btTide(i,j,fr) = CS%tideamp(i,j,fr)
+ enddo ; enddo ; enddo
+
+end subroutine get_barotropic_tidal_vel
+
!> Initializes the data related to the internal tide input module
subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide)
type(time_type), intent(in) :: Time !< The current model time
@@ -305,6 +380,9 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide)
character(len=40) :: mdl = "MOM_int_tide_input" ! This module's name.
character(len=200) :: filename, tideamp_file, h2_file ! Input file names or paths
character(len=80) :: tideamp_var, rough_var ! Input file variable names
+ character(len=80) :: var_name
+ character(len=200) :: var_descript
+ character(len=200) :: tidefile_varnames
real :: mask_itidal ! A multiplicative land mask, 0 or 1 [nondim]
real :: max_frac_rough ! The fraction relating the maximum topographic roughness
@@ -317,6 +395,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide)
integer :: tlen_days !< Time interval from start for adding wave source
!! for testing internal tides (BDM)
integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
+ integer :: num_freq, fr
if (associated(CS)) then
call MOM_error(WARNING, "int_tide_input_init called with an associated "// &
@@ -352,17 +431,21 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide)
call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_fill, &
"A diapycnal diffusivity that is used to interpolate "//&
"more sensible values of T & S into thin layers.", &
- units="m2 s-1", default=1.0e-6, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "UTIDE", utide, &
"The constant tidal amplitude used with INT_TIDE_DISSIPATION.", &
units="m s-1", default=0.0, scale=US%m_s_to_L_T)
+ call read_param(param_file, "INTERNAL_TIDE_FREQS", num_freq)
+ CS%nFreq= num_freq
+
allocate(itide%Nb(isd:ied,jsd:jed), source=0.0)
+ allocate(itide%Rho_bot(isd:ied,jsd:jed), source=0.0)
allocate(itide%h2(isd:ied,jsd:jed), source=0.0)
- allocate(itide%TKE_itidal_input(isd:ied,jsd:jed), source=0.0)
- allocate(itide%tideamp(isd:ied,jsd:jed), source=utide)
- allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed), source=0.0)
+ allocate(CS%TKE_itidal_input(isd:ied,jsd:jed,num_freq), source=0.0)
+ allocate(CS%tideamp(isd:ied,jsd:jed,num_freq), source=utide)
+ allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed, num_freq), source=0.0)
call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, &
"A topographic wavenumber used with INT_TIDE_DISSIPATION. "//&
@@ -386,10 +469,13 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide)
"tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc")
filename = trim(CS%inputdir) // trim(tideamp_file)
call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename)
- call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, &
- "The name of the tidal amplitude variable in the input file.", &
- default="tideamp")
- call MOM_read_data(filename, tideamp_var, itide%tideamp, G%domain, scale=US%m_s_to_L_T)
+
+ call read_param(param_file, "INTTIDE_AMP_VARNAMES", tidefile_varnames)
+ do fr=1,num_freq
+ tideamp_var = extractWord(tidefile_varnames,fr)
+ call MOM_read_data(filename, tideamp_var, CS%tideamp(:,:,fr), G%domain, scale=US%m_s_to_L_T)
+ enddo
+
endif
call get_param(param_file, mdl, "H2_FILE", h2_file, &
@@ -442,25 +528,31 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide)
endif
endif
- do j=js,je ; do i=is,ie
+ do fr=1,num_freq ; do j=js,je ; do i=is,ie
mask_itidal = 1.0
if (G%bathyT(i,j) + G%Z_ref < min_zbot_itides) mask_itidal = 0.0
- itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j)
+ CS%tideamp(i,j,fr) = CS%tideamp(i,j,fr) * mask_itidal * G%mask2dT(i,j)
! Restrict rms topo to a fraction (often 10 percent) of the column depth.
if (max_frac_rough >= 0.0) &
itide%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, itide%h2(i,j))
- ! Compute the fixed part of internal tidal forcing; units are [R Z3 T-2 ~> J m-2] here.
- CS%TKE_itidal_coef(i,j) = 0.5*US%L_to_Z*kappa_h2_factor*GV%Rho0*&
- kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2
- enddo ; enddo
+ ! Compute the fixed part of internal tidal forcing; units are [R Z4 H-1 T-2 ~> J m-2 or J m kg-1] here.
+ CS%TKE_itidal_coef(i,j,fr) = 0.5*US%L_to_Z*kappa_h2_factor * GV%H_to_RZ * &
+ kappa_itides * itide%h2(i,j) * CS%tideamp(i,j,fr)**2
+ enddo ; enddo ; enddo
- CS%id_TKE_itidal_itide = register_diag_field('ocean_model','TKE_itidal_itide',diag%axesT1,Time, &
- 'Internal Tide Driven Turbulent Kinetic Energy', &
- 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+ allocate( CS%id_TKE_itidal_itide(num_freq), source=-1)
+
+ do fr=1,num_freq
+ write(var_name, '("TKE_itidal_itide_freq",i1)') fr
+ write(var_descript, '("Internal Tide Driven Turbulent Kinetic Energy in frequency ",i1)') fr
+
+ CS%id_TKE_itidal_itide(fr) = register_diag_field('ocean_model',var_name,diag%axesT1,Time, &
+ var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2)
+ enddo
CS%id_Nb = register_diag_field('ocean_model','Nb_itide',diag%axesT1,Time, &
'Bottom Buoyancy Frequency', 's-1', conversion=US%s_to_T)
diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90
index 78ec0d9391..8a1974d8ea 100644
--- a/src/parameterizations/vertical/MOM_kappa_shear.F90
+++ b/src/parameterizations/vertical/MOM_kappa_shear.F90
@@ -3,18 +3,20 @@ module MOM_kappa_shear
! This file is part of MOM6. See LICENSE.md for the license.
-use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
-use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE
-use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
-use MOM_diag_mediator, only : diag_ctrl, time_type
-use MOM_debugging, only : hchksum, Bchksum
-use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
-use MOM_file_parser, only : get_param, log_version, param_file_type
-use MOM_grid, only : ocean_grid_type
-use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : thermo_var_ptrs
-use MOM_verticalGrid, only : verticalGrid_type
-use MOM_EOS, only : calculate_density_derivs
+use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
+use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE
+use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
+use MOM_diag_mediator, only : diag_ctrl, time_type
+use MOM_debugging, only : hchksum, Bchksum
+use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE
+use MOM_file_parser, only : get_param, log_version, param_file_type
+use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
+use MOM_unit_scaling, only : unit_scale_type
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
+use MOM_EOS, only : calculate_density_derivs
+use MOM_EOS, only : calculate_density, calculate_specific_vol_derivs
implicit none ; private
@@ -53,12 +55,12 @@ module MOM_kappa_shear
!! the buoyancy and shear scales in the diffusivity
!! equation, 0 to eliminate the shear scale [nondim].
real :: TKE_bg !< The background level of TKE [Z2 T-2 ~> m2 s-2].
- real :: kappa_0 !< The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
+ real :: kappa_0 !< The background diapycnal diffusivity [H Z T-1 ~> m2 s-1 or Pa s]
real :: kappa_seed !< A moderately large seed value of diapycnal diffusivity that
!! is used as a starting turbulent diffusivity in the iterations
!! to findind an energetically constrained solution for the
- !! shear-driven diffusivity [Z2 T-1 ~> m2 s-1].
- real :: kappa_trunc !< Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1].
+ !! shear-driven diffusivity [H Z T-1 ~> m2 s-1 or Pa s]
+ real :: kappa_trunc !< Diffusivities smaller than this are rounded to 0 [H Z T-1 ~> m2 s-1 or Pa s]
real :: kappa_tol_err !< The fractional error in kappa that is tolerated [nondim].
real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity [nondim].
integer :: nkml !< The number of layers in the mixed layer, as
@@ -101,7 +103,7 @@ module MOM_kappa_shear
type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
!! regulate the timing of diagnostic output.
!>@{ Diagnostic IDs
- integer :: id_Kd_shear = -1, id_TKE = -1, id_ILd2 = -1, id_dz_Int = -1
+ integer :: id_Kd_shear = -1, id_TKE = -1
!>@}
end type Kappa_shear_CS
@@ -127,15 +129,15 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL).
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface
- !! (not layer!) [Z2 T-1 ~> m2 s-1]. Initially this is the
- !! value from the previous timestep, which may
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. Initially this
+ !! is the value from the previous timestep, which may
!! accelerate the iteration toward convergence.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at
!! each interface (not layer!) [Z2 T-2 ~> m2 s-2].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(inout) :: kv_io !< The vertical viscosity at each interface
- !! (not layer!) [Z2 T-1 ~> m2 s-1]. This discards any
+ !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s]. This discards any
!! previous value (i.e. it is intent out) and
!! simply sets Kv = Prandtl * Kd_shear
real, intent(in) :: dt !< Time increment [T ~> s].
@@ -144,30 +146,33 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
! Local variables
real, dimension(SZI_(G),SZK_(GV)) :: &
- h_2d, & ! A 2-D version of h, but converted to [Z ~> m].
+ h_2d, & ! A 2-D version of h [H ~> m or kg m-2].
+ dz_2d, & ! Vertical distance between interface heights [Z ~> m].
u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1].
T_2d, S_2d, rho_2d ! 2-D versions of T [C ~> degC], S [S ~> ppt], and rho [R ~> kg m-3].
real, dimension(SZI_(G),SZK_(GV)+1) :: &
- kappa_2d, & ! 2-D version of kappa_io [Z2 T-1 ~> m2 s-1].
+ kappa_2d, & ! 2-D version of kappa_io [H Z T-1 ~> m2 s-1 or Pa s]
tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2].
real, dimension(SZK_(GV)) :: &
- Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1].
- dz, & ! The layer thickness [Z ~> m].
- u0xdz, & ! The initial zonal velocity times dz [Z L T-1 ~> m2 s-1].
- v0xdz, & ! The initial meridional velocity times dz [Z L T-1 ~> m2 s-1].
- T0xdz, & ! The initial temperature times dz [C Z ~> degC m].
- S0xdz ! The initial salinity times dz [S Z ~> ppt m].
+ Idz, & ! The inverse of the thickness of the merged layers [H-1 ~> m2 kg-1].
+ h_lay, & ! The layer thickness [H ~> m or kg m-2]
+ dz_lay, & ! The geometric layer thickness in height units [Z ~> m]
+ u0xdz, & ! The initial zonal velocity times dz [H L T-1 ~> m2 s-1 or kg m-1 s-1]
+ v0xdz, & ! The initial meridional velocity times dz [H L T-1 ~> m2 s-1 or kg m-1 s-1]
+ T0xdz, & ! The initial temperature times thickness [C H ~> degC m or degC kg m-2] or if
+ ! temperature is not a state variable, the density times thickness [R H ~> kg m-2 or kg2 m-3]
+ S0xdz ! The initial salinity times dz [S H ~> ppt m or ppt kg m-2].
real, dimension(SZK_(GV)+1) :: &
- kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1].
+ kappa, & ! The shear-driven diapycnal diffusivity at an interface [H Z T-1 ~> m2 s-1 or Pa s]
tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2].
- kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1].
+ kappa_avg, & ! The time-weighted average of kappa [H Z T-1 ~> m2 s-1 or Pa s]
tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2].
- real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2].
+ real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2].
real :: surface_pres ! The top surface pressure [R L2 T-2 ~> Pa].
- real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m].
- real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2].
- real :: dz_massless ! A layer thickness that is considered massless [Z ~> m].
+ real :: dz_in_lay ! The running sum of the thickness in a layer [H ~> m or kg m-2]
+ real :: k0dt ! The background diffusivity times the timestep [H Z ~> m2 or kg m-1]
+ real :: dz_massless ! A layer thickness that is considered massless [H ~> m or kg m-2]
logical :: use_temperature ! If true, temperature and salinity have been
! allocated and are being used as state variables.
@@ -183,13 +188,17 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
use_temperature = associated(tv%T)
k0dt = dt*CS%kappa_0
- dz_massless = 0.1*sqrt(k0dt)
+ dz_massless = 0.1*sqrt((US%Z_to_m*GV%m_to_H)*k0dt)
!$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,tv,G,GV,US, &
!$OMP CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io)
do j=js,je
+
+ ! Convert layer thicknesses into geometric thickness in height units.
+ call thickness_to_dz(h, tv, dz_2d, j, G, GV)
+
do k=1,nz ; do i=is,ie
- h_2d(i,k) = h(i,j,k)*GV%H_to_Z
+ h_2d(i,k) = h(i,j,k)
u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k)
enddo ; enddo
if (use_temperature) then ; do k=1,nz ; do i=is,ie
@@ -203,26 +212,28 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
!---------------------------------------
do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
! call cpu_clock_begin(id_clock_setup)
+
! Store a transposed version of the initial arrays.
! Any elimination of massless layers would occur here.
if (CS%eliminate_massless) then
nzc = 1
do k=1,nz
! Zero out the thicknesses of all layers, even if they are unused.
- dz(k) = 0.0 ; u0xdz(k) = 0.0 ; v0xdz(k) = 0.0
+ h_lay(k) = 0.0 ; dz_lay(k) = 0.0 ; u0xdz(k) = 0.0 ; v0xdz(k) = 0.0
T0xdz(k) = 0.0 ; S0xdz(k) = 0.0
! Add a new layer if this one has mass.
-! if ((dz(nzc) > 0.0) .and. (h_2d(i,k) > dz_massless)) nzc = nzc+1
- if ((k>CS%nkml) .and. (dz(nzc) > 0.0) .and. &
+! if ((h_lay(nzc) > 0.0) .and. (h_2d(i,k) > dz_massless)) nzc = nzc+1
+ if ((k>CS%nkml) .and. (h_lay(nzc) > 0.0) .and. &
(h_2d(i,k) > dz_massless)) nzc = nzc+1
! Only merge clusters of massless layers.
-! if ((dz(nzc) > dz_massless) .or. &
-! ((dz(nzc) > 0.0) .and. (h_2d(i,k) > dz_massless))) nzc = nzc+1
+! if ((h_lay(nzc) > dz_massless) .or. &
+! ((h_lay(nzc) > 0.0) .and. (h_2d(i,k) > dz_massless))) nzc = nzc+1
kc(k) = nzc
- dz(nzc) = dz(nzc) + h_2d(i,k)
+ h_lay(nzc) = h_lay(nzc) + h_2d(i,k)
+ dz_lay(nzc) = dz_lay(nzc) + dz_2d(i,k)
u0xdz(nzc) = u0xdz(nzc) + u_2d(i,k)*h_2d(i,k)
v0xdz(nzc) = v0xdz(nzc) + v_2d(i,k)*h_2d(i,k)
if (use_temperature) then
@@ -236,7 +247,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
kc(nz+1) = nzc+1
! Set up Idz as the inverse of layer thicknesses.
- do k=1,nzc ; Idz(k) = 1.0 / dz(k) ; enddo
+ do k=1,nzc ; Idz(k) = 1.0 / h_lay(k) ; enddo
! Now determine kf, the fractional weight of interface kc when
! interpolating between interfaces kc and kc+1.
@@ -251,21 +262,23 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
kf(nz+1) = 0.0
else
do k=1,nz
- dz(k) = h_2d(i,k)
- u0xdz(k) = u_2d(i,k)*dz(k) ; v0xdz(k) = v_2d(i,k)*dz(k)
+ h_lay(k) = h_2d(i,k)
+ dz_lay(k) = dz_2d(i,k)
+ u0xdz(k) = u_2d(i,k)*h_lay(k) ; v0xdz(k) = v_2d(i,k)*h_lay(k)
enddo
if (use_temperature) then
do k=1,nz
- T0xdz(k) = T_2d(i,k)*dz(k) ; S0xdz(k) = S_2d(i,k)*dz(k)
+ T0xdz(k) = T_2d(i,k)*h_lay(k) ; S0xdz(k) = S_2d(i,k)*h_lay(k)
enddo
else
do k=1,nz
- T0xdz(k) = rho_2d(i,k)*dz(k) ; S0xdz(k) = rho_2d(i,k)*dz(k)
+ T0xdz(k) = rho_2d(i,k)*h_lay(k) ; S0xdz(k) = rho_2d(i,k)*h_lay(k)
enddo
endif
nzc = nz
do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo
endif
+
f2 = 0.25 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + &
(G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2))
surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j)
@@ -277,7 +290,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
do K=1,nzc+1 ; kappa(K) = CS%kappa_seed ; enddo
call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
- dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, &
+ h_lay, dz_lay, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, &
tke_avg, tv, CS, GV, US)
! call cpu_clock_begin(id_clock_setup)
@@ -320,7 +333,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
enddo ! end of j-loop
if (CS%debug) then
- call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s)
+ call hchksum(kappa_io, "kappa", G%HI, scale=GV%HZ_T_to_m2_s)
call hchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2)
endif
@@ -353,12 +366,13 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
!! (or NULL).
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(out) :: kappa_io !< The diapycnal diffusivity at each interface
- !! (not layer!) [Z2 T-1 ~> m2 s-1].
+ !! (not layer!) [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), &
intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at
!! each interface (not layer!) [Z2 T-2 ~> m2 s-2].
real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), &
- intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1].
+ intent(inout) :: kv_io !< The vertical viscosity at each interface
+ !! [H Z T-1 ~> m2 s-1 or Pa s].
!! The previous value is used to initialize kappa
!! in the vertex columns as Kappa = Kv/Prandtl
!! to accelerate the iteration toward convergence.
@@ -367,32 +381,36 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
!! call to kappa_shear_init.
! Local variables
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
+ dz_3d ! Vertical distance between interface heights [Z ~> m].
real, dimension(SZIB_(G),SZK_(GV)) :: &
- h_2d, & ! A 2-D version of h, but converted to [Z ~> m].
+ h_2d, & ! A 2-D version of h [H ~> m or kg m-2].
+ dz_2d, & ! Vertical distance between interface heights [Z ~> m].
u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1].
T_2d, S_2d, rho_2d ! 2-D versions of T [C ~> degC], S [S ~> ppt], and rho [R ~> kg m-3].
real, dimension(SZIB_(G),SZK_(GV)+1,2) :: &
- kappa_2d ! Quasi 2-D versions of kappa_io [Z2 T-1 ~> m2 s-1].
+ kappa_2d ! Quasi 2-D versions of kappa_io [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZIB_(G),SZK_(GV)+1) :: &
tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2].
real, dimension(SZK_(GV)) :: &
- Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1].
- dz, & ! The layer thickness [Z ~> m].
- u0xdz, & ! The initial zonal velocity times dz [L Z T-1 ~> m2 s-1].
- v0xdz, & ! The initial meridional velocity times dz [L Z T-1 ~> m2 s-1].
- T0xdz, & ! The initial temperature times dz [C Z ~> degC m].
- S0xdz ! The initial salinity times dz [S Z ~> ppt m].
+ Idz, & ! The inverse of the thickness of the merged layers [H-1 ~> m2 kg-1].
+ h_lay, & ! The layer thickness [H ~> m or kg m-2]
+ dz_lay, & ! The geometric layer thickness in height units [Z ~> m]
+ u0xdz, & ! The initial zonal velocity times dz [L H T-1 ~> m2 s-1 or kg m-1 s-1].
+ v0xdz, & ! The initial meridional velocity times dz [H L T-1 ~> m2 s-1 or kg m-1 s-1]
+ T0xdz, & ! The initial temperature times dz [C H ~> degC m or degC kg m-2]
+ S0xdz ! The initial salinity times dz [S H ~> ppt m or ppt kg m-2]
real, dimension(SZK_(GV)+1) :: &
- kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1].
+ kappa, & ! The shear-driven diapycnal diffusivity at an interface [H Z T-1 ~> m2 s-1 or Pa s]
tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2].
- kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1].
+ kappa_avg, & ! The time-weighted average of kappa [H Z T-1 ~> m2 s-1 or Pa s]
tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2].
real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2].
real :: surface_pres ! The top surface pressure [R L2 T-2 ~> Pa].
- real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m].
- real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2].
- real :: dz_massless ! A layer thickness that is considered massless [Z ~> m].
+ real :: dz_in_lay ! The running sum of the thickness in a layer [H ~> m or kg m-2]
+ real :: k0dt ! The background diffusivity times the timestep [H Z ~> m2 or kg m-1]
+ real :: dz_massless ! A layer thickness that is considered massless [H ~> m or kg m-2]
real :: I_hwt ! The inverse of the masked thickness weights [H-1 ~> m-1 or m2 kg-1].
real :: I_Prandtl ! The inverse of the turbulent Prandtl number [nondim].
logical :: use_temperature ! If true, temperature and salinity have been
@@ -411,9 +429,12 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
use_temperature = associated(tv%T)
k0dt = dt*CS%kappa_0
- dz_massless = 0.1*sqrt(k0dt)
+ dz_massless = 0.1*sqrt((US%Z_to_m*GV%m_to_H)*k0dt)
I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb
+ ! Convert layer thicknesses into geometric thickness in height units.
+ call thickness_to_dz(h, tv, dz_3d, G, GV, US, halo_size=1)
+
!$OMP parallel do default(private) shared(jsB,jeB,isB,ieB,nz,h,u_in,v_in,use_temperature,tv,G,GV, &
!$OMP US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io,I_Prandtl)
do J=JsB,JeB
@@ -442,13 +463,17 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
((G%mask2dT(i+1,j) * h(i+1,j,k)) * S_in(i+1,j,k) + &
(G%mask2dT(i,j+1) * h(i,j+1,k)) * S_in(i,j+1,k)) ) * I_hwt
endif
- h_2d(I,k) = GV%H_to_Z * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + &
- (G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k)) ) / &
- ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + &
- (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 )
-! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_Z
+ h_2d(I,k) = ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + &
+ (G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k)) ) / &
+ ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + &
+ (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 )
+ dz_2d(I,k) = ((G%mask2dT(i,j) * dz_3d(i,j,k) + G%mask2dT(i+1,j+1) * dz_3d(i+1,j+1,k)) + &
+ (G%mask2dT(i+1,j) * dz_3d(i+1,j,k) + G%mask2dT(i,j+1) * dz_3d(i,j+1,k)) ) / &
+ ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + &
+ (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 )
+! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))
! h_2d(I,k) = ((h(i,j,k)**2 + h(i+1,j+1,k)**2) + &
-! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_Z * I_hwt
+! (h(i+1,j,k)**2 + h(i,j+1,k)**2)) * I_hwt
enddo ; enddo
if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB
rho_2d(I,k) = GV%Rlay(k)
@@ -466,20 +491,21 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
nzc = 1
do k=1,nz
! Zero out the thicknesses of all layers, even if they are unused.
- dz(k) = 0.0 ; u0xdz(k) = 0.0 ; v0xdz(k) = 0.0
+ h_lay(k) = 0.0 ; dz_lay(k) = 0.0 ; u0xdz(k) = 0.0 ; v0xdz(k) = 0.0
T0xdz(k) = 0.0 ; S0xdz(k) = 0.0
! Add a new layer if this one has mass.
-! if ((dz(nzc) > 0.0) .and. (h_2d(I,k) > dz_massless)) nzc = nzc+1
- if ((k>CS%nkml) .and. (dz(nzc) > 0.0) .and. &
+! if ((h_lay(nzc) > 0.0) .and. (h_2d(I,k) > dz_massless)) nzc = nzc+1
+ if ((k>CS%nkml) .and. (h_lay(nzc) > 0.0) .and. &
(h_2d(I,k) > dz_massless)) nzc = nzc+1
! Only merge clusters of massless layers.
-! if ((dz(nzc) > dz_massless) .or. &
-! ((dz(nzc) > 0.0) .and. (h_2d(I,k) > dz_massless))) nzc = nzc+1
+! if ((h_lay(nzc) > dz_massless) .or. &
+! ((h_lay(nzc) > 0.0) .and. (h_2d(I,k) > dz_massless))) nzc = nzc+1
kc(k) = nzc
- dz(nzc) = dz(nzc) + h_2d(I,k)
+ h_lay(nzc) = h_lay(nzc) + h_2d(I,k)
+ dz_lay(nzc) = dz_lay(nzc) + dz_2d(I,k)
u0xdz(nzc) = u0xdz(nzc) + u_2d(I,k)*h_2d(I,k)
v0xdz(nzc) = v0xdz(nzc) + v_2d(I,k)*h_2d(I,k)
if (use_temperature) then
@@ -493,7 +519,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
kc(nz+1) = nzc+1
! Set up Idz as the inverse of layer thicknesses.
- do k=1,nzc ; Idz(k) = 1.0 / dz(k) ; enddo
+ do k=1,nzc ; Idz(k) = 1.0 / h_lay(k) ; enddo
! Now determine kf, the fractional weight of interface kc when
! interpolating between interfaces kc and kc+1.
@@ -508,21 +534,23 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
kf(nz+1) = 0.0
else
do k=1,nz
- dz(k) = h_2d(I,k)
- u0xdz(k) = u_2d(I,k)*dz(k) ; v0xdz(k) = v_2d(I,k)*dz(k)
+ h_lay(k) = h_2d(I,k)
+ dz_lay(k) = dz_2d(I,k)
+ u0xdz(k) = u_2d(I,k)*h_lay(k) ; v0xdz(k) = v_2d(I,k)*h_lay(k)
enddo
if (use_temperature) then
do k=1,nz
- T0xdz(k) = T_2d(I,k)*dz(k) ; S0xdz(k) = S_2d(I,k)*dz(k)
+ T0xdz(k) = T_2d(I,k)*h_lay(k) ; S0xdz(k) = S_2d(I,k)*h_lay(k)
enddo
else
do k=1,nz
- T0xdz(k) = rho_2d(I,k)*dz(k) ; S0xdz(k) = rho_2d(I,k)*dz(k)
+ T0xdz(k) = rho_2d(I,k)*h_lay(k) ; S0xdz(k) = rho_2d(I,k)*h_lay(k)
enddo
endif
nzc = nz
do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo
endif
+
f2 = G%CoriolisBu(I,J)**2
surface_pres = 0.0
if (associated(p_surf)) then
@@ -544,7 +572,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
do K=1,nzc+1 ; kappa(K) = CS%kappa_seed ; enddo
call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, &
- dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, &
+ h_lay, dz_lay, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, &
tke_avg, tv, CS, GV, US)
! call cpu_clock_begin(Id_clock_setup)
! Extrapolate from the vertically reduced grid back to the original layers.
@@ -589,7 +617,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
enddo ! end of J-loop
if (CS%debug) then
- call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s)
+ call hchksum(kappa_io, "kappa", G%HI, scale=GV%HZ_T_to_m2_s)
call Bchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2)
endif
@@ -600,11 +628,11 @@ end subroutine Calc_kappa_shear_vertex
!> This subroutine calculates shear-driven diffusivity and TKE in a single column
-subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
+subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, hlay, dz_lay, &
u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, tke_avg, tv, CS, GV, US)
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZK_(GV)+1), &
- intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1].
+ intent(inout) :: kappa !< The time-weighted average of kappa [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZK_(GV)+1), &
intent(out) :: tke !< The Turbulent Kinetic Energy per unit mass at
!! an interface [Z2 T-2 ~> m2 s-2].
@@ -612,17 +640,20 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
real, intent(in) :: f2 !< The square of the Coriolis parameter [T-2 ~> s-2].
real, intent(in) :: surface_pres !< The surface pressure [R L2 T-2 ~> Pa].
real, dimension(SZK_(GV)), &
- intent(in) :: dz !< The layer thickness [Z ~> m].
+ intent(in) :: hlay !< The layer thickness [H ~> m or kg m-2]
real, dimension(SZK_(GV)), &
- intent(in) :: u0xdz !< The initial zonal velocity times dz [Z L T-1 ~> m2 s-1].
+ intent(in) :: dz_lay !< The geometric layer thickness in height units [Z ~> m]
real, dimension(SZK_(GV)), &
- intent(in) :: v0xdz !< The initial meridional velocity times dz [Z L T-1 ~> m2 s-1].
+ intent(in) :: u0xdz !< The initial zonal velocity times hlay [H L T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZK_(GV)), &
- intent(in) :: T0xdz !< The initial temperature times dz [C Z ~> degC m].
+ intent(in) :: v0xdz !< The initial meridional velocity times the
+ !! layer thickness [H L T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZK_(GV)), &
- intent(in) :: S0xdz !< The initial salinity times dz [S Z ~> ppt m].
+ intent(in) :: T0xdz !< The initial temperature times hlay [C H ~> degC m or degC kg m-2]
+ real, dimension(SZK_(GV)), &
+ intent(in) :: S0xdz !< The initial salinity times hlay [S H ~> ppt m or ppt kg m-2]
real, dimension(SZK_(GV)+1), &
- intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1].
+ intent(out) :: kappa_avg !< The time-weighted average of kappa [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZK_(GV)+1), &
intent(out) :: tke_avg !< The time-weighted average of TKE [Z2 T-2 ~> m2 s-2].
real, intent(in) :: dt !< Time increment [T ~> s].
@@ -645,47 +676,56 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
real, dimension(nzc+1) :: &
N2, & ! The squared buoyancy frequency at an interface [T-2 ~> s-2].
- dz_Int, & ! The extent of a finite-volume space surrounding an interface,
- ! as used in calculating kappa and TKE [Z ~> m].
+ h_Int, & ! The extent of a finite-volume space surrounding an interface,
+ ! as used in calculating kappa and TKE [H ~> m or kg m-2]
+ dz_Int, & ! The vertical distance with the space surrounding an interface,
+ ! as used in calculating kappa and TKE [Z ~> m]
+ dz_h_Int, & ! The ratio of the vertical distances to the thickness around an
+ ! interface [Z H-1 ~> nondim or m3 kg-1]. In non-Boussinesq mode
+ ! this is the specific volume, otherwise it is a scaling factor.
I_dz_int, & ! The inverse of the distance between velocity & density points
! above and below an interface [Z-1 ~> m-1]. This is used to
- ! calculate N2, shear, and fluxes, and it might differ from
- ! 1/dz_Int, as they have different uses.
+ ! calculate N2, shear and fluxes.
S2, & ! The squared shear at an interface [T-2 ~> s-2].
a1, & ! a1 is the coupling between adjacent interfaces in the TKE,
- ! velocity, and density equations [Z ~> m]
+ ! velocity, and density equations [H ~> m or kg m-2]
c1, & ! c1 is used in the tridiagonal (and similar) solvers [nondim].
- k_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1].
- kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1].
- kappa_out, & ! The kappa that results from the kappa equation [Z2 T-1 ~> m2 s-1].
- kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 T-1 ~> m2 s-1].
+ k_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]
+ kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]
+ kappa_out, & ! The kappa that results from the kappa equation [H Z T-1 ~> m2 s-1 or Pa s]
+ kappa_mid, & ! The average of the initial and predictor estimates of kappa [H Z T-1 ~> m2 s-1 or Pa s]
tke_pred, & ! The value of TKE from a predictor step [Z2 T-2 ~> m2 s-2].
- kappa_pred, & ! The value of kappa from a predictor step [Z2 T-1 ~> m2 s-1].
+ kappa_pred, & ! The value of kappa from a predictor step [H Z T-1 ~> m2 s-1 or Pa s]
pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa].
T_int, & ! The temperature interpolated to an interface [C ~> degC].
Sal_int, & ! The salinity interpolated to an interface [S ~> ppt].
dbuoy_dT, & ! The partial derivative of buoyancy with changes in temperature [Z T-2 C-1 ~> m s-2 degC-1]
dbuoy_dS, & ! The partial derivative of buoyancy with changes in salinity [Z T-2 S-1 ~> m s-2 ppt-1]
+ dSpV_dT, & ! The partial derivative of specific volume with changes in temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ dSpV_dS, & ! The partial derivative of specific volume with changes in salinity [R-1 S-1 ~> m3 kg-1 ppt-1]
+ rho_int, & ! The in situ density interpolated to an interface [R ~> kg m-3]
I_L2_bdry, & ! The inverse of the square of twice the harmonic mean
- ! distance to the top and bottom boundaries [Z-2 ~> m-2].
- K_Q, & ! Diffusivity divided by TKE [T ~> s].
- K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [T ~> s].
- local_src_avg, & ! The time-integral of the local source [nondim].
+ ! distance to the top and bottom boundaries [H-1 Z-1 ~> m-2 or m kg-1].
+ K_Q, & ! Diffusivity divided by TKE [H T Z-1 ~> s or kg s m-3]
+ K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [H T Z-1 ~> s or kg s m-3]
+ local_src_avg, & ! The time-integral of the local source [nondim]
tol_min, & ! Minimum tolerated ksrc for the corrector step [T-1 ~> s-1].
tol_max, & ! Maximum tolerated ksrc for the corrector step [T-1 ~> s-1].
tol_chg, & ! The tolerated kappa change integrated over a timestep [nondim].
dist_from_top, & ! The distance from the top surface [Z ~> m].
+ h_from_top, & ! The total thickness above an interface [H ~> m or kg m-2]
local_src ! The sum of all sources of kappa, including kappa_src and
- ! sources from the elliptic term [T-1 ~> s-1].
+ ! sources from the elliptic term [T-1 ~> s-1]
real :: dist_from_bot ! The distance from the bottom surface [Z ~> m].
- real :: b1 ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1].
- real :: bd1 ! A term in the denominator of b1 [Z ~> m].
+ real :: h_from_bot ! The total thickness below and interface [H ~> m or kg m-2]
+ real :: b1 ! The inverse of the pivot in the tridiagonal equations [H-1 ~> m-1 or m2 kg-1].
+ real :: bd1 ! A term in the denominator of b1 [H ~> m or kg m-2].
real :: d1 ! 1 - c1 in the tridiagonal equations [nondim]
- real :: gR0 ! A conversion factor from Z to pressure, given by Rho_0 times g
- ! [R L2 T-2 Z-1 ~> kg m-2 s-2].
+ real :: gR0 ! A conversion factor from H to pressure, Rho_0 times g in Boussinesq
+ ! mode, or just g when non-Boussinesq [R L2 T-2 H-1 ~> kg m-2 s-2 or m s-2].
real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z R-1 T-2 ~> m4 kg-1 s-2].
- real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2].
+ real :: Norm ! A factor that normalizes two weights to 1 [H-2 ~> m-2 or m4 kg-2].
real :: tol_dksrc ! Tolerance for the change in the kappa source within an iteration
! relative to the local source [nondim]. This must be greater than 1.
real :: tol2 ! The tolerance for the change in the kappa source within an iteration
@@ -701,8 +741,11 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! gives acceptably small changes in k_src [T ~> s].
real :: Idtt ! Idtt = 1 / dt_test [T-1 ~> s-1].
real :: dt_inc ! An increment to dt_test that is being tested [T ~> s].
-
- real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2].
+ real :: wt_a ! The fraction of a layer thickness identified with the interface
+ ! above a layer [nondim]
+ real :: wt_b ! The fraction of a layer thickness identified with the interface
+ ! below a layer [nondim]
+ real :: k0dt ! The background diffusivity times the timestep [H Z ~> m2 or kg m-1].
logical :: valid_dt ! If true, all levels so far exhibit acceptably small changes in k_src.
logical :: use_temperature ! If true, temperature and salinity have been
! allocated and are being used as state variables.
@@ -717,8 +760,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! N2_debug, & ! A version of N2 for debugging [T-2 ~> s-2]
Ri_crit = CS%Rino_crit
- gR0 = GV%Rho0 * GV%g_Earth
- g_R0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0)
+ gR0 = GV%H_to_RZ * GV%g_Earth
+ g_R0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0
k0dt = dt*CS%kappa_0
tol_dksrc = CS%kappa_src_max_chg
@@ -734,27 +777,37 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! Set up Idz as the inverse of layer thicknesses.
- do k=1,nzc ; Idz(k) = 1.0 / dz(k) ; enddo
+ do k=1,nzc ; Idz(k) = 1.0 / dz_lay(k) ; enddo
! Set up I_dz_int as the inverse of the distance between
! adjacent layer centers.
- I_dz_int(1) = 2.0 / dz(1)
- dist_from_top(1) = 0.0
+ I_dz_int(1) = 2.0 / dz_lay(1)
+ dist_from_top(1) = 0.0 ; h_from_top(1) = 0.0
do K=2,nzc
- I_dz_int(K) = 2.0 / (dz(k-1) + dz(k))
- dist_from_top(K) = dist_from_top(K-1) + dz(k-1)
+ I_dz_int(K) = 2.0 / (dz_lay(k-1) + dz_lay(k))
+ dist_from_top(K) = dist_from_top(K-1) + dz_lay(k-1)
+ h_from_top(K) = h_from_top(K-1) + hlay(k-1)
+ enddo
+ I_dz_int(nzc+1) = 2.0 / dz_lay(nzc)
+
+ ! Find the inverse of the squared distances from the boundaries.
+ dist_from_bot = 0.0 ; h_from_bot = 0.0
+ do K=nzc,2,-1
+ dist_from_bot = dist_from_bot + dz_lay(k)
+ h_from_bot = h_from_bot + hlay(k)
+ I_L2_bdry(K) = ((dist_from_top(K) + dist_from_bot) * (h_from_top(K) + h_from_bot)) / &
+ ((dist_from_top(K) * dist_from_bot) * (h_from_top(K) * h_from_bot))
enddo
- I_dz_int(nzc+1) = 2.0 / dz(nzc)
! Determine the velocities and thicknesses after eliminating massless
! layers and applying a time-step of background diffusion.
if (nzc > 1) then
a1(2) = k0dt*I_dz_int(2)
- b1 = 1.0 / (dz(1) + a1(2))
+ b1 = 1.0 / (hlay(1) + a1(2))
u(1) = b1 * u0xdz(1) ; v(1) = b1 * v0xdz(1)
T(1) = b1 * T0xdz(1) ; Sal(1) = b1 * S0xdz(1)
- c1(2) = a1(2) * b1 ; d1 = dz(1) * b1 ! = 1 - c1
+ c1(2) = a1(2) * b1 ; d1 = hlay(1) * b1 ! = 1 - c1
do k=2,nzc-1
- bd1 = dz(k) + d1*a1(k)
+ bd1 = hlay(k) + d1*a1(k)
a1(k+1) = k0dt*I_dz_int(k+1)
b1 = 1.0 / (bd1 + a1(k+1))
u(k) = b1 * (u0xdz(k) + a1(k)*u(k-1))
@@ -766,11 +819,11 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! rho or T and S have insulating boundary conditions, u & v use no-slip
! bottom boundary conditions (if kappa0 > 0).
! For no-slip bottom boundary conditions
- b1 = 1.0 / ((dz(nzc) + d1*a1(nzc)) + k0dt*I_dz_int(nzc+1))
+ b1 = 1.0 / ((hlay(nzc) + d1*a1(nzc)) + k0dt*I_dz_int(nzc+1))
u(nzc) = b1 * (u0xdz(nzc) + a1(nzc)*u(nzc-1))
v(nzc) = b1 * (v0xdz(nzc) + a1(nzc)*v(nzc-1))
! For insulating boundary conditions
- b1 = 1.0 / (dz(nzc) + d1*a1(nzc))
+ b1 = 1.0 / (hlay(nzc) + d1*a1(nzc))
T(nzc) = b1 * (T0xdz(nzc) + a1(nzc)*T(nzc-1))
Sal(nzc) = b1 * (S0xdz(nzc) + a1(nzc)*Sal(nzc-1))
do k=nzc-1,1,-1
@@ -779,9 +832,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
enddo
else
! This is correct, but probably unnecessary.
- b1 = 1.0 / (dz(1) + k0dt*I_dz_int(2))
+ b1 = 1.0 / (hlay(1) + k0dt*I_dz_int(2))
u(1) = b1 * u0xdz(1) ; v(1) = b1 * v0xdz(1)
- b1 = 1.0 / dz(1)
+ b1 = 1.0 / hlay(1)
T(1) = b1 * T0xdz(1) ; Sal(1) = b1 * S0xdz(1)
endif
@@ -791,33 +844,66 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! layers have thin cells, and the total thickness adds up properly.
! The top- and bottom- interfaces have zero thickness, consistent with
! adding additional zero thickness layers.
- dz_Int(1) = 0.0 ; dz_Int(2) = dz(1)
+ h_Int(1) = 0.0 ; h_Int(2) = hlay(1)
+ dz_Int(1) = 0.0 ; dz_Int(2) = dz_lay(1)
do K=2,nzc-1
- Norm = 1.0 / (dz(k)*(dz(k-1)+dz(k+1)) + 2.0*dz(k-1)*dz(k+1))
- dz_Int(K) = dz_Int(K) + dz(k) * ( ((dz(k)+dz(k+1)) * dz(k-1)) * Norm)
- dz_Int(K+1) = dz(k) * ( ((dz(k-1)+dz(k)) * dz(k+1)) * Norm)
+ Norm = 1.0 / (hlay(k)*(hlay(k-1)+hlay(k+1)) + 2.0*hlay(k-1)*hlay(k+1))
+ wt_a = ((hlay(k)+hlay(k+1)) * hlay(k-1)) * Norm
+ wt_b = ((hlay(k-1)+hlay(k)) * hlay(k+1)) * Norm
+ h_Int(K) = h_Int(K) + hlay(k) * wt_a
+ h_Int(K+1) = hlay(k) * wt_b
+ dz_Int(K) = dz_Int(K) + dz_lay(k) * wt_a
+ dz_Int(K+1) = dz_lay(k) * wt_b
enddo
- dz_Int(nzc) = dz_Int(nzc) + dz(nzc) ; dz_Int(nzc+1) = 0.0
+ h_Int(nzc) = h_Int(nzc) + hlay(nzc) ; h_Int(nzc+1) = 0.0
+ dz_Int(nzc) = dz_Int(nzc) + dz_lay(nzc) ; dz_Int(nzc+1) = 0.0
- dist_from_bot = 0.0
- do K=nzc,2,-1
- dist_from_bot = dist_from_bot + dz(k)
- I_L2_bdry(K) = (dist_from_top(K) + dist_from_bot)**2 / &
- (dist_from_top(K) * dist_from_bot)**2
- enddo
+ if (GV%Boussinesq) then
+ do K=1,nzc+1 ; dz_h_Int(K) = GV%H_to_Z ; enddo
+ else
+ ! Find an effective average specific volume around an interface.
+ dz_h_Int(1:nzc+1) = 0.0
+ if (hlay(1) > 0.0) dz_h_Int(1) = dz_lay(1) / hlay(1)
+ do K=2,nzc+1
+ if (h_Int(K) > 0.0) then
+ dz_h_Int(K) = dz_Int(K) / h_Int(K)
+ else
+ dz_h_Int(K) = dz_h_Int(K-1)
+ endif
+ enddo
+ endif
! Calculate thermodynamic coefficients and an initial estimate of N2.
if (use_temperature) then
pressure(1) = surface_pres
do K=2,nzc
- pressure(K) = pressure(K-1) + gR0*dz(k-1)
+ pressure(K) = pressure(K-1) + gR0*hlay(k-1)
T_int(K) = 0.5*(T(k-1) + T(k))
Sal_int(K) = 0.5*(Sal(k-1) + Sal(k))
enddo
- call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, dbuoy_dS, &
- tv%eqn_of_state, (/2,nzc/), scale=-g_R0 )
- else
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, dbuoy_dS, &
+ tv%eqn_of_state, (/2,nzc/), scale=-g_R0 )
+ else
+ ! These should perhaps be combined into a single call to calculate the thermal expansion
+ ! and haline contraction coefficients?
+ call calculate_specific_vol_derivs(T_int, Sal_int, pressure, dSpV_dT, dSpV_dS, &
+ tv%eqn_of_state, (/2,nzc/) )
+ call calculate_density(T_int, Sal_int, pressure, rho_int, tv%eqn_of_state, (/2,nzc/) )
+ do K=2,nzc
+ dbuoy_dT(K) = (US%L_to_Z**2 * GV%g_Earth) * (rho_int(K) * dSpV_dT(K))
+ dbuoy_dS(K) = (US%L_to_Z**2 * GV%g_Earth) * (rho_int(K) * dSpV_dS(K))
+ enddo
+ endif
+ elseif (GV%Boussinesq .or. GV%semi_Boussinesq) then
do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo
+ else
+ do K=1,nzc+1 ; dbuoy_dS(K) = 0.0 ; enddo
+ dbuoy_dT(1) = -(US%L_to_Z**2 * GV%g_Earth) / GV%Rlay(1)
+ do K=2,nzc
+ dbuoy_dT(K) = -(US%L_to_Z**2 * GV%g_Earth) / (0.5*(GV%Rlay(k-1) + GV%Rlay(k)))
+ enddo
+ dbuoy_dT(nzc+1) = -(US%L_to_Z**2 * GV%g_Earth) / GV%Rlay(nzc)
endif
! N2_debug(1) = 0.0 ; N2_debug(nzc+1) = 0.0
@@ -828,7 +914,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! enddo
! This call just calculates N2 and S2.
- call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, &
+ call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, hlay, I_dz_int, dbuoy_dT, dbuoy_dS, &
CS%vel_underflow, u, v, T, Sal, N2, S2, GV, US)
! ----------------------------------------------------
! Iterate
@@ -839,8 +925,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
kappa_avg(K) = 0.0 ; tke_avg(K) = 0.0
local_src_avg(K) = 0.0
! Use the grid spacings to scale errors in the source.
- if ( dz_Int(K) > 0.0 ) &
- local_src_avg(K) = 0.1 * k0dt * I_dz_int(K) / dz_Int(K)
+ if ( h_Int(K) > 0.0 ) &
+ local_src_avg(K) = 0.1 * k0dt * I_dz_int(K) / h_Int(K)
enddo
! call cpu_clock_end(id_clock_setup)
@@ -853,7 +939,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! ----------------------------------------------------
! call cpu_clock_begin(id_clock_KQ)
- call find_kappa_tke(N2, S2, kappa, Idz, dz_Int, I_L2_bdry, f2, &
+ call find_kappa_tke(N2, S2, kappa, Idz, h_Int, dz_Int, dz_h_Int, I_L2_bdry, f2, &
nzc, CS, GV, US, K_Q, tke, kappa_out, kappa_src, local_src)
! call cpu_clock_end(id_clock_KQ)
@@ -891,7 +977,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! timestep is found long before the minimum is reached, so the
! value of max_KS_it may be unimportant, especially if it is large
! enough.
- call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, dz, I_dz_int, &
+ call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, hlay, I_dz_int, &
dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, &
T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa)
valid_dt = .true.
@@ -924,7 +1010,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
if ((dt_test < dt_rem) .and. valid_dt) then
dt_inc = 0.5*dt_test
do itt_dt=1,dt_refinements
- call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), nzc, dz, &
+ call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), nzc, hlay, &
I_dz_int, dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, T_test, S_test, &
N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa)
valid_dt = .true.
@@ -973,14 +1059,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
! call cpu_clock_end(id_clock_avg)
else
! call cpu_clock_begin(id_clock_project)
- call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, &
+ call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, hlay, I_dz_int, &
dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, &
T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa)
! call cpu_clock_end(id_clock_project)
! call cpu_clock_begin(id_clock_KQ)
do K=1,nzc+1 ; K_Q_tmp(K) = K_Q(K) ; enddo
- call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, &
+ call find_kappa_tke(N2, S2, kappa_out, Idz, h_Int, dz_Int, dz_h_Int, I_L2_bdry, f2, &
nzc, CS, GV, US, K_Q_tmp, tke_pred, kappa_pred)
! call cpu_clock_end(id_clock_KQ)
@@ -992,13 +1078,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
enddo
! call cpu_clock_begin(id_clock_project)
- call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, &
+ call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, hlay, I_dz_int, &
dbuoy_dT, dbuoy_dS, CS%vel_underflow, u_test, v_test, &
T_test, S_test, N2, S2, GV, US, ks_int=ks_kappa, ke_int=ke_kappa)
! call cpu_clock_end(id_clock_project)
! call cpu_clock_begin(id_clock_KQ)
- call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, &
+ call find_kappa_tke(N2, S2, kappa_out, Idz, h_Int, dz_Int, dz_h_Int, I_L2_bdry, f2, &
nzc, CS, GV, US, K_Q, tke_pred, kappa_pred)
! call cpu_clock_end(id_clock_KQ)
@@ -1016,7 +1102,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, &
if (dt_rem > 0.0) then
! Update the values of u, v, T, Sal, N2, and S2 for the next iteration.
! call cpu_clock_begin(id_clock_project)
- call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, &
+ call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, hlay, I_dz_int, &
dbuoy_dT, dbuoy_dS, CS%vel_underflow, u, v, T, Sal, N2, S2, &
GV, US)
! call cpu_clock_end(id_clock_project)
@@ -1036,15 +1122,15 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int
integer, intent(in) :: nz !< The number of layers (after eliminating massless
!! layers?).
real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces,
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or Pa s].
real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [L T-1 ~> m s-1].
real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [L T-1 ~> m s-1].
real, dimension(nz), intent(in) :: T0 !< The initial temperature [C ~> degC].
real, dimension(nz), intent(in) :: S0 !< The initial salinity [S ~> ppt].
real, intent(in) :: dt !< The time step [T ~> s].
- real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m].
- real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses
- !! [Z-1 ~> m-1].
+ real, dimension(nz), intent(in) :: dz !< The layer thicknesses [H ~> m or kg m-2]
+ real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the distance between succesive
+ !! layer centers [Z-1 ~> m-1].
real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with
!! temperature [Z T-2 C-1 ~> m s-2 degC-1].
real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with
@@ -1065,9 +1151,9 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int
! Local variables
real, dimension(nz+1) :: c1 ! A tridiagonal variable [nondim]
- real :: a_a, a_b ! Tridiagonal coupling coefficients [Z ~> m]
- real :: b1, b1nz_0 ! Tridiagonal variables [Z-1 ~> m-1]
- real :: bd1 ! A term in the denominator of b1 [Z ~> m]
+ real :: a_a, a_b ! Tridiagonal coupling coefficients [H ~> m or kg m-2]
+ real :: b1, b1nz_0 ! Tridiagonal variables [H-1 ~> m-1 or m2 kg-1]
+ real :: bd1 ! A term in the denominator of b1 [H ~> m or kg m-2]
real :: d1 ! A tridiagonal variable [nondim]
integer :: k, ks, ke
@@ -1161,17 +1247,21 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int
end subroutine calculate_projected_state
!> This subroutine calculates new, consistent estimates of TKE and kappa.
-subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
+subroutine find_kappa_tke(N2, S2, kappa_in, Idz, h_Int, dz_Int, dz_h_Int, I_L2_bdry, f2, &
nz, CS, GV, US, K_Q, tke, kappa, kappa_src, local_src)
integer, intent(in) :: nz !< The number of layers to work on.
real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2].
real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [T-2 ~> s-2].
real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity
- !! [Z2 T-1 ~> m2 s-1].
- real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces
- !! [Z ~> m].
+ !! [H Z T-1 ~> m2 s-1 or Pa s]
+ real, dimension(nz+1), intent(in) :: h_Int !< The thicknesses associated with interfaces
+ !! [H ~> m or kg m-2]
+ real, dimension(nz+1), intent(in) :: dz_Int !< The vertical distances around interfaces [Z ~> m]
+ real, dimension(nz+1), intent(in) :: dz_h_Int !< The ratio of the vertical distances to the
+ !! thickness around an interface [Z H-1 ~> nondim or m3 kg-1].
+ !! In non-Boussinesq mode this is the specific volume.
real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to
- !! boundaries [Z-2 ~> m-2].
+ !! boundaries [H-1 Z-1 ~> m-2 or m kg-1].
real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1].
real, intent(in) :: f2 !< The squared Coriolis parameter [T-2 ~> s-2].
type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure.
@@ -1179,42 +1269,41 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by
!! the turbulent kinetic energy per unit mass at
- !! interfaces [T ~> s].
+ !! interfaces [H T Z-1 ~> s or kg s m-3].
real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at
!! interfaces [Z2 T-2 ~> m2 s-2].
- real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces
- !! [Z2 T-1 ~> m2 s-1].
+ real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces
+ !! [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(nz+1), optional, &
- intent(out) :: kappa_src !< The source term for kappa [T-1 ~> s-1].
+ intent(out) :: kappa_src !< The source term for kappa [T-1 ~> s-1]
real, dimension(nz+1), optional, &
- intent(out) :: local_src !< The sum of all local sources for kappa,
- !! [T-1 ~> s-1].
+ intent(out) :: local_src !< The sum of all local sources for kappa
+ !! [T-1 ~> s-1]
! This subroutine calculates new, consistent estimates of TKE and kappa.
! Local variables
real, dimension(nz) :: &
- aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [Z T-1 ~> m s-1].
+ aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [H T-1 ~> m s-1 or kg m-2 s-1]
dQdz ! Half the partial derivative of TKE with depth [Z T-2 ~> m s-2].
real, dimension(nz+1) :: &
- dK, & ! The change in kappa [Z2 T-1 ~> m2 s-1].
+ dK, & ! The change in kappa [H Z T-1 ~> m2 s-1 or Pa s].
dQ, & ! The change in TKE [Z2 T-2 ~> m2 s-2].
cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and
! hexadiagonal solvers for the TKE and kappa equations [nondim].
- I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale for kappa [Z-2 ~> m-2].
+ I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale for kappa [H-1 Z-1 ~> m-2 or m kg-1]
TKE_decay, & ! The local TKE decay rate [T-1 ~> s-1].
k_src, & ! The source term in the kappa equation [T-1 ~> s-1].
- dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [T ~> s].
- dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [T-1 ~> s-1].
+ dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [Z T H-1 ~> s or m3 s kg-1]
+ dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [H Z-1 T-1 ~> s-1 or kg m-3 s-1]
e1 ! The fractional change in a layer TKE due to a change in the
! TKE of the layer above when all the kappas below are 0 [nondim].
! e1 is nondimensional, and 0 < e1 < 1.
- real :: tke_src ! The net source of TKE due to mixing against the shear
- ! and stratification [Z2 T-3 ~> m2 s-3]. (For convenience,
- ! a term involving the non-dissipation of q0 is also
- ! included here.)
- real :: bQ ! The inverse of the pivot in the tridiagonal equations [T Z-1 ~> s m-1].
+ real :: tke_src ! The net source of TKE due to mixing against the shear and stratification
+ ! [Z2 T-3 ~> m2 s-3] or [H Z T-3 ~> m2 s-3 or kg m-1 s-3].
+ ! (For convenience, a term involving the non-dissipation of q0 is also included here.)
+ real :: bQ ! The inverse of the pivot in the tridiagonal equations [T H-1 ~> s m-1 or m2 s kg-1]
real :: bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1].
- real :: bQd1 ! A term in the denominator of bQ [Z T-1 ~> m s-1].
+ real :: bQd1 ! A term in the denominator of bQ [H T-1 ~> m s-1 or kg m-2 s-1]
real :: bKd1 ! A term in the denominator of bK [Z ~> m].
real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations [nondim].
real :: c_s2 ! The coefficient for the decay of TKE due to
@@ -1227,26 +1316,28 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim]
real :: TKE_min ! The minimum value of shear-driven TKE that can be
! solved for [Z2 T-2 ~> m2 s-2].
- real :: kappa0 ! The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
- real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1].
+ real :: kappa0 ! The background diapycnal diffusivity [H Z T-1 ~> m2 s-1 or Pa s]
+ real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [H Z T-1 ~> m2 s-1 or Pa s]
- real :: eden1, eden2 ! Variables used in calculating e1 [Z-1 ~> m-1]
- real :: I_eden ! The inverse of the denominator in e1 [Z ~> m]
+ real :: eden1, eden2 ! Variables used in calculating e1 [H Z-2 ~> m-1 or kg m-4]
+ real :: I_eden ! The inverse of the denominator in e1 [Z2 H-1 ~> m or m4 kg-1]
real :: ome ! Variables used in calculating e1 [nondim]
- real :: diffusive_src ! The diffusive source in the kappa equation [Z T-1 ~> m s-1].
+ real :: diffusive_src ! The diffusive source in the kappa equation [H T-1 ~> m s-1 or kg m-2 s-1]
real :: chg_by_k0 ! The value of k_src that leads to an increase of
- ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1].
+ ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1]
+ real :: h_dz_here ! The ratio of the thicknesses to the vertical distances around an interface
+ ! [H Z-1 ~> nondim or kg m-3]. In non-Boussinesq mode this is the density.
- real :: kappa_mean ! A mean value of kappa [Z2 T-1 ~> m2 s-1].
+ real :: kappa_mean ! A mean value of kappa [H Z T-1 ~> m2 s-1 or Pa s]
real :: Newton_test ! The value of relative error that will cause the next
! iteration to use Newton's method [nondim].
! Temporary variables used in the Newton's method iterations.
real :: decay_term_k ! The decay term in the diffusivity equation [Z-1 ~> m-1]
- real :: decay_term_Q ! The decay term in the TKE equation - proportional to [T-1 ~> s-1]
+ real :: decay_term_Q ! The decay term in the TKE equation - proportional to [H Z-1 T-1 ~> s-1 or kg m-3 s-1]
real :: I_Q ! The inverse of TKE [T2 Z-2 ~> s2 m-2]
- real :: kap_src ! A source term in the kappa equation [Z T-1 ~> m s-1]
- real :: v1 ! A temporary variable proportional to [T-1 ~> s-1]
- real :: v2 ! A temporary variable in [Z T-2 ~> m s-2]
+ real :: kap_src ! A source term in the kappa equation [H T-1 ~> m s-1 or kg m-2 s-1]
+ real :: v1 ! A temporary variable proportional to [H Z-1 T-1 ~> s-1 or kg m-3 s-1]
+ real :: v2 ! A temporary variable in [Z T-2 ~> m s-2]
real :: tol_err ! The tolerance for max_err that determines when to
! stop iterating [nondim].
real :: Newton_err ! The tolerance for max_err that determines when to
@@ -1270,11 +1361,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! These variables are used only for debugging.
logical, parameter :: debug_soln = .false.
- real :: K_err_lin ! The imbalance in the K equation [Z T-1 ~> m s-1]
- real :: Q_err_lin ! The imbalance in the Q equation [Z2 T-3 ~> m2 s-3]
+ real :: K_err_lin ! The imbalance in the K equation [H T-1 ~> m s-1 or kg m-2 s-1]
+ real :: Q_err_lin ! The imbalance in the Q equation [H Z T-3 ~> m2 s-3 or kg m-1 s-3]
real, dimension(nz+1) :: &
- I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2].
- kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1].
+ I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [H-1 Z-1 ~> m-2 or m kg-1].
+ kappa_prev, & ! The value of kappa at the start of the current iteration [H Z T-1 ~> m2 s-1 or Pa s]
TKE_prev ! The value of TKE at the start of the current iteration [Z2 T-2 ~> m2 s-2].
c_N2 = CS%C_N**2 ; c_S2 = CS%C_S**2
@@ -1332,14 +1423,14 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! k-1, the final changes in TKE are related by dQ(K+1) = e1(K+1)*dQ(K).
eden2 = kappa0 * Idz(nz)
if (tke_noflux_bottom_BC) then
- eden1 = dz_Int(nz+1)*TKE_decay(nz+1)
+ eden1 = h_Int(nz+1)*TKE_decay(nz+1)
I_eden = 1.0 / (eden2 + eden1)
e1(nz+1) = eden2 * I_eden ; ome = eden1 * I_eden
else
e1(nz+1) = 0.0 ; ome = 1.0
endif
do k=nz,2,-1
- eden1 = dz_Int(K)*TKE_decay(K) + ome * eden2
+ eden1 = h_Int(K)*TKE_decay(K) + ome * eden2
eden2 = kappa0 * Idz(k-1)
I_eden = 1.0 / (eden2 + eden1)
e1(K) = eden2 * I_eden ; ome = eden1 * I_eden ! = 1-e1
@@ -1369,20 +1460,20 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
enddo
dQ(1) = -TKE(1)
if (tke_noflux_top_BC) then
- tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0
- bQd1 = dz_Int(1) * TKE_decay(1)
+ tke_src = dz_h_Int(1)*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0
+ bQd1 = h_Int(1) * TKE_decay(1)
bQ = 1.0 / (bQd1 + aQ(1))
- tke(1) = bQ * (dz_Int(1)*tke_src)
+ tke(1) = bQ * (h_Int(1)*tke_src)
cQ(2) = aQ(1) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ
else
tke(1) = q0 ; cQ(2) = 0.0 ; cQcomp = 1.0
endif
do K=2,ke_tke-1
dQ(K) = -TKE(K)
- tke_src = (kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K)
- bQd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*K_Q(K)) + cQcomp*aQ(k-1)
+ tke_src = dz_h_Int(K)*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K)
+ bQd1 = h_Int(K)*(TKE_decay(K) + dz_h_Int(K)*N2(K)*K_Q(K)) + cQcomp*aQ(k-1)
bQ = 1.0 / (bQd1 + aQ(k))
- tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1))
+ tke(K) = bQ * (h_Int(K)*tke_src + aQ(k-1)*tke(K-1))
cQ(K+1) = aQ(k) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ
enddo
if ((ke_tke == nz+1) .and. .not.(tke_noflux_bottom_BC)) then
@@ -1390,18 +1481,18 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
dQ(nz+1) = 0.0
else
k = ke_tke
- tke_src = kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0
+ tke_src = dz_h_Int(K)*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0
if (K == nz+1) then
dQ(K) = -TKE(K)
- bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1))
- tke(K) = max(TKE_min, bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)))
+ bQ = 1.0 / (h_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1))
+ tke(K) = max(TKE_min, bQ * (h_Int(K)*tke_src + aQ(k-1)*tke(K-1)))
dQ(K) = tke(K) + dQ(K)
else
- bQ = 1.0 / ((dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) + aQ(k))
+ bQ = 1.0 / ((h_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) + aQ(k))
cQ(K+1) = aQ(k) * bQ
! Account for all changes deeper in the water column.
dQ(K) = -TKE(K)
- tke(K) = max((bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) + &
+ tke(K) = max((bQ * (h_Int(K)*tke_src + aQ(k-1)*tke(K-1)) + &
cQ(K+1)*(tke(K+1) - e1(K+1)*tke(K))) / (1.0 - cQ(K+1)*e1(K+1)), TKE_min)
dQ(K) = tke(K) + dQ(K)
@@ -1431,17 +1522,17 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
dK(1) = 0.0 ! kappa takes boundary values of 0.
cK(2) = 0.0 ; cKcomp = 1.0
- if (itt == 1) then ; dO K=2,nz
- I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K)
+ if (itt == 1) then ; do K=2,nz
+ I_Ld2(K) = dz_h_Int(K)*(N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K)
enddo ; endif
do K=2,nz
dK(K) = -kappa(K)
if (itt>1) &
- I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K)
- bKd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1)
+ I_Ld2(K) = dz_h_Int(K)*(N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K)
+ bKd1 = h_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1)
bK = 1.0 / (bKd1 + Idz(k))
- kappa(K) = bK * (Idz(k-1)*kappa(K-1) + dz_Int(K) * K_src(K))
+ kappa(K) = bK * (Idz(k-1)*kappa(K-1) + h_Int(K) * K_src(K))
cK(K+1) = Idz(k) * bK ; cKcomp = bKd1 * bK ! = 1 - cK(K+1)
! Neglect values that are smaller than kappa_trunc.
@@ -1481,12 +1572,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1)
dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1)
if (tke_noflux_top_BC) then
- tke_src = dz_Int(1) * (kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - &
+ tke_src = h_Int(1) * (kappa0*dz_h_Int(1)*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - &
aQ(1) * (TKE(1) - TKE(2))
- bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1))
+ bQ = 1.0 / (aQ(1) + h_Int(1)*TKE_decay(1))
cQ(2) = aQ(1) * bQ
- cQcomp = (dz_Int(1)*TKE_decay(1)) * bQ ! = 1 - cQ(2)
+ cQcomp = (h_Int(1)*TKE_decay(1)) * bQ ! = 1 - cQ(2)
dQmdK(2) = -dQdz(1) * bQ
dQ(1) = bQ * tke_src
else
@@ -1494,14 +1585,14 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
endif
do K=2,nz
I_Q = 1.0 / TKE(K)
- I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K)
+ I_Ld2(K) = (N2(K)*Ilambda2 + f2) * dz_h_Int(K)*I_Q + I_L2_bdry(K)
- kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa(K)) + &
+ kap_src = h_Int(K) * (K_src(K) - I_Ld2(K)*kappa(K)) + &
Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1))
! Ensure that the pivot is always positive, and that 0 <= cK <= 1.
! Otherwise do not use Newton's method.
- decay_term_k = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K)
+ decay_term_k = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + h_Int(K)*I_Ld2(K)
if (decay_term_k < 0.0) then ; abort_Newton = .true. ; exit ; endif
bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term_k)
@@ -1527,8 +1618,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! Solve for dQ(K)...
aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k)
dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k)
- tke_src = dz_Int(K) * (((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - &
- (TKE(k) - q0)*TKE_decay(k)) - &
+ tke_src = h_Int(K) * ((dz_h_Int(K) * ((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K))) - &
+ (TKE(k) - q0)*TKE_decay(k)) - &
(aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K)))
v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1)
v2 = (v1*dQmdK(K) + dQdz(k-1)*cK(K)) + &
@@ -1536,7 +1627,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! Ensure that the pivot is always positive, and that 0 <= cQ <= 1.
! Otherwise do not use Newton's method.
- decay_term_Q = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K)
+ decay_term_Q = h_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K)
if (decay_term_Q < 0.0) then ; abort_Newton = .true. ; exit ; endif
bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q))
@@ -1559,11 +1650,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0
if (tke_noflux_bottom_BC) then
K = nz+1
- tke_src = dz_Int(K) * (kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + &
+ tke_src = h_Int(K) * (kappa0*dz_h_Int(K)*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + &
aQ(k-1) * (TKE(K-1) - TKE(K))
v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1)
- decay_term_Q = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K))
+ decay_term_Q = max(0.0, h_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K))
if (decay_term_Q < 0.0) then
abort_Newton = .true.
else
@@ -1583,9 +1674,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
if (debug_soln .and. (K < nz+1)) then
! Ignore this source?
aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k)
- ! tke_src_norm = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - &
+ ! tke_src_norm = ((kappa0*dz_Int(K)*S2(K) - h_Int(K)*(TKE(K)-q0)*TKE_decay(K)) - &
! (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / &
- ! (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K)))
+ ! (aQ(k) + (aQ(k-1) + h_Int(K)*TKE_decay(K)))
endif
dK(K) = 0.0
! Ensure that TKE+dQ will not drop below 0.5*TKE.
@@ -1624,23 +1715,24 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
! The unit conversions here have not been carefully tested.
if (debug_soln) then ; do K=2,nz
! In these equations, K_err_lin and Q_err_lin should be at round-off levels
- ! compared with the dominant terms, perhaps, dz_Int*I_Ld2*kappa and
- ! dz_Int*TKE_decay*TKE. The exception is where, either 1) the decay term has been
+ ! compared with the dominant terms, perhaps, h_Int*I_Ld2*kappa and
+ ! h_Int*TKE_decay*TKE. The exception is where, either 1) the decay term has been
! been increased to ensure a positive pivot, or 2) negative TKEs have been
! truncated, or 3) small or negative kappas have been rounded toward 0.
I_Q = 1.0 / TKE(K)
- I_Ld2_debug(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K)
+ I_Ld2_debug(K) = (N2(K)*Ilambda2 + f2) * dz_h_Int(K)*I_Q + I_L2_bdry(K)
- kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa_prev(K)) + &
+ kap_src = h_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + &
(Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - &
Idz(k)*(kappa_prev(k)-kappa_prev(k+1)))
K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + &
- dz_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - &
+ h_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - &
dz_Int(K)*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K)
- tke_src = dz_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - &
- kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - &
- (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K)))
+ h_dz_here = 0.0 ; if (abs(dz_h_Int(K)) > 0.0) h_dz_here = 1.0 / dz_h_Int(K)
+ tke_src = h_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - &
+ kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*h_dz_here*TKE_decay(K)) - &
+ (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K)))
Q_err_lin = tke_src + (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - &
0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - &
0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + &
@@ -1700,11 +1792,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, &
local_src(1) = 0.0 ; local_src(nz+1) = 0.0
do K=2,nz
diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + Idz(k)*(kappa(K+1)-kappa(K))
- chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / dz_Int(K) + I_Ld2(K))
+ chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / h_Int(K) + I_Ld2(K))
if (diffusive_src <= 0.0) then
local_src(K) = K_src(K) + chg_by_k0
else
- local_src(K) = (K_src(K) + chg_by_k0) + diffusive_src / dz_Int(K)
+ local_src(K) = (K_src(K) + chg_by_k0) + diffusive_src / h_Int(K)
endif
enddo
endif
@@ -1789,17 +1881,17 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS)
"The background diffusivity that is used to smooth the "//&
"density and shear profiles before solving for the "//&
"diffusivities. The default is the greater of KD and 1e-7 m2 s-1.", &
- units="m2 s-1", default=kappa_0_default*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, &
+ units="m2 s-1", default=kappa_0_default*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T, &
do_not_log=just_read)
call get_param(param_file, mdl, "KD_SEED_KAPPA_SHEAR", CS%kappa_seed, &
"A moderately large seed value of diapycnal diffusivity that is used as a "//&
"starting turbulent diffusivity in the iterations to find an energetically "//&
"constrained solution for the shear-driven diffusivity.", &
- units="m2 s-1", default=1.0, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=1.0, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "KD_TRUNC_KAPPA_SHEAR", CS%kappa_trunc, &
"The value of shear-driven diffusivity that is considered negligible "//&
"and is rounded down to 0. The default is 1% of KD_KAPPA_SHEAR_0.", &
- units="m2 s-1", default=0.01*CS%kappa_0*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, &
+ units="m2 s-1", default=0.01*CS%kappa_0*GV%HZ_T_to_m2_s, scale=GV%m2_s_to_HZ_T, &
do_not_log=just_read)
call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, &
"The nondimensional curvature of the function of the "//&
@@ -1906,7 +1998,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS)
CS%diag => diag
CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear', diag%axesTi, Time, &
- 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
CS%id_TKE = register_diag_field('ocean_model','TKE_shear', diag%axesTi, Time, &
'Shear-driven Turbulent Kinetic Energy', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2)
diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90
index 77de5d13cd..61a7a0c7d0 100644
--- a/src/parameterizations/vertical/MOM_opacity.F90
+++ b/src/parameterizations/vertical/MOM_opacity.F90
@@ -128,13 +128,13 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_
! Make sure there is no division by 0.
inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_Z, &
- GV%H_to_Z*GV%H_subroundoff)
+ GV%dZ_subroundoff)
if ( CS%Opacity_scheme == DOUBLE_EXP ) then
!$OMP parallel do default(shared)
do k=1,nz ; do j=js,je ; do i=is,ie
optics%opacity_band(1,i,j,k) = inv_sw_pen_scale
optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, &
- 0.1*GV%Angstrom_Z, GV%H_to_Z*GV%H_subroundoff)
+ 0.1*GV%Angstrom_Z, GV%dZ_subroundoff)
enddo ; enddo ; enddo
if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then
!$OMP parallel do default(shared)
@@ -422,7 +422,7 @@ function opacity_morel(chl_data)
!> This sets the penetrating shortwave fraction according to the scheme proposed by
!! Morel and Antoine (1994).
function SW_pen_frac_morel(chl_data)
- real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3.
+ real, intent(in) :: chl_data !< The chlorophyll-A concentration [mg m-3]
real :: SW_pen_frac_morel !< The returned penetrating shortwave fraction [nondim]
! The following are coefficients for the optical model taken from Morel and
@@ -451,7 +451,7 @@ function opacity_manizza(chl_data)
!> This subroutine returns a 2-d slice at constant j of fields from an optics_type, with the potential
!! for rescaling these fields.
-subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_top, penSW_scale)
+subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_top, penSW_scale, SpV_avg)
type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities
!! and shortwave fluxes.
integer, intent(in) :: j !< j-index to extract
@@ -459,33 +459,47 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(max(optics%nbands,1),SZI_(G),SZK_(GV)), &
optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer [Z-1 ~> m-1],
- !! but with units that can be altered by opacity_scale.
+ !! but with units that can be altered by opacity_scale
+ !! and the presence of SpV_avg to change this to other
+ !! units like [H-1 ~> m-1 or m2 kg-1]
real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity [nondim] or
!! [Z H-1 ~> 1 or m3 kg-1]
real, dimension(max(optics%nbands,1),SZI_(G)), &
optional, intent(out) :: penSW_top !< The shortwave radiation [Q R Z T-1 ~> W m-2]
!! at the surface in each of the nbands bands
!! that penetrates beyond the surface skin layer.
- real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux [nondim]?
+ real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux [nondim]
+ !! or other units.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ optional, intent(in) :: SpV_avg !< The layer-averaged specific volume [R-1 ~> m3 kg-1]
+ !! that is used along with opacity_scale in non-Boussinesq
+ !! cases to change the opacity from distance based units to
+ !! mass-based units
! Local variables
- real :: scale_opacity, scale_penSW ! Rescaling factors [nondim]?
+ real :: scale_opacity ! A rescaling factor for opacity [nondim], or the same units as opacity_scale.
+ real :: scale_penSW ! A rescaling factor for the penetrating shortwave radiation [nondim] or the
+ ! same units as penSW_scale
integer :: i, is, ie, k, nz, n
is = G%isc ; ie = G%iec ; nz = GV%ke
scale_opacity = 1.0 ; if (present(opacity_scale)) scale_opacity = opacity_scale
scale_penSW = 1.0 ; if (present(penSW_scale)) scale_penSW = penSW_scale
- if (present(opacity)) then ; do k=1,nz ; do i=is,ie
- do n=1,optics%nbands
- opacity(n,i,k) = scale_opacity * optics%opacity_band(n,i,j,k)
- enddo
- enddo ; enddo ; endif
+ if (present(opacity)) then
+ if (present(SpV_avg)) then
+ do k=1,nz ; do i=is,ie ; do n=1,optics%nbands
+ opacity(n,i,k) = (scale_opacity * SpV_avg(i,j,k)) * optics%opacity_band(n,i,j,k)
+ enddo ; enddo ; enddo
+ else
+ do k=1,nz ; do i=is,ie ; do n=1,optics%nbands
+ opacity(n,i,k) = scale_opacity * optics%opacity_band(n,i,j,k)
+ enddo ; enddo ; enddo
+ endif
+ endif
- if (present(penSW_top)) then ; do k=1,nz ; do i=is,ie
- do n=1,optics%nbands
- penSW_top(n,i) = scale_penSW * optics%sw_pen_band(n,i,j)
- enddo
+ if (present(penSW_top)) then ; do i=is,ie ; do n=1,optics%nbands
+ penSW_top(n,i) = scale_penSW * optics%sw_pen_band(n,i,j)
enddo ; enddo ; endif
end subroutine extract_optics_slice
@@ -594,7 +608,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l
real :: SW_trans ! fraction of shortwave radiation that is not
! absorbed in a layer [nondim]
real :: unabsorbed ! fraction of the shortwave radiation that
- ! is not absorbed because the layers are too thin
+ ! is not absorbed because the layers are too thin [nondim]
real :: Ih_limit ! inverse of the total depth at which the
! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1]
real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2]
@@ -793,13 +807,15 @@ end subroutine absorbRemainingSW
!> This subroutine calculates the total shortwave heat flux integrated over
!! bands as a function of depth. This routine is only called for computing
!! buoyancy fluxes for use in KPP. This routine does not update the state.
-subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, &
+subroutine sumSWoverBands(G, GV, US, h, dz, nsw, optics, j, dt, &
H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZK_(GV)), &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
+ real, dimension(SZI_(G),SZK_(GV)), &
+ intent(in) :: dz !< Layer vertical extent [Z ~> m].
integer, intent(in) :: nsw !< The number of bands of penetrating shortwave
!! radiation, perhaps from optics_nbands(optics),
type(optics_type), intent(in) :: optics !< An optics structure that has values
@@ -877,7 +893,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, &
if (h(i,k) > 0.0) then
do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then
! SW_trans is the SW that is transmitted THROUGH the layer
- opt_depth = h(i,k)*GV%H_to_Z * optics%opacity_band(n,i,j,k)
+ opt_depth = dz(i,k) * optics%opacity_band(n,i,j,k)
exp_OD = exp(-opt_depth)
SW_trans = exp_OD
@@ -960,11 +976,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics)
real :: PenSW_absorb_minthick ! A thickness that is used to absorb the remaining shortwave heat
! flux when that flux drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2]
real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m]
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags
integer :: isd, ied, jsd, jed, nz, n
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke
@@ -1065,24 +1077,12 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated expressions for "//&
- "handling the absorption of small remaining shortwave fluxes.", &
- default=default_2018_answers)
- ! Revise inconsistent default answer dates for optics.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "OPTICS_ANSWER_DATE", optics%answer_date, &
"The vintage of the order of arithmetic and expressions in the optics calculations. "//&
"Values below 20190101 recover the answers from the end of 2018, while "//&
- "higher values use updated and more robust forms of the same expressions. "//&
- "If both OPTICS_2018_ANSWERS and OPTICS_ANSWER_DATE are "//&
- "specified, the latter takes precedence.", default=default_answer_date)
-
+ "higher values use updated and more robust forms of the same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) optics%answer_date = max(optics%answer_date, 20230701)
call get_param(param_file, mdl, "PEN_SW_FLUX_ABSORB", optics%PenSW_flux_absorb, &
"A minimum remaining shortwave heating rate that will be simply absorbed in "//&
diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90
index 5380b4cda0..b00238f60c 100644
--- a/src/parameterizations/vertical/MOM_regularize_layers.F90
+++ b/src/parameterizations/vertical/MOM_regularize_layers.F90
@@ -576,14 +576,14 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS)
trim(mesg), .true.)
fatal_error = .true.
endif
- if (abs(Th_tot1(i) - Th_tot2(i)) > 1e-12*(Th_tot1(i)+10.0*h_tot1(i))) then
+ if (abs(Th_tot1(i) - Th_tot2(i)) > 1e-12*abs(Th_tot1(i) + 10.0*US%degC_to_C*h_tot1(i))) then
write(mesg,'(ES11.4," became ",ES11.4," diff ",ES11.4," int diff ",ES11.4)') &
Th_tot1(i), Th_tot2(i), (Th_tot1(i) - Th_tot2(i)), (Th_tot1(i) - Th_tot3(i))
call MOM_error(WARNING, "regularize_surface: Heat non-conservation."//&
trim(mesg), .true.)
fatal_error = .true.
endif
- if (abs(Sh_tot1(i) - Sh_tot2(i)) > 1e-12*(Sh_tot1(i)+10.0*h_tot1(i))) then
+ if (abs(Sh_tot1(i) - Sh_tot2(i)) > 1e-12*abs(Sh_tot1(i) + 10.0*US%ppt_to_S*h_tot1(i))) then
write(mesg,'(ES11.4," became ",ES11.4," diff ",ES11.4," int diff ",ES11.4)') &
Sh_tot1(i), Sh_tot2(i), (Sh_tot1(i) - Sh_tot2(i)), (Sh_tot1(i) - Sh_tot3(i))
call MOM_error(WARNING, "regularize_surface: Salinity non-conservation."//&
@@ -719,10 +719,6 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS)
# include "version_variable.h"
character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
logical :: just_read
integer :: isd, ied, jsd, jed
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -760,23 +756,13 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231, do_not_log=just_read)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101), do_not_log=just_read)
- call get_param(param_file, mdl, "REGULARIZE_LAYERS_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the answers "//&
- "from the end of 2018. Otherwise, use updated and more robust forms of the "//&
- "same expressions.", default=default_2018_answers, do_not_log=just_read)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REGULARIZE_LAYERS_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the regularize "//&
"layers calculations. Values below 20190101 recover the answers from the "//&
"end of 2018, while higher values use updated and more robust forms of the "//&
- "same expressions. If both REGULARIZE_LAYERS_2018_ANSWERS and "//&
- "REGULARIZE_LAYERS_ANSWER_DATE are specified, the latter takes precedence.", &
- default=default_answer_date)
+ "same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
endif
call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, &
diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90
index 0dec7a40c0..3de5ad1162 100644
--- a/src/parameterizations/vertical/MOM_set_diffusivity.F90
+++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90
@@ -22,6 +22,7 @@ module MOM_set_diffusivity
use MOM_forcing_type, only : forcing, optics_type
use MOM_full_convection, only : full_convection
use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz, find_rho_bottom
use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss
use MOM_intrinsic_functions, only : invcosh
use MOM_io, only : slasher, MOM_read_data
@@ -77,17 +78,19 @@ module MOM_set_diffusivity
real :: BBL_effic !< efficiency with which the energy extracted
!! by bottom drag drives BBL diffusion [nondim]
real :: cdrag !< quadratic drag coefficient [nondim]
- real :: IMax_decay !< inverse of a maximum decay scale for
- !! bottom-drag driven turbulence [Z-1 ~> m-1].
- real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1].
- real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
- real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
- real :: Kd_max !< maximum increment for diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
+ real :: dz_BBL_avg_min !< A minimal distance over which to average to determine the average
+ !! bottom boundary layer density [Z ~> m]
+ real :: IMax_decay !< Inverse of a maximum decay scale for
+ !! bottom-drag driven turbulence [H-1 ~> m-1 or m2 kg-1].
+ real :: Kv !< The interior vertical viscosity [H Z T-1 ~> m2 s-1 or Pa s]
+ real :: Kd !< interior diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: Kd_min !< minimum diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: Kd_max !< maximum increment for diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
!! Set to a negative value to have no limit.
real :: Kd_add !< uniform diffusivity added everywhere without
- !! filtering or scaling [Z2 T-1 ~> m2 s-1].
+ !! filtering or scaling [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: Kd_smooth !< Vertical diffusivity used to interpolate more
- !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1].
+ !! sensible values of T & S into thin layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing
logical :: limit_dissipation !< If enabled, dissipation is limited to be larger
@@ -96,7 +99,7 @@ module MOM_set_diffusivity
real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [R Z2 T-3 ~> W m-3]
real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [R Z2 T-2 ~> J m-3]
real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [R Z2 T-1 ~> J s m-3]
- real :: dissip_Kd_min !< Minimum Kd [Z2 T-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2
+ real :: dissip_Kd_min !< Minimum Kd [H Z T-1 ~> m2 s-1 or kg m-1 s-1], with dissipation Rho0*Kd_min*N^2
real :: omega !< Earth's rotation frequency [T-1 ~> s-1]
logical :: ML_radiation !< allow a fraction of TKE available from wind work
@@ -112,8 +115,8 @@ module MOM_set_diffusivity
!! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2),
!! where N2 is the squared buoyancy frequency [T-2 ~> s-2] and OMEGA2
!! is the rotation rate of the earth squared.
- real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence
- !! radiated from the base of the mixed layer [Z2 T-1 ~> m2 s-1].
+ real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence radiated from
+ !! the base of the mixed layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real :: ML_rad_efold_coeff !< Coefficient to scale penetration depth [nondim]
real :: ML_rad_coeff !< Coefficient which scales MSTAR*USTAR^3 to obtain energy
!! available for mixing below mixed layer base [nondim]
@@ -148,8 +151,8 @@ module MOM_set_diffusivity
logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that
!! does not rely on a layer-formulation.
real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering [nondim]
- real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1]
- real :: Kv_molecular !< Molecular viscosity for double diffusive convection [Z2 T-1 ~> m2 s-1]
+ real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: Kv_molecular !< Molecular viscosity for double diffusive convection [H Z T-1 ~> m2 s-1 or Pa s]
integer :: answer_date !< The vintage of the order of arithmetic and expressions in this module's
!! calculations. Values below 20190101 recover the answers from the
@@ -178,19 +181,19 @@ module MOM_set_diffusivity
type diffusivity_diags
real, pointer, dimension(:,:,:) :: &
N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [T-2 ~> s-2]
- Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 T-1 ~> m2 s-1]
- Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 T-1 ~> m2 s-1]
+ Kd_user => NULL(), & !< user-added diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [R Z3 T-3 ~> W m-2]
- maxTKE => NULL(), & !< energy required to entrain to h_max [Z3 T-3 ~> m3 s-3]
- Kd_bkgnd => NULL(), & !< Background diffusivity at interfaces [Z2 T-1 ~> m2 s-1]
- Kv_bkgnd => NULL(), & !< Viscosity from background diffusivity at interfaces [Z2 T-1 ~> m2 s-1]
- KT_extra => NULL(), & !< Double diffusion diffusivity for temperature [Z2 T-1 ~> m2 s-1].
- KS_extra => NULL(), & !< Double diffusion diffusivity for salinity [Z2 T-1 ~> m2 s-1].
+ maxTKE => NULL(), & !< energy required to entrain to h_max [H Z2 T-3 ~> m3 s-3 or W m-2]
+ Kd_bkgnd => NULL(), & !< Background diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kv_bkgnd => NULL(), & !< Viscosity from background diffusivity at interfaces [H Z T-1 ~> m2 s-1 or Pa s]
+ KT_extra => NULL(), & !< Double diffusion diffusivity for temperature [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ KS_extra => NULL(), & !< Double diffusion diffusivity for salinity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
drho_rat => NULL() !< The density difference ratio used in double diffusion [nondim].
real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL()
!< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE
!! dissipated within a layer and Kd in that layer
- !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]
+ !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]
end type diffusivity_diags
@@ -224,22 +227,26 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
!! boundary layer properties and related fields.
real, intent(in) :: dt !< Time increment [T ~> s].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 T-1 ~> m2 s-1].
+ intent(out) :: Kd_int !< Diapycnal diffusivity at each interface
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
type(set_diffusivity_CS), pointer :: CS !< Module control structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- optional, intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1].
+ optional, intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
optional, intent(out) :: Kd_extra_T !< The extra diffusivity at interfaces of
- !! temperature due to double diffusion relative to
- !! the diffusivity of density [Z2 T-1 ~> m2 s-1].
+ !! temperature due to double diffusion relative
+ !! to the diffusivity of density
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
optional, intent(out) :: Kd_extra_S !< The extra diffusivity at interfaces of
- !! salinity due to double diffusion relative to
- !! the diffusivity of density [Z2 T-1 ~> m2 s-1].
+ !! salinity due to double diffusion relative
+ !! to the diffusivity of density
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
! local variables
- real, dimension(SZI_(G)) :: &
- N2_bot ! bottom squared buoyancy frequency [T-2 ~> s-2]
+ real :: N2_bot(SZI_(G)) ! Bottom squared buoyancy frequency [T-2 ~> s-2]
+ real :: rho_bot(SZI_(G)) ! In situ near-bottom density [T-2 ~> s-2]
type(diffusivity_diags) :: dd ! structure with arrays of available diags
@@ -249,19 +256,20 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
real, dimension(SZI_(G),SZK_(GV)) :: &
N2_lay, & !< Squared buoyancy frequency associated with layers [T-2 ~> s-2]
- Kd_lay_2d, & !< The layer diffusivities [Z2 T-1 ~> m2 s-1]
- maxTKE, & !< Energy required to entrain to h_max [Z3 T-3 ~> m3 s-3]
+ Kd_lay_2d, & !< The layer diffusivities [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ dz, & !< Height change across layers [Z ~> m]
+ maxTKE, & !< Energy required to entrain to h_max [H Z2 T-3 ~> m3 s-3 or W m-2]
TKE_to_Kd !< Conversion rate (~1.0 / (G_Earth + dRho_lay)) between
!< TKE dissipated within a layer and Kd in that layer
- !< [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]
+ !< [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]
real, dimension(SZI_(G),SZK_(GV)+1) :: &
N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2]
- Kd_int_2d, & !< The interface diffusivities [Z2 T-1 ~> m2 s-1]
- Kv_bkgnd, & !< The background diffusion related interface viscosities [Z2 T-1 ~> m2 s-1]
+ Kd_int_2d, & !< The interface diffusivities [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ Kv_bkgnd, & !< The background diffusion related interface viscosities [H Z T-1 ~> m2 s-1 or Pa s]
dRho_int, & !< Locally referenced potential density difference across interfaces [R ~> kg m-3]
- KT_extra, & !< Double diffusion diffusivity of temperature [Z2 T-1 ~> m2 s-1]
- KS_extra !< Double diffusion diffusivity of salinity [Z2 T-1 ~> m2 s-1]
+ KT_extra, & !< Double diffusion diffusivity of temperature [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ KS_extra !< Double diffusion diffusivity of salinity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: dissip ! local variable for dissipation calculations [Z2 R T-3 ~> W m-3]
real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2]
@@ -274,7 +282,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
integer :: i, j, k, is, ie, js, je, nz, isd, ied, jsd, jed
- real :: kappa_dt_fill ! diffusivity times a timestep used to fill massless layers [Z2 ~> m2]
+ real :: kappa_dt_fill ! diffusivity times a timestep used to fill massless layers [H Z ~> m2 or kg m-1]
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
@@ -289,7 +297,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
if (CS%answer_date < 20190101) then
! These hard-coded dimensional parameters are being replaced.
- kappa_dt_fill = US%m_to_Z**2 * 1.e-3 * 7200.
+ kappa_dt_fill = 1.e-3*GV%m2_s_to_HZ_T * 7200.*US%s_to_T
else
kappa_dt_fill = CS%Kd_smooth * dt
endif
@@ -340,14 +348,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
call cpu_clock_begin(id_clock_kappaShear)
if (CS%Vertex_shear) then
call full_convection(G, GV, US, h, tv, T_f, S_f, fluxes%p_surf, &
- (GV%Z_to_H**2)*kappa_dt_fill, halo=1)
+ kappa_dt_fill, halo=1)
call calc_kappa_shear_vertex(u, v, h, T_f, S_f, tv, fluxes%p_surf, visc%Kd_shear, &
visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp)
if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations
if (CS%debug) then
- call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s)
- call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z2_T_to_m2_s)
+ call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%HZ_T_to_m2_s)
+ call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%HZ_T_to_m2_s)
call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2)
endif
else
@@ -355,8 +363,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, &
visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp)
if (CS%debug) then
- call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s)
- call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s)
+ call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%HZ_T_to_m2_s)
+ call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%HZ_T_to_m2_s)
call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2)
endif
endif
@@ -366,8 +374,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
!NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside.
call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, US, CS%CVMix_shear_CSp)
if (CS%debug) then
- call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s)
- call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s)
+ call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%HZ_T_to_m2_s)
+ call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%HZ_T_to_m2_s)
endif
elseif (associated(visc%Kv_shear)) then
visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled
@@ -380,7 +388,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
call hchksum(tv%S, "before vert_fill_TS tv%S", G%HI, scale=US%S_to_ppt)
call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m)
endif
- call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV, larger_h_denom=.true.)
+ call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV, US, larger_h_denom=.true.)
if (CS%debug) then
call hchksum(tv%T, "after vert_fill_TS tv%T", G%HI, scale=US%C_to_degC)
call hchksum(tv%S, "after vert_fill_TS tv%S", G%HI, scale=US%S_to_ppt)
@@ -392,13 +400,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
! be an appropriate place to add a depth-dependent parameterization or another explicit
! parameterization of Kd.
- !$OMP parallel do default(shared) private(dRho_int,N2_lay,Kd_lay_2d,Kd_int_2d,Kv_bkgnd,N2_int,&
- !$OMP N2_bot,KT_extra,KS_extra,TKE_to_Kd,maxTKE,dissip,kb)&
+ !$OMP parallel do default(shared) private(dRho_int,N2_lay,Kd_lay_2d,Kd_int_2d,Kv_bkgnd,N2_int,dz, &
+ !$OMP N2_bot,rho_bot,KT_extra,KS_extra,TKE_to_Kd,maxTKE,dissip,kb) &
!$OMP if(.not. CS%use_CVMix_ddiff)
do j=js,je
! Set up variables related to the stratification.
- call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, N2_lay, N2_int, N2_bot)
+ call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, N2_lay, N2_int, N2_bot, rho_bot)
if (associated(dd%N2_3d)) then
do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo
@@ -426,12 +434,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering
Kd_lay_2d(i,k-1) = Kd_lay_2d(i,k-1) + 0.5 * KT_extra(i,K)
Kd_lay_2d(i,k) = Kd_lay_2d(i,k) + 0.5 * KT_extra(i,K)
- Kd_extra_S(i,j,K) = (KS_extra(i,K) - KT_extra(i,K))
+ Kd_extra_S(i,j,K) = KS_extra(i,K) - KT_extra(i,K)
Kd_extra_T(i,j,K) = 0.0
elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection
Kd_lay_2d(i,k-1) = Kd_lay_2d(i,k-1) + 0.5 * KS_extra(i,K)
Kd_lay_2d(i,k) = Kd_lay_2d(i,k) + 0.5 * KS_extra(i,K)
- Kd_extra_T(i,j,K) = (KT_extra(i,K) - KS_extra(i,K))
+ Kd_extra_T(i,j,K) = KT_extra(i,K) - KS_extra(i,K)
Kd_extra_S(i,j,K) = 0.0
else ! There is no double diffusion at this interface.
Kd_extra_T(i,j,K) = 0.0
@@ -492,25 +500,29 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
enddo ; enddo
endif
+ if (CS%ML_radiation .or. CS%use_tidal_mixing .or. associated(dd%Kd_work)) then
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+ endif
+
! Add the ML_Rad diffusivity.
- if (CS%ML_radiation) &
- call add_MLrad_diffusivity(h, fluxes, j, Kd_int_2d, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d)
+ if (CS%ML_radiation) then
+ call add_MLrad_diffusivity(dz, fluxes, tv, j, Kd_int_2d, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d)
+ endif
! Add the Nikurashin and / or tidal bottom-driven mixing
if (CS%use_tidal_mixing) &
- call calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, &
+ call calculate_tidal_mixing(dz, j, N2_bot, rho_bot, N2_lay, N2_int, TKE_to_Kd, &
maxTKE, G, GV, US, CS%tidal_mixing, &
CS%Kd_max, visc%Kv_slow, Kd_lay_2d, Kd_int_2d)
-
! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag.
if (CS%bottomdraglaw .and. (CS%BBL_effic > 0.0)) then
if (CS%use_LOTW_BBL_diffusivity) then
- call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int_2d, G, GV, US, CS, &
- dd%Kd_BBL, Kd_lay_2d)
+ call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Rho_bot, Kd_int_2d, &
+ G, GV, US, CS, dd%Kd_BBL, Kd_lay_2d)
else
call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
- maxTKE, kb, G, GV, US, CS, Kd_lay_2d, Kd_int_2d, dd%Kd_BBL)
+ maxTKE, kb, rho_bot, G, GV, US, CS, Kd_lay_2d, Kd_int_2d, dd%Kd_BBL)
endif
endif
@@ -525,7 +537,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett
CS%dissip_N2 * N2_int(i,K)) ! Floor of Kd_min*rho0/F_Ri
Kd_int_2d(i,K) = max(Kd_int_2d(i,K) , & ! Apply floor to Kd
- dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))))
+ dissip * (CS%FluxRi_max / (GV%H_to_RZ * (N2_int(i,K) + Omega2))))
enddo ; enddo
endif
@@ -550,14 +562,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett
CS%dissip_N2 * N2_lay(i,k)) ! Floor of Kd_min*rho0/F_Ri
Kd_lay_2d(i,k) = max(Kd_lay_2d(i,k) , & ! Apply floor to Kd
- dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))))
+ dissip * (CS%FluxRi_max / (GV%H_to_RZ * (N2_lay(i,k) + Omega2))))
enddo ; enddo
endif
if (associated(dd%Kd_work)) then
do k=1,nz ; do i=is,ie
- dd%Kd_Work(i,j,k) = GV%Rho0 * Kd_lay_2d(i,k) * N2_lay(i,k) * &
- GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3
+ dd%Kd_Work(i,j,k) = GV%H_to_RZ * Kd_lay_2d(i,k) * N2_lay(i,k) * dz(i,k) ! Watt m-2 = kg s-3
enddo ; enddo
endif
@@ -580,18 +591,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
endif
if (CS%debug) then
- if (present(Kd_lay)) call hchksum(Kd_lay, "Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ if (present(Kd_lay)) call hchksum(Kd_lay, "Kd_lay", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
- if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
if (CS%use_CVMix_ddiff) then
- call hchksum(Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
- call hchksum(Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
+ call hchksum(Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
+ call hchksum(Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s)
endif
if (allocated(visc%kv_bbl_u) .and. allocated(visc%kv_bbl_v)) then
call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, &
- haloshift=0, symmetric=.true., scale=US%Z2_T_to_m2_s, &
+ haloshift=0, symmetric=.true., scale=GV%HZ_T_to_m2_s, &
scalar_pair=.true.)
endif
@@ -602,7 +613,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i
endif
if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) then
- call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m*US%s_to_T)
+ call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=GV%H_to_m*US%s_to_T)
endif
endif
@@ -673,9 +684,9 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, &
!! TKE dissipated within a layer and the
!! diapycnal diffusivity within that layer,
!! usually (~Rho_0 / (G_Earth * dRho_lay))
- !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]
- real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain
- !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3]
+ !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]
+ real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain to its
+ !! maximum realizable thickness [H Z2 T-3 ~> m3 s-3 or W m-2]
integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer
!! layer, or -1 without a bulk mixed layer.
! Local variables
@@ -687,27 +698,30 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, &
! across an interface times the difference across the
! interface above it [nondim]
rho_0, & ! Layer potential densities relative to surface pressure [R ~> kg m-3]
+ dz, & ! Height change across layers [Z ~> m]
maxEnt ! maxEnt is the maximum value of entrainment from below (with
! compensating entrainment from above to keep the layer
! density from changing) that will not deplete all of the
- ! layers above or below a layer within a timestep [Z ~> m].
+ ! layers above or below a layer within a timestep [H ~> m or kg m-2].
real, dimension(SZI_(G)) :: &
htot, & ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL [Z ~> m].
- mFkb, & ! total thickness in the mixed and buffer layers times ds_dsp1 [Z ~> m].
+ ! integrated thickness in the BBL [H ~> m or kg m-2].
+ mFkb, & ! total thickness in the mixed and buffer layers times ds_dsp1 [H ~> m or kg m-2]
p_ref, & ! array of tv%P_Ref pressures [R L2 T-2 ~> Pa]
Rcv_kmb, & ! coordinate density in the lowest buffer layer [R ~> kg m-3]
p_0 ! An array of 0 pressures [R L2 T-2 ~> Pa]
real :: dh_max ! maximum amount of entrainment a layer could undergo before
- ! entraining all fluid in the layers above or below [Z ~> m].
+ ! entraining all fluid in the layers above or below [H ~> m or kg m-2]
real :: dRho_lay ! density change across a layer [R ~> kg m-3]
real :: Omega2 ! rotation rate squared [T-2 ~> s-2]
- real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density [Z T-2 R-1 ~> m4 s-2 kg-1]
- real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z T-2 R-1 ~> m4 s-2 kg-1]
- real :: I_Rho0 ! inverse of Boussinesq reference density [R-1 ~> m3 kg-1]
+ real :: grav ! Gravitational acceleration [Z T-1 ~> m s-2]
+ real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density
+ ! [Z R-1 T-2 ~> m4 s-2 kg-1]
+ real :: G_IRho0 ! Alternate calculation of G_Rho0 with thickness rescaling factors
+ ! [Z2 T-2 R-1 H-1 ~> m4 s-2 kg-1 or m7 kg-2 s-2]
real :: I_dt ! 1/dt [T-1 ~> s-1]
- real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2]
+ real :: dz_neglect ! A negligibly small height change [Z ~> m]
real :: hN2pO2 ! h (N^2 + Omega^2), in [Z T-2 ~> m s-2].
logical :: do_i(SZI_(G))
@@ -717,25 +731,28 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, &
I_dt = 1.0 / dt
Omega2 = CS%omega**2
- H_neglect = GV%H_subroundoff
- G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0)
+ dz_neglect = GV%dZ_subroundoff
+ grav = (US%L_to_Z**2 * GV%g_Earth)
+ G_Rho0 = grav / GV%Rho0
if (CS%answer_date < 20190101) then
- I_Rho0 = 1.0 / (GV%Rho0)
- G_IRho0 = (US%L_to_Z**2 * GV%g_Earth) * I_Rho0
+ G_IRho0 = grav * GV%H_to_Z**2 * GV%RZ_to_H
else
- G_IRho0 = G_Rho0
+ G_IRho0 = GV%H_to_Z*G_Rho0
endif
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
! Simple but coordinate-independent estimate of Kd/TKE
if (CS%simple_TKE_to_Kd) then
do k=1,nz ; do i=is,ie
- hN2pO2 = (GV%H_to_Z * h(i,j,k)) * (N2_lay(i,k) + Omega2) ! Units of Z T-2.
- if (hN2pO2>0.) then
- TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of T2 Z-1.
- else; TKE_to_Kd(i,k) = 0.; endif
+ hN2pO2 = dz(i,k) * (N2_lay(i,k) + Omega2) ! Units of Z T-2.
+ if (hN2pO2 > 0.) then
+ TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of T2 H-1.
+ else ; TKE_to_Kd(i,k) = 0. ; endif
! The maximum TKE conversion we allow is really a statement
! about the upper diffusivity we allow. Kd_max must be set.
- maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of Z3 T-3.
+ maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of H Z2 T-3.
enddo ; enddo
kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA
return
@@ -783,18 +800,17 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, &
if (CS%bulkmixedlayer) then
kmb = GV%nk_rho_varies
do i=is,ie
- htot(i) = GV%H_to_Z*h(i,j,kmb)
+ htot(i) = h(i,j,kmb)
mFkb(i) = 0.0
- if (kb(i) < nz) &
- mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_Z*(h(i,j,kmb) - GV%Angstrom_H))
+ if (kb(i) < nz) mFkb(i) = ds_dsp1(i,kb(i)) * (h(i,j,kmb) - GV%Angstrom_H)
enddo
do k=1,kmb-1 ; do i=is,ie
- htot(i) = htot(i) + GV%H_to_Z*h(i,j,k)
- mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H))
+ htot(i) = htot(i) + h(i,j,k)
+ mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(h(i,j,k) - GV%Angstrom_H)
enddo ; enddo
else
do i=is,i
- maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_Z*(h(i,j,1) - GV%Angstrom_H)
+ maxEnt(i,1) = 0.0 ; htot(i) = h(i,j,1) - GV%Angstrom_H
enddo
endif
do k=kb_min,nz-1 ; do i=is,ie
@@ -806,12 +822,12 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, &
else
maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i))
endif
- htot(i) = htot(i) + GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H)
+ htot(i) = htot(i) + (h(i,j,k) - GV%Angstrom_H)
endif
enddo ; enddo
do i=is,ie
- htot(i) = GV%H_to_Z*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0
+ htot(i) = h(i,j,nz) - GV%Angstrom_H ; maxEnt(i,nz) = 0.0
do_i(i) = (G%mask2dT(i,j) > 0.0)
enddo
do k=nz-1,kb_min,-1
@@ -819,8 +835,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, &
do i=is,ie ; if (do_i(i)) then
if (k Calculate Brunt-Vaisala frequency, N^2.
subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
- N2_lay, N2_int, N2_bot)
+ N2_lay, N2_int, N2_bot, Rho_bot)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -892,24 +914,28 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
real, dimension(SZI_(G),SZK_(GV)), &
intent(out) :: N2_lay !< The squared buoyancy frequency of the layers [T-2 ~> s-2].
real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency [T-2 ~> s-2].
+ real, dimension(SZI_(G)), intent(out) :: Rho_bot !< Near-bottom density [R ~> kg m-3].
+
! Local variables
real, dimension(SZI_(G),SZK_(GV)+1) :: &
+ pres, & ! pressure at each interface [R L2 T-2 ~> Pa]
dRho_int_unfilt, & ! unfiltered density differences across interfaces [R ~> kg m-3]
dRho_dT, & ! partial derivative of density wrt temp [R C-1 ~> kg m-3 degC-1]
dRho_dS ! partial derivative of density wrt saln [R S-1 ~> kg m-3 ppt-1]
-
+ real, dimension(SZI_(G),SZK_(GV)) :: &
+ dz ! Height change across layers [Z ~> m]
real, dimension(SZI_(G)) :: &
- pres, & ! pressure at each interface [R L2 T-2 ~> Pa]
Temp_int, & ! temperature at each interface [C ~> degC]
Salin_int, & ! salinity at each interface [S ~> ppt]
drho_bot, & ! A density difference [R ~> kg m-3]
h_amp, & ! The topographic roughness amplitude [Z ~> m].
- hb, & ! The thickness of the bottom layer [Z ~> m].
- z_from_bot ! The hieght above the bottom [Z ~> m].
+ dz_BBL_avg, & ! The distance over which to average to find the near-bottom density [Z ~> m]
+ hb, & ! The thickness of the bottom layer [H ~> m or kg m-2]
+ z_from_bot ! The height above the bottom [Z ~> m]
- real :: dz_int ! thickness associated with an interface [Z ~> m].
- real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density
- ! times some unit conversion factors [Z T-2 R-1 ~> m4 s-2 kg-1].
+ real :: dz_int ! Vertical distance associated with an interface [Z ~> m]
+ real :: G_Rho0 ! Gravitational acceleration, perhaps divided by Boussinesq reference density,
+ ! times some unit conversion factors [H T-2 R-1 ~> m4 s-2 kg-1 or m s-2].
real :: H_neglect ! A negligibly small thickness [H ~> m or kg m-2]
logical :: do_i(SZI_(G)), do_any
@@ -917,7 +943,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
integer :: i, k, is, ie, nz
is = G%isc ; ie = G%iec ; nz = GV%ke
- G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0
+ G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%H_to_RZ
H_neglect = GV%H_subroundoff
! Find the (limited) density jump across each interface.
@@ -927,24 +953,24 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
enddo
if (associated(tv%eqn_of_state)) then
if (associated(fluxes%p_surf)) then
- do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo
+ do i=is,ie ; pres(i,1) = fluxes%p_surf(i,j) ; enddo
else
- do i=is,ie ; pres(i) = 0.0 ; enddo
+ do i=is,ie ; pres(i,1) = 0.0 ; enddo
endif
EOSdom(:) = EOS_domain(G%HI)
do K=2,nz
do i=is,ie
- pres(i) = pres(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1)
+ pres(i,K) = pres(i,K-1) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1)
Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1))
Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1))
enddo
- call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:,K), dRho_dS(:,K), &
+ call calculate_density_derivs(Temp_int, Salin_int, pres(:,K), dRho_dT(:,K), dRho_dS(:,K), &
tv%eqn_of_state, EOSdom)
do i=is,ie
dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + &
dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0)
dRho_int_unfilt(i,K) = max(dRho_dT(i,K)*(tv%T(i,j,k) - tv%T(i,j,k-1)) + &
- dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0)
+ dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0)
enddo
enddo
else
@@ -953,21 +979,24 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
enddo ; enddo
endif
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
! Set the buoyancy frequencies.
do k=1,nz ; do i=is,ie
N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / &
- (GV%H_to_Z*(h(i,j,k) + H_neglect))
+ (h(i,j,k) + H_neglect)
enddo ; enddo
do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo
do K=2,nz ; do i=is,ie
N2_int(i,K) = G_Rho0 * dRho_int(i,K) / &
- (0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k) + H_neglect))
+ (0.5*(h(i,j,k-1) + h(i,j,k) + H_neglect))
enddo ; enddo
! Find the bottom boundary layer stratification, and use this in the deepest layers.
do i=is,ie
hb(i) = 0.0 ; dRho_bot(i) = 0.0 ; h_amp(i) = 0.0
- z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz)
+ z_from_bot(i) = 0.5*dz(i,nz)
do_i(i) = (G%mask2dT(i,j) > 0.0)
enddo
if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing)
@@ -975,16 +1004,16 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
do k=nz,2,-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1))
+ dz_int = 0.5*(dz(i,k) + dz(i,k-1))
z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above
- hb(i) = hb(i) + dz_int
+ hb(i) = hb(i) + 0.5*(h(i,j,k) + h(i,j,k-1))
drho_bot(i) = drho_bot(i) + dRho_int(i,K)
if (z_from_bot(i) > h_amp(i)) then
if (k>2) then
! Always include at least one full layer.
- hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2))
+ hb(i) = hb(i) + 0.5*(h(i,j,k-1) + h(i,j,k-2))
drho_bot(i) = drho_bot(i) + dRho_int(i,K-1)
endif
do_i(i) = .false.
@@ -999,14 +1028,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
if (hb(i) > 0.0) then
N2_bot(i) = (G_Rho0 * drho_bot(i)) / hb(i)
else ; N2_bot(i) = 0.0 ; endif
- z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz)
+ z_from_bot(i) = 0.5*dz(i,nz)
do_i(i) = (G%mask2dT(i,j) > 0.0)
enddo
do k=nz,2,-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1))
+ dz_int = 0.5*(dz(i,k) + dz(i,k-1))
z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above
N2_int(i,K) = N2_bot(i)
@@ -1028,6 +1057,10 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, &
enddo ; enddo
endif
+ ! Average over the larger of the envelope of the topography or a minimal distance.
+ do i=is,ie ; dz_BBL_avg(i) = max(h_amp(i), CS%dz_BBL_avg_min) ; enddo
+ call find_rho_bottom(h, dz, pres, dz_BBL_avg, tv, j, G, GV, US, Rho_bot)
+
end subroutine find_N2
!> This subroutine sets the additional diffusivities of temperature and
@@ -1055,10 +1088,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd)
type(set_diffusivity_CS), pointer :: CS !< Module control structure.
real, dimension(SZI_(G),SZK_(GV)+1), &
intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal
- !! diffusivity for temp [Z2 T-1 ~> m2 s-1].
+ !! diffusivity for temp [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZK_(GV)+1), &
intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal
- !! diffusivity for saln [Z2 T-1 ~> m2 s-1].
+ !! diffusivity for saln [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G)) :: &
dRho_dT, & ! partial derivatives of density with respect to temperature [R C-1 ~> kg m-3 degC-1]
@@ -1072,7 +1105,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd)
real :: Rrho ! vertical density ratio [nondim]
real :: diff_dd ! factor for double-diffusion [nondim]
- real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 T-1 ~> m2 s-1]
+ real :: Kd_dd ! The dominant double diffusive diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: prandtl ! flux ratio for diffusive convection regime [nondim]
real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio [nondim]
@@ -1124,8 +1157,8 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd)
end subroutine double_diffusion
!> This routine adds diffusion sustained by flow energy extracted by bottom drag.
-subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
- maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, Kd_BBL)
+subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, maxTKE, &
+ kb, rho_bot, G, GV, US, CS, Kd_lay, Kd_int, Kd_BBL)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -1142,20 +1175,23 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
!! boundary layer properties and related fields
integer, intent(in) :: j !< j-index of row to work on
real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE
- !! TKE dissipated within a layer and the
+ !! TKE dissipated within a layer and the
!! diapycnal diffusivity within that layer,
!! usually (~Rho_0 / (G_Earth * dRho_lay))
- !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]
- real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain
- !! to its maximum-realizable thickness [Z3 T-3 ~> m3 s-3]
+ !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain to its
+ !! maximum-realizable thickness [H Z2 T-3 ~> m3 s-3 or W m-2]
integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer
!! layer, or -1 without a bulk mixed layer
+ real, dimension(SZI_(G)), intent(in) :: rho_bot !< In situ density averaged over a near-bottom
+ !! region [R ~> kg m-3]
type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers,
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces,
- !! [Z2 T-1 ~> m2 s-1].
- real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
! This routine adds diffusion sustained by flow energy extracted by bottom drag.
@@ -1163,25 +1199,25 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
Rint ! coordinate density of an interface [R ~> kg m-3]
real, dimension(SZI_(G)) :: &
htot, & ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL [Z ~> m].
- rho_htot, & ! running integral with depth of density [R Z ~> kg m-2]
+ ! integrated thickness in the BBL [H ~> m or kg m-2].
+ rho_htot, & ! running integral with depth of density [R H ~> kg m-2 or kg2 m-5]
gh_sum_top, & ! BBL value of g'h that can be supported by
- ! the local ustar, times R0_g [R Z ~> kg m-2]
+ ! the local ustar, times R0_g [R H ~> kg m-2 or kg2 m-5]
Rho_top, & ! density at top of the BBL [R ~> kg m-3]
TKE, & ! turbulent kinetic energy available to drive
- ! bottom-boundary layer mixing in a layer [Z3 T-3 ~> m3 s-3]
- I2decay ! inverse of twice the TKE decay scale [Z-1 ~> m-1].
+ ! bottom-boundary layer mixing in a layer [H Z2 T-3 ~> m3 s-3 or W m-2]
+ I2decay ! inverse of twice the TKE decay scale [H-1 ~> m-1 or m2 kg-1].
- real :: TKE_to_layer ! TKE used to drive mixing in a layer [Z3 T-3 ~> m3 s-3]
- real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [Z3 T-3 ~> m3 s-3]
- real :: TKE_here ! TKE that goes into mixing in this layer [Z3 T-3 ~> m3 s-3]
+ real :: TKE_to_layer ! TKE used to drive mixing in a layer [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real :: TKE_here ! TKE that goes into mixing in this layer [H Z2 T-3 ~> m3 s-3 or W m-2]
real :: dRl, dRbot ! temporaries holding density differences [R ~> kg m-3]
real :: cdrag_sqrt ! square root of the drag coefficient [nondim]
- real :: ustar_h ! value of ustar at a thickness point [Z T-1 ~> m s-1].
+ real :: ustar_h ! Ustar at a thickness point rescaled into thickness
+ ! flux units [H T-1 ~> m s-1 or kg m-2 s-1].
real :: absf ! average absolute Coriolis parameter around a thickness point [T-1 ~> s-1]
- real :: R0_g ! Rho0 / G_Earth [R T2 Z-1 ~> kg s2 m-4]
- real :: I_rho0 ! 1 / RHO0 [R-1 ~> m3 kg-1]
- real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 T-1 ~> m2 s-1].
+ real :: R0_g ! Rho0 / G_Earth [R T2 H-1 ~> kg s2 m-4 or s2 m-1]
+ real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities
! defined in visc, on the assumption that this
! extracted energy also drives diapycnal mixing.
@@ -1200,8 +1236,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
TKE_Ray = 0.0 ; Rayleigh_drag = .false.
if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) Rayleigh_drag = .true.
- I_Rho0 = 1.0 / (GV%Rho0)
- R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth)
+ R0_g = GV%H_to_RZ / (US%L_to_Z**2 * GV%g_Earth)
do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo
@@ -1212,8 +1247,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
! to be relatively small and is discarded.
do i=is,ie
ustar_h = visc%ustar_BBL(i,j)
- if (associated(fluxes%ustar_tidal)) &
- ustar_h = ustar_h + fluxes%ustar_tidal(i,j)
+ if (associated(fluxes%ustar_tidal)) then
+ if (allocated(tv%SpV_avg)) then
+ ustar_h = ustar_h + GV%RZ_to_H*rho_bot(i) * fluxes%ustar_tidal(i,j)
+ else
+ ustar_h = ustar_h + GV%Z_to_H * fluxes%ustar_tidal(i,j)
+ endif
+ endif
absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + &
(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))))
if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then
@@ -1223,12 +1263,11 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
! If ustar_h = 0, this is land so this value doesn't matter.
I2decay(i) = 0.5*CS%IMax_decay
endif
- TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * &
- visc%TKE_BBL(i,j)
+ TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * exp(-I2decay(i)*h(i,j,nz)) ) * visc%TKE_BBL(i,j)
if (associated(fluxes%TKE_tidal)) &
- TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * &
- (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))))
+ TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * GV%RZ_to_H * &
+ (CS%BBL_effic * exp(-I2decay(i)*h(i,j,nz)))
! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following
! Killworth & Edwards (1999) and Zilitikevich & Mironov (1996).
@@ -1238,16 +1277,16 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
gh_sum_top(i) = R0_g * 400.0 * ustar_h**2
do_i(i) = (G%mask2dT(i,j) > 0.0)
- htot(i) = GV%H_to_Z*h(i,j,nz)
- rho_htot(i) = GV%Rlay(nz)*(GV%H_to_Z*h(i,j,nz))
+ htot(i) = h(i,j,nz)
+ rho_htot(i) = GV%Rlay(nz)*(h(i,j,nz))
Rho_top(i) = GV%Rlay(1)
if (CS%bulkmixedlayer .and. do_i(i)) Rho_top(i) = GV%Rlay(kb(i)-1)
enddo
do k=nz-1,2,-1 ; domore = .false.
do i=is,ie ; if (do_i(i)) then
- htot(i) = htot(i) + GV%H_to_Z*h(i,j,k)
- rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_Z*h(i,j,k))
+ htot(i) = htot(i) + h(i,j,k)
+ rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(h(i,j,k))
if (htot(i)*GV%Rlay(k-1) <= (rho_htot(i) - gh_sum_top(i))) then
! The top of the mixing is in the interface atop the current layer.
Rho_top(i) = (rho_htot(i) - gh_sum_top(i)) / htot(i)
@@ -1266,9 +1305,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
i_rem = i_rem + 1 ! Count the i-rows that are still being worked on.
! Apply vertical decay of the turbulent energy. This energy is
! simply lost.
- TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_Z*(h(i,j,k) + h(i,j,k+1))))
+ TKE(i) = TKE(i) * exp(-I2decay(i) * (h(i,j,k) + h(i,j,k+1)))
-! if (maxEnt(i,k) <= 0.0) cycle
if (maxTKE(i,k) <= 0.0) cycle
! This is an analytic integral where diffusivity is a quadratic function of
@@ -1303,7 +1341,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, &
delta_Kd = CS%Kd_max
Kd_lay(i,k) = Kd_lay(i,k) + delta_Kd
else
- Kd_lay(i,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)
+ Kd_lay(i,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k)
endif
Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd
Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd
@@ -1357,7 +1395,7 @@ end subroutine add_drag_diffusivity
!> Calculates a BBL diffusivity use a Prandtl number 1 diffusivity with a law of the
!! wall turbulent viscosity, up to a BBL height where the energy used for mixing has
!! consumed the mechanical TKE input.
-subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int, &
+subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Rho_bot, Kd_int, &
G, GV, US, CS, Kd_BBL, Kd_lay)
type(ocean_grid_type), intent(in) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -1376,35 +1414,39 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int
integer, intent(in) :: j !< j-index of row to work on
real, dimension(SZI_(G),SZK_(GV)+1), &
intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [T-2 ~> s-2]
+ real, dimension(SZI_(G)), intent(in) :: rho_bot !< In situ density averaged over a near-bottom
+ !! region [R ~> kg m-3]
real, dimension(SZI_(G),SZK_(GV)+1), &
- intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1]
+ intent(inout) :: Kd_int !< Interface net diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
- real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1]
+ real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZK_(GV)), &
- optional, intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1]
+ optional, intent(inout) :: Kd_lay !< Layer net diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
! Local variables
- real :: TKE_column ! net TKE input into the column [Z3 T-3 ~> m3 s-3]
- real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [Z3 T-3 ~> m3 s-3]
- real :: TKE_consumed ! TKE used for mixing in this layer [Z3 T-3 ~> m3 s-3]
- real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [Z3 T-3 ~> m3 s-3]
+ real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
+ real :: TKE_column ! net TKE input into the column [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real :: TKE_consumed ! TKE used for mixing in this layer [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [H Z2 T-3 ~> m3 s-3 or W m-2]
real :: cdrag_sqrt ! square root of the drag coefficient [nondim]
- real :: ustar ! value of ustar at a thickness point [Z T-1 ~> m s-1].
- real :: ustar2 ! square of ustar, for convenience [Z2 T-2 ~> m2 s-2]
+ real :: ustar ! value of ustar at a thickness point [H T-1 ~> m s-1 or kg m-2 s-1].
+ real :: ustar2 ! The square of ustar [H2 T-2 ~> m2 s-2 or kg2 m-4 s-2]
real :: absf ! average absolute value of Coriolis parameter around a thickness point [T-1 ~> s-1]
- real :: dh, dhm1 ! thickness of layers k and k-1, respectively [Z ~> m].
- real :: z_bot ! distance to interface k from bottom [Z ~> m].
- real :: D_minus_z ! distance to interface k from surface [Z ~> m].
- real :: total_thickness ! total thickness of water column [Z ~> m].
- real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height [Z-1 ~> m-1].
- real :: Kd_wall ! Law of the wall diffusivity [Z2 T-1 ~> m2 s-1].
- real :: Kd_lower ! diffusivity for lower interface [Z2 T-1 ~> m2 s-1]
- real :: ustar_D ! u* x D [Z2 T-1 ~> m2 s-1].
- real :: I_Rho0 ! 1 / rho0 [R-1 ~> m3 kg-1]
+ real :: dz_int ! Distance between the center of the layers around an interface [Z ~> m]
+ real :: z_bot ! Distance to interface K from bottom [Z ~> m]
+ real :: h_bot ! Total thickness between interface K and the bottom [H ~> m or kg m-2]
+ real :: D_minus_z ! Distance between interface k and the surface [Z ~> m]
+ real :: total_depth ! Total distance between the seafloor and the sea surface [Z ~> m]
+ real :: Idecay ! Inverse of decay scale used for "Joule heating" loss of TKE with
+ ! height [H-1 ~> m-1 or m2 kg-1].
+ real :: Kd_wall ! Law of the wall diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: Kd_lower ! diffusivity for lower interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: ustar_D ! The extent of the water column times u* [H Z T-1 ~> m2 s-1 or Pa s].
real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall [T-2 ~> s-2]
logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on
! the assumption that this extracted energy also drives diapycnal mixing.
- integer :: i, k, km1
+ integer :: i, k
logical :: do_diag_Kd_BBL
if (.not.(CS%bottomdraglaw .and. (CS%BBL_effic > 0.0))) return
@@ -1416,50 +1458,57 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int
! Determine whether to add Rayleigh drag contribution to TKE
Rayleigh_drag = .false.
if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) Rayleigh_drag = .true.
- I_Rho0 = 1.0 / (GV%Rho0)
cdrag_sqrt = sqrt(CS%cdrag)
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+
do i=G%isc,G%iec ! Developed in single-column mode
! Column-wise parameters.
absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + &
(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator!
- ! u* at the bottom [Z T-1 ~> m s-1].
+ ! u* at the bottom [H T-1 ~> m s-1 or kg m-2 s-1].
ustar = visc%ustar_BBL(i,j)
ustar2 = ustar**2
- ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting
- ! since ustar_BBL should already include all contributions to u*? -AJA
- !### Examine the question of whether there is double counting of fluxes%ustar_tidal.
- if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j)
+ ! In add_drag_diffusivity(), fluxes%ustar_tidal is also added in. There is no
+ ! double-counting because the logic surrounding the calls to add_drag_diffusivity()
+ ! and add_LOTW_BBL_diffusivity() only calls one of the two routines.
+ if (associated(fluxes%ustar_tidal)) then
+ if (allocated(tv%SpV_avg)) then
+ ustar = ustar + GV%RZ_to_H*rho_bot(i) * fluxes%ustar_tidal(i,j)
+ else
+ ustar = ustar + GV%Z_to_H * fluxes%ustar_tidal(i,j)
+ endif
+ endif
! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and
! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter.
Idecay = CS%IMax_decay
if ((ustar > 0.0) .and. (absf > CS%IMax_decay * ustar)) Idecay = absf / ustar
- ! Energy input at the bottom [Z3 T-3 ~> m3 s-3].
- ! (Note that visc%TKE_BBL is in [Z3 T-3 ~> m3 s-3], set in set_BBL_TKE().)
+ ! Energy input at the bottom [H Z2 T-3 ~> m3 s-3 or W m-2].
+ ! (Note that visc%TKE_BBL is in [H Z2 T-3 ~> m3 s-3 or W m-2], set in set_BBL_TKE().)
! I am still unsure about sqrt(cdrag) in this expressions - AJA
TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j)
- ! Add in tidal dissipation energy at the bottom [Z3 T-3 ~> m3 s-3].
+ ! Add in tidal dissipation energy at the bottom [H Z2 T-3 ~> m3 s-3 or W m-2].
! Note that TKE_tidal is in [R Z3 T-3 ~> W m-2].
if (associated(fluxes%TKE_tidal)) &
- TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0
+ TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * GV%RZ_to_H
TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing.
TKE_remaining = TKE_column
- total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_Z ! Total column thickness [Z ~> m].
- ustar_D = ustar * total_thickness
+ total_depth = ( sum(dz(i,:)) + GV%dz_subroundoff ) ! Total column thickness [Z ~> m].
+ ustar_D = ustar * total_depth
+ h_bot = 0.
z_bot = 0.
Kd_lower = 0. ! Diffusivity on bottom boundary.
! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input
! at the bottom.
- do k=GV%ke,2,-1
- dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level [Z ~> m].
- km1 = max(k-1, 1)
- dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above [Z ~> m].
+ do K=GV%ke,2,-1
+ dz_int = 0.5 * (dz(i,k-1) + dz(i,k))
! Add in additional energy input from bottom-drag against slopes (sides)
if (Rayleigh_drag) TKE_remaining = TKE_remaining + &
@@ -1471,23 +1520,24 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int
! Exponentially decay TKE across the thickness of the layer.
! This is energy loss in addition to work done as mixing, apparently to Joule heating.
- TKE_remaining = exp(-Idecay*dh) * TKE_remaining
+ TKE_remaining = exp(-Idecay*h(i,j,k)) * TKE_remaining
- z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom [Z ~> m].
- D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer [Z ~> m].
+ z_bot = z_bot + dz(i,k) ! Distance between upper interface of layer and the bottom [Z ~> m].
+ h_bot = h_bot + h(i,j,k) ! Thickness between upper interface of layer and the bottom [H ~> m or kg m-2].
+ D_minus_z = max(total_depth - z_bot, 0.) ! Thickness above layer [H ~> m or kg m-2].
- ! Diffusivity using law of the wall, limited by rotation, at height z [Z2 T-1 ~> m2 s-1].
+ ! Diffusivity using law of the wall, limited by rotation, at height z [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
! This calculation is at the upper interface of the layer
- if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then
+ if ( ustar_D + absf * ( h_bot * D_minus_z ) == 0.) then
Kd_wall = 0.
else
Kd_wall = ((CS%von_karm * ustar2) * (z_bot * D_minus_z)) &
- / (ustar_D + absf * (z_bot * D_minus_z))
+ / (ustar_D + absf * (h_bot * D_minus_z))
endif
- ! TKE associated with Kd_wall [Z3 T-3 ~> m3 s-3].
- ! This calculation if for the volume spanning the interface.
- TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min)
+ ! TKE associated with Kd_wall [H Z2 T-3 ~> m3 s-3 or W m-2].
+ ! This calculation is for the volume spanning the interface.
+ TKE_Kd_wall = Kd_wall * dz_int * max(N2_int(i,K), N2_min)
! Now bound Kd such that the associated TKE is no greater than available TKE for mixing.
if (TKE_Kd_wall > 0.) then
@@ -1517,43 +1567,49 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int
end subroutine add_LOTW_BBL_diffusivity
!> This routine adds effects of mixed layer radiation to the layer diffusivities.
-subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, Kd_lay)
+subroutine add_MLrad_diffusivity(dz, fluxes, tv, j, Kd_int, G, GV, US, CS, TKE_to_Kd, Kd_lay)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dz !< Height change across layers [Z ~> m]
type(forcing), intent(in) :: fluxes !< Surface fluxes structure
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available
+ !! thermodynamic fields.
integer, intent(in) :: j !< The j-index to work on
real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure
real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE
!! TKE dissipated within a layer and the
!! diapycnal diffusivity witin that layer,
!! usually (~Rho_0 / (G_Earth * dRho_lay))
- !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]
+ !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]
real, dimension(SZI_(G),SZK_(GV)), &
- optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1].
+ optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
! This routine adds effects of mixed layer radiation to the layer diffusivities.
- real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness [Z ~> m].
- real, dimension(SZI_(G)) :: TKE_ml_flux ! Mixed layer TKE flux [Z3 T-3 ~> m3 s-3]
- real, dimension(SZI_(G)) :: I_decay ! A decay rate [Z-1 ~> m-1].
- real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation [Z2 T-1 ~> m2 s-1].
+ real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness [Z ~> m]
+ real, dimension(SZI_(G)) :: TKE_ml_flux ! Mixed layer TKE flux [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real, dimension(SZI_(G)) :: I_decay ! A decay rate [Z-1 ~> m-1].
+ real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation
+ ! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: f_sq ! The square of the local Coriolis parameter or a related variable [T-2 ~> s-2].
- real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2].
+ real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2]
+ real :: u_star_H ! ustar converted to thickness based units [H T-1 ~> m s-1 or kg m-2 s-1]
real :: ustar_sq ! ustar squared [Z2 T-2 ~> m2 s-2]
- real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 T-1 ~> m2 s-1].
+ real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation
+ ! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: I_rho ! The inverse of the reference density times a ratio of scaling
+ ! factors [Z L-1 R-1 ~> m3 kg-1]
real :: C1_6 ! 1/6 [nondim]
real :: Omega2 ! rotation rate squared [T-2 ~> s-2].
real :: z1 ! layer thickness times I_decay [nondim]
- real :: dzL ! thickness converted to heights [Z ~> m].
- real :: I_decay_len2_TKE ! squared inverse decay lengthscale for
- ! TKE, as used in the mixed layer code [Z-2 ~> m-2].
- real :: h_neglect ! negligibly small thickness [Z ~> m].
+ real :: I_decay_len2_TKE ! Squared inverse decay lengthscale for TKE from the bulk mixed
+ ! layer code [Z-2 ~> m-2]
+ real :: dz_neglect ! A negligibly small height change [Z ~> m]
logical :: do_any, do_i(SZI_(G))
integer :: i, k, is, ie, nz, kml
@@ -1562,12 +1618,13 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd,
Omega2 = CS%omega**2
C1_6 = 1.0 / 6.0
kml = GV%nkml
- h_neglect = GV%H_subroundoff*GV%H_to_Z
+ dz_neglect = GV%dz_subroundoff
+ I_rho = US%L_to_Z * GV%H_to_Z * GV%RZ_to_H ! == US%L_to_Z / GV%Rho0 ! This is not used when fully non-Boussinesq.
if (.not.CS%ML_radiation) return
do i=is,ie ; h_ml(i) = 0.0 ; do_i(i) = (G%mask2dT(i,j) > 0.0) ; enddo
- do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_Z*h(i,j,k) ; enddo ; enddo
+ do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + dz(i,k) ; enddo ; enddo
do i=is,ie ; if (do_i(i)) then
if (CS%ML_omega_frac >= 1.0) then
@@ -1579,21 +1636,31 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd,
f_sq = CS%ML_omega_frac * 4.0 * Omega2 + (1.0 - CS%ML_omega_frac) * f_sq
endif
- ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2
-
- TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (fluxes%ustar(i,j)))
+ ! Determine the energy flux out of the mixed layer and its vertical decay scale.
+ if (associated(fluxes%ustar) .and. (GV%Boussinesq .or. .not.associated(fluxes%tau_mag))) then
+ ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2
+ u_star_H = GV%Z_to_H * fluxes%ustar(i,j)
+ elseif (allocated(tv%SpV_avg)) then
+ ustar_sq = max(US%L_to_Z*fluxes%tau_mag(i,j) * tv%SpV_avg(i,j,1), CS%ustar_min**2)
+ u_star_H = GV%RZ_to_H * sqrt(US%L_to_Z*fluxes%tau_mag(i,j) / tv%SpV_avg(i,j,1))
+ else ! This semi-Boussinesq form is mathematically equivalent to the Boussinesq version above.
+ ! Differs at roundoff: ustar_sq = max(fluxes%tau_mag(i,j) * I_rho, CS%ustar_min**2)
+ ustar_sq = max((sqrt(fluxes%tau_mag(i,j) * I_rho))**2, CS%ustar_min**2)
+ u_star_H = GV%RZ_to_H * sqrt(US%L_to_Z*fluxes%tau_mag(i,j) * GV%Rho0)
+ endif
+ TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * u_star_H)
I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq)
if (CS%ML_rad_TKE_decay) &
TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-h_ml(i) * sqrt(I_decay_len2_TKE))
! Calculate the inverse decay scale
- h_ml_sq = (CS%ML_rad_efold_coeff * (h_ml(i)+h_neglect))**2
+ h_ml_sq = (CS%ML_rad_efold_coeff * (h_ml(i)+dz_neglect))**2
I_decay(i) = sqrt((I_decay_len2_TKE * h_ml_sq + 1.0) / h_ml_sq)
! Average the dissipation layer kml+1, using
! a more accurate Taylor series approximations for very thin layers.
- z1 = (GV%H_to_Z*h(i,j,kml+1)) * I_decay(i)
+ z1 = dz(i,kml+1) * I_decay(i)
if (z1 > 1e-5) then
Kd_mlr = TKE_ml_flux(i) * TKE_to_Kd(i,kml+1) * (1.0 - exp(-z1))
else
@@ -1618,16 +1685,16 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd,
do k=kml+2,nz-1
do_any = .false.
do i=is,ie ; if (do_i(i)) then
- dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i)
+ z1 = dz(i,k)*I_decay(i)
if (CS%ML_Rad_bug) then
! These expressions are dimensionally inconsistent. -RWH
! This is supposed to be the integrated energy deposited in the layer,
! not the average over the layer as in these expressions.
if (z1 > 1e-5) then
- Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1
- US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1
+ Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of H Z T-1
+ US%m_to_Z * ((1.0 - exp(-z1)) / dz(i,k)) ! Units of m-1
else
- Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1
+ Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of H Z T-1
US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1
endif
else
@@ -1656,7 +1723,7 @@ end subroutine add_MLrad_diffusivity
!> This subroutine calculates several properties related to bottom
!! boundary layer turbulence.
-subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
+subroutine set_BBL_TKE(u, v, h, tv, fluxes, visc, G, GV, US, CS, OBC)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -1666,6 +1733,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ type(thermo_var_ptrs), intent(in) :: tv !< Structure with pointers to thermodynamic fields
type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes
type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom
!! boundary layer properties and related fields.
@@ -1676,23 +1744,23 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
! boundary layer turbulence.
real, dimension(SZI_(G)) :: &
- htot ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL [Z ~> m].
+ htot ! Running sum of the depth in the BBL [Z ~> m].
real, dimension(SZIB_(G)) :: &
uhtot, & ! running integral of u in the BBL [Z L T-1 ~> m2 s-1]
- ustar, & ! bottom boundary layer turbulence speed [Z T-1 ~> m s-1].
+ ustar, & ! bottom boundary layer piston velocity [H T-1 ~> m s-1 or kg m-2 s-1].
u2_bbl ! square of the mean zonal velocity in the BBL [L2 T-2 ~> m2 s-2]
real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z L T-1 ~> m2 s-1]
real, dimension(SZI_(G),SZJB_(G)) :: &
- vstar, & ! ustar at at v-points [Z T-1 ~> m s-1].
+ vstar, & ! ustar at at v-points [H T-1 ~> m s-1 or kg m-2 s-1].
v2_bbl ! square of average meridional velocity in BBL [L2 T-2 ~> m2 s-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
+ dz ! The vertical distance between interfaces around a layer [Z ~> m]
- real :: cdrag_sqrt ! square root of the drag coefficient [nondim]
- real :: I_cdrag_sqrt ! The inverse of the square root of the drag coefficient [nondim]
- real :: hvel ! thickness at velocity points [Z ~> m].
+ real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]
+ real :: hvel ! thickness at velocity points [Z ~> m]
logical :: domore, do_i(SZI_(G))
integer :: i, j, k, is, ie, js, je, nz
@@ -1726,7 +1794,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
endif
cdrag_sqrt = sqrt(CS%cdrag)
- I_cdrag_sqrt = 0.0 ; if (cdrag_sqrt > 0.0) I_cdrag_sqrt = 1.0 / cdrag_sqrt
+
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
!$OMP parallel default(shared) private(do_i,vhtot,htot,domore,hvel,uhtot,ustar,u2_bbl)
!$OMP do
@@ -1759,12 +1829,12 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
! Compute h based on OBC state
if (has_obc) then
if (OBC%segment(l_seg)%direction == OBC_DIRECTION_N) then
- hvel = GV%H_to_Z*h(i,j,k)
+ hvel = dz(i,j,k)
else
- hvel = GV%H_to_Z*h(i,j+1,k)
+ hvel = dz(i,j+1,k)
endif
else
- hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k))
+ hvel = 0.5*(dz(i,j,k) + dz(i,j+1,k))
endif
if ((htot(i) + hvel) >= visc%bbl_thick_v(i,J)) then
@@ -1780,7 +1850,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
if (.not.domore) exit
enddo
do i=is,ie ; if ((G%mask2dCv(i,J) > 0.0) .and. (htot(i) > 0.0)) then
- v2_bbl(i,J) = (vhtot(i)*vhtot(i))/(htot(i)*htot(i))
+ v2_bbl(i,J) = (vhtot(i)*vhtot(i)) / (htot(i)*htot(i))
else
v2_bbl(i,J) = 0.0
endif ; enddo
@@ -1811,12 +1881,12 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
! Compute h based on OBC state
if (has_obc) then
if (OBC%segment(l_seg)%direction == OBC_DIRECTION_E) then
- hvel = GV%H_to_Z*h(i,j,k)
+ hvel = dz(i,j,k)
else ! OBC_DIRECTION_W
- hvel = GV%H_to_Z*h(i+1,j,k)
+ hvel = dz(i+1,j,k)
endif
else
- hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k))
+ hvel = 0.5*(dz(i,j,k) + dz(i+1,j,k))
endif
if ((htot(I) + hvel) >= visc%bbl_thick_u(I,j)) then
@@ -1832,7 +1902,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC)
if (.not.domore) exit
enddo
do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.0) .and. (htot(i) > 0.0)) then
- u2_bbl(I) = (uhtot(I)*uhtot(I))/(htot(I)*htot(I))
+ u2_bbl(I) = (uhtot(I)*uhtot(I)) / (htot(I)*htot(I))
else
u2_bbl(I) = 0.0
endif ; enddo
@@ -1882,7 +1952,8 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0)
real :: a(SZK_(GV)), a_0(SZK_(GV)) ! nondimensional temporary variables [nondim]
real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures [R L2 T-2 ~> Pa]
real :: Rcv(SZI_(G),SZK_(GV)) ! coordinate density in the mixed and buffer layers [R ~> kg m-3]
- real :: I_Drho ! temporary variable [R-1 ~> m3 kg-1]
+ real :: I_Drho ! The inverse of the coordinate density difference between
+ ! layers [R-1 ~> m3 kg-1]
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
integer :: i, k, k3, is, ie, nz, kmb
@@ -1890,9 +1961,15 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0)
do k=2,nz-1
if (GV%g_prime(k+1) /= 0.0) then
- do i=is,ie
- ds_dsp1(i,k) = GV%g_prime(k) / GV%g_prime(k+1)
- enddo
+ if (GV%Boussinesq .or. GV%Semi_Boussinesq) then
+ do i=is,ie
+ ds_dsp1(i,k) = GV%g_prime(k) / GV%g_prime(k+1)
+ enddo
+ else ! Use a mathematically equivalent form that avoids any dependency on RHO_0.
+ do i=is,ie
+ ds_dsp1(i,k) = (GV%Rlay(k) - GV%Rlay(k-1)) / (GV%Rlay(k+1) - GV%Rlay(k))
+ enddo
+ endif
else
do i=is,ie
ds_dsp1(i,k) = 1.
@@ -1915,7 +1992,11 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0)
! interfaces above and below the buffer layer and the next denser layer.
k = kb(i)
- I_Drho = g_R0 / GV%g_prime(k+1)
+ if (GV%Boussinesq .or. GV%Semi_Boussinesq) then
+ I_Drho = g_R0 / GV%g_prime(k+1)
+ else
+ I_Drho = 1.0 / (GV%Rlay(k+1) - GV%Rlay(k))
+ endif
! The indexing convention for a is appropriate for the interfaces.
do k3=1,kmb
a(k3+1) = (GV%Rlay(k) - Rcv(i,k3)) * I_Drho
@@ -1971,7 +2052,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output.
type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control
!! structure.
- type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control structure
+ type(int_tide_CS), pointer :: int_tide_CSp !< Internal tide control structure
integer, intent(out) :: halo_TS !< The halo size of tracer points that must be
!! valid for the calculations in set_diffusivity.
logical, intent(out) :: double_diffuse !< This indicates whether some version
@@ -1983,17 +2064,15 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
!! surface boundary layer.
! Local variables
- real :: decay_length ! The maximum decay scale for the BBL diffusion [Z ~> m]
+ real :: decay_length ! The maximum decay scale for the BBL diffusion [H ~> m or kg m-2]
logical :: ML_use_omega
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
! This include declares and sets the variable "version".
# include "version_variable.h"
character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name.
real :: vonKar ! The von Karman constant as used for mixed layer viscosity [nondim]
+ real :: Kd_z ! The background diapycnal diffusivity in [Z2 T-1 ~> m2 s-1] for use
+ ! in setting the default for other diffusivities.
real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate
! that is used in place of the absolute value of the local Coriolis
! parameter in the denominator of some expressions [nondim]
@@ -2018,7 +2097,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
CS%diag => diag
- CS%int_tide_CSp => int_tide_CSp
+ if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp
! These default values always need to be set.
CS%BBL_mixing_as_max = .true.
@@ -2041,22 +2120,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "SET_DIFF_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the set diffusivity "//&
"calculations. Values below 20190101 recover the answers from the end of 2018, "//&
- "while higher values use updated and more robust forms of the same expressions. "//&
- "If both SET_DIFF_2018_ANSWERS and SET_DIFF_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "while higher values use updated and more robust forms of the same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used.
CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, &
@@ -2070,7 +2139,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
"length scale.", default=.false.)
if (CS%ML_radiation) then
! This give a minimum decay scale that is typically much less than Angstrom.
- CS%ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + GV%H_subroundoff*GV%H_to_Z)
+ CS%ustar_min = 2e-4 * CS%omega * (GV%Angstrom_Z + GV%dZ_subroundoff)
call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, &
"A coefficient that is used to scale the penetration "//&
@@ -2084,7 +2153,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
"The maximum diapycnal diffusivity due to turbulence "//&
"radiated from the base of the mixed layer. "//&
"This is only used if ML_RADIATION is true.", &
- units="m2 s-1", default=1.0e-3, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=1.0e-3, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, &
"The coefficient which scales MSTAR*USTAR^3 to obtain "//&
"the energy available for mixing below the base of the "//&
@@ -2134,7 +2203,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
"The maximum decay scale for the BBL diffusion, or 0 to allow the mixing "//&
"to penetrate as far as stratification and rotation permit. The default "//&
"for now is 200 m. This is only used if BOTTOMDRAGLAW is true.", &
- units="m", default=200.0, scale=US%m_to_Z)
+ units="m", default=200.0, scale=GV%m_to_H)
CS%IMax_decay = 0.0
if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length
@@ -2162,7 +2231,11 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL
endif
CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, &
- 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
+
+ call get_param(param_file, mdl, "DZ_BBL_AVG_MIN", CS%dz_BBL_avg_min, &
+ "A minimal distance over which to average to determine the average bottom "//&
+ "boundary layer density.", units="m", default=0.0, scale=US%m_to_Z)
TKE_to_Kd_used = (CS%use_tidal_mixing .or. CS%ML_radiation .or. &
(CS%bottomdraglaw .and. .not.CS%use_LOTW_BBL_diffusivity))
@@ -2179,19 +2252,20 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
call get_param(param_file, mdl, "KV", CS%Kv, &
"The background kinematic viscosity in the interior. "//&
"The molecular value, ~1e-6 m2 s-1, may be used.", &
- units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.)
+ units="m2 s-1", scale=GV%m2_s_to_HZ_T, fail_if_missing=.true.)
- call get_param(param_file, mdl, "KD", CS%Kd, &
+ call get_param(param_file, mdl, "KD", Kd_z, &
"The background diapycnal diffusivity of density in the "//&
"interior. Zero or the molecular value, ~1e-7 m2 s-1, "//&
"may be used.", default=0.0, units="m2 s-1", scale=US%m2_s_to_Z2_T)
+ CS%Kd = (GV%m2_s_to_HZ_T*US%Z2_T_to_m2_s) * Kd_z
call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, &
"The minimum diapycnal diffusivity.", &
- units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=0.01*Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, &
"The maximum permitted increment for the diapycnal "//&
"diffusivity from TKE-based parameterizations, or a negative "//&
- "value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T)
+ "value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m2_s_to_HZ_T)
if (CS%simple_TKE_to_Kd) then
if (CS%Kd_max<=0.) call MOM_error(FATAL, &
"set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.")
@@ -2204,14 +2278,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, &
"A uniform diapycnal diffusivity that is added "//&
"everywhere without any filtering or scaling.", &
- units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=0.0, scale=GV%m2_s_to_HZ_T)
if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, &
"set_diffusivity_init: KD_MAX must be set (positive) when "// &
"USE_LOTW_BBL_DIFFUSIVITY=True.")
call get_param(param_file, mdl, "KD_SMOOTH", CS%Kd_smooth, &
"A diapycnal diffusivity that is used to interpolate "//&
"more sensible values of T & S into thin layers.", &
- units="m2 s-1", default=1.0e-6, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "DEBUG", CS%debug, &
"If true, write out verbose debugging data.", &
@@ -2236,29 +2310,29 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
units="J m-3", default=0.0, scale=US%W_m2_to_RZ3_T3*US%Z_to_m*US%s_to_T)
call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, &
"The minimum vertical diffusivity applied as a floor.", &
- units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=0.0, scale=GV%m2_s_to_HZ_T)
CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. &
(CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.)
CS%dissip_N2 = 0.0
if (CS%FluxRi_max > 0.0) &
- CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max
+ CS%dissip_N2 = CS%dissip_Kd_min * GV%H_to_RZ / CS%FluxRi_max
CS%id_Kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, &
- 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s)
+ 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%HZ_T_to_m2_s)
CS%id_Kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, &
- 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s)
+ 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%HZ_T_to_m2_s)
CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, &
- 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
if (CS%use_tidal_mixing) then
CS%id_Kd_Work = register_diag_field('ocean_model', 'Kd_Work', diag%axesTL, Time, &
'Work done by Diapycnal Mixing', 'W m-2', conversion=US%RZ3_T3_to_W_m2)
CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, &
- 'Maximum layer TKE', 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3))
+ 'Maximum layer TKE', 'm3 s-3', conversion=(GV%H_to_m*US%Z_to_m**2*US%s_to_T**3))
CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, &
- 'Convert TKE to Kd', 's2 m', conversion=US%Z2_T_to_m2_s*(US%m_to_Z**3*US%T_to_s**3))
+ 'Convert TKE to Kd', 's2 m', conversion=GV%HZ_T_to_m2_s*(GV%m_to_H*US%m_to_Z**2*US%T_to_s**3))
CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, &
'Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2, cmor_field_name='obvfsq', &
cmor_long_name='Square of seawater buoyancy frequency', &
@@ -2267,7 +2341,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
if (CS%user_change_diff) &
CS%id_Kd_user = register_diag_field('ocean_model', 'Kd_user', diag%axesTi, Time, &
- 'User-specified Extra Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'User-specified Extra Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, &
"If true, increase diffusivites for temperature or salinity based on the "//&
@@ -2280,10 +2354,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
default=2.55, units="nondim")
call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, &
"Maximum salt diffusivity for salt fingering regime.", &
- default=1.e-4, units="m2 s-1", scale=US%m2_s_to_Z2_T)
+ default=1.e-4, units="m2 s-1", scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, &
"Molecular viscosity for calculation of fluxes under double-diffusive "//&
- "convection.", default=1.5e-6, units="m2 s-1", scale=US%m2_s_to_Z2_T)
+ "convection.", default=1.5e-6, units="m2 s-1", scale=GV%m2_s_to_HZ_T)
! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults.
endif ! old double-diffusion
@@ -2321,9 +2395,9 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
if (CS%double_diffusion .or. CS%use_CVMix_ddiff) then
CS%id_KT_extra = register_diag_field('ocean_model', 'KT_extra', diag%axesTi, Time, &
- 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
CS%id_KS_extra = register_diag_field('ocean_model', 'KS_extra', diag%axesTi, Time, &
- 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
endif
if (CS%use_CVMix_ddiff) then
CS%id_R_rho = register_diag_field('ocean_model', 'R_rho', diag%axesTi, Time, &
diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90
index 8200201ee3..b207b1ff1c 100644
--- a/src/parameterizations/vertical/MOM_set_viscosity.F90
+++ b/src/parameterizations/vertical/MOM_set_viscosity.F90
@@ -6,30 +6,30 @@ module MOM_set_visc
use MOM_ALE, only : ALE_CS, ALE_remap_velocities, ALE_remap_interface_vals, ALE_remap_vertex_vals
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
+use MOM_cvmix_conv, only : cvmix_conv_is_used
+use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used
+use MOM_cvmix_shear, only : cvmix_shear_is_used
use MOM_debugging, only : uvchksum, hchksum
use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
use MOM_diag_mediator, only : diag_ctrl, time_type
use MOM_domains, only : pass_var, CORNER
+use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_specific_vol_derivs
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
-use MOM_forcing_type, only : forcing, mech_forcing
+use MOM_forcing_type, only : forcing, mech_forcing, find_ustar
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
-use MOM_io, only : slasher, MOM_read_data
+use MOM_interface_heights, only : thickness_to_dz
+use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc
use MOM_kappa_shear, only : kappa_shear_is_used, kappa_shear_at_vertex
-use MOM_cvmix_shear, only : cvmix_shear_is_used
-use MOM_cvmix_conv, only : cvmix_conv_is_used
-use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used
+use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE, OBC_DIRECTION_E
+use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S
use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS
-use MOM_restart, only : register_restart_field_as_obsolete
+use MOM_restart, only : register_restart_field_as_obsolete, register_restart_pair
use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type
use MOM_verticalGrid, only : verticalGrid_type
-use MOM_EOS, only : calculate_density, calculate_density_derivs
-use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E
-use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S
-use MOM_open_boundary, only : OBC_segment_type
implicit none ; private
@@ -49,6 +49,8 @@ module MOM_set_visc
logical :: initialized = .false. !< True if this control structure has been initialized.
real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2].
!! Runtime parameter `HBBL`.
+ real :: dz_bbl !< The static bottom boundary layer thickness in height units [Z ~> m].
+ !! Runtime parameter `HBBL`.
real :: cdrag !< The quadratic drag coefficient [nondim].
!! Runtime parameter `CDRAG`.
real :: c_Smag !< The Laplacian Smagorinsky coefficient for
@@ -56,14 +58,14 @@ module MOM_set_visc
real :: drag_bg_vel !< An assumed unresolved background velocity for
!! calculating the bottom drag [L T-1 ~> m s-1].
!! Runtime parameter `DRAG_BG_VEL`.
- real :: BBL_thick_min !< The minimum bottom boundary layer thickness [H ~> m or kg m-2].
+ real :: BBL_thick_min !< The minimum bottom boundary layer thickness [Z ~> m].
!! This might be Kv / (cdrag * drag_bg_vel) to give
!! Kv as the minimum near-bottom viscosity.
real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use
!! in calculating the near-surface velocity [H ~> m or kg m-2].
- real :: Htbl_shelf_min !< The minimum surface boundary layer thickness [H ~> m or kg m-2].
- real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 T-1 ~> m2 s-1].
- real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 T-1 ~> m2 s-1].
+ real :: Htbl_shelf_min !< The minimum surface boundary layer thickness [Z ~> m].
+ real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [H Z T-1 ~> m2 s-1 or Pa s]
+ real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [H Z T-1 ~> m2 s-1 or Pa s]
logical :: bottomdraglaw !< If true, the bottom stress is calculated with a
!! drag law c_drag*|u|*u. The velocity magnitude
!! may be an assumed value or it may be based on the
@@ -81,7 +83,7 @@ module MOM_set_visc
!! according to what fraction of the bottom they overlie.
real :: Chan_drag_max_vol !< The maximum bottom boundary layer volume within which the
!! channel drag is applied, normalized by the full cell area,
- !! or a negative value to apply no maximum [H ~> m or kg m-2].
+ !! or a negative value to apply no maximum [Z ~> m].
logical :: correct_BBL_bounds !< If true, uses the correct bounds on the BBL thickness and
!! viscosity so that the bottom layer feels the intended drag.
logical :: RiNo_mix !< If true, use Richardson number dependent mixing.
@@ -91,8 +93,8 @@ module MOM_set_visc
!! thickness of the viscous mixed layer [nondim]
real :: omega !< The Earth's rotation rate [T-1 ~> s-1].
real :: ustar_min !< A minimum value of ustar to avoid numerical
- !! problems [Z T-1 ~> m s-1]. If the value is small enough,
- !! this should not affect the solution.
+ !! problems [H T-1 ~> m s-1 or kg m-2 s-1]. If the value is
+ !! small enough, this should not affect the solution.
real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE
!! decay scale [nondim]
real :: omega_frac !< When setting the decay scale for turbulence, use this
@@ -146,7 +148,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! Local variables
real, dimension(SZIB_(G)) :: &
- ustar, & ! The bottom friction velocity [Z T-1 ~> m s-1].
+ ustar, & ! The bottom friction velocity [H T-1 ~> m s-1 or kg m-2 s-1].
T_EOS, & ! The temperature used to calculate the partial derivatives
! of density with T and S [C ~> degC].
S_EOS, & ! The salinity used to calculate the partial derivatives
@@ -157,9 +159,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! layer with salinity [R S-1 ~> kg m-3 ppt-1].
press, & ! The pressure at which dR_dT and dR_dS are evaluated [R L2 T-2 ~> Pa].
umag_avg, & ! The average magnitude of velocities in the bottom boundary layer [L T-1 ~> m s-1].
- h_bbl_drag ! The thickness over which to apply drag as a body force [H ~> m or kg m-2].
+ h_bbl_drag, & ! The thickness over which to apply drag as a body force [H ~> m or kg m-2].
+ dz_bbl_drag ! The vertical height over which to apply drag as a body force [Z ~> m].
real :: htot ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2].
+ real :: dztot ! Distance from the bottom up to some point [Z ~> m].
real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2].
+ real :: dztot_vel ! Distance from the bottom up to some point [Z ~> m].
real :: Rhtot ! Running sum of thicknesses times the layer potential
! densities [H R ~> kg m-2 or kg2 m-5].
@@ -177,31 +182,49 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! direction [H ~> m or kg m-2].
h_vel, & ! Arithmetic mean of the layer thicknesses adjacent to a
! velocity point [H ~> m or kg m-2].
+ dz_at_vel, & ! Vertical extent of a layer, using an upwind-biased
+ ! second order accurate estimate based on the previous velocity
+ ! direction [Z ~> m].
+ dz_vel, & ! Arithmetic mean of the difference in across the layers adjacent
+ ! to a velocity point [Z ~> m].
T_vel, & ! Arithmetic mean of the layer temperatures adjacent to a
! velocity point [C ~> degC].
S_vel, & ! Arithmetic mean of the layer salinities adjacent to a
! velocity point [S ~> ppt].
+ SpV_vel, & ! Arithmetic mean of the layer averaged specific volumes adjacent to a
+ ! velocity point [R-1 ~> kg m-3].
Rml_vel ! Arithmetic mean of the layer coordinate densities adjacent
! to a velocity point [R ~> kg m-3].
+ real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
real :: h_vel_pos ! The arithmetic mean thickness at a velocity point
! plus H_neglect to avoid 0 values [H ~> m or kg m-2].
real :: ustarsq ! 400 times the square of ustar, times
! Rho0 divided by G_Earth and the conversion
! from m to thickness units [H R ~> kg m-2 or kg2 m-5].
- real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion
- ! factor from lateral lengths to vertical depths [Z L-1 ~> nondim].
real :: cdrag_sqrt ! Square root of the drag coefficient [nondim].
+ real :: cdrag_sqrt_H ! Square root of the drag coefficient, times a unit conversion factor
+ ! from lateral lengths to layer thicknesses [H L-1 ~> nondim or kg m-3].
+ real :: cdrag_sqrt_H_RL ! Square root of the drag coefficient, times a unit conversion factor from
+ ! density times lateral lengths to layer thicknesses [H L-1 R-1 ~> m3 kg-1 or nondim]
+ real :: cdrag_L_to_H ! The drag coeffient times conversion factors from lateral
+ ! distance to thickness units [H L-1 ~> nondim or kg m-3]
+ real :: cdrag_RL_to_H ! The drag coeffient times conversion factors from density times lateral
+ ! distance to thickness units [H L-1 R-1 ~> m3 kg-1 or nondim]
+ real :: cdrag_conv ! The drag coeffient times a combination of static conversion factors and in
+ ! situ density or Boussinesq reference density [H L-1 ~> nondim or kg m-3]
real :: oldfn ! The integrated energy required to
! entrain up to the bottom of the layer,
! divided by G_Earth [H R ~> kg m-2 or kg2 m-5].
real :: Dfn ! The increment in oldfn for entraining
! the layer [H R ~> kg m-2 or kg2 m-5].
+ real :: frac_used ! The fraction of the present layer that contributes to Dh and Ddz [nondim]
real :: Dh ! The increment in layer thickness from
! the present layer [H ~> m or kg m-2].
- real :: bbl_thick ! The thickness of the bottom boundary layer [H ~> m or kg m-2].
- real :: bbl_thick_Z ! The thickness of the bottom boundary layer [Z ~> m].
- real :: kv_bbl ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1].
+ real :: Ddz ! The increment in height change from the present layer [Z ~> m].
+ real :: bbl_thick ! The thickness of the bottom boundary layer [Z ~> m].
+ real :: BBL_thick_max ! A huge upper bound on the boundary layer thickness [Z ~> m].
+ real :: kv_bbl ! The bottom boundary layer viscosity [H Z T-1 ~> m2 s-1 or Pa s]
real :: C2f ! C2f = 2*f at velocity points [T-1 ~> s-1].
real :: U_bg_sq ! The square of an assumed background
@@ -211,69 +234,75 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
real :: hwtot ! Sum of the thicknesses used to calculate
! the near-bottom velocity magnitude [H ~> m or kg m-2].
real :: I_hwtot ! The Adcroft reciprocal of hwtot [H-1 ~> m-1 or m2 kg-1].
+ real :: dzwtot ! The vertical extent of the region used to calculate
+ ! the near-bottom velocity magnitude [Z ~> m].
real :: hutot ! Running sum of thicknesses times the velocity
! magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1].
real :: Thtot ! Running sum of thickness times temperature [C H ~> degC m or degC kg m-2].
real :: Shtot ! Running sum of thickness times salinity [S H ~> ppt m or ppt kg m-2].
+ real :: SpV_htot ! Running sum of thickness times specific volume [R-1 H ~> m4 kg-1 or m]
real :: hweight ! The thickness of a layer that is within Hbbl
! of the bottom [H ~> m or kg m-2].
+ real :: dzweight ! The counterpart of hweight in height units [Z ~> m].
real :: v_at_u, u_at_v ! v at a u point or vice versa [L T-1 ~> m s-1].
real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors
- ! [R T2 H Z-2 ~> kg s2 m-4 or kg2 s2 m-7].
+ ! [R T2 H-1 ~> kg s2 m-4 or s2 m-1].
! The 400 is a constant proposed by Killworth and Edwards, 1999.
real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: &
Rml ! The mixed layer coordinate density [R ~> kg m-3].
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
! density [R L2 T-2 ~> Pa] (usually set to 2e7 Pa = 2000 dbar).
- real :: D_vel ! The bottom depth at a velocity point [H ~> m or kg m-2].
- real :: Dp, Dm ! The depths at the edges of a velocity cell [H ~> m or kg m-2].
- real :: a ! a is the curvature of the bottom depth across a
- ! cell, times the cell width squared [H ~> m or kg m-2].
- real :: a_3, a_12 ! a/3 and a/12 [H ~> m or kg m-2].
- real :: C24_a ! 24/a [H-1 ~> m-1 or m2 kg-1].
+ real :: D_vel ! The bottom depth at a velocity point [Z ~> m].
+ real :: Dp, Dm ! The depths at the edges of a velocity cell [Z ~> m].
+ real :: crv ! crv is the curvature of the bottom depth across a
+ ! cell, times the cell width squared [Z ~> m].
+ real :: crv_3 ! crv/3 [Z ~> m].
+ real :: C24_crv ! 24/crv [Z-1 ~> m-1].
real :: slope ! The absolute value of the bottom depth slope across
- ! a cell times the cell width [H ~> m or kg m-2].
- real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope [nondim].
- real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope [H-1 ~> m-1 or m2 kg-1].
- ! All of the following "volumes" have units of thickness because they are normalized
+ ! a cell times the cell width [Z ~> m].
+ real :: apb_4a, ax2_3apb ! Various nondimensional ratios of crv and slope [nondim].
+ real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of crv (a) and slope (b) [Z-1 ~> m-1]
+ ! All of the following "volumes" have units of vertical heights because they are normalized
! by the full horizontal area of a velocity cell.
real :: Vol_bbl_chan ! The volume of the bottom boundary layer as used in the channel
! drag parameterization, normalized by the full horizontal area
- ! of the velocity cell [H ~> m or kg m-2].
- real :: Vol_open ! The cell volume above which it is open [H ~> m or kg m-2].
- real :: Vol_direct ! With less than Vol_direct [H ~> m or kg m-2], there is a direct
+ ! of the velocity cell [Z ~> m].
+ real :: Vol_open ! The cell volume above which it is open [Z ~> m].
+ real :: Vol_direct ! With less than Vol_direct [Z ~> m], there is a direct
! solution of a cubic equation for L.
real :: Vol_2_reg ! The cell volume above which there are two separate
- ! open areas that must be integrated [H ~> m or kg m-2].
+ ! open areas that must be integrated [Z ~> m].
real :: vol ! The volume below the interface whose normalized
- ! width is being sought [H ~> m or kg m-2].
+ ! width is being sought [Z ~> m].
real :: vol_below ! The volume below the interface below the one that
- ! is currently under consideration [H ~> m or kg m-2].
+ ! is currently under consideration [Z ~> m].
real :: Vol_err ! The error in the volume with the latest estimate of
- ! L, or the error for the interface below [H ~> m or kg m-2].
- real :: Vol_quit ! The volume error below which to quit iterating [H ~> m or kg m-2].
- real :: Vol_tol ! A volume error tolerance [H ~> m or kg m-2].
+ ! L, or the error for the interface below [Z ~> m].
+ real :: Vol_quit ! The volume error below which to quit iterating [Z ~> m].
+ real :: Vol_tol ! A volume error tolerance [Z ~> m].
real :: L(SZK_(GV)+1) ! The fraction of the full cell width that is open at
! the depth of each interface [nondim].
real :: L_direct ! The value of L above volume Vol_direct [nondim].
- real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim].
- real :: Vol_err_max ! The volume error for the upper bound on the correct value for L [H ~> m or kg m-2]
- real :: Vol_err_min ! The volume error for the lower bound on the correct value for L [H ~> m or kg m-2]
- real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2].
+ real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim].
+ real :: Vol_err_max ! The volume error for the upper bound on the correct value for L [Z ~> m]
+ real :: Vol_err_min ! The volume error for the lower bound on the correct value for L [Z ~> m]
+ real :: Vol_0 ! A deeper volume with known width L0 [Z ~> m].
real :: L0 ! The value of L above volume Vol_0 [nondim].
- real :: dVol ! vol - Vol_0 [H ~> m or kg m-2].
+ real :: dVol ! vol - Vol_0 [Z ~> m].
real :: dV_dL2 ! The partial derivative of volume with L squared
- ! evaluated at L=L0 [H ~> m or kg m-2].
+ ! evaluated at L=L0 [Z ~> m].
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m].
real :: ustH ! ustar converted to units of H T-1 [H T-1 ~> m s-1 or kg m-2 s-1].
real :: root ! A temporary variable [H T-1 ~> m s-1 or kg m-2 s-1].
real :: Cell_width ! The transverse width of the velocity cell [L ~> m].
- real :: Rayleigh ! A nondimensional value that is multiplied by the layer's
- ! velocity magnitude to give the Rayleigh drag velocity, times
- ! a lateral to vertical distance conversion factor [Z L-1 ~> nondim].
+ real :: Rayleigh ! A factor that is multiplied by the layer's velocity magnitude
+ ! to give the Rayleigh drag velocity, times a lateral distance to
+ ! thickness conversion factor [H L-1 ~> nondim or kg m-3].
real :: gam ! The ratio of the change in the open interface width
! to the open interface width atop a cell [nondim].
real :: BBL_frac ! The fraction of a layer's drag that goes into the
@@ -288,7 +317,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
real :: tmp ! A temporary variable, sometimes in [Z ~> m]
real :: tmp_val_m1_to_p1 ! A temporary variable [nondim]
real :: curv_tol ! Numerator of curvature cubed, used to estimate
- ! accuracy of a single L(:) Newton iteration [H5 ~> m5 or kg5 m-10]
+ ! accuracy of a single L(:) Newton iteration [Z5 ~> m5]
logical :: use_L0, do_one_L_iter ! Control flags for L(:) Newton iteration
logical :: use_BBL_EOS, do_i(SZIB_(G))
integer, dimension(2) :: EOSdom ! The computational domain for the equation of state
@@ -300,8 +329,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
Isq = G%isc-1 ; Ieq = G%IecB ; Jsq = G%jsc-1 ; Jeq = G%JecB
nkmb = GV%nk_rho_varies ; nkml = GV%nkml
h_neglect = GV%H_subroundoff
- Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H
- Vol_quit = 0.9*GV%Angstrom_H + h_neglect
+ dz_neglect = GV%dZ_subroundoff
+
+ Rho0x400_G = 400.0*(GV%H_to_RZ / (US%L_to_Z**2 * GV%g_Earth))
+ Vol_quit = (0.9*GV%Angstrom_Z + dz_neglect)
C2pi_3 = 8.0*atan(1.0)/3.0
if (.not.CS%initialized) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//&
@@ -314,6 +345,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
call hchksum(h,"Start set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m)
if (associated(tv%T)) call hchksum(tv%T, "Start set_viscous_BBL T", G%HI, haloshift=1, scale=US%C_to_degC)
if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1, scale=US%S_to_ppt)
+ if (allocated(tv%SpV_avg)) &
+ call hchksum(tv%SpV_avg, "Start set_viscous_BBL SpV_avg", G%HI, haloshift=1, scale=US%kg_m3_to_R)
+ if (allocated(tv%SpV_avg)) call hchksum(tv%SpV_avg, "Cornerless SpV_avg", G%HI, &
+ haloshift=1, omit_corners=.true., scale=US%kg_m3_to_R)
+ if (associated(tv%T)) call hchksum(tv%T, "Cornerless T", G%HI, haloshift=1, omit_corners=.true., scale=US%C_to_degC)
+ if (associated(tv%S)) call hchksum(tv%S, "Cornerless S", G%HI, haloshift=1, omit_corners=.true., scale=US%S_to_ppt)
endif
use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS
@@ -321,11 +358,18 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel
cdrag_sqrt = sqrt(CS%cdrag)
- cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag)
+ cdrag_sqrt_H = cdrag_sqrt * US%L_to_m * GV%m_to_H
+ cdrag_sqrt_H_RL = cdrag_sqrt * US%L_to_Z * GV%RZ_to_H
+ cdrag_L_to_H = CS%cdrag * US%L_to_m * GV%m_to_H
+ cdrag_RL_to_H = CS%cdrag * US%L_to_Z * GV%RZ_to_H
+ BBL_thick_max = G%Rad_Earth_L * US%L_to_Z
K2 = max(nkmb+1, 2)
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
+
! With a linear drag law, the friction velocity is already known.
-! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel
+! if (CS%linear_drag) ustar(:) = cdrag_sqrt_H*CS%drag_bg_vel
if ((nkml>0) .and. .not.use_BBL_EOS) then
EOSdom(1) = Isq - (G%isd-1) ; EOSdom(2) = G%iec+1 - (G%isd-1)
@@ -394,10 +438,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
if (allocated(visc%Ray_u)) visc%Ray_u(:,:,:) = 0.0
if (allocated(visc%Ray_v)) visc%Ray_v(:,:,:) = 0.0
- !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,US,CS,Rml,nz,nkmb, &
- !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, &
- !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, &
- !$OMP OBC,maxitt,D_u,D_v,mask_u,mask_v, pbv) &
+ !$OMP parallel do default(private) shared(u,v,h,dz,tv,visc,G,GV,US,CS,Rml,nz,nkmb,nkml,K2, &
+ !$OMP Isq,Ieq,Jsq,Jeq,h_neglect,dz_neglect,Rho0x400_G,C2pi_3, &
+ !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_H,cdrag_sqrt_H_RL, &
+ !$OMP cdrag_L_to_H,cdrag_RL_to_H,use_BBL_EOS,BBL_thick_max, &
+ !$OMP OBC,maxitt,D_u,D_v,mask_u,mask_v,pbv) &
!$OMP firstprivate(Vol_quit)
do j=Jsq,Jeq ; do m=1,2
@@ -421,16 +466,20 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
if (m==1) then ! u-points
do k=1,nz ; do I=is,ie
if (do_i(I)) then
- if (u(I,j,k) *(h(i+1,j,k) - h(i,j,k)) >= 0) then
+ if (u(I,j,k) * (h(i+1,j,k) - h(i,j,k)) >= 0) then
! If the flow is from thin to thick then bias towards the thinner thickness
h_at_vel(I,k) = 2.0*h(i,j,k)*h(i+1,j,k) / &
(h(i,j,k) + h(i+1,j,k) + h_neglect)
+ dz_at_vel(I,k) = 2.0*dz(i,j,k)*dz(i+1,j,k) / &
+ (dz(i,j,k) + dz(i+1,j,k) + dz_neglect)
else
! If the flow is from thick to thin then use the simple average thickness
h_at_vel(I,k) = 0.5 * (h(i,j,k) + h(i+1,j,k))
+ dz_at_vel(I,k) = 0.5 * (dz(i,j,k) + dz(i+1,j,k))
endif
endif
h_vel(I,k) = 0.5 * (h(i,j,k) + h(i+1,j,k))
+ dz_vel(I,k) = 0.5 * (dz(i,j,k) + dz(i+1,j,k))
enddo ; enddo
if (use_BBL_EOS) then ; do k=1,nz ; do I=is,ie
! Perhaps these should be thickness weighted.
@@ -439,6 +488,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
enddo ; enddo ; else ; do k=1,nkmb ; do I=is,ie
Rml_vel(I,k) = 0.5 * (Rml(i,j,k) + Rml(i+1,j,k))
enddo ; enddo ; endif
+ if (allocated(tv%SpV_avg)) then ; do k=1,nz ; do I=is,ie
+ SpV_vel(I,k) = 0.5 * (tv%SpV_avg(i,j,k) + tv%SpV_avg(i+1,j,k))
+ enddo ; enddo ; endif
else ! v-points
do k=1,nz ; do i=is,ie
if (do_i(i)) then
@@ -446,19 +498,27 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! If the flow is from thin to thick then bias towards the thinner thickness
h_at_vel(i,k) = 2.0*h(i,j,k)*h(i,j+1,k) / &
(h(i,j,k) + h(i,j+1,k) + h_neglect)
+ dz_at_vel(i,k) = 2.0*dz(i,j,k)*dz(i,j+1,k) / &
+ (dz(i,j,k) + dz(i,j+1,k) + dz_neglect)
else
! If the flow is from thick to thin then use the simple average thickness
h_at_vel(i,k) = 0.5 * (h(i,j,k) + h(i,j+1,k))
+ dz_at_vel(i,k) = 0.5 * (dz(i,j,k) + dz(i,j+1,k))
endif
endif
h_vel(i,k) = 0.5 * (h(i,j,k) + h(i,j+1,k))
+ dz_vel(i,k) = 0.5 * (dz(i,j,k) + dz(i,j+1,k))
enddo ; enddo
if (use_BBL_EOS) then ; do k=1,nz ; do i=is,ie
+ ! Perhaps these should be thickness weighted.
T_vel(i,k) = 0.5 * (tv%T(i,j,k) + tv%T(i,j+1,k))
S_vel(i,k) = 0.5 * (tv%S(i,j,k) + tv%S(i,j+1,k))
enddo ; enddo ; else ; do k=1,nkmb ; do i=is,ie
Rml_vel(i,k) = 0.5 * (Rml(i,j,k) + Rml(i,j+1,k))
enddo ; enddo ; endif
+ if (allocated(tv%SpV_avg)) then ; do k=1,nz ; do i=is,ie
+ SpV_vel(i,k) = 0.5 * (tv%SpV_avg(i,j,k) + tv%SpV_avg(i,j+1,k))
+ enddo ; enddo ; endif
endif
if (associated(OBC)) then ; if (OBC%number_of_segments > 0) then
@@ -468,6 +528,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
do k=1,nz
h_at_vel(I,k) = h(i,j,k) ; h_vel(I,k) = h(i,j,k)
+ dz_at_vel(I,k) = dz(i,j,k) ; dz_vel(I,k) = dz(i,j,k)
enddo
if (use_BBL_EOS) then
do k=1,nz
@@ -478,9 +539,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
Rml_vel(I,k) = Rml(i,j,k)
enddo
endif
+ if (allocated(tv%SpV_avg)) then ; do k=1,nz
+ SpV_vel(I,k) = tv%SpV_avg(i,j,k)
+ enddo ; endif
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
do k=1,nz
h_at_vel(I,k) = h(i+1,j,k) ; h_vel(I,k) = h(i+1,j,k)
+ dz_at_vel(I,k) = dz(i+1,j,k) ; dz_vel(I,k) = dz(i+1,j,k)
enddo
if (use_BBL_EOS) then
do k=1,nz
@@ -491,6 +556,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
Rml_vel(I,k) = Rml(i+1,j,k)
enddo
endif
+ if (allocated(tv%SpV_avg)) then ; do k=1,nz
+ SpV_vel(I,k) = tv%SpV_avg(i+1,j,k)
+ enddo ; endif
endif
endif ; enddo
else
@@ -498,6 +566,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
do k=1,nz
h_at_vel(i,k) = h(i,j,k) ; h_vel(i,k) = h(i,j,k)
+ dz_at_vel(i,k) = dz(i,j,k) ; dz_vel(i,k) = dz(i,j,k)
enddo
if (use_BBL_EOS) then
do k=1,nz
@@ -508,9 +577,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
Rml_vel(i,k) = Rml(i,j,k)
enddo
endif
+ if (allocated(tv%SpV_avg)) then ; do k=1,nz
+ SpV_vel(i,k) = tv%SpV_avg(i,j,k)
+ enddo ; endif
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
do k=1,nz
h_at_vel(i,k) = h(i,j+1,k) ; h_vel(i,k) = h(i,j+1,k)
+ dz_at_vel(i,k) = dz(i,j+1,k) ; dz_vel(i,k) = dz(i,j+1,k)
enddo
if (use_BBL_EOS) then
do k=1,nz
@@ -521,6 +594,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
Rml_vel(i,k) = Rml(i,j+1,k)
enddo
endif
+ if (allocated(tv%SpV_avg)) then ; do k=1,nz
+ SpV_vel(i,k) = tv%SpV_avg(i,j+1,k)
+ enddo ; endif
endif
endif ; enddo
endif
@@ -532,16 +608,20 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! Used in ustar(i)
do i=is,ie ; if (do_i(i)) then
htot_vel = 0.0 ; hwtot = 0.0 ; hutot = 0.0
- Thtot = 0.0 ; Shtot = 0.0
+ dztot_vel = 0.0 ; dzwtot = 0.0
+ Thtot = 0.0 ; Shtot = 0.0 ; SpV_htot = 0.0
do k=nz,1,-1
if (htot_vel>=CS%Hbbl) exit ! terminate the k loop
hweight = MIN(CS%Hbbl - htot_vel, h_at_vel(i,k))
if (hweight < 1.5*GV%Angstrom_H + h_neglect) cycle
+ dzweight = MIN(CS%dz_bbl - dztot_vel, dz_at_vel(i,k))
- htot_vel = htot_vel + h_at_vel(i,k)
+ htot_vel = htot_vel + h_at_vel(i,k)
hwtot = hwtot + hweight
+ dztot_vel = dztot_vel + dz_at_vel(i,k)
+ dzwtot = dzwtot + dzweight
if ((.not.CS%linear_drag) .and. (hweight >= 0.0)) then ; if (m==1) then
v_at_u = set_v_at_u(v, h, G, GV, i, j, k, mask_v, OBC)
@@ -563,20 +643,28 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
Thtot = Thtot + hweight * T_vel(i,k)
Shtot = Shtot + hweight * S_vel(i,k)
endif
+ if (allocated(tv%SpV_avg) .and. (hweight >= 0.0)) then
+ SpV_htot = SpV_htot + hweight * SpV_vel(i,k)
+ endif
enddo ! end of k loop
- ! Set u* based on u*^2 = Cdrag u_bbl^2
- if (.not.CS%linear_drag .and. (hwtot > 0.0)) then
- ustar(i) = cdrag_sqrt_Z*hutot / hwtot
- else
- ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel
- endif
-
! Find the Adcroft reciprocal of the total thickness weights
I_hwtot = 0.0 ; if (hwtot > 0.0) I_hwtot = 1.0 / hwtot
+ ! Set u* based on u*^2 = Cdrag u_bbl^2
+ if ((hwtot <= 0.0) .or. (CS%linear_drag .and. .not.allocated(tv%SpV_avg))) then
+ ustar(i) = cdrag_sqrt_H * CS%drag_bg_vel
+ elseif (CS%linear_drag .and. allocated(tv%SpV_avg)) then
+ ustar(i) = cdrag_sqrt_H_RL * CS%drag_bg_vel * (hwtot / SpV_htot)
+ elseif (allocated(tv%SpV_avg)) then ! (.not.CS%linear_drag)
+ ustar(i) = cdrag_sqrt_H_RL * hutot / SpV_htot
+ else ! (.not.CS%linear_drag .and. .not.allocated(tv%SpV_avg))
+ ustar(i) = cdrag_sqrt_H * hutot / hwtot
+ endif
+
umag_avg(i) = hutot * I_hwtot
h_bbl_drag(i) = hwtot
+ dz_bbl_drag(i) = dzwtot
if (use_BBL_EOS) then ; if (hwtot > 0.0) then
T_EOS(i) = Thtot/hwtot ; S_EOS(i) = Shtot/hwtot
@@ -593,7 +681,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
endif ; enddo
else
- do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo
+ do i=is,ie ; ustar(i) = cdrag_sqrt_H*CS%drag_bg_vel ; enddo
endif ! Not linear_drag
if (use_BBL_EOS) then
@@ -622,6 +710,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! The 400.0 in this expression is the square of a Ci introduced in KW99, eq. 2.22.
ustarsq = Rho0x400_G * ustar(i)**2 ! Note not in units of u*^2 but [H R ~> kg m-2 or kg2 m-5]
htot = 0.0
+ dztot = 0.0
! Calculate the thickness of a stratification limited BBL ignoring rotation:
! h_N = Ci u* / N (limit of KW99 eq. 2.20 for |f|->0)
@@ -650,20 +739,26 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
if ((oldfn + Dfn) <= ustarsq) then
! Use whole layer
Dh = h_at_vel(i,k)
+ Ddz = dz_at_vel(i,k)
else
! Use only part of the layer
- Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn))
+ frac_used = sqrt((ustarsq-oldfn) / (Dfn))
+ Dh = h_at_vel(i,k) * frac_used
+ Ddz = dz_at_vel(i,k) * frac_used
endif
! Increment total BBL thickness and cumulative T and S
htot = htot + Dh
+ dztot = dztot + Ddz
Thtot = Thtot + T_vel(i,k)*Dh ; Shtot = Shtot + S_vel(i,k)*Dh
enddo
if ((oldfn < ustarsq) .and. h_at_vel(i,1) > 0.0) then
! Layer 1 might be part of the BBL.
if (dR_dT(i) * (Thtot - T_vel(i,1)*htot) + &
- dR_dS(i) * (Shtot - S_vel(i,1)*htot) < ustarsq) &
+ dR_dS(i) * (Shtot - S_vel(i,1)*htot) < ustarsq) then
htot = htot + h_at_vel(i,1)
+ dztot = dztot + dz_at_vel(i,1)
+ endif
endif ! Examination of layer 1.
else ! Use Rlay and/or the coordinate density as density variables.
Rhtot = 0.0
@@ -675,11 +770,15 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
cycle
elseif ((oldfn + Dfn) <= ustarsq) then
Dh = h_at_vel(i,k)
+ Ddz = dz_at_vel(i,k)
else
- Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn))
+ frac_used = sqrt((ustarsq-oldfn) / (Dfn))
+ Dh = h_at_vel(i,k) * frac_used
+ Ddz = dz_at_vel(i,k) * frac_used
endif
htot = htot + Dh
+ dztot = dztot + Ddz
Rhtot = Rhtot + GV%Rlay(k)*Dh
enddo
if (nkml>0) then
@@ -691,16 +790,26 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
cycle
elseif ((oldfn + Dfn) <= ustarsq) then
Dh = h_at_vel(i,k)
+ Ddz = dz_at_vel(i,k)
else
- Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn))
+ frac_used = sqrt((ustarsq-oldfn) / (Dfn))
+ Dh = h_at_vel(i,k) * frac_used
+ Ddz = dz_at_vel(i,k) * frac_used
endif
htot = htot + Dh
+ dztot = dztot + Ddz
Rhtot = Rhtot + Rml_vel(i,k)*Dh
enddo
- if (Rhtot - Rml_vel(i,1)*htot < ustarsq) htot = htot + h_at_vel(i,1)
+ if (Rhtot - Rml_vel(i,1)*htot < ustarsq) then
+ htot = htot + h_at_vel(i,1)
+ dztot = dztot + dz_at_vel(i,1)
+ endif
else
- if (Rhtot - GV%Rlay(1)*htot < ustarsq) htot = htot + h_at_vel(i,1)
+ if (Rhtot - GV%Rlay(1)*htot < ustarsq) then
+ htot = htot + h_at_vel(i,1)
+ dztot = dztot + dz_at_vel(i,1)
+ endif
endif
endif ! use_BBL_EOS
@@ -722,21 +831,20 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
if (CS%cdrag * U_bg_sq <= 0.0) then
! This avoids NaNs and overflows, and could be used in all cases,
! but is not bitwise identical to the current code.
- ustH = ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2)
- if (htot*ustH <= (CS%BBL_thick_min+h_neglect) * (0.5*ustH + root)) then
+ ustH = ustar(i) ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2)
+ if (dztot*ustH <= (CS%BBL_thick_min+dz_neglect) * (0.5*ustH + root)) then
bbl_thick = CS%BBL_thick_min
else
! The following expression reads
! h_bbl = h_N u* / ( 1/2 u* + sqrt( 1/4 u*^2 + ( 2 f h_N )^2 ) )
! which is h_bbl = h_N u*/(xp u*) as described above.
- bbl_thick = (htot * ustH) / (0.5*ustH + root)
+ bbl_thick = (dztot * ustH) / (0.5*ustH + root)
endif
else
! The following expression reads
! h_bbl = h_N / ( 1/2 + sqrt( 1/4 + ( 2 f h_N / u* )^2 ) )
! which is h_bbl = h_N/xp as described above.
- bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ &
- ((ustar(i)*ustar(i)) * (GV%Z_to_H**2)) ) )
+ bbl_thick = dztot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f / (ustar(i)*ustar(i)) ) )
if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min
endif
@@ -749,12 +857,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! need to set that scale here. In fact, viscously reducing the
! shears over an excessively large region reduces the efficacy of
! the Richardson number dependent mixing.
- ! In other words, if using RiNo_mix then CS%Hbbl acts as an upper bound on
+ ! In other words, if using RiNo_mix then CS%dz_bbl acts as an upper bound on
! bbl_thick.
- if ((bbl_thick > 0.5*CS%Hbbl) .and. (CS%RiNo_mix)) bbl_thick = 0.5*CS%Hbbl
+ if ((bbl_thick > 0.5*CS%dz_bbl) .and. (CS%RiNo_mix)) bbl_thick = 0.5*CS%dz_bbl
! If drag is a body force, bbl_thick is HBBL
- if (CS%body_force_drag) bbl_thick = h_bbl_drag(i)
+ if (CS%body_force_drag) bbl_thick = dz_bbl_drag(i)
if (CS%Channel_drag) then
! The drag within the bottommost Vol_bbl_chan is applied as a part of
@@ -780,45 +888,42 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
endif
if (Dm > Dp) then ; tmp = Dp ; Dp = Dm ; Dm = tmp ; endif
- ! Convert the D's to the units of thickness.
- Dp = GV%Z_to_H*Dp ; Dm = GV%Z_to_H*Dm ; D_vel = GV%Z_to_H*D_vel
-
- a_3 = (Dp + Dm - 2.0*D_vel) ; a = 3.0*a_3 ; a_12 = 0.25*a_3
+ crv_3 = (Dp + Dm - 2.0*D_vel) ; crv = 3.0*crv_3
slope = Dp - Dm
! If the curvature is small enough, there is no reason not to assume
! a uniformly sloping or flat bottom.
- if (abs(a) < 1e-2*(slope + CS%BBL_thick_min)) a = 0.0
+ if (abs(crv) < 1e-2*(slope + CS%BBL_thick_min)) crv = 0.0
! Each cell extends from x=-1/2 to 1/2, and has a topography
- ! given by D(x) = a*x^2 + b*x + D - a/12.
+ ! given by D(x) = crv*x^2 + slope*x + D - crv/12.
! Calculate the volume above which the entire cell is open and the
! other volumes at which the equation that is solved for L changes.
- if (a > 0.0) then
- if (slope >= a) then
+ if (crv > 0.0) then
+ if (slope >= crv) then
Vol_open = D_vel - Dm ; Vol_2_reg = Vol_open
else
- tmp = slope/a
- Vol_open = 0.25*slope*tmp + C1_12*a
- Vol_2_reg = 0.5*tmp**2 * (a - C1_3*slope)
+ tmp = slope/crv
+ Vol_open = 0.25*slope*tmp + C1_12*crv
+ Vol_2_reg = 0.5*tmp**2 * (crv - C1_3*slope)
endif
- ! Define some combinations of a & b for later use.
- C24_a = 24.0/a ; Iapb = 1.0/(a+slope)
- apb_4a = (slope+a)/(4.0*a) ; a2x48_apb3 = (48.0*(a*a))*(Iapb**3)
- ax2_3apb = 2.0*C1_3*a*Iapb
- elseif (a == 0.0) then
+ ! Define some combinations of crv & slope for later use.
+ C24_crv = 24.0/crv ; Iapb = 1.0/(crv+slope)
+ apb_4a = (slope+crv)/(4.0*crv) ; a2x48_apb3 = (48.0*(crv*crv))*(Iapb**3)
+ ax2_3apb = 2.0*C1_3*crv*Iapb
+ elseif (crv == 0.0) then
Vol_open = 0.5*slope
if (slope > 0) Iapb = 1.0/slope
- else ! a < 0.0
+ else ! crv < 0.0
Vol_open = D_vel - Dm
- if (slope >= -a) then
- Iapb = 1.0e30 ; if (slope+a /= 0.0) Iapb = 1.0/(a+slope)
- Vol_direct = 0.0 ; L_direct = 0.0 ; C24_a = 0.0
+ if (slope >= -crv) then
+ Iapb = 1.0e30*US%Z_to_m ; if (slope+crv /= 0.0) Iapb = 1.0/(crv+slope)
+ Vol_direct = 0.0 ; L_direct = 0.0 ; C24_crv = 0.0
else
- C24_a = 24.0/a ; Iapb = 1.0/(a+slope)
- L_direct = 1.0 + slope/a ! L_direct < 1 because a < 0
- Vol_direct = -C1_6*a*L_direct**3
+ C24_crv = 24.0/crv ; Iapb = 1.0/(crv+slope)
+ L_direct = 1.0 + slope/crv ! L_direct < 1 because crv < 0
+ Vol_direct = -C1_6*crv*L_direct**3
endif
- Ibma_2 = 2.0 / (slope - a)
+ Ibma_2 = 2.0 / (slope - crv)
endif
L(nz+1) = 0.0 ; vol = 0.0 ; Vol_err = 0.0 ; BBL_visc_frac = 0.0
@@ -826,18 +931,18 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
do K=nz,1,-1
vol_below = vol
- vol = vol + h_vel(i,k)
+ vol = vol + dz_vel(i,k)
h_vel_pos = h_vel(i,k) + h_neglect
if (vol >= Vol_open) then ; L(K) = 1.0
- elseif (a == 0) then ! The bottom has no curvature.
+ elseif (crv == 0) then ! The bottom has no curvature.
L(K) = sqrt(2.0*vol*Iapb)
- elseif (a > 0) then
+ elseif (crv > 0) then
! There may be a minimum depth, and there are
! analytic expressions for L for all cases.
if (vol < Vol_2_reg) then
! In this case, there is a contiguous open region and
- ! vol = 0.5*L^2*(slope + a/3*(3-4L)).
+ ! vol = 0.5*L^2*(slope + crv/3*(3-4L)).
if (a2x48_apb3*vol < 1e-8) then ! Could be 1e-7?
! There is a very good approximation here for massless layers.
L0 = sqrt(2.0*vol*Iapb) ; L(K) = L0*(1.0 + ax2_3apb*L0)
@@ -846,67 +951,67 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
2.0 * cos(C1_3*acos(a2x48_apb3*vol - 1.0) - C2pi_3))
endif
! To check the answers.
- ! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol
+ ! Vol_err = 0.5*(L(K)*L(K))*(slope + crv_3*(3.0-4.0*L(K))) - vol
else ! There are two separate open regions.
- ! vol = slope^2/4a + a/12 - (a/12)*(1-L)^2*(1+2L)
- ! At the deepest volume, L = slope/a, at the top L = 1.
- !L(K) = 0.5 - cos(C1_3*acos(1.0 - C24_a*(Vol_open - vol)) - C2pi_3)
- tmp_val_m1_to_p1 = 1.0 - C24_a*(Vol_open - vol)
+ ! vol = slope^2/4crv + crv/12 - (crv/12)*(1-L)^2*(1+2L)
+ ! At the deepest volume, L = slope/crv, at the top L = 1.
+ !L(K) = 0.5 - cos(C1_3*acos(1.0 - C24_crv*(Vol_open - vol)) - C2pi_3)
+ tmp_val_m1_to_p1 = 1.0 - C24_crv*(Vol_open - vol)
tmp_val_m1_to_p1 = max(-1., min(1., tmp_val_m1_to_p1))
L(K) = 0.5 - cos(C1_3*acos(tmp_val_m1_to_p1) - C2pi_3)
! To check the answers.
- ! Vol_err = Vol_open - a_12*(1.0+2.0*L(K)) * (1.0-L(K))**2 - vol
+ ! Vol_err = Vol_open - 0.25*crv_3*(1.0+2.0*L(K)) * (1.0-L(K))**2 - vol
endif
else ! a < 0.
if (vol <= Vol_direct) then
! Both edges of the cell are bounded by walls.
- L(K) = (-0.25*C24_a*vol)**C1_3
+ L(K) = (-0.25*C24_crv*vol)**C1_3
else
! x_R is at 1/2 but x_L is in the interior & L is found by solving
- ! vol = 0.5*L^2*(slope + a/3*(3-4L))
+ ! vol = 0.5*L^2*(slope + crv/3*(3-4L))
- ! Vol_err = 0.5*(L(K+1)*L(K+1))*(slope + a_3*(3.0-4.0*L(K+1))) - vol_below
+ ! Vol_err = 0.5*(L(K+1)*L(K+1))*(slope + crv_3*(3.0-4.0*L(K+1))) - vol_below
! Change to ...
- ! if (min(Vol_below + Vol_err, vol) <= Vol_direct) then ?
+ ! if (min(vol_below + Vol_err, vol) <= Vol_direct) then ?
if (vol_below + Vol_err <= Vol_direct) then
L0 = L_direct ; Vol_0 = Vol_direct
else
- L0 = L(K+1) ; Vol_0 = Vol_below + Vol_err
- ! Change to Vol_0 = min(Vol_below + Vol_err, vol) ?
+ L0 = L(K+1) ; Vol_0 = vol_below + Vol_err
+ ! Change to Vol_0 = min(vol_below + Vol_err, vol) ?
endif
! Try a relatively simple solution that usually works well
! for massless layers.
- dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0)
- ! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0)
+ dV_dL2 = 0.5*(slope+crv) - crv*L0 ; dVol = (vol-Vol_0)
+ ! dV_dL2 = 0.5*(slope+crv) - crv*L0 ; dVol = max(vol-Vol_0, 0.0)
use_L0 = .false.
do_one_L_iter = .false.
if (CS%answer_date < 20190101) then
- curv_tol = GV%Angstrom_H*dV_dL2**2 &
- * (0.25 * dV_dL2 * GV%Angstrom_H - a * L0 * dVol)
- do_one_L_iter = (a * a * dVol**3) < curv_tol
+ curv_tol = GV%Angstrom_Z*dV_dL2**2 &
+ * (0.25 * dV_dL2 * GV%Angstrom_Z - crv * L0 * dVol)
+ do_one_L_iter = (crv * crv * dVol**3) < curv_tol
else
! The following code is more robust when GV%Angstrom_H=0, but
! it changes answers.
use_L0 = (dVol <= 0.)
- Vol_tol = max(0.5 * GV%Angstrom_H + GV%H_subroundoff, 1e-14 * vol)
- Vol_quit = max(0.9 * GV%Angstrom_H + GV%H_subroundoff, 1e-14 * vol)
+ Vol_tol = max(0.5 * GV%Angstrom_Z + dz_neglect, 1e-14 * vol)
+ Vol_quit = max(0.9 * GV%Angstrom_Z + dz_neglect, 1e-14 * vol)
curv_tol = Vol_tol * dV_dL2**2 &
- * (dV_dL2 * Vol_tol - 2.0 * a * L0 * dVol)
- do_one_L_iter = (a * a * dVol**3) < curv_tol
+ * (dV_dL2 * Vol_tol - 2.0 * crv * L0 * dVol)
+ do_one_L_iter = (crv * crv * dVol**3) < curv_tol
endif
if (use_L0) then
L(K) = L0
- Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol
+ Vol_err = 0.5*(L(K)*L(K))*(slope + crv_3*(3.0-4.0*L(K))) - vol
elseif (do_one_L_iter) then
! One iteration of Newton's method should give an estimate
! that is accurate to within Vol_tol.
L(K) = sqrt(L0*L0 + dVol / dV_dL2)
- Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol
+ Vol_err = 0.5*(L(K)*L(K))*(slope + crv_3*(3.0-4.0*L(K))) - vol
else
if (dV_dL2*(1.0-L0*L0) < dVol + &
dV_dL2 * (Vol_open - Vol)*Ibma_2) then
@@ -914,10 +1019,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
else
L_max = sqrt(L0*L0 + dVol / dV_dL2)
endif
- L_min = sqrt(L0*L0 + dVol / (0.5*(slope+a) - a*L_max))
+ L_min = sqrt(L0*L0 + dVol / (0.5*(slope+crv) - crv*L_max))
- Vol_err_min = 0.5*(L_min**2)*(slope + a_3*(3.0-4.0*L_min)) - vol
- Vol_err_max = 0.5*(L_max**2)*(slope + a_3*(3.0-4.0*L_max)) - vol
+ Vol_err_min = 0.5*(L_min**2)*(slope + crv_3*(3.0-4.0*L_min)) - vol
+ Vol_err_max = 0.5*(L_max**2)*(slope + crv_3*(3.0-4.0*L_max)) - vol
! if ((abs(Vol_err_min) <= Vol_quit) .or. (Vol_err_min >= Vol_err_max)) then
if (abs(Vol_err_min) <= Vol_quit) then
L(K) = L_min ; Vol_err = Vol_err_min
@@ -925,13 +1030,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
L(K) = sqrt((L_min**2*Vol_err_max - L_max**2*Vol_err_min) / &
(Vol_err_max - Vol_err_min))
do itt=1,maxitt
- Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol
+ Vol_err = 0.5*(L(K)*L(K))*(slope + crv_3*(3.0-4.0*L(K))) - vol
if (abs(Vol_err) <= Vol_quit) exit
! Take a Newton's method iteration. This equation has proven
! robust enough not to need bracketing.
- L(K) = L(K) - Vol_err / (L(K)* (slope + a - 2.0*a*L(K)))
+ L(K) = L(K) - Vol_err / (L(K)* (slope + crv - 2.0*crv*L(K)))
! This would be a Newton's method iteration for L^2:
- ! L(K) = sqrt(L(K)*L(K) - Vol_err / (0.5*(slope+a) - a*L(K)))
+ ! L(K) = sqrt(L(K)*L(K) - Vol_err / (0.5*(slope+crv) - crv*L(K)))
enddo
endif ! end of iterative solver
endif ! end of 1-boundary alternatives.
@@ -952,12 +1057,18 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
BBL_frac = 0.0
endif
+ if (allocated(tv%SpV_avg)) then
+ cdrag_conv = cdrag_RL_to_H / SpV_vel(i,k)
+ else
+ cdrag_conv = cdrag_L_to_H
+ endif
+
if (m==1) then ; Cell_width = G%dy_Cu(I,j)*pbv%por_face_areaU(I,j,k)
else ; Cell_width = G%dx_Cv(i,J)*pbv%por_face_areaV(i,J,k) ; endif
gam = 1.0 - L(K+1)/L(K)
- Rayleigh = US%L_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * &
+ Rayleigh = cdrag_conv * (L(K)-L(K+1)) * (1.0-BBL_frac) * &
(12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + &
- US%L_to_Z*GV%Z_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width)
+ cdrag_conv * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width)
else ! This layer feels no drag.
Rayleigh = 0.0
endif
@@ -979,20 +1090,19 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! Set the near-bottom viscosity to a value which will give
! the correct stress when the shear occurs over bbl_thick.
! See next block for explanation.
- bbl_thick_Z = bbl_thick * GV%H_to_Z
if (CS%correct_BBL_bounds .and. &
- cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac <= CS%Kv_BBL_min) then
+ cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac <= CS%Kv_BBL_min) then
! If the bottom stress implies less viscosity than Kv_BBL_min then
! set kv_bbl to the bound and recompute bbl_thick to be consistent
! but with a ridiculously large upper bound on thickness (for Cd u*=0)
kv_bbl = CS%Kv_BBL_min
- if (cdrag_sqrt*ustar(i)*BBL_visc_frac*G%Rad_Earth_L*US%L_to_Z > kv_bbl) then
- bbl_thick_Z = kv_bbl / ( cdrag_sqrt*ustar(i)*BBL_visc_frac )
+ if ((cdrag_sqrt*ustar(i))*BBL_visc_frac*BBL_thick_max > kv_bbl) then
+ bbl_thick = kv_bbl / ( (cdrag_sqrt*ustar(i)) * BBL_visc_frac )
else
- bbl_thick_Z = G%Rad_Earth_L * US%L_to_Z
+ bbl_thick = BBL_thick_max
endif
else
- kv_bbl = cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac
+ kv_bbl = (cdrag_sqrt*ustar(i)) * bbl_thick*BBL_visc_frac
endif
else ! Not Channel_drag.
@@ -1004,54 +1114,58 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
! - u_bbl is embedded in u* since u*^2 = Cdrag u_bbl^2
! - The average shear in the BBL is du/dz = 2 * u_bbl / h_bbl
! (which assumes a linear profile, hence the "2")
- ! - bbl_thick was bounded to <= 0.5 * CS%Hbbl
+ ! - bbl_thick was bounded to <= 0.5 * CS%dz_bbl
! - The viscous stress kv_bbl du/dz should balance tau_b
! Cdrag u_bbl^2 = kv_bbl du/dz
! = 2 kv_bbl u_bbl
! so
! kv_bbl = 0.5 h_bbl Cdrag u_bbl
! = 0.5 h_bbl sqrt(Cdrag) u*
- bbl_thick_Z = bbl_thick * GV%H_to_Z
if (CS%correct_BBL_bounds .and. &
- cdrag_sqrt*ustar(i)*bbl_thick_Z <= CS%Kv_BBL_min) then
+ cdrag_sqrt*ustar(i)*bbl_thick <= CS%Kv_BBL_min) then
! If the bottom stress implies less viscosity than Kv_BBL_min then
! set kv_bbl to the bound and recompute bbl_thick to be consistent
! but with a ridiculously large upper bound on thickness (for Cd u*=0)
kv_bbl = CS%Kv_BBL_min
- if (cdrag_sqrt*ustar(i)*G%Rad_Earth_L*US%L_to_Z > kv_bbl) then
- bbl_thick_Z = kv_bbl / ( cdrag_sqrt*ustar(i) )
+ if ((cdrag_sqrt*ustar(i))*BBL_thick_max > kv_bbl) then
+ bbl_thick = kv_bbl / ( cdrag_sqrt*ustar(i) )
else
- bbl_thick_Z = G%Rad_Earth_L * US%L_to_Z
+ bbl_thick = BBL_thick_max
endif
else
- kv_bbl = cdrag_sqrt*ustar(i)*bbl_thick_Z
+ kv_bbl = (cdrag_sqrt*ustar(i)) * bbl_thick
endif
endif
- if (CS%body_force_drag .and. (h_bbl_drag(i) > 0.0)) then
+ if (CS%body_force_drag) then ; if (h_bbl_drag(i) > 0.0) then
! Increment the Rayleigh drag as a way introduce the bottom drag as a body force.
h_sum = 0.0
I_hwtot = 1.0 / h_bbl_drag(i)
do k=nz,1,-1
h_bbl_fr = min(h_bbl_drag(i) - h_sum, h_at_vel(i,k)) * I_hwtot
+ if (allocated(tv%SpV_avg)) then
+ cdrag_conv = cdrag_RL_to_H / SpV_vel(i,k)
+ else
+ cdrag_conv = cdrag_L_to_H
+ endif
if (m==1) then
- visc%Ray_u(I,j,k) = visc%Ray_u(I,j,k) + (CS%cdrag*US%L_to_Z*umag_avg(I)) * h_bbl_fr
+ visc%Ray_u(I,j,k) = visc%Ray_u(I,j,k) + (cdrag_conv * umag_avg(I)) * h_bbl_fr
else
- visc%Ray_v(i,J,k) = visc%Ray_v(i,J,k) + (CS%cdrag*US%L_to_Z*umag_avg(i)) * h_bbl_fr
+ visc%Ray_v(i,J,k) = visc%Ray_v(i,J,k) + (cdrag_conv * umag_avg(i)) * h_bbl_fr
endif
h_sum = h_sum + h_at_vel(i,k)
if (h_sum >= h_bbl_drag(i)) exit ! The top of this layer is above the drag zone.
enddo
! Do not enhance the near-bottom viscosity in this case.
Kv_bbl = CS%Kv_BBL_min
- endif
+ endif ; endif
kv_bbl = max(CS%Kv_BBL_min, kv_bbl)
if (m==1) then
- visc%bbl_thick_u(I,j) = bbl_thick_Z
+ visc%bbl_thick_u(I,j) = bbl_thick
if (allocated(visc%Kv_bbl_u)) visc%Kv_bbl_u(I,j) = kv_bbl
else
- visc%bbl_thick_v(i,J) = bbl_thick_Z
+ visc%bbl_thick_v(i,J) = bbl_thick
if (allocated(visc%Kv_bbl_v)) visc%Kv_bbl_v(i,J) = kv_bbl
endif
endif ; enddo ! end of i loop
@@ -1077,10 +1191,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv)
if (CS%debug) then
if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) &
- call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T)
+ call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T)
if (allocated(visc%kv_bbl_u) .and. allocated(visc%kv_bbl_v)) &
call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, &
- haloshift=0, scale=US%Z2_T_to_m2_s, scalar_pair=.true.)
+ haloshift=0, scale=GV%HZ_T_to_m2_s, scalar_pair=.true.)
if (allocated(visc%bbl_thick_u) .and. allocated(visc%bbl_thick_v)) &
call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, visc%bbl_thick_v, &
G%HI, haloshift=0, scale=US%Z_to_m, scalar_pair=.true.)
@@ -1205,12 +1319,15 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
! Local variables
real, dimension(SZIB_(G)) :: &
- htot, & ! The total depth of the layers being that are within the
+ htot, & ! The total thickness of the layers that are within the
! surface mixed layer [H ~> m or kg m-2].
+ dztot, & ! The distance from the surface to the bottom of the layers that are
+ ! within the surface mixed layer [Z ~> m]
Thtot, & ! The integrated temperature of layers that are within the
! surface mixed layer [H C ~> m degC or kg degC m-2].
Shtot, & ! The integrated salt of layers that are within the
! surface mixed layer [H S ~> m ppt or kg ppt m-2].
+ SpV_htot, & ! Running sum of thickness times specific volume [R-1 H ~> m4 kg-1 or m]
Rhtot, & ! The integrated density of layers that are within the surface mixed layer
! [H R ~> kg m-2 or kg2 m-5]. Rhtot is only used if no
! equation of state is used.
@@ -1223,19 +1340,30 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
! (roughly the base of the mixed layer) with temperature [R C-1 ~> kg m-3 degC-1].
dR_dS, & ! Partial derivative of the density at the base of layer nkml
! (roughly the base of the mixed layer) with salinity [R S-1 ~> kg m-3 ppt-1].
- ustar, & ! The surface friction velocity under ice shelves [Z T-1 ~> m s-1].
+ dSpV_dT, & ! Partial derivative of the specific volume at the base of layer nkml
+ ! (roughly the base of the mixed layer) with temperature [R-1 C-1 ~> m3 kg-1 degC-1].
+ dSpV_dS, & ! Partial derivative of the specific volume at the base of layer nkml
+ ! (roughly the base of the mixed layer) with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
+ ustar, & ! The surface friction velocity under ice shelves [H T-1 ~> m s-1 or kg m-2 s-1].
press, & ! The pressure at which dR_dT and dR_dS are evaluated [R L2 T-2 ~> Pa].
T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [C ~> degC]
S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [S ~> ppt].
+ real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
real, dimension(SZIB_(G),SZJ_(G)) :: &
mask_u ! A mask that disables any contributions from u points that
! are land or past open boundary conditions [nondim], 0 or 1.
real, dimension(SZI_(G),SZJB_(G)) :: &
mask_v ! A mask that disables any contributions from v points that
! are land or past open boundary conditions [nondim], 0 or 1.
+ real :: U_star_2d(SZI_(G),SZJ_(G)) ! The wind friction velocity in thickness-based units,
+ ! calculated using the Boussinesq reference density or the time-evolving
+ ! surface density in non-Boussinesq mode [H T-1 ~> m s-1 or kg m-2 s-1]
real :: h_at_vel(SZIB_(G),SZK_(GV))! Layer thickness at velocity points,
! using an upwind-biased second order accurate estimate based
! on the previous velocity direction [H ~> m or kg m-2].
+ real :: dz_at_vel(SZIB_(G),SZK_(GV)) ! Vertical extent of a layer at velocity points,
+ ! using an upwind-biased second order accurate estimate based
+ ! on the previous velocity direction [Z ~> m].
integer :: k_massive(SZIB_(G)) ! The k-index of the deepest layer yet found
! that has more than h_tiny thickness and will be in the
! viscous mixed layer.
@@ -1250,7 +1378,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
! magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1].
real :: hweight ! The thickness of a layer that is within Hbbl
! of the bottom [H ~> m or kg m-2].
- real :: tbl_thick_Z ! The thickness of the top boundary layer [Z ~> m].
+ real :: tbl_thick ! The thickness of the top boundary layer [Z ~> m].
real :: hlay ! The layer thickness at velocity points [H ~> m or kg m-2].
real :: I_2hlay ! 1 / 2*hlay [H-1 ~> m-1 or m2 kg-1].
@@ -1272,31 +1400,38 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
real :: ustarsq ! 400 times the square of ustar, times
! Rho0 divided by G_Earth and the conversion
! from m to thickness units [H R ~> kg m-2 or kg2 m-5].
- real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion
- ! factor from lateral lengths to vertical depths [Z L-1 ~> nondim]
real :: cdrag_sqrt ! Square root of the drag coefficient [nondim].
+ real :: cdrag_sqrt_H ! Square root of the drag coefficient, times a unit conversion
+ ! factor from lateral lengths to layer thicknesses [H L-1 ~> nondim or kg m-3].
+ real :: cdrag_sqrt_H_RL ! Square root of the drag coefficient, times a unit conversion factor from
+ ! density times lateral lengths to layer thicknesses [H L-1 R-1 ~> m3 kg-1 or nondim]
real :: oldfn ! The integrated energy required to
! entrain up to the bottom of the layer,
! divided by G_Earth [H R ~> kg m-2 or kg2 m-5].
real :: Dfn ! The increment in oldfn for entraining
! the layer [H R ~> kg m-2 or kg2 m-5].
- real :: Dh ! The increment in layer thickness from
- ! the present layer [H ~> m or kg m-2].
+ real :: frac_used ! The fraction of the present layer that contributes to Dh and Ddz [nondim]
+ real :: Dh ! The increment in layer thickness from the present layer [H ~> m or kg m-2].
+ real :: Ddz ! The increment in height change from the present layer [Z ~> m].
real :: U_bg_sq ! The square of an assumed background velocity, for
! calculating the mean magnitude near the top for use in
! the quadratic surface drag [L2 T-2 ~> m2 s-2].
real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. Layers that are less than
! h_tiny can not be the deepest in the viscous mixed layer.
real :: absf ! The absolute value of f averaged to velocity points [T-1 ~> s-1].
- real :: U_star ! The friction velocity at velocity points [Z T-1 ~> m s-1].
+ real :: U_star ! The friction velocity at velocity points [H T-1 ~> m s-1 or kg m-2 s-1].
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m].
real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors
- ! [R T2 H Z-2 ~> kg s2 m-4 or kg2 s2 m-7].
+ ! [R T2 H-1 ~> kg s2 m-4 or s2 m-1].
! The 400 is a constant proposed by Killworth and Edwards, 1999.
real :: ustar1 ! ustar [H T-1 ~> m s-1 or kg m-2 s-1]
real :: h2f2 ! (h*2*f)^2 [H2 T-2 ~> m2 s-2 or kg2 m-4 s-2]
logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G))
+ logical :: nonBous_ML ! If true, use the non-Boussinesq form of some energy and
+ ! stratification calculations.
integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n
type(ocean_OBC_type), pointer :: OBC => NULL()
@@ -1310,22 +1445,28 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (.not.(CS%dynamic_viscous_ML .or. associated(forces%frac_shelf_u) .or. &
associated(forces%frac_shelf_v)) ) return
- Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H
+ Rho0x400_G = 400.0*(GV%H_to_RZ / (US%L_to_Z**2 * GV%g_Earth))
U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel
cdrag_sqrt = sqrt(CS%cdrag)
- cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag)
+ cdrag_sqrt_H = cdrag_sqrt * US%L_to_m * GV%m_to_H
+ cdrag_sqrt_H_RL = cdrag_sqrt * US%L_to_Z * GV%RZ_to_H
OBC => CS%OBC
use_EOS = associated(tv%eqn_of_state)
+ nonBous_ML = allocated(tv%SpV_avg)
dt_Rho0 = dt / GV%H_to_RZ
h_neglect = GV%H_subroundoff
h_tiny = 2.0*GV%Angstrom_H + h_neglect
+ dz_neglect = GV%dZ_subroundoff
g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / (GV%Rho0)
if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) &
call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//&
"forces%frac_shelf_v is associated, but the other is not.")
+ ! Extract the friction velocity from the forcing type.
+ call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1, H_T_units=.true.)
+
if (associated(forces%frac_shelf_u)) then
! This configuration has ice shelves, and the appropriate variables need to be
! allocated. If the arrays have already been allocated, these calls do nothing.
@@ -1343,7 +1484,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
allocate(visc%kv_tbl_shelf_v(G%isd:G%ied, G%JsdB:G%JedB), source=0.0)
! With a linear drag law under shelves, the friction velocity is already known.
-! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel
+! if (CS%linear_drag) ustar(:) = cdrag_sqrt_H*CS%drag_bg_vel
+
+ ! Find the vertical distances across layers.
+ call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1)
endif
!$OMP parallel do default(shared)
@@ -1374,9 +1518,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
endif
enddo ; endif
- !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,US,CS,use_EOS,dt_Rho0, &
- !$OMP h_neglect,h_tiny,g_H_Rho0,js,je,OBC,Isq,Ieq,nz, &
- !$OMP U_bg_sq,mask_v,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml)
+ !$OMP parallel do default(private) shared(u,v,h,dz,tv,forces,visc,dt,G,GV,US,CS,use_EOS,dt_Rho0, &
+ !$OMP nonBous_ML,h_neglect,dz_neglect,h_tiny,g_H_Rho0, &
+ !$OMP js,je,OBC,Isq,Ieq,nz,nkml,U_star_2d,U_bg_sq,mask_v, &
+ !$OMP cdrag_sqrt,cdrag_sqrt_H,cdrag_sqrt_H_RL,Rho0x400_G)
do j=js,je ! u-point loop
if (CS%dynamic_viscous_ML) then
do_any = .false.
@@ -1397,8 +1542,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (CS%omega_frac > 0.0) &
absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2)
endif
- U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j)))
- Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z
+ U_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i+1,j)))
+ Idecay_len_TKE(I) = (absf / U_star) * CS%TKE_decay
endif
enddo
@@ -1417,6 +1562,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
enddo
call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, tv%eqn_of_state, &
(/Isq-G%IsdB+1,Ieq-G%IsdB+1/) )
+ if (nonBous_ML) then
+ call calculate_specific_vol_derivs(T_EOS, S_EOS, press, dSpV_dT, dSpV_dS, tv%eqn_of_state, &
+ (/Isq-G%IsdB+1,Ieq-G%IsdB+1/) )
+ endif
endif
do I=Isq,Ieq ; if (do_i(I)) then
@@ -1431,8 +1580,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (use_EOS) then
T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i+1,j,k)*tv%T(i+1,j,k)) * I_2hlay
S_lay = (h(i,j,k)*tv%S(i,j,k) + h(i+1,j,k)*tv%S(i+1,j,k)) * I_2hlay
- gHprime = g_H_Rho0 * (dR_dT(I) * (T_lay*htot(I) - Thtot(I)) + &
- dR_dS(I) * (S_lay*htot(I) - Shtot(I)))
+ if (nonBous_ML) then
+ gHprime = (GV%g_Earth * GV%H_to_RZ) * (dSpV_dT(I) * (Thtot(I) - T_lay*htot(I)) + &
+ dSpV_dS(I) * (Shtot(I) - S_lay*htot(I)))
+ else
+ gHprime = g_H_Rho0 * (dR_dT(I) * (T_lay*htot(I) - Thtot(I)) + &
+ dR_dS(I) * (S_lay*htot(I) - Shtot(I)))
+ endif
else
gHprime = g_H_Rho0 * (GV%Rlay(k)*htot(I) - Rhtot(I))
endif
@@ -1490,19 +1644,24 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (do_any_shelf) then
do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then
- if (u(I,j,k) *(h(i+1,j,k) - h(i,j,k)) >= 0) then
+ if (u(I,j,k) * (h(i+1,j,k) - h(i,j,k)) >= 0) then
h_at_vel(i,k) = 2.0*h(i,j,k)*h(i+1,j,k) / &
(h(i,j,k) + h(i+1,j,k) + h_neglect)
+ dz_at_vel(i,k) = 2.0*dz(i,j,k)*dz(i+1,j,k) / &
+ (dz(i,j,k) + dz(i+1,j,k) + dz_neglect)
else
h_at_vel(i,k) = 0.5 * (h(i,j,k) + h(i+1,j,k))
+ dz_at_vel(i,k) = 0.5 * (dz(i,j,k) + dz(i+1,j,k))
endif
else
- h_at_vel(I,k) = 0.0 ; ustar(I) = 0.0
+ h_at_vel(I,k) = 0.0
+ dz_at_vel(I,k) = 0.0
+ ustar(I) = 0.0
endif ; enddo ; enddo
do I=Isq,Ieq ; if (do_i(I)) then
htot_vel = 0.0 ; hwtot = 0.0 ; hutot = 0.0
- Thtot(I) = 0.0 ; Shtot(I) = 0.0
+ Thtot(I) = 0.0 ; Shtot(I) = 0.0 ; SpV_htot(I) = 0.0
if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz
if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop
hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k))
@@ -1519,12 +1678,19 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
Thtot(I) = Thtot(I) + hweight * 0.5 * (tv%T(i,j,k) + tv%T(i+1,j,k))
Shtot(I) = Shtot(I) + hweight * 0.5 * (tv%S(i,j,k) + tv%S(i+1,j,k))
endif
+ if (allocated(tv%SpV_avg)) then
+ SpV_htot(I) = SpV_htot(I) + hweight * 0.5 * (tv%SpV_avg(i,j,k) + tv%SpV_avg(i+1,j,k))
+ endif
enddo ; endif
- if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then
- ustar(I) = cdrag_sqrt_Z * hutot / hwtot
- else
- ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel
+ if ((hwtot <= 0.0) .or. (CS%linear_drag .and. .not.allocated(tv%SpV_avg))) then
+ ustar(I) = cdrag_sqrt_H * CS%drag_bg_vel
+ elseif (CS%linear_drag .and. allocated(tv%SpV_avg)) then
+ ustar(I) = cdrag_sqrt_H_RL * CS%drag_bg_vel * (hwtot / SpV_htot(I))
+ elseif (allocated(tv%SpV_avg)) then ! (.not.CS%linear_drag)
+ ustar(I) = cdrag_sqrt_H_RL * hutot / SpV_htot(I)
+ else ! (.not.CS%linear_drag .and. .not.allocated(tv%SpV_avg))
+ ustar(I) = cdrag_sqrt_H * hutot / hwtot
endif
if (use_EOS) then ; if (hwtot > 0.0) then
@@ -1532,6 +1698,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
else
T_EOS(I) = 0.0 ; S_EOS(I) = 0.0
endif ; endif
+ ! if (allocated(tv%SpV_avg)) SpV_av(I) = SpVhtot(I) / hwtot
endif ; enddo ! I-loop
if (use_EOS) then
@@ -1543,7 +1710,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
! The 400.0 in this expression is the square of a constant proposed
! by Killworth and Edwards, 1999, in equation (2.20).
ustarsq = Rho0x400_G * ustar(i)**2
- htot(i) = 0.0
+ htot(i) = 0.0 ; dztot(i) = 0.0
if (use_EOS) then
Thtot(i) = 0.0 ; Shtot(i) = 0.0
do k=1,nz-1
@@ -1558,19 +1725,25 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
(h_at_vel(i,k)+htot(i))
if ((oldfn + Dfn) <= ustarsq) then
Dh = h_at_vel(i,k)
+ Ddz = dz_at_vel(i,k)
else
- Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn))
+ frac_used = sqrt((ustarsq-oldfn) / (Dfn))
+ Dh = h_at_vel(i,k) * frac_used
+ Ddz = dz_at_vel(i,k) * frac_used
endif
htot(i) = htot(i) + Dh
+ dztot(i) = dztot(i) + Ddz
Thtot(i) = Thtot(i) + T_Lay*Dh ; Shtot(i) = Shtot(i) + S_Lay*Dh
enddo
if ((oldfn < ustarsq) .and. (h_at_vel(i,nz) > 0.0)) then
T_Lay = 0.5*(tv%T(i,j,nz) + tv%T(i+1,j,nz))
S_Lay = 0.5*(tv%S(i,j,nz) + tv%S(i+1,j,nz))
if (dR_dT(i)*(T_Lay*htot(i) - Thtot(i)) + &
- dR_dS(i)*(S_Lay*htot(i) - Shtot(i)) < ustarsq) &
+ dR_dS(i)*(S_Lay*htot(i) - Shtot(i)) < ustarsq) then
htot(i) = htot(i) + h_at_vel(i,nz)
+ dztot(i) = dztot(i) + dz_at_vel(i,nz)
+ endif
endif ! Examination of layer nz.
else ! Use Rlay as the density variable.
Rhtot = 0.0
@@ -1583,35 +1756,42 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
Dfn = (Rlb - Rlay)*(h_at_vel(i,k)+htot(i))
if ((oldfn + Dfn) <= ustarsq) then
Dh = h_at_vel(i,k)
+ Ddz = dz_at_vel(i,k)
else
- Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn))
+ frac_used = sqrt((ustarsq-oldfn) / (Dfn))
+ Dh = h_at_vel(i,k) * frac_used
+ Ddz = dz_at_vel(i,k) * frac_used
endif
htot(i) = htot(i) + Dh
+ dztot(i) = dztot(i) + Ddz
Rhtot(i) = Rhtot(i) + Rlay*Dh
enddo
- if (GV%Rlay(nz)*htot(i) - Rhtot(i) < ustarsq) &
+ if (GV%Rlay(nz)*htot(i) - Rhtot(i) < ustarsq) then
htot(i) = htot(i) + h_at_vel(i,nz)
+ dztot(i) = dztot(i) + dz_at_vel(i,nz)
+ endif
endif ! use_EOS
- !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, &
- ! htot(I) / (0.5 + sqrt(0.25 + &
+ ! visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, &
+ ! dztot(I) / (0.5 + sqrt(0.25 + &
! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / &
- ! (ustar(i)*GV%Z_to_H)**2 )) )
- ustar1 = ustar(i)*GV%Z_to_H
+ ! (ustar(i))**2 )) )
+ ustar1 = ustar(i)
h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%omega)**2
- tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, &
- ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) )
- visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z
- visc%Kv_tbl_shelf_u(I,j) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z)
+ tbl_thick = max(CS%Htbl_shelf_min, &
+ ( dztot(I)*ustar(i) ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) )
+ visc%tbl_thick_shelf_u(I,j) = tbl_thick
+ visc%Kv_tbl_shelf_u(I,j) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar1*tbl_thick)
endif ; enddo ! I-loop
endif ! do_any_shelf
enddo ! j-loop at u-points
- !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,US,CS,use_EOS,dt_Rho0, &
- !$OMP h_neglect,h_tiny,g_H_Rho0,is,ie,OBC,Jsq,Jeq,nz, &
- !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml,mask_u)
+ !$OMP parallel do default(private) shared(u,v,h,dz,tv,forces,visc,dt,G,GV,US,CS,use_EOS,dt_Rho0, &
+ !$OMP nonBous_ML,h_neglect,dz_neglect,h_tiny,g_H_Rho0, &
+ !$OMP is,ie,OBC,Jsq,Jeq,nz,nkml,U_bg_sq,U_star_2d,mask_u, &
+ !$OMP cdrag_sqrt,cdrag_sqrt_H,cdrag_sqrt_H_RL,Rho0x400_G)
do J=Jsq,Jeq ! v-point loop
if (CS%dynamic_viscous_ML) then
do_any = .false.
@@ -1627,14 +1807,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + &
(forces%taux(I-1,j) + forces%taux(I,j+1)))
- if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else
- absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
- if (CS%omega_frac > 0.0) &
- absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2)
- endif
+ if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else
+ absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
+ if (CS%omega_frac > 0.0) &
+ absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2)
+ endif
- U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1)))
- Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z
+ U_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i,j+1)))
+ Idecay_len_TKE(i) = (absf / U_star) * CS%TKE_decay
endif
enddo
@@ -1654,6 +1834,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
enddo
call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, &
tv%eqn_of_state, (/is-G%IsdB+1,ie-G%IsdB+1/) )
+ if (nonBous_ML) then
+ call calculate_specific_vol_derivs(T_EOS, S_EOS, press, dSpV_dT, dSpV_dS, tv%eqn_of_state, &
+ (/is-G%IsdB+1,ie-G%IsdB+1/) )
+ endif
endif
do i=is,ie ; if (do_i(i)) then
@@ -1668,8 +1852,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (use_EOS) then
T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i,j+1,k)*tv%T(i,j+1,k)) * I_2hlay
S_lay = (h(i,j,k)*tv%S(i,j,k) + h(i,j+1,k)*tv%S(i,j+1,k)) * I_2hlay
- gHprime = g_H_Rho0 * (dR_dT(i) * (T_lay*htot(i) - Thtot(i)) + &
- dR_dS(i) * (S_lay*htot(i) - Shtot(i)))
+ if (nonBous_ML) then
+ gHprime = (GV%g_Earth * GV%H_to_RZ) * (dSpV_dT(i) * (Thtot(i) - T_lay*htot(i)) + &
+ dSpV_dS(i) * (Shtot(i) - S_lay*htot(i)))
+ else
+ gHprime = g_H_Rho0 * (dR_dT(i) * (T_lay*htot(i) - Thtot(i)) + &
+ dR_dS(i) * (S_lay*htot(i) - Shtot(i)))
+ endif
else
gHprime = g_H_Rho0 * (GV%Rlay(k)*htot(i) - Rhtot(i))
endif
@@ -1730,16 +1919,21 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (v(i,J,k) * (h(i,j+1,k) - h(i,j,k)) >= 0) then
h_at_vel(i,k) = 2.0*h(i,j,k)*h(i,j+1,k) / &
(h(i,j,k) + h(i,j+1,k) + h_neglect)
+ dz_at_vel(i,k) = 2.0*dz(i,j,k)*dz(i,j+1,k) / &
+ (dz(i,j,k) + dz(i,j+1,k) + dz_neglect)
else
h_at_vel(i,k) = 0.5 * (h(i,j,k) + h(i,j+1,k))
+ dz_at_vel(i,k) = 0.5 * (dz(i,j,k) + dz(i,j+1,k))
endif
else
- h_at_vel(I,k) = 0.0 ; ustar(i) = 0.0
+ h_at_vel(I,k) = 0.0
+ dz_at_vel(I,k) = 0.0
+ ustar(i) = 0.0
endif ; enddo ; enddo
do i=is,ie ; if (do_i(i)) then
htot_vel = 0.0 ; hwtot = 0.0 ; hutot = 0.0
- Thtot(i) = 0.0 ; Shtot(i) = 0.0
+ Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; SpV_htot(i) = 0.0
if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz
if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop
hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k))
@@ -1756,13 +1950,20 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
Thtot(i) = Thtot(i) + hweight * 0.5 * (tv%T(i,j,k) + tv%T(i,j+1,k))
Shtot(i) = Shtot(i) + hweight * 0.5 * (tv%S(i,j,k) + tv%S(i,j+1,k))
endif
+ if (allocated(tv%SpV_avg)) then
+ SpV_htot(i) = SpV_htot(i) + hweight * 0.5 * (tv%SpV_avg(i,j,k) + tv%SpV_avg(i,j+1,k))
+ endif
enddo ; endif
- if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then
- ustar(i) = cdrag_sqrt_Z * hutot / hwtot
- else
- ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel
- endif ; endif
+ if ((hwtot <= 0.0) .or. (CS%linear_drag .and. .not.allocated(tv%SpV_avg))) then
+ ustar(i) = cdrag_sqrt_H * CS%drag_bg_vel
+ elseif (CS%linear_drag .and. allocated(tv%SpV_avg)) then
+ ustar(i) = cdrag_sqrt_H_RL * CS%drag_bg_vel * (hwtot / SpV_htot(i))
+ elseif (allocated(tv%SpV_avg)) then ! (.not.CS%linear_drag)
+ ustar(i) = cdrag_sqrt_H_RL * hutot / SpV_htot(i)
+ else ! (.not.CS%linear_drag .and. .not.allocated(tv%SpV_avg))
+ ustar(i) = cdrag_sqrt_H * hutot / hwtot
+ endif
if (use_EOS) then ; if (hwtot > 0.0) then
T_EOS(i) = Thtot(i)/hwtot ; S_EOS(i) = Shtot(i)/hwtot
@@ -1781,6 +1982,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
! by Killworth and Edwards, 1999, in equation (2.20).
ustarsq = Rho0x400_G * ustar(i)**2
htot(i) = 0.0
+ dztot(i) = 0.0
if (use_EOS) then
Thtot(i) = 0.0 ; Shtot(i) = 0.0
do k=1,nz-1
@@ -1795,19 +1997,25 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
(h_at_vel(i,k)+htot(i))
if ((oldfn + Dfn) <= ustarsq) then
Dh = h_at_vel(i,k)
+ Ddz = dz_at_vel(i,k)
else
- Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn))
+ frac_used = sqrt((ustarsq-oldfn) / (Dfn))
+ Dh = h_at_vel(i,k) * frac_used
+ Ddz = dz_at_vel(i,k) * frac_used
endif
htot(i) = htot(i) + Dh
+ dztot(i) = dztot(i) + Ddz
Thtot(i) = Thtot(i) + T_Lay*Dh ; Shtot(i) = Shtot(i) + S_Lay*Dh
enddo
if ((oldfn < ustarsq) .and. (h_at_vel(i,nz) > 0.0)) then
T_Lay = 0.5*(tv%T(i,j,nz) + tv%T(i,j+1,nz))
S_Lay = 0.5*(tv%S(i,j,nz) + tv%S(i,j+1,nz))
if (dR_dT(i)*(T_Lay*htot(i) - Thtot(i)) + &
- dR_dS(i)*(S_Lay*htot(i) - Shtot(i)) < ustarsq) &
+ dR_dS(i)*(S_Lay*htot(i) - Shtot(i)) < ustarsq) then
htot(i) = htot(i) + h_at_vel(i,nz)
+ dztot(i) = dztot(i) + dz_at_vel(i,nz)
+ endif
endif ! Examination of layer nz.
else ! Use Rlay as the density variable.
Rhtot = 0.0
@@ -1820,27 +2028,33 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
Dfn = (Rlb - Rlay)*(h_at_vel(i,k)+htot(i))
if ((oldfn + Dfn) <= ustarsq) then
Dh = h_at_vel(i,k)
+ Ddz = dz_at_vel(i,k)
else
- Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn) / (Dfn))
+ frac_used = sqrt((ustarsq-oldfn) / (Dfn))
+ Dh = h_at_vel(i,k) * frac_used
+ Ddz = dz_at_vel(i,k) * frac_used
endif
htot(i) = htot(i) + Dh
+ dztot(i) = dztot(i) + Ddz
Rhtot = Rhtot + Rlay*Dh
enddo
- if (GV%Rlay(nz)*htot(i) - Rhtot(i) < ustarsq) &
+ if (GV%Rlay(nz)*htot(i) - Rhtot(i) < ustarsq) then
htot(i) = htot(i) + h_at_vel(i,nz)
+ dztot(i) = dztot(i) + dz_at_vel(i,nz)
+ endif
endif ! use_EOS
- !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, &
- ! htot(i) / (0.5 + sqrt(0.25 + &
+ ! visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, &
+ ! dztot(i) / (0.5 + sqrt(0.25 + &
! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / &
- ! (ustar(i)*GV%Z_to_H)**2 )) )
- ustar1 = ustar(i)*GV%Z_to_H
+ ! (ustar(i))**2 )) )
+ ustar1 = ustar(i)
h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%omega)**2
- tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, &
- ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) )
- visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z
- visc%Kv_tbl_shelf_v(i,J) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z)
+ tbl_thick = max(CS%Htbl_shelf_min, &
+ ( dztot(i)*ustar(i) ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) )
+ visc%tbl_thick_shelf_v(i,J) = tbl_thick
+ visc%Kv_tbl_shelf_v(i,J) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar1*tbl_thick)
endif ; enddo ! i-loop
endif ! do_any_shelf
@@ -1858,8 +2072,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
end subroutine set_viscous_ML
!> Register any fields associated with the vertvisc_type.
-subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS)
+subroutine set_visc_register_restarts(HI, G, GV, US, param_file, visc, restart_CS, use_ice_shelf)
type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
@@ -1868,13 +2083,16 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS)
!! viscosities and related fields.
!! Allocated here.
type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure
+ logical, intent(in) :: use_ice_shelf !< if true, register tau_shelf restarts
! Local variables
logical :: use_kappa_shear, KS_at_vertex
logical :: adiabatic, useKPP, useEPBL
logical :: use_CVMix_shear, MLE_use_PBL_MLD, MLE_use_Bodner, use_CVMix_conv
integer :: isd, ied, jsd, jed, nz
real :: hfreeze !< If hfreeze > 0 [Z ~> m], melt potential will be computed.
+ character(len=16) :: Kv_units, Kd_units
character(len=40) :: mdl = "MOM_set_visc" ! This module's name.
+ type(vardesc) :: u_desc, v_desc
isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke
call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., &
@@ -1898,25 +2116,31 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS)
"in the surface boundary layer.", default=.false., do_not_log=.true.)
endif
+ if (GV%Boussinesq) then
+ Kv_units = "m2 s-1" ; Kd_units = "m2 s-1"
+ else
+ Kv_units = "Pa s" ; Kd_units = "kg m-1 s-1"
+ endif
+
if (use_kappa_shear .or. useKPP .or. useEPBL .or. use_CVMix_shear .or. use_CVMix_conv) then
call safe_alloc_ptr(visc%Kd_shear, isd, ied, jsd, jed, nz+1)
call register_restart_field(visc%Kd_shear, "Kd_shear", .false., restart_CS, &
"Shear-driven turbulent diffusivity at interfaces", &
- units="m2 s-1", conversion=US%Z2_T_to_m2_s, z_grid='i')
+ units=Kd_units, conversion=GV%HZ_T_to_MKS, z_grid='i')
endif
if (useKPP .or. useEPBL .or. use_CVMix_shear .or. use_CVMix_conv .or. &
(use_kappa_shear .and. .not.KS_at_vertex )) then
call safe_alloc_ptr(visc%Kv_shear, isd, ied, jsd, jed, nz+1)
call register_restart_field(visc%Kv_shear, "Kv_shear", .false., restart_CS, &
"Shear-driven turbulent viscosity at interfaces", &
- units="m2 s-1", conversion=US%Z2_T_to_m2_s, z_grid='i')
+ units=Kv_units, conversion=GV%HZ_T_to_MKS, z_grid='i')
endif
if (use_kappa_shear .and. KS_at_vertex) then
call safe_alloc_ptr(visc%TKE_turb, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1)
call safe_alloc_ptr(visc%Kv_shear_Bu, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1)
call register_restart_field(visc%Kv_shear_Bu, "Kv_shear_Bu", .false., restart_CS, &
"Shear-driven turbulent viscosity at vertex interfaces", &
- units="m2 s-1", conversion=US%Z2_T_to_m2_s, hor_grid="Bu", z_grid='i')
+ units=Kv_units, conversion=GV%HZ_T_to_MKS, hor_grid="Bu", z_grid='i')
elseif (use_kappa_shear) then
call safe_alloc_ptr(visc%TKE_turb, isd, ied, jsd, jed, nz+1)
endif
@@ -1933,14 +2157,13 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS)
call get_param(param_file, mdl, "HFREEZE", hfreeze, &
units="m", default=-1.0, scale=US%m_to_Z, do_not_log=.true.)
- if (MLE_use_PBL_MLD) then
+ if (hfreeze >= 0.0 .or. MLE_use_PBL_MLD) then
call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed)
- call register_restart_field(visc%MLD, "MLD", .false., restart_CS, &
- "Instantaneous active mixing layer depth", "m", conversion=US%Z_to_m)
endif
- if (hfreeze >= 0.0 .and. .not.MLE_use_PBL_MLD) then
- call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed)
+ if (MLE_use_PBL_MLD) then
+ call register_restart_field(visc%MLD, "MLD", .false., restart_CS, &
+ "Instantaneous active mixing layer depth", units="m", conversion=US%Z_to_m)
endif
! visc%sfc_buoy_flx is used to communicate the state of the (e)PBL or KPP to the rest of the model
@@ -1953,6 +2176,19 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS)
conversion=US%Z_to_m**2*US%s_to_T**3)
endif
+ if (use_ice_shelf) then
+ if (.not.allocated(visc%taux_shelf)) &
+ allocate(visc%taux_shelf(G%IsdB:G%IedB, G%jsd:G%jed), source=0.0)
+ if (.not.allocated(visc%tauy_shelf)) &
+ allocate(visc%tauy_shelf(G%isd:G%ied, G%JsdB:G%JedB), source=0.0)
+ u_desc = var_desc("u_taux_shelf", "Pa", "the zonal stress on the ocean under ice shelves", &
+ hor_grid='Cu',z_grid='1')
+ v_desc = var_desc("v_tauy_shelf", "Pa", "the meridional stress on the ocean under ice shelves", &
+ hor_grid='Cv',z_grid='1')
+ call register_restart_pair(visc%taux_shelf, visc%tauy_shelf, u_desc, v_desc, &
+ .false., restart_CS, conversion=US%RZ_T_to_kg_m2s*US%L_T_to_m_s)
+ endif
+
end subroutine set_visc_register_restarts
!> This subroutine does remapping for the auxiliary restart variables in a vertvisc_type
@@ -2010,16 +2246,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
! is used in place of the absolute value of the local Coriolis
! parameter in the denominator of some expressions [nondim]
real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [Z ~> m]
- real :: Hbbl ! The static bottom boundary layer thickness [Z ~> m].
- real :: BBL_thick_min ! The minimum bottom boundary layer thickness [Z ~> m].
integer :: i, j, k, is, ie, js, je
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
logical :: adiabatic, use_omega, MLE_use_PBL_MLD
logical :: use_KPP
logical :: use_regridding ! If true, use the ALE algorithm rather than layered
@@ -2049,22 +2279,12 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "SET_VISC_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "SET_VISC_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the set viscosity "//&
"calculations. Values below 20190101 recover the answers from the end of 2018, "//&
- "while higher values use updated and more robust forms of the same expressions. "//&
- "If both SET_VISC_2018_ANSWERS and SET_VISC_ANSWER_DATE are specified, "//&
- "the latter takes precedence.", default=default_answer_date)
+ "while higher values use updated and more robust forms of the same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, &
"If true, the bottom stress is calculated with a drag "//&
"law of the form c_drag*|u|*u. The velocity magnitude "//&
@@ -2138,14 +2358,14 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
"The rotation rate of the earth.", &
units="s-1", default=7.2921e-5, scale=US%T_to_s)
! This give a minimum decay scale that is typically much less than Angstrom.
- CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff)
+ CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_H + GV%H_subroundoff)
else
call get_param(param_file, mdl, "OMEGA", CS%omega, &
"The rotation rate of the earth.", &
units="s-1", default=7.2921e-5, scale=US%T_to_s)
endif
- call get_param(param_file, mdl, "HBBL", Hbbl, &
+ call get_param(param_file, mdl, "HBBL", CS%dz_bbl, &
"The thickness of a bottom boundary layer with a viscosity increased by "//&
"KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which "//&
"near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is "//&
@@ -2190,7 +2410,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
if (use_regridding .and. (.not. CS%BBL_use_EOS)) &
call MOM_error(FATAL,"When using MOM6 in ALE mode it is required to set BBL_USE_EOS to True.")
endif
- call get_param(param_file, mdl, "BBL_THICK_MIN", BBL_thick_min, &
+ call get_param(param_file, mdl, "BBL_THICK_MIN", CS%BBL_thick_min, &
"The minimum bottom boundary layer thickness that can be "//&
"used with BOTTOMDRAGLAW. This might be "//&
"Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//&
@@ -2199,12 +2419,12 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
"The minimum top boundary layer thickness that can be "//&
"used with BOTTOMDRAGLAW. This might be "//&
"Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//&
- "near-top viscosity.", units="m", default=US%Z_to_m*BBL_thick_min, scale=GV%m_to_H)
+ "near-top viscosity.", units="m", default=US%Z_to_m*CS%BBL_thick_min, scale=US%m_to_Z)
call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, &
"The thickness over which near-surface velocities are "//&
"averaged for the drag law under an ice shelf. By "//&
"default this is the same as HBBL", &
- units="m", default=US%Z_to_m*Hbbl, scale=GV%m_to_H)
+ units="m", default=US%Z_to_m*CS%dz_bbl, scale=GV%m_to_H)
call get_param(param_file, mdl, "KV", Kv_background, &
"The background kinematic viscosity in the interior. "//&
@@ -2218,10 +2438,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, &
"The minimum viscosities in the bottom boundary layer.", &
- units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, &
"The minimum viscosities in the top boundary layer.", &
- units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=US%m2_s_to_Z2_T)
+ units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "CORRECT_BBL_BOUNDS", CS%correct_BBL_bounds, &
"If true, uses the correct bounds on the BBL thickness and "//&
"viscosity so that the bottom layer feels the intended drag.", &
@@ -2244,21 +2464,20 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
endif
Chan_max_thick_dflt = -1.0*US%m_to_Z
- if (CS%RiNo_mix) Chan_max_thick_dflt = 0.5*Hbbl
- if (CS%body_force_drag) Chan_max_thick_dflt = Hbbl
+ if (CS%RiNo_mix) Chan_max_thick_dflt = 0.5*CS%dz_bbl
+ if (CS%body_force_drag) Chan_max_thick_dflt = CS%dz_bbl
call get_param(param_file, mdl, "CHANNEL_DRAG_MAX_BBL_THICK", CS%Chan_drag_max_vol, &
"The maximum bottom boundary layer thickness over which the channel drag is "//&
"exerted, or a negative value for no fixed limit, instead basing the BBL "//&
"thickness on the bottom stress, rotation and stratification. The default is "//&
"proportional to HBBL if USE_JACKSON_PARAM or DRAG_AS_BODY_FORCE is true.", &
- units="m", default=US%Z_to_m*Chan_max_thick_dflt, scale=GV%m_to_H, &
+ units="m", default=US%Z_to_m*Chan_max_thick_dflt, scale=US%m_to_Z, &
do_not_log=.not.CS%Channel_drag)
call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, &
default=.false., do_not_log=.true.)
- CS%Hbbl = Hbbl * GV%Z_to_H ! Rescaled for later use
- CS%BBL_thick_min = BBL_thick_min * GV%Z_to_H ! Rescaled for later use
+ CS%Hbbl = CS%dz_bbl * (US%Z_to_m * GV%m_to_H) ! Rescaled for use in expressions in thickness units.
if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then
! This is necessary for reproducibility across restarts in non-symmetric mode.
@@ -2276,7 +2495,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', &
diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=US%Z_to_m)
CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, &
- Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
CS%id_bbl_u = register_diag_field('ocean_model', 'bbl_u', diag%axesCu1, &
Time, 'BBL mean u current', 'm s-1', conversion=US%L_T_to_m_s)
if (CS%id_bbl_u>0) then
@@ -2285,7 +2504,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', &
diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=US%Z_to_m)
CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, &
- Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
CS%id_bbl_v = register_diag_field('ocean_model', 'bbl_v', diag%axesCv1, &
Time, 'BBL mean v current', 'm s-1', conversion=US%L_T_to_m_s)
if (CS%id_bbl_v>0) then
@@ -2303,9 +2522,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS
allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz), source=0.0)
allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz), source=0.0)
CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, &
- Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m*US%s_to_T)
+ Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=GV%H_to_m*US%s_to_T)
CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, &
- Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m*US%s_to_T)
+ Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=GV%H_to_m*US%s_to_T)
endif
diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90
index 0ef732a024..4bdf610a24 100644
--- a/src/parameterizations/vertical/MOM_sponge.F90
+++ b/src/parameterizations/vertical/MOM_sponge.F90
@@ -3,16 +3,17 @@ module MOM_sponge
! This file is part of MOM6. See LICENSE.md for the license.
-use MOM_coms, only : sum_across_PEs
+use MOM_coms, only : sum_across_PEs
use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field
use MOM_diag_mediator, only : diag_ctrl
use MOM_error_handler, only : MOM_error, FATAL, NOTE, WARNING, is_root_pe
-use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
-use MOM_grid, only : ocean_grid_type
+use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
+use MOM_grid, only : ocean_grid_type
use MOM_spatial_means, only : global_i_mean
-use MOM_time_manager, only : time_type
-use MOM_unit_scaling, only : unit_scale_type
-use MOM_verticalGrid, only : verticalGrid_type
+use MOM_time_manager, only : time_type
+use MOM_unit_scaling, only : unit_scale_type
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
! Planned extension: Support for time varying sponge targets.
@@ -301,12 +302,14 @@ end subroutine set_up_sponge_ML_density
!> This subroutine applies damping to the layers thicknesses, mixed layer buoyancy, and a variety of
!! tracers for every column where there is damping.
-subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml)
+subroutine apply_sponge(h, tv, dt, G, GV, US, ea, eb, CS, Rcv_ml)
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
+ !! thermodynamic variables
real, intent(in) :: dt !< The amount of time covered by this call [T ~> s].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: ea !< An array to which the amount of fluid entrained
@@ -344,10 +347,14 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml)
! give 0 at the surface [nondim].
real :: e(SZK_(GV)+1) ! The interface heights [Z ~> m], usually negative.
+ real :: dz_to_h(SZK_(GV)+1) ! Factors used to convert interface height movement
+ ! to thickness fluxes [H Z-1 ~> nondim or kg m-3]
real :: e0 ! The height of the free surface [Z ~> m].
real :: e_str ! A nondimensional amount by which the reference
! profile must be stretched for the free surfaces
! heights in the two profiles to agree [nondim].
+ real :: w_mean ! The vertical displacement of water moving upward through an
+ ! interface within 1 timestep [Z ~> m].
real :: w ! The thickness of water moving upward through an
! interface within 1 timestep [H ~> m or kg m-2].
real :: wm ! wm is w if w is negative and 0 otherwise [H ~> m or kg m-2].
@@ -381,9 +388,15 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml)
"work properly with i-mean sponges and a bulk mixed layer.")
do j=js,je ; do i=is,ie ; e_D(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo
- do k=nz,1,-1 ; do j=js,je ; do i=is,ie
- e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_Z
- enddo ; enddo ; enddo
+ if ((.not.GV%Boussinesq) .and. allocated(tv%SpV_avg)) then
+ do k=nz,1,-1 ; do j=js,je ; do i=is,ie
+ e_D(i,j,K) = e_D(i,j,K+1) + GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)
+ enddo ; enddo ; enddo
+ else
+ do k=nz,1,-1 ; do j=js,je ; do i=is,ie
+ e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_Z
+ enddo ; enddo ; enddo
+ endif
do j=js,je
do i=is,ie
dilate(i) = (G%bathyT(i,j) + G%Z_ref) / (e_D(i,j,1) + G%bathyT(i,j))
@@ -421,20 +434,39 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml)
do K=2,nz+1 ; do i=is,ie
h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom_H, 0.0)
enddo ; enddo
- do K=2,nz
- ! w is positive for an upward (lightward) flux of mass, resulting
- ! in the downward movement of an interface.
- w = damp_1pdamp * eta_mean_anom(j,K) * GV%Z_to_H
- do i=is,ie
+
+ ! In both blocks below, w is positive for an upward (lightward) flux of mass,
+ ! resulting in the downward movement of an interface.
+ if ((.not.GV%Boussinesq) .and. allocated(tv%SpV_avg)) then
+ do K=2,nz
+ w_mean = damp_1pdamp * eta_mean_anom(j,K)
+ do i=is,ie
+ w = w_mean * 2.0*GV%RZ_to_H / (tv%SpV_avg(i,j,k-1) + tv%SpV_avg(i,j,k))
+ if (w > 0.0) then
+ w_int(i,j,K) = min(w, h_below(i,K))
+ eb(i,j,k-1) = eb(i,j,k-1) + w_int(i,j,K)
+ else
+ w_int(i,j,K) = max(w, -h_above(i,K))
+ ea(i,j,k) = ea(i,j,k) - w_int(i,j,K)
+ endif
+ enddo
+ enddo
+ else
+ do K=2,nz
+ w = damp_1pdamp * eta_mean_anom(j,K) * GV%Z_to_H
if (w > 0.0) then
- w_int(i,j,K) = min(w, h_below(i,K))
- eb(i,j,k-1) = eb(i,j,k-1) + w_int(i,j,K)
+ do i=is,ie
+ w_int(i,j,K) = min(w, h_below(i,K))
+ eb(i,j,k-1) = eb(i,j,k-1) + w_int(i,j,K)
+ enddo
else
- w_int(i,j,K) = max(w, -h_above(i,K))
- ea(i,j,k) = ea(i,j,k) - w_int(i,j,K)
+ do i=is,ie
+ w_int(i,j,K) = max(w, -h_above(i,K))
+ ea(i,j,k) = ea(i,j,k) - w_int(i,j,K)
+ enddo
endif
enddo
- enddo
+ endif
do k=1,nz ; do i=is,ie
ea_k = max(0.0, -w_int(i,j,K))
eb_k = max(0.0, w_int(i,j,K+1))
@@ -459,9 +491,20 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml)
damp = dt * CS%Iresttime_col(c)
e(1) = 0.0 ; e0 = 0.0
- do K=1,nz
- e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z
- enddo
+ if ((.not.GV%Boussinesq) .and. allocated(tv%SpV_avg)) then
+ do K=1,nz
+ e(K+1) = e(K) - GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)
+ enddo
+ dz_to_h(1) = GV%RZ_to_H / tv%SpV_avg(i,j,1)
+ do K=2,nz
+ dz_to_h(K) = 2.0*GV%RZ_to_H / (tv%SpV_avg(i,j,k-1) + tv%SpV_avg(i,j,k))
+ enddo
+ else
+ do K=1,nz
+ e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z
+ dz_to_h(K) = GV%Z_to_H
+ enddo
+ endif
e_str = e(nz+1) / CS%Ref_eta(nz+1,c)
if ( CS%bulkmixedlayer ) then
@@ -478,7 +521,7 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml)
wpb = 0.0; wb = 0.0
do k=nz,nkmb+1,-1
if (GV%Rlay(k) > Rcv_ml(i,j)) then
- w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, &
+ w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*dz_to_h(K), &
((wb + h(i,j,k)) - GV%Angstrom_H))
wm = 0.5*(w-ABS(w))
do m=1,CS%fldno
@@ -534,7 +577,7 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml)
wpb = 0.0
wb = 0.0
do k=nz,1,-1
- w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, &
+ w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*dz_to_h(K), &
((wb + h(i,j,k)) - GV%Angstrom_H))
wm = 0.5*(w - ABS(w))
do m=1,CS%fldno
diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90
index 430a9225b5..31f90cdcb1 100644
--- a/src/parameterizations/vertical/MOM_tidal_mixing.F90
+++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90
@@ -43,9 +43,11 @@ module MOM_tidal_mixing
!> Containers for tidal mixing diagnostics
type, public :: tidal_mixing_diags ; private
- real, allocatable :: Kd_itidal(:,:,:) !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1].
- real, allocatable :: Fl_itidal(:,:,:) !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3]
- real, allocatable :: Kd_Niku(:,:,:) !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1].
+ real, allocatable :: Kd_itidal(:,:,:) !< internal tide diffusivity at interfaces
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real, allocatable :: Fl_itidal(:,:,:) !< vertical flux of tidal turbulent dissipation
+ !! [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real, allocatable :: Kd_Niku(:,:,:) !< lee-wave diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, allocatable :: Kd_Niku_work(:,:,:) !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2]
real, allocatable :: Kd_Itidal_Work(:,:,:) !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2]
real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2]
@@ -55,14 +57,14 @@ module MOM_tidal_mixing
real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally,
!! interpolated to model vertical coordinate [R Z3 T-3 ~> W m-2]
real, allocatable :: Kd_lowmode(:,:,:) !< internal tide diffusivity at interfaces
- !! due to propagating low modes [Z2 T-1 ~> m2 s-1].
+ !! due to propagating low modes [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, allocatable :: Fl_lowmode(:,:,:) !< vertical flux of tidal turbulent
- !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3]
+ !! dissipation due to propagating low modes [H Z2 T-3 ~> m3 s-3 or W m-2]
real, allocatable :: TKE_itidal_used(:,:) !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2]
real, allocatable :: N2_bot(:,:) !< bottom squared buoyancy frequency [T-2 ~> s-2]
real, allocatable :: N2_meanz(:,:) !< vertically averaged buoyancy frequency [T-2 ~> s-2]
- real, allocatable :: Polzin_decay_scale_scaled(:,:) !< vertical scale of decay for tidal dissipation [Z ~> m]
- real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal dissipation with Polzin [Z ~> m]
+ real, allocatable :: Polzin_decay_scale_scaled(:,:) !< Vertical scale of decay for tidal dissipation [Z ~> m]
+ real, allocatable :: Polzin_decay_scale(:,:) !< Vertical decay scale for tidal dissipation with Polzin [Z ~> m]
real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient [nondim]
end type
@@ -86,7 +88,7 @@ module MOM_tidal_mixing
!! for dissipation of the lee waves. Schemes that are
!! currently encoded are St Laurent et al (2002) and
!! Polzin (2009).
- real :: Int_tide_decay_scale !< decay scale for internal wave TKE [Z ~> m].
+ real :: Int_tide_decay_scale !< decay scale for internal wave TKE [Z ~> m]
real :: Mu_itides !< efficiency for conversion of dissipation
!! to potential energy [nondim]
@@ -117,7 +119,7 @@ module MOM_tidal_mixing
!! profile in Polzin formulation should not exceed
!! Polzin_decay_scale_max_factor * depth of the ocean [nondim].
real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation
- !! profile in Polzin formulation [Z ~> m].
+ !! profile in Polzin formulation [Z ~> m]
real :: TKE_itide_max !< maximum internal tide conversion [R Z3 T-3 ~> W m-2]
!! available to mix above the BBL
@@ -155,8 +157,9 @@ module MOM_tidal_mixing
! Data containers
real, allocatable :: TKE_Niku(:,:) !< Lee wave driven Turbulent Kinetic Energy input
!! [R Z3 T-3 ~> W m-2]
- real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided
- !! by the bottom stratification [R Z3 T-2 ~> J m-2].
+ real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided by
+ !! the bottom stratification and in non-Boussinesq mode by
+ !! the near-bottom density [R Z4 H-1 T-2 ~> J m-2 or J m kg-1]
real, allocatable :: Nb(:,:) !< The near bottom buoyancy frequency [T-1 ~> s-1].
real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input [nondim]
real, allocatable :: h2(:,:) !< Squared bottom depth variance [Z2 ~> m2].
@@ -218,7 +221,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle
- type(int_tide_CS),target, intent(in) :: int_tide_CSp !< A pointer to the internal tides control structure
+ type(int_tide_CS), pointer :: int_tide_CSp !< A pointer to the internal tides control structure
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure.
type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure.
@@ -227,15 +230,6 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
logical :: int_tide_dissipation
logical :: read_tideamp
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the remapping answers from 2018. If false, use more
- ! robust forms of the same remapping expressions.
- integer :: default_remap_ans_date ! The default setting for remap_answer_date
- integer :: default_tide_ans_date ! The default setting for tides_answer_date
- logical :: tide_answers_2018 ! If true, use the order of arithmetic and expressions that recover the
- ! answers from the end of 2018. Otherwise, use updated and more robust
- ! forms of the same expressions.
character(len=20) :: tmpstr, int_tide_profile_str
character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type
character(len=200) :: filename, h2_file, Niku_TKE_input_file ! Input file names
@@ -282,7 +276,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
CS%debug = CS%debug.and.is_root_pe()
CS%diag => diag
- CS%int_tide_CSp => int_tide_CSp
+ if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp
CS%use_CVmix_tidal = use_CVmix_tidal
CS%int_tide_dissipation = int_tide_dissipation
@@ -292,39 +286,20 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", tide_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for the tidal mixing.
- default_tide_ans_date = default_answer_date
- if (tide_answers_2018 .and. (default_tide_ans_date >= 20190101)) default_tide_ans_date = 20181231
- if (.not.tide_answers_2018 .and. (default_tide_ans_date < 20190101)) default_tide_ans_date = 20190101
call get_param(param_file, mdl, "TIDAL_MIXING_ANSWER_DATE", CS%tidal_answer_date, &
"The vintage of the order of arithmetic and expressions in the tidal mixing "//&
"calculations. Values below 20190101 recover the answers from the end of 2018, "//&
- "while higher values use updated and more robust forms of the same expressions. "//&
- "If both TIDAL_MIXING_2018_ANSWERS and TIDAL_MIXING_ANSWER_DATE are specified, "//&
- "the latter takes precedence.", default=default_tide_ans_date)
-
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- default_remap_ans_date = default_answer_date
- if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231
- if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101
+ "while higher values use updated and more robust forms of the same expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%tidal_answer_date = max(CS%tidal_answer_date, 20230701)
+
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_remap_ans_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%remap_answer_date = max(CS%remap_answer_date, 20230701)
if (CS%int_tide_dissipation) then
@@ -545,8 +520,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
utide = CS%tideamp(i,j)
! Compute the fixed part of internal tidal forcing.
- ! The units here are [R Z3 T-2 ~> J m-2 = kg s-2] here.
- CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%Rho0 * &
+ ! The units here are [R Z4 H-1 T-2 ~> J m-2 or m3 s-2] here. (Note that J m-2 = kg s-2.)
+ CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%H_to_RZ * &
CS%kappa_itides * CS%h2(i,j) * utide*utide
enddo ; enddo
@@ -639,7 +614,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
CS%Lowmode_itidal_dissipation) then
CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, &
- 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
if (CS%use_CVMix_tidal) then
CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, &
@@ -666,24 +641,24 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, &
'Internal Tide Driven Diffusivity (from propagating low modes)', &
- 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, &
'Vertical flux of tidal turbulent dissipation', &
- 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3))
+ 'm3 s-3', conversion=(GV%H_to_m*US%Z_to_m**2*US%s_to_T**3))
CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, &
'Vertical flux of tidal turbulent dissipation (from propagating low modes)', &
- 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3))
+ 'm3 s-3', conversion=(GV%H_to_m*US%Z_to_m**2*US%s_to_T**3))
- CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, &
+ CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale', diag%axesT1, Time, &
'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', &
- 'm', conversion=US%Z_to_m)
+ units='m', conversion=US%Z_to_m)
CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', &
'Polzin_decay_scale_scaled', diag%axesT1, Time, &
'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// &
- 'scaled by N2_bot/N2_meanz', 'm', conversion=US%Z_to_m)
+ 'scaled by N2_bot/N2_meanz', units='m', conversion=US%Z_to_m)
CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, &
'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2)
@@ -708,7 +683,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
'Lee wave Driven Turbulent Kinetic Energy', &
'W m-2', conversion=US%RZ3_T3_to_W_m2)
CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, &
- 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
endif
endif ! S%use_CVMix_tidal
endif
@@ -719,16 +694,16 @@ end function tidal_mixing_init
!> Depending on whether or not CVMix is active, calls the associated subroutine to compute internal
!! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface
!! diffusivities.
-subroutine calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, max_TKE, &
+subroutine calculate_tidal_mixing(dz, j, N2_bot, Rho_bot, N2_lay, N2_int, TKE_to_Kd, max_TKE, &
G, GV, US, CS, Kd_max, Kv, Kd_lay, Kd_int)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m]
integer, intent(in) :: j !< The j-index to work on
real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy
!! frequency [T-2 ~> s-2].
+ real, dimension(SZI_(G)), intent(in) :: Rho_bot !< The near-bottom in situ density [R ~> kg m-3]
real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the
!! layers [T-2 ~> s-2].
real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the
@@ -737,27 +712,29 @@ subroutine calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, max_T
!! dissipated within a layer and the
!! diapycnal diffusivity within that layer,
!! usually (~Rho_0 / (G_Earth * dRho_lay))
- !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]
- real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain
- !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3]
+ !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required for a layer to
+ !! entrain to its maximum realizable
+ !! thickness [H Z2 T-3 ~> m3 s-3 or W m-2]
type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module
real, intent(in) :: Kd_max !< The maximum increment for diapycnal
!! diffusivity due to TKE-based processes,
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
!! Set this to a negative value to have no limit.
real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface
- !! (not layer!) [Z2 T-1 ~> m2 s-1].
+ !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZI_(G),SZK_(GV)), &
- optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1].
+ optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZK_(GV)+1), &
- optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces,
- !! [Z2 T-1 ~> m2 s-1].
+ optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then
if (CS%use_CVMix_tidal) then
- call calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int)
+ call calculate_CVMix_tidal(dz, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int)
else
- call add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
+ call add_int_tide_diffusivity(dz, j, N2_bot, Rho_bot, N2_lay, TKE_to_Kd, max_TKE, &
G, GV, US, CS, Kd_max, Kd_lay, Kd_int)
endif
endif
@@ -766,22 +743,23 @@ end subroutine calculate_tidal_mixing
!> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven
!! mixing to the interface diffusivities.
-subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int)
+subroutine calculate_CVMix_tidal(dz, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int)
type(ocean_grid_type), intent(in) :: G !< Grid structure.
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure.
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m]
integer, intent(in) :: j !< The j-index to work on
real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy
!! frequency at the interfaces [T-2 ~> s-2].
real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface
- !! (not layer!) [Z2 T-1 ~> m2 s-1].
+ !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZI_(G),SZK_(GV)), &
- optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers [Z2 T-1 ~> m2 s-1].
+ optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZI_(G),SZK_(GV)+1), &
- optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces [Z2 T-1 ~> m2 s-1].
+ optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
! Local variables
real, dimension(SZK_(GV)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1]
real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1]
@@ -801,7 +779,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int
! related to the distribution of tidal mixing energy, with unusual array
! extents that are not explained, that is set and used by the CVMix
! tidal mixing schemes, perhaps in [m3 kg-1]?
- real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m]
+ real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m]
real :: Simmons_coeff ! A coefficient in the Simmons et al (2004) mixing parameterization [nondim]
integer :: i, k, is, ie
@@ -820,7 +798,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int
hcorr = 0.0
! Compute cell center depth and cell bottom in meters (negative values in the ocean)
do k=1,GV%ke
- dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights
+ dh = dz(i,k) ! Nominal thickness to use for increment, in the units of heights
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness
@@ -862,24 +840,24 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int
! Update diffusivity
if (present(Kd_lay)) then
do k=1,GV%ke
- Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1))
+ Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * GV%m2_s_to_HZ_T * (Kd_tidal(k) + Kd_tidal(k+1))
enddo
endif
if (present(Kd_int)) then
do K=1,GV%ke+1
- Kd_int(i,K) = Kd_int(i,K) + (US%m2_s_to_Z2_T * Kd_tidal(K))
+ Kd_int(i,K) = Kd_int(i,K) + GV%m2_s_to_HZ_T * Kd_tidal(K)
enddo
endif
! Update viscosity with the proper unit conversion.
if (associated(Kv)) then
do K=1,GV%ke+1
- Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1.
+ Kv(i,j,K) = Kv(i,j,K) + GV%m2_s_to_HZ_T * Kv_tidal(K) ! Rescale from m2 s-1 to H Z T-1.
enddo
endif
! diagnostics
if (allocated(CS%dd%Kd_itidal)) then
- CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T * Kd_tidal(:)
+ CS%dd%Kd_itidal(i,j,:) = GV%m2_s_to_HZ_T * Kd_tidal(:)
endif
if (allocated(CS%dd%N2_int)) then
CS%dd%N2_int(i,j,:) = N2_int(i,:)
@@ -908,8 +886,8 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int
hcorr = 0.0
! Compute heights at cell center and interfaces, and rescale layer thicknesses
do k=1,GV%ke
- h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix.
- dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights
+ h_m(k) = dz(i,k)*US%Z_to_m ! Rescale thicknesses to m for use by CVmix.
+ dh = dz(i,k) ! Nominal thickness to use for increment, in the units of heights
dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0)
hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0
dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness
@@ -963,25 +941,25 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int
! Update diffusivity
if (present(Kd_lay)) then
do k=1,GV%ke
- Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1))
+ Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * GV%m2_s_to_HZ_T * (Kd_tidal(k) + Kd_tidal(k+1))
enddo
endif
if (present(Kd_int)) then
do K=1,GV%ke+1
- Kd_int(i,K) = Kd_int(i,K) + (US%m2_s_to_Z2_T * Kd_tidal(K))
+ Kd_int(i,K) = Kd_int(i,K) + (GV%m2_s_to_HZ_T * Kd_tidal(K))
enddo
endif
! Update viscosity
if (associated(Kv)) then
do K=1,GV%ke+1
- Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1.
+ Kv(i,j,K) = Kv(i,j,K) + GV%m2_s_to_HZ_T * Kv_tidal(K) ! Rescale from m2 s-1 to H Z T-1.
enddo
endif
! diagnostics
if (allocated(CS%dd%Kd_itidal)) then
- CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:)
+ CS%dd%Kd_itidal(i,j,:) = GV%m2_s_to_HZ_T*Kd_tidal(:)
endif
if (allocated(CS%dd%N2_int)) then
CS%dd%N2_int(i,j,:) = N2_int(i,:)
@@ -1013,76 +991,76 @@ end subroutine calculate_CVMix_tidal
!! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves.
!! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction,
!! Froude-number-depending breaking, PSI, etc.).
-subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
+subroutine add_int_tide_diffusivity(dz, j, N2_bot, Rho_bot, N2_lay, TKE_to_Kd, max_TKE, &
G, GV, US, CS, Kd_max, Kd_lay, Kd_int)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m]
integer, intent(in) :: j !< The j-index to work on
real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency
!! frequency [T-2 ~> s-2].
+ real, dimension(SZI_(G)), intent(in) :: Rho_bot !< The near-bottom in situ density [R ~> kg m-3]
real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the
!! layers [T-2 ~> s-2].
real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE
!! dissipated within a layer and the
!! diapycnal diffusivity within that layer,
!! usually (~Rho_0 / (G_Earth * dRho_lay))
- !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]
- real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain
- !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3]
+ !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]
+ real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required for a layer
+ !! to entrain to its maximum realizable
+ !! thickness [H Z2 T-3 ~> m3 s-3 or W m-2]
type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module
real, intent(in) :: Kd_max !< The maximum increment for diapycnal
!! diffusivity due to TKE-based processes
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
!! Set this to a negative value to have no limit.
real, dimension(SZI_(G),SZK_(GV)), &
- optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]
+ optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
real, dimension(SZI_(G),SZK_(GV)+1), &
optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces
- !! [Z2 T-1 ~> m2 s-1].
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
! local
real, dimension(SZI_(G)) :: &
- htot, & ! total thickness above or below a layer, or the
- ! integrated thickness in the BBL [Z ~> m].
- htot_WKB, & ! WKB scaled distance from top to bottom [Z ~> m].
- TKE_itidal_bot, & ! internal tide TKE at ocean bottom [Z3 T-3 ~> m3 s-3]
- TKE_Niku_bot, & ! lee-wave TKE at ocean bottom [Z3 T-3 ~> m3 s-3]
- TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes [Z3 T-3 ~> m3 s-3] (BDM)
+ dztot, & ! Vertical distance between the top and bottom of the ocean [Z ~> m]
+ dztot_WKB, & ! WKB scaled distance from top to bottom [Z ~> m]
+ TKE_itidal_bot, & ! internal tide TKE at ocean bottom [H Z2 T-3 ~> m3 s-3 or W m-2]
+ TKE_Niku_bot, & ! lee-wave TKE at ocean bottom [H Z2 T-3 ~> m3 s-3 or W m-2]
+ TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes [H Z2 T-3 ~> m3 s-3 or W m-2]
Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean [nondim]
Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean [nondim]
- Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean [nondim] (BDM)
- z0_Polzin, & ! TKE decay scale in Polzin formulation [Z ~> m].
+ Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean [nondim]
+ z0_Polzin, & ! TKE decay scale in Polzin formulation [Z ~> m]
z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation [Z ~> m].
! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z
! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz)
! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz
N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2 ~> s-2] for WKB scaling
- TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [Z3 T-3 ~> m3 s-3]
- TKE_Niku_rem, & ! remaining lee-wave TKE [Z3 T-3 ~> m3 s-3]
- TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [Z3 T-3 ~> m3 s-3] (BDM)
+ TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [H Z2 T-3 ~> m3 s-3 or W m-2]
+ TKE_Niku_rem, & ! remaining lee-wave TKE [H Z2 T-3 ~> m3 s-3 or W m-2]
+ TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [H Z2 T-3 ~> m3 s-3 or W m-2]
TKE_frac_top, & ! fraction of bottom TKE that should appear at top of a layer [nondim]
TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer [nondim]
TKE_frac_top_lowmode, &
- ! fraction of bottom TKE that should appear at top of a layer [nondim] (BDM)
- z_from_bot, & ! distance from bottom [Z ~> m].
- z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m].
-
- real :: I_rho0 ! Inverse of the Boussinesq reference density, i.e. 1 / RHO0 [R-1 ~> m3 kg-1]
- real :: Kd_add ! diffusivity to add in a layer [Z2 T-1 ~> m2 s-1].
- real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [Z3 T-3 ~> m3 s-3]
- real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [Z3 T-3 ~> m3 s-3]
- real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [Z3 T-3 ~> m3 s-3] (BDM)
+ ! fraction of bottom TKE that should appear at top of a layer [nondim]
+ z_from_bot, & ! distance from bottom [Z ~> m]
+ z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]
+
+ real :: Kd_add ! Diffusivity to add in a layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [H Z2 T-3 ~> m3 s-3 or W m-2]
+ real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [H Z2 T-3 ~> m3 s-3 or W m-2]
real :: frac_used ! fraction of TKE that can be used in a layer [nondim]
- real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1].
- real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1].
- real :: z0Ps_num ! The numerator of the unlimited z0_Polzin_scaled [Z T-3 ~> m s-3].
+ real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]
+ real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]
+ real :: z0Ps_num ! The numerator of the unlimited z0_Polzin_scaled [Z T-3 ~> m s-3]
real :: z0Ps_denom ! The denominator of the unlimited z0_Polzin_scaled [T-3 ~> s-3].
- real :: z0_psl ! temporary variable [Z ~> m].
- real :: TKE_lowmode_tot ! TKE from all low modes [R Z3 T-3 ~> W m-2] (BDM)
+ real :: z0_psl ! temporary variable [Z ~> m]
+ real :: TKE_lowmode_tot ! TKE from all low modes [R Z3 T-3 ~> W m-2]
logical :: use_Polzin, use_Simmons
integer :: i, k, is, ie, nz
@@ -1091,13 +1069,11 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return
- do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo
+ do i=is,ie ; dztot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ; enddo
do k=1,nz ; do i=is,ie
- htot(i) = htot(i) + GV%H_to_Z*h(i,j,k)
+ dztot(i) = dztot(i) + dz(i,k)
enddo ; enddo
- I_Rho0 = 1.0 / (GV%Rho0)
-
use_Polzin = ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. &
(CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09)) .or. &
(CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09)))
@@ -1108,29 +1084,28 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
! Calculate parameters for vertical structure of dissipation
! Simmons:
if ( use_Simmons ) then
- Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_Z)
- Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, &
- GV%H_subroundoff*GV%H_to_Z)
+ Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%dz_subroundoff)
+ Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, GV%dz_subroundoff)
do i=is,ie
CS%Nb(i,j) = sqrt(N2_bot(i))
if (allocated(CS%dd%N2_bot)) &
CS%dd%N2_bot(i,j) = N2_bot(i)
if ( CS%Int_tide_dissipation ) then
- if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule.
- Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i)))
+ if (Izeta*dztot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule.
+ Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*dztot(i)))
endif
endif
if ( CS%Lee_wave_dissipation ) then
- if (Izeta_lee*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule.
- Inv_int_lee(i) = 1.0 / (1.0 - exp(-Izeta_lee*htot(i)))
+ if (Izeta_lee*dztot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule.
+ Inv_int_lee(i) = 1.0 / (1.0 - exp(-Izeta_lee*dztot(i)))
endif
endif
if ( CS%Lowmode_itidal_dissipation) then
- if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule.
- Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i)))
+ if (Izeta*dztot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule.
+ Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*dztot(i)))
endif
endif
- z_from_bot(i) = GV%H_to_Z*h(i,j,nz)
+ z_from_bot(i) = dz(i,nz)
enddo
endif ! Simmons
@@ -1139,109 +1114,109 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
! WKB scaling of the vertical coordinate
do i=is,ie ; N2_meanz(i) = 0.0 ; enddo
do k=1,nz ; do i=is,ie
- N2_meanz(i) = N2_meanz(i) + N2_lay(i,k) * GV%H_to_Z * h(i,j,k)
+ N2_meanz(i) = N2_meanz(i) + N2_lay(i,k) * dz(i,k)
enddo ; enddo
do i=is,ie
- N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z)
+ N2_meanz(i) = N2_meanz(i) / (dztot(i) + GV%dz_subroundoff)
if (allocated(CS%dd%N2_meanz)) &
CS%dd%N2_meanz(i,j) = N2_meanz(i)
enddo
! WKB scaled z*(z=H) z* at the surface using the modified Polzin WKB scaling
- do i=is,ie ; htot_WKB(i) = htot(i) ; enddo
-! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo
+ do i=is,ie ; dztot_WKB(i) = dztot(i) ; enddo
+! do i=is,ie ; dztot_WKB(i) = 0.0 ; enddo
! do k=1,nz ; do i=is,ie
-! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * N2_lay(i,k) / N2_meanz(i)
+! dztot_WKB(i) = dztot_WKB(i) + dz(i,k) * N2_lay(i,k) / N2_meanz(i)
! enddo ; enddo
- ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler
+ ! dztot_WKB(i) = dztot(i) ! Nearly equivalent and simpler
do i=is,ie
CS%Nb(i,j) = sqrt(N2_bot(i))
if (CS%tidal_answer_date < 20190101) then
if ((CS%tideamp(i,j) > 0.0) .and. &
(CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14*US%T_to_s**3) ) then
- z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * &
+ z0_Polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * &
CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / &
( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 )
- if (z0_polzin(i) < CS%Polzin_min_decay_scale) &
- z0_polzin(i) = CS%Polzin_min_decay_scale
+ if (z0_Polzin(i) < CS%Polzin_min_decay_scale) &
+ z0_Polzin(i) = CS%Polzin_min_decay_scale
if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then
- z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i)
+ z0_Polzin_scaled(i) = z0_Polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i)
else
- z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i)
+ z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i)
endif
- if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) &
- z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i)
+ if (z0_Polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * dztot(i)) ) &
+ z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i)
else
- z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i)
- z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i)
+ z0_Polzin(i) = CS%Polzin_decay_scale_max_factor * dztot(i)
+ z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i)
endif
else
z0Ps_num = (CS%Polzin_decay_scale_factor * CS%Nu_Polzin * CS%Nbotref_Polzin**2) * CS%tideamp(i,j)
z0Ps_denom = ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j) * N2_meanz(i) )
if ((CS%tideamp(i,j) > 0.0) .and. &
- (z0Ps_num < z0Ps_denom * CS%Polzin_decay_scale_max_factor * htot(i))) then
- z0_polzin_scaled(i) = z0Ps_num / z0Ps_denom
+ (z0Ps_num < z0Ps_denom * CS%Polzin_decay_scale_max_factor * dztot(i))) then
+ z0_Polzin_scaled(i) = z0Ps_num / z0Ps_denom
- if (abs(N2_meanz(i) * z0_polzin_scaled(i)) < &
- CS%Nb(i,j)**2 * (CS%Polzin_decay_scale_max_factor * htot(i))) then
- z0_polzin(i) = z0_polzin_scaled(i) * (N2_meanz(i) / CS%Nb(i,j)**2)
+ if (abs(N2_meanz(i) * z0_Polzin_scaled(i)) < &
+ CS%Nb(i,j)**2 * (CS%Polzin_decay_scale_max_factor * dztot(i))) then
+ z0_Polzin(i) = z0_Polzin_scaled(i) * (N2_meanz(i) / CS%Nb(i,j)**2)
else
- z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i)
+ z0_Polzin(i) = CS%Polzin_decay_scale_max_factor * dztot(i)
endif
else
- z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i)
- z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i)
+ z0_Polzin(i) = CS%Polzin_decay_scale_max_factor * dztot(i)
+ z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i)
endif
endif
if (allocated(CS%dd%Polzin_decay_scale)) &
- CS%dd%Polzin_decay_scale(i,j) = z0_polzin(i)
+ CS%dd%Polzin_decay_scale(i,j) = z0_Polzin(i)
if (allocated(CS%dd%Polzin_decay_scale_scaled)) &
- CS%dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i)
+ CS%dd%Polzin_decay_scale_scaled(i,j) = z0_Polzin_scaled(i)
if (allocated(CS%dd%N2_bot)) &
CS%dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j)
if (CS%tidal_answer_date < 20190101) then
! These expressions use dimensional constants to avoid NaN values.
if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then
- if (htot_WKB(i) > 1.0e-14*US%m_to_Z) &
- Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0
+ if (dztot_WKB(i) > 1.0e-14*US%m_to_Z) &
+ Inv_int(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0
endif
if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then
- if (htot_WKB(i) > 1.0e-14*US%m_to_Z) &
- Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0
+ if (dztot_WKB(i) > 1.0e-14*US%m_to_Z) &
+ Inv_int_lee(i) = ( z0_Polzin_scaled(i)*CS%Decay_scale_factor_lee / dztot_WKB(i) ) + 1.0
endif
if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then
- if (htot_WKB(i) > 1.0e-14*US%m_to_Z) &
- Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0
+ if (dztot_WKB(i) > 1.0e-14*US%m_to_Z) &
+ Inv_int_low(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0
endif
else
! These expressions give values of Inv_int < 10^14 using a variant of Adcroft's reciprocal rule.
Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0
if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then
- if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) &
- Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0
+ if (z0_Polzin_scaled(i) < 1.0e14 * dztot_WKB(i)) &
+ Inv_int(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0
endif
if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then
- if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) &
- Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0
+ if (z0_Polzin_scaled(i) < 1.0e14 * dztot_WKB(i)) &
+ Inv_int_lee(i) = ( z0_Polzin_scaled(i)*CS%Decay_scale_factor_lee / dztot_WKB(i) ) + 1.0
endif
if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then
- if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) &
- Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0
+ if (z0_Polzin_scaled(i) < 1.0e14 * dztot_WKB(i)) &
+ Inv_int_low(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0
endif
endif
- z_from_bot(i) = GV%H_to_Z*h(i,j,nz)
+ z_from_bot(i) = dz(i,nz)
! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean.
if (CS%tidal_answer_date < 20190101) then
if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then
- z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i)
+ z_from_bot_WKB(i) = dz(i,nz) * N2_lay(i,nz) / N2_meanz(i)
else ; z_from_bot_WKB(i) = 0 ; endif
else
- if (GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) < N2_meanz(i) * (1.0e14 * htot_WKB(i))) then
- z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i)
+ if (dz(i,nz) * N2_lay(i,nz) < N2_meanz(i) * (1.0e14 * dztot_WKB(i))) then
+ z_from_bot_WKB(i) = dz(i,nz) * N2_lay(i,nz) / N2_meanz(i)
else ; z_from_bot_WKB(i) = 0 ; endif
endif
enddo
@@ -1251,14 +1226,19 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
! Both Polzin and Simmons:
do i=is,ie
! Dissipation of locally trapped internal tide (non-propagating high modes)
- TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max)
+ if (GV%Boussinesq .or. GV%semi_Boussinesq) then
+ TKE_itidal_bot(i) = min(GV%Z_to_H*CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max)
+ else
+ TKE_itidal_bot(i) = min(GV%RZ_to_H*Rho_bot(i) * (CS%TKE_itidal(i,j)*CS%Nb(i,j)), &
+ CS%TKE_itide_max)
+ endif
if (allocated(CS%dd%TKE_itidal_used)) &
CS%dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i)
- TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i)
+ TKE_itidal_bot(i) = (GV%RZ_to_H * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i)
! Dissipation of locally trapped lee waves
TKE_Niku_bot(i) = 0.0
if (CS%Lee_wave_dissipation) then
- TKE_Niku_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_lee) * CS%TKE_Niku(i,j)
+ TKE_Niku_bot(i) = (GV%RZ_to_H * CS%Mu_itides * CS%Gamma_lee) * CS%TKE_Niku(i,j)
endif
! Dissipation of propagating internal tide (baroclinic low modes; rays) (BDM)
TKE_lowmode_tot = 0.0
@@ -1266,7 +1246,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
if (CS%Lowmode_itidal_dissipation) then
! get loss rate due to wave drag on low modes (already multiplied by q)
call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot)
- TKE_lowmode_bot(i) = CS%Mu_itides * I_rho0 * TKE_lowmode_tot
+ TKE_lowmode_bot(i) = CS%Mu_itides * GV%RZ_to_H * TKE_lowmode_tot
endif
! Vertical energy flux at bottom
TKE_itidal_rem(i) = Inv_int(i) * TKE_itidal_bot(i)
@@ -1282,7 +1262,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
if ( use_Simmons ) then
do k=nz-1,2,-1 ; do i=is,ie
if (max_TKE(i,k) <= 0.0) cycle
- z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k)
+ z_from_bot(i) = z_from_bot(i) + dz(i,k)
! Fraction of bottom flux predicted to reach top of this layer
TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i))
@@ -1296,7 +1276,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)* TKE_frac_top_lowmode(i)
! Actual power expended may be less than predicted if stratification is weak; adjust
- if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (max_TKE(i,k))) then
+ if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then
frac_used = (max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay)
TKE_itide_lay = frac_used * TKE_itide_lay
TKE_Niku_lay = frac_used * TKE_Niku_lay
@@ -1331,7 +1311,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
if (k 1.0e-14*US%T_to_s**2 ) then
- z_from_bot_WKB(i) = z_from_bot_WKB(i) &
- + GV%H_to_Z * h(i,j,k) * N2_lay(i,k) / N2_meanz(i)
+ z_from_bot_WKB(i) = z_from_bot_WKB(i) + dz(i,k) * N2_lay(i,k) / N2_meanz(i)
else ; z_from_bot_WKB(i) = 0 ; endif
else
- if (GV%H_to_Z*h(i,j,k) * N2_lay(i,k) < (1.0e14 * htot_WKB(i)) * N2_meanz(i)) then
- z_from_bot_WKB(i) = z_from_bot_WKB(i) + &
- GV%H_to_Z*h(i,j,k) * N2_lay(i,k) / N2_meanz(i)
+ if (dz(i,k) * N2_lay(i,k) < (1.0e14 * dztot_WKB(i)) * N2_meanz(i)) then
+ z_from_bot_WKB(i) = z_from_bot_WKB(i) + dz(i,k) * N2_lay(i,k) / N2_meanz(i)
endif
endif
! Fraction of bottom flux predicted to reach top of this layer
- TKE_frac_top(i) = ( Inv_int(i) * z0_polzin_scaled(i) ) / &
- ( z0_polzin_scaled(i) + z_from_bot_WKB(i) )
- z0_psl = z0_polzin_scaled(i)*CS%Decay_scale_factor_lee
+ TKE_frac_top(i) = ( Inv_int(i) * z0_Polzin_scaled(i) ) / &
+ ( z0_Polzin_scaled(i) + z_from_bot_WKB(i) )
+ z0_psl = z0_Polzin_scaled(i)*CS%Decay_scale_factor_lee
TKE_frac_top_lee(i) = (Inv_int_lee(i) * z0_psl) / (z0_psl + z_from_bot_WKB(i))
- TKE_frac_top_lowmode(i) = ( Inv_int_low(i) * z0_polzin_scaled(i) ) / &
- ( z0_polzin_scaled(i) + z_from_bot_WKB(i) )
+ TKE_frac_top_lowmode(i) = ( Inv_int_low(i) * z0_Polzin_scaled(i) ) / &
+ ( z0_Polzin_scaled(i) + z_from_bot_WKB(i) )
! Actual influx at bottom of layer minus predicted outflux at top of layer to give
! predicted power expended
@@ -1394,8 +1372,8 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)*TKE_frac_top_lowmode(i)
! Actual power expended may be less than predicted if stratification is weak; adjust
- if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (max_TKE(i,k))) then
- frac_used = (max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay)
+ if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then
+ frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay)
TKE_itide_lay = frac_used * TKE_itide_lay
TKE_Niku_lay = frac_used * TKE_Niku_lay
TKE_lowmode_lay = frac_used * TKE_lowmode_lay
@@ -1429,7 +1407,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, &
if (k
@@ -47,18 +48,18 @@ module MOM_vert_friction
!> The control structure with parameters and memory for the MOM_vert_friction module
type, public :: vertvisc_CS ; private
logical :: initialized = .false. !< True if this control structure has been initialized.
- real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2].
+ real :: Hmix !< The mixed layer thickness [Z ~> m].
real :: Hmix_stress !< The mixed layer thickness over which the wind
!! stress is applied with direct_stress [H ~> m or kg m-2].
- real :: Kvml_invZ2 !< The extra vertical viscosity scale in [Z2 T-1 ~> m2 s-1] in a
+ real :: Kvml_invZ2 !< The extra vertical viscosity scale in [H Z T-1 ~> m2 s-1 or Pa s] in a
!! surface mixed layer with a characteristic thickness given by Hmix,
!! and scaling proportional to (Hmix/z)^2, where z is the distance
!! from the surface; this can get very large with thin layers.
- real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1].
- real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2].
- real :: Hbbl_gl90 !< The static bottom boundary layer thickness used for GL90 [H ~> m or kg m-2].
+ real :: Kv !< The interior vertical viscosity [H Z T-1 ~> m2 s-1 or Pa s].
+ real :: Hbbl !< The static bottom boundary layer thickness [Z ~> m].
+ real :: Hbbl_gl90 !< The static bottom boundary layer thickness used for GL90 [Z ~> m].
real :: Kv_extra_bbl !< An extra vertical viscosity in the bottom boundary layer of thickness
- !! Hbbl when there is not a bottom drag law in use [Z2 T-1 ~> m2 s-1].
+ !! Hbbl when there is not a bottom drag law in use [H Z T-1 ~> m2 s-1 or Pa s].
real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim]
logical :: use_GL90_in_SSW !< If true, use the GL90 parameterization in stacked shallow water mode (SSW).
@@ -68,12 +69,12 @@ module MOM_vert_friction
logical :: use_GL90_N2 !< If true, use GL90 vertical viscosity coefficient that is depth-independent;
!! this corresponds to a kappa_GM that scales as N^2 with depth.
real :: kappa_gl90 !< The scalar diffusivity used in the GL90 vertical viscosity scheme
- !! [L2 T-1 ~> m2 s-1]
+ !! [L2 H Z-1 T-1 ~> m2 s-1 or Pa s]
logical :: read_kappa_gl90 !< If true, read a file containing the spatially varying kappa_gl90
real :: alpha_gl90 !< Coefficient used to compute a depth-independent GL90 vertical
!! viscosity via Kv_gl90 = alpha_gl90 * f^2. Note that the implied
!! Kv_gl90 corresponds to a kappa_gl90 that scales as N^2 with depth.
- !! [L2 T ~> m2 s]
+ !! [H Z T ~> m2 s or kg s m-1]
real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1].
real :: vel_underflow !< Velocity components smaller than vel_underflow
!! are set to 0 [L T-1 ~> m s-1].
@@ -93,21 +94,21 @@ module MOM_vert_friction
type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: &
- a_u !< The u-drag coefficient across an interface [Z T-1 ~> m s-1].
+ a_u !< The u-drag coefficient across an interface [H T-1 ~> m s-1 or Pa s m-1]
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: &
- a_u_gl90 !< The u-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1].
+ a_u_gl90 !< The u-drag coefficient associated with GL90 across an interface [H T-1 ~> m s-1 or Pa s m-1]
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
h_u !< The effective layer thickness at u-points [H ~> m or kg m-2].
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: &
- a_v !< The v-drag coefficient across an interface [Z T-1 ~> m s-1].
+ a_v !< The v-drag coefficient across an interface [H T-1 ~> m s-1 or Pa s m-1]
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: &
- a_v_gl90 !< The v-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1].
+ a_v_gl90 !< The v-drag coefficient associated with GL90 across an interface [H T-1 ~> m s-1 or Pa s m-1]
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
h_v !< The effective layer thickness at v-points [H ~> m or kg m-2].
real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under
- !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves.
+ !! ice shelves [H T-1 ~> m s-1 or Pa s m-1]. Retained to determine stress under shelves.
real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under
- !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves.
+ !! ice shelves [H T-1 ~> m s-1 or Pa s m-1]. Retained to determine stress under shelves.
logical :: split !< If true, use the split time stepping scheme.
logical :: bottomdraglaw !< If true, the bottom stress is calculated with a
@@ -161,7 +162,7 @@ module MOM_vert_friction
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
!! timing of diagnostic output.
- real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 T-1 ~> m2 s-1]
+ real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 H Z-1 T-1 ~> m2 s-1 or Pa s]
!>@{ Diagnostic identifiers
integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_du_dt_visc_gl90 = -1, id_dv_dt_visc_gl90 = -1
@@ -220,8 +221,8 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
real, dimension(SZI_(G),SZJB_(G)) :: ustar2_v !< ustar squared at v-pts [L2 T-2 ~> m2 s-2]
real, dimension(SZIB_(G),SZJ_(G)) :: taux_u !< zonal wind stress at u-pts [R L Z T-2 ~> Pa]
real, dimension(SZI_(G),SZJB_(G)) :: tauy_v !< meridional wind stress at v-pts [R L Z T-2 ~> Pa]
- real, dimension(SZIB_(G),SZJ_(G)) :: omega_w2x_u !< angle between wind and x-axis at u-pts [rad]
- real, dimension(SZI_(G),SZJB_(G)) :: omega_w2x_v !< angle between wind and y-axis at v-pts [rad]
+ !real, dimension(SZIB_(G),SZJ_(G)) :: omega_w2x_u !< angle between wind and x-axis at u-pts [rad]
+ !real, dimension(SZI_(G),SZJB_(G)) :: omega_w2x_v !< angle between wind and y-axis at v-pts [rad]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tau_u !< kinematic zonal mtm flux at u-pts [L2 T-2 ~> m2 s-2]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: tau_v !< kinematic mer. mtm flux at v-pts [L2 T-2 ~> m2 s-2]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: tauxDG_u !< downgradient zonal mtm flux at u-pts [L2 T-2 ~> m2 s-2]
@@ -270,8 +271,8 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
hbl_v(:,:) = 0.
kbl_u(:,:) = 0
kbl_v(:,:) = 0
- omega_w2x_u(:,:) = 0.0
- omega_w2x_v(:,:) = 0.0
+ !omega_w2x_u(:,:) = 0.0
+ !omega_w2x_v(:,:) = 0.0
tauxDG_u(:,:,:) = 0.0
tauyDG_v(:,:,:) = 0.0
do j = js,je
@@ -283,7 +284,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
tauy = ( G%mask2dCv(i ,j )*tauy_v(i ,j ) + G%mask2dCv(i ,j-1)*tauy_v(i ,j-1) &
+ G%mask2dCv(i+1,j )*tauy_v(i+1,j ) + G%mask2dCv(i+1,j-1)*tauy_v(i+1,j-1) ) / tmp
ustar2_u(I,j) = sqrt( taux_u(I,j)*taux_u(I,j) + tauy*tauy )
- omega_w2x_u(I,j) = atan2( tauy , taux_u(I,j) )
+ !omega_w2x_u(I,j) = atan2( tauy , taux_u(I,j) )
tauxDG_u(I,j,1) = taux_u(I,j)
depth = 0.0
do k = 1, nz
@@ -305,7 +306,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
taux = ( G%mask2dCu(i ,j) * taux_u(i ,j) + G%mask2dCu(i ,j+1) * taux_u(i ,j+1) &
+ G%mask2dCu(i-1,j) * taux_u(i-1,j) + G%mask2dCu(i-1,j+1) * taux_u(i-1,j+1)) / tmp
ustar2_v(i,J) = sqrt(tauy_v(i,J)*tauy_v(i,J) + taux*taux)
- omega_w2x_v(i,J) = atan2( tauy_v(i,J), taux )
+ !omega_w2x_v(i,J) = atan2( tauy_v(i,J), taux )
tauyDG_v(i,J,1) = tauy_v(i,J)
depth = 0.0
do k = 1, nz
@@ -377,7 +378,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
do I = Isq,Ieq
if( (G%mask2dCu(I,j) > 0.5) ) then
! SURFACE
- tauyDG_u(I,j,1) = ustar2_u(I,j) * cos(omega_w2x_u(I,j))
+ tauyDG_u(I,j,1) = ustar2_u(I,j) !* cos(omega_w2x_u(I,j))
tau_u(I,j,1) = ustar2_u(I,j)
Omega_tau2w_u(I,j,1) = 0.0
Omega_tau2s_u(I,j,1) = 0.0
@@ -386,7 +387,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
kp1 = MIN(k+1 , nz)
tau_u(I,j,k+1) = sqrt( tauxDG_u(I,j,k+1)*tauxDG_u(I,j,k+1) + tauyDG_u(I,j,k+1)*tauyDG_u(I,j,k+1))
Omega_tau2x = atan2( tauyDG_u(I,j,k+1) , tauxDG_u(I,j,k+1) )
- omega_tmp = Omega_tau2x - omega_w2x_u(I,j)
+ omega_tmp = Omega_tau2x !- omega_w2x_u(I,j)
if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi
if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi
Omega_tau2w_u(I,j,k+1) = omega_tmp
@@ -399,7 +400,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
do i = is, ie
if( (G%mask2dCv(i,J) > 0.5) ) then
! SURFACE
- tauxDG_v(i,J,1) = ustar2_v(i,J) * sin(omega_w2x_v(i,J))
+ tauxDG_v(i,J,1) = ustar2_v(i,J) !* sin(omega_w2x_v(i,J))
tau_v(i,J,1) = ustar2_v(i,J)
Omega_tau2w_v(i,J,1) = 0.0
Omega_tau2s_v(i,J,1) = 0.0
@@ -408,7 +409,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
kp1 = MIN(k+1 , nz)
tau_v(i,J,k+1) = sqrt ( tauxDG_v(i,J,k+1)*tauxDG_v(i,J,k+1) + tauyDG_v(i,J,k+1)*tauyDG_v(i,J,k+1) )
omega_tau2x = atan2( tauyDG_v(i,J,k+1) , tauxDG_v(i,J,k+1) )
- omega_tmp = omega_tau2x - omega_w2x_v(i,J)
+ omega_tmp = omega_tau2x !- omega_w2x_v(i,J)
if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi
if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi
Omega_tau2w_v(i,J,k+1) = omega_tmp
@@ -440,8 +441,8 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
sin_tmp = tauyDG_u(I,j,k+1) / (tau_u(I,j,k+1) + GV%H_subroundoff)
! rotate to wind coordinates
- Wind_x = ustar2_u(I,j) * cos(omega_w2x_u(I,j))
- Wind_y = ustar2_u(I,j) * sin(omega_w2x_u(I,j))
+ Wind_x = ustar2_u(I,j) !* cos(omega_w2x_u(I,j))
+ Wind_y = ustar2_u(I,j) !* sin(omega_w2x_u(I,j))
tauNL_DG = (Wind_x * cos_tmp + Wind_y * sin_tmp)
tauNL_CG = (Wind_y * cos_tmp - Wind_x * sin_tmp)
omega_w2s = atan2(tauNL_CG, tauNL_DG)
@@ -465,7 +466,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
Omega_tau2s_u(I,j,k+1) = atan2(tauNL_CG , (tau_u(I,j,k+1)+tauNL_DG))
tau_u(I,j,k+1) = sqrt((tauxDG_u(I,j,k+1) + tauNL_X)**2 + (tauyDG_u(I,j,k+1) + tauNL_Y)**2)
omega_tau2x = atan2((tauyDG_u(I,j,k+1) + tauNL_Y), (tauxDG_u(I,j,k+1) + tauNL_X))
- omega_tau2w = omega_tau2x - omega_w2x_u(I,j)
+ omega_tau2w = omega_tau2x !- omega_w2x_u(I,j)
if (omega_tau2w >= pi ) omega_tau2w = omega_tau2w - 2.*pi
if (omega_tau2w <= (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi
Omega_tau2w_u(I,j,k+1) = omega_tau2w
@@ -499,8 +500,8 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
sin_tmp = tauyDG_v(i,J,k+1) / (tau_v(i,J,k+1) + GV%H_subroundoff)
! rotate into wind coordinate
- Wind_x = ustar2_v(i,J) * cos(omega_w2x_v(i,J))
- Wind_y = ustar2_v(i,J) * sin(omega_w2x_v(i,J))
+ Wind_x = ustar2_v(i,J) !* cos(omega_w2x_v(i,J))
+ Wind_y = ustar2_v(i,J) !* sin(omega_w2x_v(i,J))
tauNL_DG = (Wind_x * cos_tmp + Wind_y * sin_tmp)
tauNL_CG = (Wind_y * cos_tmp - Wind_x * sin_tmp)
omega_w2s = atan2(tauNL_CG , tauNL_DG)
@@ -521,8 +522,8 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
! diagnostics
Omega_tau2s_v(i,J,k+1) = atan2(tauNL_CG, tau_v(i,J,k+1) + tauNL_DG)
tau_v(i,J,k+1) = sqrt((tauxDG_v(i,J,k+1) + tauNL_X)**2 + (tauyDG_v(i,J,k+1) + tauNL_Y)**2)
- omega_tau2x = atan2((tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X))
- omega_tau2w = omega_tau2x - omega_w2x_v(i,J)
+ !omega_tau2x = atan2((tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X))
+ !omega_tau2w = omega_tau2x - omega_w2x_v(i,J)
if (omega_tau2w > pi) omega_tau2w = omega_tau2w - 2.*pi
if (omega_tau2w .le. (0.-pi) ) omega_tau2w = omega_tau2w + 2.*pi
Omega_tau2w_v(i,J,k+1) = omega_tau2w
@@ -546,7 +547,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
if (CS%id_FPtau2s_v > 0) call post_data(CS%id_FPtau2s_v, omega_tau2s_v, CS%diag)
if (CS%id_FPtau2w_u > 0) call post_data(CS%id_FPtau2w_u, omega_tau2w_u, CS%diag)
if (CS%id_FPtau2w_v > 0) call post_data(CS%id_FPtau2w_v, omega_tau2w_v, CS%diag)
- if (CS%id_FPw2x > 0) call post_data(CS%id_FPw2x, forces%omega_w2x , CS%diag)
+ !if (CS%id_FPw2x > 0) call post_data(CS%id_FPw2x, forces%omega_w2x , CS%diag)
end subroutine vertFPmix
@@ -587,8 +588,8 @@ end function G_sig
subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u)
type(ocean_grid_type), intent(in) :: G !< Grid structure.
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure.
- real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity
- !! grid point [H ~> m or kg m-2].
+ real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Distance between interfaces
+ !! at velocity points [Z ~> m]
logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient
!! for a column
real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the
@@ -596,7 +597,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va
!! boundary layer thickness [nondim]
real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated
!! with GL90 across interfaces; is not
- !! included in a_cpl [Z T-1 ~> m s-1].
+ !! included in a_cpl [H T-1 ~> m s-1 or Pa s m-1].
integer, intent(in) :: j !< j-index to find coupling coefficient for
type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure
type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients
@@ -604,23 +605,19 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va
!! otherwise they are v-points.
! local variables
- logical :: kdgl90_use_ebt_struct
- integer :: i, k, is, ie, nz, Isq, Ieq
- real :: f2 !< Squared Coriolis parameter at a
- !! velocity grid point [T-2 ~> s-2].
- real :: h_neglect ! A thickness that is so small
- !! it is usually lost in roundoff error
- !! and can be neglected [H ~> m or kg m-2].
- real :: botfn ! A function that is 1 at the bottom
- !! and small far from it [nondim]
- real :: z2 ! The distance from the bottom,
- !! normalized by Hbbl_gl90 [nondim]
+ logical :: kdgl90_use_ebt_struct
+ integer :: i, k, is, ie, nz, Isq, Ieq
+ real :: f2 !< Squared Coriolis parameter at a velocity grid point [T-2 ~> s-2].
+ real :: h_neglect ! A vertical distance that is so small it is usually lost in roundoff error
+ ! and can be neglected [Z ~> m].
+ real :: botfn ! A function that is 1 at the bottom and small far from it [nondim]
+ real :: z2 ! The distance from the bottom, normalized by Hbbl_gl90 [nondim]
is = G%isc ; ie = G%iec
Isq = G%IscB ; Ieq = G%IecB
nz = GV%ke
- h_neglect = GV%H_subroundoff
+ h_neglect = GV%dZ_subroundoff
kdgl90_use_ebt_struct = .false.
if (VarMix%use_variable_mixing) then
kdgl90_use_ebt_struct = VarMix%kdgl90_use_ebt_struct
@@ -729,7 +726,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim].
real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim].
- real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1].
+ real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [H T-1 ~> m s-1 or Pa s m-1]
real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2].
real :: Hmix ! The mixed layer thickness over which stress
@@ -737,8 +734,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1].
real :: Idt ! The inverse of the time step [T-1 ~> s-1].
real :: dt_Rho0 ! The time step divided by the mean density [T H Z-1 R-1 ~> s m3 kg-1 or s].
- real :: dt_Z_to_H ! The time step times the conversion from Z to the
- ! units of thickness - [T H Z-1 ~> s or s kg m-3].
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
@@ -783,7 +778,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
I_Hmix = 1.0 / Hmix
endif
dt_Rho0 = dt / GV%H_to_RZ
- dt_Z_to_H = dt*GV%Z_to_H
h_neglect = GV%H_subroundoff
Idt = 1.0 / dt
@@ -854,9 +848,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
! and the superdiagonal as c_k. The right-hand side terms are d_k.
!
! ignoring the Rayleigh drag contribution,
- ! we have a_k = -dt_Z_to_H * a_u(k)
- ! b_k = h_u(k) + dt_Z_to_H * (a_u(k) + a_u(k+1))
- ! c_k = -dt_Z_to_H * a_u(k+1)
+ ! we have a_k = -dt * a_u(k)
+ ! b_k = h_u(k) + dt * (a_u(k) + a_u(k+1))
+ ! c_k = -dt * a_u(k+1)
!
! for forward elimination, we want to:
! calculate c'_k = - c_k / (b_k + a_k c'_(k-1))
@@ -875,23 +869,23 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
! and the right-hand-side is destructively updated to be d'_k
!
do I=Isq,Ieq ; if (do_i(I)) then
- b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1))
- b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2))
+ b_denom_1 = CS%h_u(I,j,1) + dt * (Ray(I,1) + CS%a_u(I,j,1))
+ b1(I) = 1.0 / (b_denom_1 + dt*CS%a_u(I,j,2))
d1(I) = b_denom_1 * b1(I)
u(I,j,1) = b1(I) * (CS%h_u(I,j,1) * u(I,j,1) + surface_stress(I))
if (associated(ADp%du_dt_str)) &
ADp%du_dt_str(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_str(I,j,1) + surface_stress(I)*Idt)
endif ; enddo
do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then
- c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K) * b1(I)
- b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
- b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1))
+ c1(I,k) = dt * CS%a_u(I,j,K) * b1(I)
+ b_denom_1 = CS%h_u(I,j,k) + dt * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
+ b1(I) = 1.0 / (b_denom_1 + dt * CS%a_u(I,j,K+1))
d1(I) = b_denom_1 * b1(I)
u(I,j,k) = (CS%h_u(I,j,k) * u(I,j,k) + &
- dt_Z_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I)
+ dt * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I)
if (associated(ADp%du_dt_str)) &
ADp%du_dt_str(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_str(I,j,k) + &
- dt_Z_to_H * CS%a_u(I,j,K) * ADp%du_dt_str(I,j,k-1)) * b1(I)
+ dt * CS%a_u(I,j,K) * ADp%du_dt_str(I,j,k-1)) * b1(I)
endif ; enddo ; enddo
! back substitute to solve for the new velocities
@@ -915,17 +909,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
if (associated(ADp%du_dt_visc_gl90)) then
do I=Isq,Ieq ; if (do_i(I)) then
b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero
- b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u_gl90(I,j,2))
+ b1(I) = 1.0 / (b_denom_1 + dt*CS%a_u_gl90(I,j,2))
d1(I) = b_denom_1 * b1(I)
ADp%du_dt_visc_gl90(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_visc_gl90(I,j,1))
endif ; enddo
do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then
- c1(I,k) = dt_Z_to_H * CS%a_u_gl90(I,j,K) * b1(I)
- b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (CS%a_u_gl90(I,j,K)*d1(I))
- b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u_gl90(I,j,K+1))
+ c1(I,k) = dt * CS%a_u_gl90(I,j,K) * b1(I)
+ b_denom_1 = CS%h_u(I,j,k) + dt * (CS%a_u_gl90(I,j,K)*d1(I))
+ b1(I) = 1.0 / (b_denom_1 + dt * CS%a_u_gl90(I,j,K+1))
d1(I) = b_denom_1 * b1(I)
ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + &
- dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I)
+ dt * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I)
endif ; enddo ; enddo
! back substitute to solve for new velocities, held by ADp%du_dt_visc_gl90
do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then
@@ -954,15 +948,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
enddo ; enddo ; endif
if (allocated(visc%taux_shelf)) then ; do I=Isq,Ieq
- visc%taux_shelf(I,j) = -GV%Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf?
+ visc%taux_shelf(I,j) = -GV%H_to_RZ*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf?
enddo ; endif
if (PRESENT(taux_bot)) then
do I=Isq,Ieq
- taux_bot(I,j) = GV%Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1))
+ taux_bot(I,j) = GV%H_to_RZ * (u(I,j,nz)*CS%a_u(I,j,nz+1))
enddo
if (allocated(visc%Ray_u)) then ; do k=1,nz ; do I=Isq,Ieq
- taux_bot(I,j) = taux_bot(I,j) + GV%Rho0 * (Ray(I,k)*u(I,j,k))
+ taux_bot(I,j) = taux_bot(I,j) + GV%H_to_RZ * (Ray(I,k)*u(I,j,k))
enddo ; enddo ; endif
endif
@@ -1021,22 +1015,22 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
enddo ; enddo ; endif
do i=is,ie ; if (do_i(i)) then
- b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1))
- b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2))
+ b_denom_1 = CS%h_v(i,J,1) + dt * (Ray(i,1) + CS%a_v(i,J,1))
+ b1(i) = 1.0 / (b_denom_1 + dt*CS%a_v(i,J,2))
d1(i) = b_denom_1 * b1(i)
v(i,J,1) = b1(i) * (CS%h_v(i,J,1) * v(i,J,1) + surface_stress(i))
if (associated(ADp%dv_dt_str)) &
ADp%dv_dt_str(i,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_str(i,J,1) + surface_stress(i)*Idt)
endif ; enddo
do k=2,nz ; do i=is,ie ; if (do_i(i)) then
- c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i)
- b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
- b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1))
+ c1(i,k) = dt * CS%a_v(i,J,K) * b1(i)
+ b_denom_1 = CS%h_v(i,J,k) + dt * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
+ b1(i) = 1.0 / (b_denom_1 + dt * CS%a_v(i,J,K+1))
d1(i) = b_denom_1 * b1(i)
- v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i)
+ v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i)
if (associated(ADp%dv_dt_str)) &
ADp%dv_dt_str(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_str(i,J,k) + &
- dt_Z_to_H * CS%a_v(i,J,K) * ADp%dv_dt_str(i,J,k-1)) * b1(i)
+ dt * CS%a_v(i,J,K) * ADp%dv_dt_str(i,J,k-1)) * b1(i)
endif ; enddo ; enddo
do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then
v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1)
@@ -1057,17 +1051,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
if (associated(ADp%dv_dt_visc_gl90)) then
do i=is,ie ; if (do_i(i)) then
b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero
- b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v_gl90(i,J,2))
+ b1(i) = 1.0 / (b_denom_1 + dt*CS%a_v_gl90(i,J,2))
d1(i) = b_denom_1 * b1(i)
ADp%dv_dt_visc_gl90(I,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_visc_gl90(i,J,1))
endif ; enddo
do k=2,nz ; do i=is,ie ; if (do_i(i)) then
- c1(i,k) = dt_Z_to_H * CS%a_v_gl90(i,J,K) * b1(i)
- b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (CS%a_v_gl90(i,J,K)*d1(i))
- b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v_gl90(i,J,K+1))
+ c1(i,k) = dt * CS%a_v_gl90(i,J,K) * b1(i)
+ b_denom_1 = CS%h_v(i,J,k) + dt * (CS%a_v_gl90(i,J,K)*d1(i))
+ b1(i) = 1.0 / (b_denom_1 + dt * CS%a_v_gl90(i,J,K+1))
d1(i) = b_denom_1 * b1(i)
ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + &
- dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i)
+ dt * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i)
endif ; enddo ; enddo
! back substitute to solve for new velocities, held by ADp%dv_dt_visc_gl90
do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then
@@ -1097,15 +1091,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, &
enddo ; enddo ; endif
if (allocated(visc%tauy_shelf)) then ; do i=is,ie
- visc%tauy_shelf(i,J) = -GV%Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf?
+ visc%tauy_shelf(i,J) = -GV%H_to_RZ*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf?
enddo ; endif
if (present(tauy_bot)) then
do i=is,ie
- tauy_bot(i,J) = GV%Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1))
+ tauy_bot(i,J) = GV%H_to_RZ * (v(i,J,nz)*CS%a_v(i,J,nz+1))
enddo
if (allocated(visc%Ray_v)) then ; do k=1,nz ; do i=is,ie
- tauy_bot(i,J) = tauy_bot(i,J) + GV%Rho0 * (Ray(i,k)*v(i,J,k))
+ tauy_bot(i,J) = tauy_bot(i,J) + GV%H_to_RZ * (Ray(i,k)*v(i,J,k))
enddo ; enddo ; endif
endif
@@ -1232,10 +1226,8 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS)
real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim].
real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim].
- real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1].
+ real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [H T-1 ~> m s-1 or Pa s m-1]
real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2].
- real :: dt_Z_to_H ! The time step times the conversion from Z to the
- ! units of thickness [T H Z-1 ~> s or s kg m-3].
logical :: do_i(SZIB_(G))
integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz
@@ -1248,8 +1240,6 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS)
if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(remant): "// &
"Module must be initialized before it is used.")
- dt_Z_to_H = dt*GV%Z_to_H
-
do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo
! Find the zonal viscous remnant using a modification of a standard tridagonal solver.
@@ -1262,17 +1252,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS)
enddo ; enddo ; endif
do I=Isq,Ieq ; if (do_i(I)) then
- b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1))
- b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2))
+ b_denom_1 = CS%h_u(I,j,1) + dt * (Ray(I,1) + CS%a_u(I,j,1))
+ b1(I) = 1.0 / (b_denom_1 + dt*CS%a_u(I,j,2))
d1(I) = b_denom_1 * b1(I)
visc_rem_u(I,j,1) = b1(I) * CS%h_u(I,j,1)
endif ; enddo
do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then
- c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K)*b1(I)
- b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
- b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1))
+ c1(I,k) = dt * CS%a_u(I,j,K)*b1(I)
+ b_denom_1 = CS%h_u(I,j,k) + dt * (Ray(I,k) + CS%a_u(I,j,K)*d1(I))
+ b1(I) = 1.0 / (b_denom_1 + dt * CS%a_u(I,j,K+1))
d1(I) = b_denom_1 * b1(I)
- visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_Z_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I)
+ visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I)
endif ; enddo ; enddo
do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then
visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + c1(I,k+1)*visc_rem_u(I,j,k+1)
@@ -1291,17 +1281,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS)
enddo ; enddo ; endif
do i=is,ie ; if (do_i(i)) then
- b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1))
- b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2))
+ b_denom_1 = CS%h_v(i,J,1) + dt * (Ray(i,1) + CS%a_v(i,J,1))
+ b1(i) = 1.0 / (b_denom_1 + dt*CS%a_v(i,J,2))
d1(i) = b_denom_1 * b1(i)
visc_rem_v(i,J,1) = b1(i) * CS%h_v(i,J,1)
endif ; enddo
do k=2,nz ; do i=is,ie ; if (do_i(i)) then
- c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K)*b1(i)
- b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
- b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1))
+ c1(i,k) = dt * CS%a_v(i,J,K)*b1(i)
+ b_denom_1 = CS%h_v(i,J,k) + dt * (Ray(i,k) + CS%a_v(i,J,K)*d1(i))
+ b1(i) = 1.0 / (b_denom_1 + dt * CS%a_v(i,J,K+1))
d1(i) = b_denom_1 * b1(i)
- visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i)
+ visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i)
endif ; enddo ; enddo
do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then
visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + c1(i,k+1)*visc_rem_v(i,J,k+1)
@@ -1319,7 +1309,7 @@ end subroutine vertvisc_remnant
!> Calculate the coupling coefficients (CS%a_u, CS%a_v, CS%a_u_gl90, CS%a_v_gl90)
!! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the
!! applying the implicit vertical viscosity via vertvisc().
-subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
+subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, VarMix)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -1329,8 +1319,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h !< Layer thickness [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: dz !< Vertical distance across layers [Z ~> m]
type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available
+ !! thermodynamic fields.
real, intent(in) :: dt !< Time increment [T ~> s]
type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure
@@ -1347,52 +1341,65 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
h_arith, & ! The arithmetic mean thickness [H ~> m or kg m-2].
h_delta, & ! The lateral difference of thickness [H ~> m or kg m-2].
hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2].
- hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2].
+ hvel_shelf, & ! The equivalent of hvel under shelves [H ~> m or kg m-2].
+ dz_harm, & ! Harmonic mean of the vertical distances around a velocity grid point,
+ ! given by 2*(h+ * h-)/(h+ + h-) [Z ~> m].
+ dz_arith, & ! The arithmetic mean of the vertical distances around a velocity grid point [Z ~> m]
+ dz_vel, & ! The vertical distance between interfaces used at a velocity grid point [Z ~> m].
+ dz_vel_shelf ! The equivalent of dz_vel under shelves [Z ~> m].
real, dimension(SZIB_(G),SZK_(GV)+1) :: &
- a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times
+ a_cpl, & ! The drag coefficients across interfaces [H T-1 ~> m s-1 or Pa s m-1]. a_cpl times
! the velocity difference gives the stress across an interface.
- a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [Z T-1 ~> m s-1].
+ a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [H T-1 ~> m s-1 or Pa s m-1].
! a_cpl_gl90 times the velocity difference gives the GL90 stress across an interface.
! a_cpl_gl90 is part of a_cpl.
a_shelf, & ! The drag coefficients across interfaces in water columns under
- ! ice shelves [Z T-1 ~> m s-1].
+ ! ice shelves [H T-1 ~> m s-1 or Pa s m-1].
z_i, & ! An estimate of each interface's height above the bottom,
! normalized by the bottom boundary layer thickness [nondim]
z_i_gl90 ! An estimate of each interface's height above the bottom,
! normalized by the GL90 bottom boundary layer thickness [nondim]
real, dimension(SZIB_(G)) :: &
- kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1].
- bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2].
- I_Hbbl, & ! The inverse of the bottom boundary layer thickness [H-1 ~> m-1 or m2 kg-1].
+ kv_bbl, & ! The bottom boundary layer viscosity [H Z T-1 ~> m2 s-1 or Pa s].
+ bbl_thick, & ! The bottom boundary layer thickness [Z ~> m].
+ I_Hbbl, & ! The inverse of the bottom boundary layer thickness [Z-1 ~> m-1].
I_Hbbl_gl90, &! The inverse of the bottom boundary layer thickness used for the GL90 scheme
- ! [H-1 ~> m-1 or m2 kg-1].
- I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1].
- zcol1, & ! The height of the interfaces to the south of a v-point [H ~> m or kg m-2].
- zcol2, & ! The height of the interfaces to the north of a v-point [H ~> m or kg m-2].
- Ztop_min, & ! The deeper of the two adjacent surface heights [H ~> m or kg m-2].
- Dmin, & ! The shallower of the two adjacent bottom depths converted to
- ! thickness units [H ~> m or kg m-2].
+ ! [Z-1 ~> m-1].
+ I_HTbl, & ! The inverse of the top boundary layer thickness [Z-1 ~> m-1].
+ zcol1, & ! The height of the interfaces to the south of a v-point [Z ~> m].
+ zcol2, & ! The height of the interfaces to the north of a v-point [Z ~> m].
+ Ztop_min, & ! The deeper of the two adjacent surface heights [Z ~> m].
+ Dmin, & ! The shallower of the two adjacent bottom depths [Z ~> m].
zh, & ! An estimate of the interface's distance from the bottom
- ! based on harmonic mean thicknesses [H ~> m or kg m-2].
- h_ml ! The mixed layer depth [H ~> m or kg m-2].
- real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [H ~> m or kg m-2].
- real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2].
- real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1].
- real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1].
- real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1].
- real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1].
- real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2].
+ ! based on harmonic mean thicknesses [Z ~> m].
+ h_ml ! The mixed layer depth [Z ~> m].
+ real, dimension(SZI_(G),SZJ_(G)) :: &
+ Ustar_2d ! The wind friction velocity, calculated using the Boussinesq reference density or
+ ! the time-evolving surface density in non-Boussinesq mode [Z T-1 ~> m s-1]
+ real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [Z ~> m].
+ real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [Z ~> m].
+ real, allocatable, dimension(:,:,:) :: Kv_u ! Total vertical viscosity at u-points in
+ ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1].
+ real, allocatable, dimension(:,:,:) :: Kv_v ! Total vertical viscosity at v-points in
+ ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1].
+ real, allocatable, dimension(:,:,:) :: Kv_gl90_u ! GL90 vertical viscosity at u-points in
+ ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1].
+ real, allocatable, dimension(:,:,:) :: Kv_gl90_v ! GL90 vertical viscosity at v-points in
+ ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1].
+ real :: zcol(SZI_(G)) ! The height of an interface at h-points [Z ~> m].
real :: botfn ! A function which goes from 1 at the bottom to 0 much more
! than Hbbl into the interior [nondim].
real :: topfn ! A function which goes from 1 at the top to 0 much more
! than Htbl into the interior [nondim].
real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim]
real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2 [nondim].
- real :: z_clear ! The clearance of an interface above the surrounding topography [H ~> m or kg m-2].
+ real :: z_clear ! The clearance of an interface above the surrounding topography [Z ~> m].
real :: a_cpl_max ! The maximum drag coefficient across interfaces, set so that it will be
- ! representable as a 32-bit float in MKS units [Z T-1 ~> m s-1]
+ ! representable as a 32-bit float in MKS units [H T-1 ~> m s-1 or Pa s m-1]
real :: h_neglect ! A thickness that is so small it is usually lost
! in roundoff and can be neglected [H ~> m or kg m-2].
+ real :: dz_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m].
real :: I_valBL ! The inverse of a scaling factor determining when water is
! still within the boundary layer, as determined by the sum
@@ -1413,10 +1420,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
"Module must be initialized before it is used.")
h_neglect = GV%H_subroundoff
- a_cpl_max = 1.0e37 * US%m_to_Z * US%T_to_s
- I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect)
+ dz_neglect = GV%dZ_subroundoff
+ a_cpl_max = 1.0e37 * GV%m_to_H * US%T_to_s
+ I_Hbbl(:) = 1.0 / (CS%Hbbl + dz_neglect)
if (CS%use_GL90_in_SSW) then
- I_Hbbl_gl90 = 1.0 / (CS%Hbbl_gl90 + h_neglect)
+ I_Hbbl_gl90(:) = 1.0 / (CS%Hbbl_gl90 + dz_neglect)
endif
I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val
@@ -1440,15 +1448,18 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0)
endif
- !$OMP parallel do default(private) shared(G,GV,US,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, &
- !$OMP OBC,h_neglect,dt,I_valBL,Kv_u,a_cpl_max) &
- !$OMP firstprivate(i_hbbl)
+ call find_ustar(forces, tv, Ustar_2d, G, GV, US, halo=1)
+
+ !$OMP parallel do default(private) shared(G,GV,US,CS,tv,visc,OBC,Isq,Ieq,nz,u,h,dz,forces, &
+ !$OMP Ustar_2d,h_neglect,dz_neglect,dt,I_valBL,hML_u,Kv_u, &
+ !$OMP a_cpl_max,I_Hbbl_gl90,Kv_gl90_u) &
+ !$OMP firstprivate(I_Hbbl)
do j=G%Jsc,G%Jec
do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0.0) ; enddo
if (CS%bottomdraglaw) then ; do I=Isq,Ieq
kv_bbl(I) = visc%Kv_bbl_u(I,j)
- bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H + h_neglect
+ bbl_thick(I) = visc%bbl_thick_u(I,j) + dz_neglect
if (do_i(I)) I_Hbbl(I) = 1.0 / bbl_thick(I)
enddo ; endif
@@ -1456,9 +1467,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
h_harm(I,k) = 2.0*h(i,j,k)*h(i+1,j,k) / (h(i,j,k)+h(i+1,j,k)+h_neglect)
h_arith(I,k) = 0.5*(h(i+1,j,k)+h(i,j,k))
h_delta(I,k) = h(i+1,j,k) - h(i,j,k)
+ dz_harm(I,k) = 2.0*dz(i,j,k)*dz(i+1,j,k) / (dz(i,j,k)+dz(i+1,j,k)+dz_neglect)
+ dz_arith(I,k) = 0.5*(dz(i+1,j,k)+dz(i,j,k))
endif ; enddo ; enddo
do I=Isq,Ieq
- Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * GV%Z_to_H
+ Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j))
zi_dir(I) = 0
enddo
@@ -1466,19 +1479,25 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
if (associated(OBC)) then ; if (OBC%number_of_segments > 0) then
do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then
if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
- do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo
- Dmin(I) = G%bathyT(i,j) * GV%Z_to_H
+ do k=1,nz
+ h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0.
+ dz_harm(I,k) = dz(i,j,k) ; dz_arith(I,k) = dz(i,j,k)
+ enddo
+ Dmin(I) = G%bathyT(i,j)
zi_dir(I) = -1
elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
- do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo
- Dmin(I) = G%bathyT(i+1,j) * GV%Z_to_H
+ do k=1,nz
+ h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0.
+ dz_harm(I,k) = dz(i+1,j,k) ; dz_arith(I,k) = dz(i+1,j,k)
+ enddo
+ Dmin(I) = G%bathyT(i+1,j)
zi_dir(I) = 1
endif
endif ; enddo
endif ; endif
! The following block calculates the thicknesses at velocity
-! grid points for the vertical viscosity (hvel). Near the
+! grid points for the vertical viscosity (hvel and dz_vel). Near the
! bottom an upwind biased thickness is used to control the effect
! of spurious Montgomery potential gradients at the bottom where
! nearly massless layers layers ride over the topography.
@@ -1486,19 +1505,21 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
do I=Isq,Ieq ; z_i(I,nz+1) = 0.0 ; enddo
do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then
hvel(I,k) = h_harm(I,k)
+ dz_vel(I,k) = dz_harm(I,k)
if (u(I,j,k) * h_delta(I,k) < 0) then
z2 = z_i(I,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2)
hvel(I,k) = (1.0-botfn)*h_harm(I,k) + botfn*h_arith(I,k)
+ dz_vel(I,k) = (1.0-botfn)*dz_harm(I,k) + botfn*dz_arith(I,k)
endif
- z_i(I,k) = z_i(I,k+1) + h_harm(I,k)*I_Hbbl(I)
+ z_i(I,k) = z_i(I,k+1) + dz_harm(I,k)*I_Hbbl(I)
endif ; enddo ; enddo ! i & k loops
else ! Not harmonic_visc
do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo
- do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * GV%Z_to_H ; enddo
+ do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) ; enddo
do k=nz,1,-1
- do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo
+ do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + dz(i,j,k) ; enddo
do I=Isq,Ieq ; if (do_i(I)) then
- zh(I) = zh(I) + h_harm(I,k)
+ zh(I) = zh(I) + dz_harm(I,k)
z_clear = max(zcol(i),zcol(i+1)) + Dmin(I)
if (zi_dir(I) < 0) z_clear = zcol(i) + Dmin(I)
@@ -1507,15 +1528,18 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
z_i(I,k) = max(zh(I), z_clear) * I_Hbbl(I)
hvel(I,k) = h_arith(I,k)
+ dz_vel(I,k) = dz_arith(I,k)
if (u(I,j,k) * h_delta(I,k) > 0) then
if (zh(I) * I_Hbbl(I) < CS%harm_BL_val) then
hvel(I,k) = h_harm(I,k)
+ dz_vel(I,k) = dz_harm(I,k)
else
z2_wt = 1.0 ; if (zh(I) * I_Hbbl(I) < 2.0*CS%harm_BL_val) &
z2_wt = max(0.0, min(1.0, zh(I) * I_Hbbl(I) * I_valBL - 1.0))
z2 = z2_wt * (max(zh(I), z_clear) * I_Hbbl(I))
botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2)
hvel(I,k) = (1.0-botfn)*h_arith(I,k) + botfn*h_harm(I,k)
+ dz_vel(I,k) = (1.0-botfn)*dz_arith(I,k) + botfn*dz_harm(I,k)
endif
endif
@@ -1523,8 +1547,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
enddo ! k loop
endif
- call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
- dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC)
+ call find_coupling_coef(a_cpl, dz_vel, do_i, dz_harm, bbl_thick, kv_bbl, z_i, h_ml, &
+ dt, j, G, GV, US, CS, visc, Ustar_2d, tv, work_on_u=.true., OBC=OBC)
a_cpl_gl90(:,:) = 0.0
if (CS%use_GL90_in_SSW) then
! The following block calculates the normalized height above the GL90
@@ -1537,9 +1561,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
! over topography, small enough to not contaminate the interior.
do I=Isq,Ieq ; z_i_gl90(I,nz+1) = 0.0 ; enddo
do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then
- z_i_gl90(I,k) = z_i_gl90(I,k+1) + h_harm(I,k)*I_Hbbl_gl90(I)
+ z_i_gl90(I,k) = z_i_gl90(I,k+1) + dz_harm(I,k)*I_Hbbl_gl90(I)
endif ; enddo ; enddo ! i & k loops
- call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.)
+ call find_coupling_coef_gl90(a_cpl_gl90, dz_vel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.)
endif
if (allocated(hML_u)) then
@@ -1555,35 +1579,39 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
enddo
if (do_any_shelf) then
if (CS%harmonic_visc) then
- do k=1,nz ; do I=Isq,Ieq ; hvel_shelf(I,k) = hvel(I,k) ; enddo ; enddo
+ do k=1,nz ; do I=Isq,Ieq
+ hvel_shelf(I,k) = hvel(I,k) ; dz_vel_shelf(I,k) = dz_vel(I,k)
+ enddo ; enddo
else ! Find upwind-biased thickness near the surface.
! Perhaps this needs to be done more carefully, via find_eta.
do I=Isq,Ieq ; if (do_i_shelf(I)) then
zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1))
- I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%Z_to_H + h_neglect)
+ I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j) + dz_neglect)
endif ; enddo
do k=1,nz
- do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo
+ do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - dz(i,j,k) ; enddo
do I=Isq,Ieq ; if (do_i_shelf(I)) then
- zh(I) = zh(I) + h_harm(I,k)
+ zh(I) = zh(I) + dz_harm(I,k)
- hvel_shelf(I,k) = hvel(I,k)
+ hvel_shelf(I,k) = hvel(I,k) ; dz_vel_shelf(I,k) = dz_vel(I,k)
if (u(I,j,k) * h_delta(I,k) > 0) then
if (zh(I) * I_HTbl(I) < CS%harm_BL_val) then
hvel_shelf(I,k) = min(hvel(I,k), h_harm(I,k))
+ dz_vel_shelf(I,k) = min(dz_vel(I,k), dz_harm(I,k))
else
z2_wt = 1.0 ; if (zh(I) * I_HTbl(I) < 2.0*CS%harm_BL_val) &
z2_wt = max(0.0, min(1.0, zh(I) * I_HTbl(I) * I_valBL - 1.0))
z2 = z2_wt * (max(zh(I), Ztop_min(I) - min(zcol(i),zcol(i+1))) * I_HTbl(I))
topfn = 1.0 / (1.0 + 0.09*z2**6)
hvel_shelf(I,k) = min(hvel(I,k), (1.0-topfn)*h_arith(I,k) + topfn*h_harm(I,k))
+ dz_vel_shelf(I,k) = min(dz_vel(I,k), (1.0-topfn)*dz_arith(I,k) + topfn*dz_harm(I,k))
endif
endif
endif ; enddo
enddo
endif
- call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, &
- kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, &
+ call find_coupling_coef(a_shelf, dz_vel_shelf, do_i_shelf, dz_harm, bbl_thick, &
+ kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, Ustar_2d, tv, &
work_on_u=.true., OBC=OBC, shelf=.true.)
do I=Isq,Ieq ; if (do_i_shelf(I)) CS%a1_shelf_u(I,j) = a_shelf(I,1) ; enddo
endif
@@ -1609,10 +1637,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
endif ; enddo ; enddo
else
do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then
- CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K))
+ CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K))
endif; enddo ; enddo
do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then
- CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K))
+ CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K))
endif; enddo ; enddo
do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) + h_neglect ; enddo ; enddo
endif
@@ -1620,28 +1648,29 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
! Diagnose total Kv at u-points
if (CS%id_Kv_u > 0) then
do k=1,nz ; do I=Isq,Ieq
- if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k)
+ if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k)
enddo ; enddo
endif
! Diagnose GL90 Kv at u-points
if (CS%id_Kv_gl90_u > 0) then
do k=1,nz ; do I=Isq,Ieq
- if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k)
+ if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * (CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k)
enddo ; enddo
endif
enddo
! Now work on v-points.
- !$OMP parallel do default(private) shared(G,GV,CS,US,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, &
- !$OMP OBC,h_neglect,dt,I_valBL,Kv_v,a_cpl_max) &
- !$OMP firstprivate(i_hbbl)
+ !$OMP parallel do default(private) shared(G,GV,US,CS,tv,OBC,visc,is,ie,Jsq,Jeq,nz,v,h,dz,forces, &
+ !$OMP Ustar_2d,h_neglect,dz_neglect,dt,I_valBL,hML_v,Kv_v, &
+ !$OMP a_cpl_max,I_Hbbl_gl90,Kv_gl90_v) &
+ !$OMP firstprivate(I_Hbbl)
do J=Jsq,Jeq
do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0.0) ; enddo
if (CS%bottomdraglaw) then ; do i=is,ie
kv_bbl(i) = visc%Kv_bbl_v(i,J)
- bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H + h_neglect
+ bbl_thick(i) = visc%bbl_thick_v(i,J) + dz_neglect
if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i)
enddo ; endif
@@ -1649,9 +1678,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
h_harm(i,k) = 2.0*h(i,j,k)*h(i,j+1,k) / (h(i,j,k)+h(i,j+1,k)+h_neglect)
h_arith(i,k) = 0.5*(h(i,j+1,k)+h(i,j,k))
h_delta(i,k) = h(i,j+1,k) - h(i,j,k)
+ dz_harm(i,k) = 2.0*dz(i,j,k)*dz(i,j+1,k) / (dz(i,j,k)+dz(i,j+1,k)+dz_neglect)
+ dz_arith(i,k) = 0.5*(dz(i,j+1,k)+dz(i,j,k))
endif ; enddo ; enddo
do i=is,ie
- Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * GV%Z_to_H
+ Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1))
zi_dir(i) = 0
enddo
@@ -1659,12 +1690,18 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
if (associated(OBC)) then ; if (OBC%number_of_segments > 0) then
do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then
if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
- do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo
- Dmin(I) = G%bathyT(i,j) * GV%Z_to_H
+ do k=1,nz
+ h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0.
+ dz_harm(I,k) = dz(i,j,k) ; dz_arith(I,k) = dz(i,j,k)
+ enddo
+ Dmin(I) = G%bathyT(i,j)
zi_dir(I) = -1
elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
- do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo
- Dmin(i) = G%bathyT(i,j+1) * GV%Z_to_H
+ do k=1,nz
+ h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0.
+ dz_harm(i,k) = dz(i,j+1,k) ; dz_arith(i,k) = dz(i,j+1,k)
+ enddo
+ Dmin(i) = G%bathyT(i,j+1)
zi_dir(i) = 1
endif
endif ; enddo
@@ -1680,21 +1717,23 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then
hvel(i,k) = h_harm(i,k)
+ dz_vel(i,k) = dz_harm(i,k)
if (v(i,J,k) * h_delta(i,k) < 0) then
z2 = z_i(i,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2)
hvel(i,k) = (1.0-botfn)*h_harm(i,k) + botfn*h_arith(i,k)
+ dz_vel(i,k) = (1.0-botfn)*dz_harm(i,k) + botfn*dz_arith(i,k)
endif
- z_i(i,k) = z_i(i,k+1) + h_harm(i,k)*I_Hbbl(i)
+ z_i(i,k) = z_i(i,k+1) + dz_harm(i,k)*I_Hbbl(i)
endif ; enddo ; enddo ! i & k loops
else ! Not harmonic_visc
do i=is,ie
zh(i) = 0.0 ; z_i(i,nz+1) = 0.0
- zcol1(i) = -G%bathyT(i,j) * GV%Z_to_H
- zcol2(i) = -G%bathyT(i,j+1) * GV%Z_to_H
+ zcol1(i) = -G%bathyT(i,j)
+ zcol2(i) = -G%bathyT(i,j+1)
enddo
do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then
- zh(i) = zh(i) + h_harm(i,k)
- zcol1(i) = zcol1(i) + h(i,j,k) ; zcol2(i) = zcol2(i) + h(i,j+1,k)
+ zh(i) = zh(i) + dz_harm(i,k)
+ zcol1(i) = zcol1(i) + dz(i,j,k) ; zcol2(i) = zcol2(i) + dz(i,j+1,k)
z_clear = max(zcol1(i),zcol2(i)) + Dmin(i)
if (zi_dir(i) < 0) z_clear = zcol1(i) + Dmin(I)
@@ -1703,23 +1742,26 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
z_i(I,k) = max(zh(i), z_clear) * I_Hbbl(i)
hvel(i,k) = h_arith(i,k)
+ dz_vel(i,k) = dz_arith(i,k)
if (v(i,J,k) * h_delta(i,k) > 0) then
if (zh(i) * I_Hbbl(i) < CS%harm_BL_val) then
hvel(i,k) = h_harm(i,k)
+ dz_vel(i,k) = dz_harm(i,k)
else
z2_wt = 1.0 ; if (zh(i) * I_Hbbl(i) < 2.0*CS%harm_BL_val) &
z2_wt = max(0.0, min(1.0, zh(i) * I_Hbbl(i) * I_valBL - 1.0))
z2 = z2_wt * (max(zh(i), max(zcol1(i),zcol2(i)) + Dmin(i)) * I_Hbbl(i))
botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2)
hvel(i,k) = (1.0-botfn)*h_arith(i,k) + botfn*h_harm(i,k)
+ dz_vel(i,k) = (1.0-botfn)*dz_arith(i,k) + botfn*dz_harm(i,k)
endif
endif
endif ; enddo ; enddo ! i & k loops
endif
- call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
- dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC)
+ call find_coupling_coef(a_cpl, dz_vel, do_i, dz_harm, bbl_thick, kv_bbl, z_i, h_ml, &
+ dt, j, G, GV, US, CS, visc, Ustar_2d, tv, work_on_u=.false., OBC=OBC)
a_cpl_gl90(:,:) = 0.0
if (CS%use_GL90_in_SSW) then
! The following block calculates the normalized height above the GL90
@@ -1733,10 +1775,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
do i=is,ie ; z_i_gl90(i,nz+1) = 0.0 ; enddo
do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then
- z_i_gl90(i,k) = z_i_gl90(i,k+1) + h_harm(i,k)*I_Hbbl_gl90(i)
+ z_i_gl90(i,k) = z_i_gl90(i,k+1) + dz_harm(i,k)*I_Hbbl_gl90(i)
endif ; enddo ; enddo ! i & k loops
- call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.)
+ call find_coupling_coef_gl90(a_cpl_gl90, dz_vel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.)
endif
if ( allocated(hML_v)) then
@@ -1751,35 +1793,39 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
enddo
if (do_any_shelf) then
if (CS%harmonic_visc) then
- do k=1,nz ; do i=is,ie ; hvel_shelf(i,k) = hvel(i,k) ; enddo ; enddo
+ do k=1,nz ; do i=is,ie
+ hvel_shelf(i,k) = hvel(i,k) ; dz_vel_shelf(i,k) = dz_vel(i,k)
+ enddo ; enddo
else ! Find upwind-biased thickness near the surface.
! Perhaps this needs to be done more carefully, via find_eta.
do i=is,ie ; if (do_i_shelf(i)) then
zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i))
- I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%Z_to_H + h_neglect)
+ I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J) + dz_neglect)
endif ; enddo
do k=1,nz
do i=is,ie ; if (do_i_shelf(i)) then
- zcol1(i) = zcol1(i) - h(i,j,k) ; zcol2(i) = zcol2(i) - h(i,j+1,k)
- zh(i) = zh(i) + h_harm(i,k)
+ zcol1(i) = zcol1(i) - dz(i,j,k) ; zcol2(i) = zcol2(i) - dz(i,j+1,k)
+ zh(i) = zh(i) + dz_harm(i,k)
- hvel_shelf(i,k) = hvel(i,k)
+ hvel_shelf(i,k) = hvel(i,k) ; dz_vel_shelf(i,k) = dz_vel(i,k)
if (v(i,J,k) * h_delta(i,k) > 0) then
if (zh(i) * I_HTbl(i) < CS%harm_BL_val) then
hvel_shelf(i,k) = min(hvel(i,k), h_harm(i,k))
+ dz_vel_shelf(i,k) = min(dz_vel(i,k), dz_harm(i,k))
else
z2_wt = 1.0 ; if (zh(i) * I_HTbl(i) < 2.0*CS%harm_BL_val) &
z2_wt = max(0.0, min(1.0, zh(i) * I_HTbl(i) * I_valBL - 1.0))
z2 = z2_wt * (max(zh(i), Ztop_min(i) - min(zcol1(i),zcol2(i))) * I_HTbl(i))
topfn = 1.0 / (1.0 + 0.09*z2**6)
hvel_shelf(i,k) = min(hvel(i,k), (1.0-topfn)*h_arith(i,k) + topfn*h_harm(i,k))
+ dz_vel_shelf(i,k) = min(dz_vel(i,k), (1.0-topfn)*dz_arith(i,k) + topfn*dz_harm(i,k))
endif
endif
endif ; enddo
enddo
endif
- call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, &
- kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, &
+ call find_coupling_coef(a_shelf, dz_vel_shelf, do_i_shelf, dz_harm, bbl_thick, &
+ kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, Ustar_2d, tv, &
work_on_u=.false., OBC=OBC, shelf=.true.)
do i=is,ie ; if (do_i_shelf(i)) CS%a1_shelf_v(i,J) = a_shelf(i,1) ; enddo
endif
@@ -1809,20 +1855,20 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
endif ; enddo ; enddo
do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then
CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K))
- endif ; enddo ; enddo
+ endif ; enddo ; enddo
do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) + h_neglect ; enddo ; enddo
endif
! Diagnose total Kv at v-points
if (CS%id_Kv_v > 0) then
do k=1,nz ; do i=is,ie
- if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k)
+ if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k)
enddo ; enddo
endif
! Diagnose GL90 Kv at v-points
if (CS%id_Kv_gl90_v > 0) then
do k=1,nz ; do i=is,ie
- if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k)
+ if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * (CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k)
enddo ; enddo
endif
enddo ! end of v-point j loop
@@ -1831,10 +1877,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix)
call uvchksum("vertvisc_coef h_[uv]", CS%h_u, CS%h_v, G%HI, haloshift=0, &
scale=GV%H_to_m, scalar_pair=.true.)
call uvchksum("vertvisc_coef a_[uv]", CS%a_u, CS%a_v, G%HI, haloshift=0, &
- scale=US%Z_to_m*US%s_to_T, scalar_pair=.true.)
+ scale=GV%H_to_m*US%s_to_T, scalar_pair=.true.)
if (allocated(hML_u) .and. allocated(hML_v)) &
call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, G%HI, &
- haloshift=0, scale=GV%H_to_m, scalar_pair=.true.)
+ haloshift=0, scale=US%Z_to_m, scalar_pair=.true.)
endif
! Offer diagnostic fields for averaging.
@@ -1864,32 +1910,38 @@ end subroutine vertvisc_coef
!! If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the adjacent
!! layer thicknesses are used to calculate a_cpl near the bottom.
subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, &
- dt, j, G, GV, US, CS, visc, forces, work_on_u, OBC, shelf)
+ dt, j, G, GV, US, CS, visc, Ustar_2d, tv, work_on_u, OBC, shelf)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZIB_(G),SZK_(GV)+1), &
- intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z T-1 ~> m s-1].
+ intent(out) :: a_cpl !< Coupling coefficient across interfaces [H T-1 ~> m s-1 or Pa s m-1]
real, dimension(SZIB_(G),SZK_(GV)), &
- intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2]
+ intent(in) :: hvel !< Distance between interfaces at velocity points [Z ~> m]
logical, dimension(SZIB_(G)), &
intent(in) :: do_i !< If true, determine coupling coefficient for a column
real, dimension(SZIB_(G),SZK_(GV)), &
intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity
- !! grid point [H ~> m or kg m-2]
- real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [H ~> m or kg m-2]
+ !! grid point [Z ~> m]
+ real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [Z ~> m]
real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, exclusive of
!! any depth-dependent contributions from
- !! visc%Kv_shear [Z2 T-1 ~> m2 s-1].
+ !! visc%Kv_shear [H Z T-1 ~> m2 s-1 or Pa s]
real, dimension(SZIB_(G),SZK_(GV)+1), &
intent(in) :: z_i !< Estimate of interface heights above the bottom,
!! normalized by the bottom boundary layer thickness [nondim]
- real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [H ~> m or kg m-2]
+ real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [Z ~> m]
integer, intent(in) :: j !< j-index to find coupling coefficient for
real, intent(in) :: dt !< Time increment [T ~> s]
type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure
type(vertvisc_type), intent(in) :: visc !< Structure containing viscosities and bottom drag
- type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
+ real, dimension(SZI_(G),SZJ_(G)), &
+ intent(in) :: Ustar_2d !< The wind friction velocity, calculated using
+ !! the Boussinesq reference density or the
+ !! time-evolving surface density in non-Boussinesq
+ !! mode [Z T-1 ~> m s-1]
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available
+ !! thermodynamic fields.
logical, intent(in) :: work_on_u !< If true, u-points are being calculated,
!! otherwise they are v-points
type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure
@@ -1899,38 +1951,38 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
! Local variables
real, dimension(SZIB_(G)) :: &
- u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1].
- tau_mag, & ! The magnitude of the wind stress at a velocity point including gustiness,
- ! divided by the Boussinesq refernce density [Z2 T-2 ~> m2 s-2]
+ u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1]
+ tau_mag, & ! The magnitude of the wind stress at a velocity point including gustiness [H Z T-2 ~> m2 s-2 or Pa]
absf, & ! The average of the neighboring absolute values of f [T-1 ~> s-1].
-! h_ml, & ! The mixed layer depth [H ~> m or kg m-2].
+ rho_av1, & ! The harmonic mean surface layer density at velocity points [R ~> kg m-3]
z_t, & ! The distance from the top, sometimes normalized
- ! by Hmix, [H ~> m or kg m-2] or [nondim].
- kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1].
- tbl_thick ! The thickness of the top boundary layer [H ~> m or kg m-2]
+ ! by Hmix, [Z ~> m] or [nondim].
+ kv_TBL, & ! The viscosity in a top boundary layer under ice [H Z T-1 ~> m2 s-1 or Pa s]
+ tbl_thick ! The thickness of the top boundary layer [Z ~> m]
real, dimension(SZIB_(G),SZK_(GV)+1) :: &
- Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1].
- Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1].
+ Kv_tot, & ! The total viscosity at an interface [H Z T-1 ~> m2 s-1 or Pa s]
+ Kv_add ! A viscosity to add [H Z T-1 ~> m2 s-1 or Pa s]
integer, dimension(SZIB_(G)) :: &
nk_in_ml ! The index of the deepest interface in the mixed layer.
- real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2].
- real :: dhc ! The distance between the center of adjacent layers [H ~> m or kg m-2].
- real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1].
- real :: I_Hmix ! The inverse of the mixed layer thickness [H-1 ~> m-1 or m2 kg-1].
+ real :: h_shear ! The distance over which shears occur [Z ~> m].
+ real :: dhc ! The distance between the center of adjacent layers [Z ~> m].
+ real :: visc_ml ! The mixed layer viscosity [H Z T-1 ~> m2 s-1 or Pa s].
+ real :: tau_scale ! A scaling factor for the interpolated wind stress magnitude [H R-1 L-1 ~> m3 kg-1 or nondim]
+ real :: I_Hmix ! The inverse of the mixed layer thickness [Z-1 ~> m-1].
real :: a_ml ! The layer coupling coefficient across an interface in
- ! the mixed layer [Z T-1 ~> m s-1].
+ ! the mixed layer [H T-1 ~> m s-1 or Pa s m-1].
real :: a_floor ! A lower bound on the layer coupling coefficient across an interface in
- ! the mixed layer [Z T-1 ~> m s-1].
- real :: I_amax ! The inverse of the maximum coupling coefficient [T Z-1 ~> s m-1].
- real :: temp1 ! A temporary variable [H Z ~> m2 or kg m-1]
+ ! the mixed layer [H T-1 ~> m s-1 or Pa s m-1].
+ real :: I_amax ! The inverse of the maximum coupling coefficient [T H-1 ~> s m-1 or s m2 kg-1].
+ real :: temp1 ! A temporary variable [Z2 ~> m2]
real :: ustar2_denom ! A temporary variable in the surface boundary layer turbulence
- ! calculations [Z H-1 T-1 ~> s-1 or m3 kg-1 s-1]
- real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected [H ~> m or kg m-2].
+ ! calculations [H Z-1 T-1 ~> s-1 or kg m-3 s-1]
+ real :: h_neglect ! A vertical distance that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m].
real :: z2 ! A copy of z_i [nondim]
real :: botfn ! A function that is 1 at the bottom and small far from it [nondim]
real :: topfn ! A function that is 1 at the top and small far from it [nondim]
- real :: kv_top ! A viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1]
+ real :: kv_top ! A viscosity associated with the top boundary layer [H Z T-1 ~> m2 s-1 or Pa s]
logical :: do_shelf, do_OBCs, can_exit
integer :: i, k, is, ie, max_nk
integer :: nz
@@ -1941,13 +1993,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
if (work_on_u) then ; is = G%IscB ; ie = G%IecB
else ; is = G%isc ; ie = G%iec ; endif
nz = GV%ke
- h_neglect = GV%H_subroundoff
+ h_neglect = GV%dZ_subroundoff
+
+ tau_scale = US%L_to_Z * GV%RZ_to_H
if (CS%answer_date < 20190101) then
! The maximum coupling coefficient was originally introduced to avoid
! truncation error problems in the tridiagonal solver. Effectively, the 1e-10
! sets the maximum coupling coefficient increment to 1e10 m per timestep.
- I_amax = (1.0e-10*US%Z_to_m) * dt
+ I_amax = (1.0e-10*GV%H_to_m) * dt
else
I_amax = 0.0
endif
@@ -2025,11 +2079,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
! to further modify these viscosities here to take OBCs into account.
if (work_on_u) then
do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then
- Kv_tot(I,K) = Kv_tot(I,K) + (0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k))
+ Kv_tot(I,K) = Kv_tot(I,K) + 0.5*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k))
endif ; enddo ; enddo
else
do K=2,nz ; do i=is,ie ; if (do_i(i)) then
- Kv_tot(i,K) = Kv_tot(i,K) + (0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k))
+ Kv_tot(i,K) = Kv_tot(i,K) + 0.5*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k))
endif ; enddo ; enddo
endif
endif
@@ -2042,9 +2096,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
! These expressions assume that Kv_tot(i,nz+1) = CS%Kv, consistent with
! the suppression of turbulent mixing by the presence of a solid boundary.
if (dhc < bbl_thick(i)) then
- a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (dhc+h_neglect)*GV%H_to_Z)
+ a_cpl(i,nz+1) = kv_bbl(i) / ((dhc+h_neglect) + I_amax*kv_bbl(i))
else
- a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (bbl_thick(i)+h_neglect)*GV%H_to_Z)
+ a_cpl(i,nz+1) = kv_bbl(i) / ((bbl_thick(i)+h_neglect) + I_amax*kv_bbl(i))
endif
endif ; enddo
do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then
@@ -2062,14 +2116,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
endif
! Calculate the coupling coefficients from the viscosities.
- a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K))
+ a_cpl(i,K) = Kv_tot(i,K) / (h_shear + (I_amax * Kv_tot(i,K)))
endif ; enddo ; enddo ! i & k loops
elseif (abs(CS%Kv_extra_bbl) > 0.0) then
! There is a simple enhancement of the near-bottom viscosities, but no adjustment
! of the viscous coupling length scales to give a particular bottom stress.
do i=is,ie ; if (do_i(i)) then
a_cpl(i,nz+1) = (Kv_tot(i,nz+1) + CS%Kv_extra_bbl) / &
- ((0.5*hvel(i,nz)+h_neglect)*GV%H_to_Z + I_amax*(Kv_tot(i,nz+1)+CS%Kv_extra_bbl))
+ ((0.5*hvel(i,nz)+h_neglect) + I_amax*(Kv_tot(i,nz+1)+CS%Kv_extra_bbl))
endif ; enddo
do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then
! botfn determines when a point is within the influence of the bottom
@@ -2081,18 +2135,18 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect)
! Calculate the coupling coefficients from the viscosities.
- a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K))
+ a_cpl(i,K) = Kv_tot(i,K) / (h_shear + I_amax*Kv_tot(i,K))
endif ; enddo ; enddo ! i & k loops
else
! Any near-bottom viscous enhancements were already incorporated into Kv_tot, and there is
! no adjustment of the viscous coupling length scales to give a particular bottom stress.
do i=is,ie ; if (do_i(i)) then
- a_cpl(i,nz+1) = Kv_tot(i,nz+1) / ((0.5*hvel(i,nz)+h_neglect)*GV%H_to_Z + I_amax*Kv_tot(i,nz+1))
+ a_cpl(i,nz+1) = Kv_tot(i,nz+1) / ((0.5*hvel(i,nz)+h_neglect) + I_amax*Kv_tot(i,nz+1))
endif ; enddo
do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then
h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect)
! Calculate the coupling coefficients from the viscosities.
- a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K))
+ a_cpl(i,K) = Kv_tot(i,K) / (h_shear + I_amax*Kv_tot(i,K))
endif ; enddo ; enddo ! i & k loops
endif
@@ -2104,18 +2158,18 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
do i=is,ie ; if (do_i(i)) then
if (work_on_u) then
kv_TBL(i) = visc%Kv_tbl_shelf_u(I,j)
- tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H + h_neglect
+ tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) + h_neglect
else
kv_TBL(i) = visc%Kv_tbl_shelf_v(i,J)
- tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H + h_neglect
+ tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) + h_neglect
endif
z_t(i) = 0.0
! If a_cpl(i,1) were not already 0, it would be added here.
if (0.5*hvel(i,1) > tbl_thick(i)) then
- a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i)*GV%H_to_Z + I_amax*kv_TBL(i))
+ a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i) + I_amax*kv_TBL(i))
else
- a_cpl(i,1) = kv_TBL(i) / ((0.5*hvel(i,1)+h_neglect)*GV%H_to_Z + I_amax*kv_TBL(i))
+ a_cpl(i,1) = kv_TBL(i) / ((0.5*hvel(i,1)+h_neglect) + I_amax*kv_TBL(i))
endif
endif ; enddo
@@ -2131,35 +2185,78 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
endif
kv_top = topfn * kv_TBL(i)
- a_cpl(i,K) = a_cpl(i,K) + kv_top / (h_shear*GV%H_to_Z + I_amax*kv_top)
+ a_cpl(i,K) = a_cpl(i,K) + kv_top / (h_shear + I_amax*kv_top)
endif ; enddo ; enddo
elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0) .or. CS%fixed_LOTW_ML .or. CS%apply_LOTW_floor) then
! Find the friction velocity and the absolute value of the Coriolis parameter at this point.
u_star(:) = 0.0 ! Zero out the friction velocity on land points.
- if (work_on_u) then
- do I=is,ie ; if (do_i(I)) then
- u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))
- absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
- endif ; enddo
- if (do_OBCs) then ; do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then
- if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) &
- u_star(I) = forces%ustar(i,j)
- if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) &
- u_star(I) = forces%ustar(i+1,j)
- endif ; enddo ; endif
- else
- do i=is,ie ; if (do_i(i)) then
- u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))
- absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
- endif ; enddo
- if (do_OBCs) then ; do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then
- if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) &
- u_star(i) = forces%ustar(i,j)
- if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) &
- u_star(i) = forces%ustar(i,j+1)
- endif ; enddo ; endif
+ tau_mag(:) = 0.0 ! Zero out the friction velocity on land points.
+
+ if (allocated(tv%SpV_avg)) then
+ rho_av1(:) = 0.0
+ if (work_on_u) then
+ do I=is,ie ; if (do_i(I)) then
+ u_star(I) = 0.5 * (Ustar_2d(i,j) + Ustar_2d(i+1,j))
+ rho_av1(I) = 2.0 / (tv%SpV_avg(i,j,1) + tv%SpV_avg(i+1,j,1))
+ absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
+ endif ; enddo
+ if (do_OBCs) then ; do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then
+ if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then
+ u_star(I) = Ustar_2d(i,j)
+ rho_av1(I) = 1.0 / tv%SpV_avg(i,j,1)
+ elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then
+ u_star(I) = Ustar_2d(i+1,j)
+ rho_av1(I) = 1.0 / tv%SpV_avg(i+1,j,1)
+ endif
+ endif ; enddo ; endif
+ else ! Work on v-points
+ do i=is,ie ; if (do_i(i)) then
+ u_star(i) = 0.5 * (Ustar_2d(i,j) + Ustar_2d(i,j+1))
+ rho_av1(i) = 2.0 / (tv%SpV_avg(i,j,1) + tv%SpV_avg(i,j+1,1))
+ absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
+ endif ; enddo
+ if (do_OBCs) then ; do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then
+ if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then
+ u_star(i) = Ustar_2d(i,j)
+ rho_av1(i) = 1.0 / tv%SpV_avg(i,j,1)
+ elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then
+ u_star(i) = Ustar_2d(i,j+1)
+ rho_av1(i) = 1.0 / tv%SpV_avg(i,j+1,1)
+ endif
+ endif ; enddo ; endif
+ endif
+ do I=is,ie
+ tau_mag(I) = GV%RZ_to_H*rho_av1(i) * u_star(I)**2
+ enddo
+ else ! (.not.allocated(tv%SpV_avg))
+ if (work_on_u) then
+ do I=is,ie ; if (do_i(I)) then
+ u_star(I) = 0.5*(Ustar_2d(i,j) + Ustar_2d(i+1,j))
+ absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
+ endif ; enddo
+ if (do_OBCs) then ; do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then
+ if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) &
+ u_star(I) = Ustar_2d(i,j)
+ if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) &
+ u_star(I) = Ustar_2d(i+1,j)
+ endif ; enddo ; endif
+ else
+ do i=is,ie ; if (do_i(i)) then
+ u_star(i) = 0.5*(Ustar_2d(i,j) + Ustar_2d(i,j+1))
+ absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
+ endif ; enddo
+ if (do_OBCs) then ; do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then
+ if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) &
+ u_star(i) = Ustar_2d(i,j)
+ if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) &
+ u_star(i) = Ustar_2d(i,j+1)
+ endif ; enddo ; endif
+ endif
+ do I=is,ie
+ tau_mag(I) = GV%Z_to_H*u_star(I)**2
+ enddo
endif
! Determine the thickness of the surface ocean boundary layer and its extent in index space.
@@ -2240,12 +2337,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
! The viscosity in visc_ml is set to go to 0 at the mixed layer top and bottom
! (in a log-layer) and be further limited by rotation to give the natural Ekman length.
- temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z
- ustar2_denom = (CS%vonKar * u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
+ temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))
+ if (GV%Boussinesq) then
+ ustar2_denom = (CS%vonKar * GV%Z_to_H*u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
+ else
+ ustar2_denom = (CS%vonKar * tau_mag(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
+ endif
visc_ml = temp1 * ustar2_denom
! Set the viscous coupling based on the model's vertical resolution. The omission of
! the I_amax factor here is consistent with answer dates above 20190101.
- a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z)
+ a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect))
! As a floor on the viscous coupling, assume that the length scale in the denominator can
! not be larger than the distance from the surface, consistent with a logarithmic velocity
@@ -2260,8 +2361,12 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
do K=2,max_nk ; do i=is,ie ; if (k <= nk_in_ml(i)) then
z_t(i) = z_t(i) + hvel(i,k-1)
- temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z
- ustar2_denom = (CS%vonKar * u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
+ temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))
+ if (GV%Boussinesq) then
+ ustar2_denom = (CS%vonKar * GV%Z_to_H*u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
+ else
+ ustar2_denom = (CS%vonKar * tau_mag(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
+ endif
! As a floor on the viscous coupling, assume that the length scale in the denominator can not
! be larger than the distance from the surface, consistent with a logarithmic velocity profile.
@@ -2271,16 +2376,17 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i,
do K=2,max_nk ; do i=is,ie ; if (k <= nk_in_ml(i)) then
z_t(i) = z_t(i) + hvel(i,k-1)
- temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z
+ temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))
! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer)
! and be further limited by rotation to give the natural Ekman length.
+ ! The following expressions are mathematically equivalent.
if (GV%Boussinesq .or. (CS%answer_date < 20230601)) then
- visc_ml = u_star(i) * CS%vonKar * (temp1*u_star(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
+ visc_ml = u_star(i) * CS%vonKar * (GV%Z_to_H*temp1*u_star(i)) / &
+ (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
else
- tau_mag(i) = u_star(i)**2
visc_ml = CS%vonKar * (temp1*tau_mag(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i))
endif
- a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 0.5*I_amax*visc_ml)
+ a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) + 0.5*I_amax*visc_ml)
! Choose the largest estimate of a_cpl, but these could be changed to be additive.
a_cpl(i,K) = max(a_cpl(i,K), a_ml)
@@ -2382,7 +2488,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS
enddo ! j-loop
else ! Do not report accelerations leading to large velocities.
if (CS%CFL_based_trunc) then
-!$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report)
+ !$OMP parallel do default(shared)
do k=1,nz ; do j=js,je ; do I=Isq,Ieq
if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0
elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then
@@ -2394,7 +2500,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS
endif
enddo ; enddo ; enddo
else
-!$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,G,CS,truncvel,maxvel,h,H_report)
+ !$OMP parallel do default(shared)
do k=1,nz ; do j=js,je ; do I=Isq,Ieq
if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0
elseif (abs(u(I,j,k)) > maxvel) then
@@ -2519,20 +2625,16 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
! Local variables
- real :: Kv_BBL ! A viscosity in the bottom boundary layer with a simple scheme [Z2 T-1 ~> m2 s-1].
- real :: Hmix_z ! A boundary layer thickness [Z ~> m].
+ real :: Kv_BBL ! A viscosity in the bottom boundary layer with a simple scheme [H Z T-1 ~> m2 s-1 or Pa s]
+ real :: Kv_back_z ! A background kinematic viscosity [Z2 T-1 ~> m2 s-1]
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the
- !! answers from the end of 2018. Otherwise, use expressions that do not
- !! use an arbitrary and hard-coded maximum viscous coupling coefficient
- !! between layers.
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz
character(len=200) :: kappa_gl90_file, inputdir, kdgl90_varname
! This include declares and sets the variable "version".
# include "version_variable.h"
character(len=40) :: mdl = "MOM_vert_friction" ! This module's name.
character(len=40) :: thickness_units
+ real :: Kv_mks ! KVML in MKS
if (associated(CS)) then
call MOM_error(WARNING, "vertvisc_init called with an associated "// &
@@ -2556,26 +2658,15 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "VERT_FRICTION_2018_ANSWERS", answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the answers "//&
- "from the end of 2018. Otherwise, use expressions that do not use an arbitrary "//&
- "hard-coded maximum viscous coupling coefficient between layers.", &
- default=default_2018_answers)
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "VERT_FRICTION_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the viscous "//&
"calculations. Values below 20190101 recover the answers from the end of 2018, "//&
"while higher values use expressions that do not use an arbitrary hard-coded "//&
"maximum viscous coupling coefficient between layers. Values below 20230601 "//&
"recover a form of the viscosity within the mixed layer that breaks up the "//&
- "magnitude of the wind stress in some non-Boussinesq cases. "//&
- "If both VERT_FRICTION_2018_ANSWERS and VERT_FRICTION_ANSWER_DATE are "//&
- "specified, the latter takes precedence.", default=default_answer_date)
+ "magnitude of the wind stress in some non-Boussinesq cases.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, &
"If true, the bottom stress is calculated with a drag "//&
@@ -2628,17 +2719,16 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.)
if (GV%nkml < 1) then
- call get_param(param_file, mdl, "HMIX_FIXED", Hmix_z, &
+ call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, &
"The prescribed depth over which the near-surface viscosity and "//&
"diffusivity are elevated when the bulk mixed layer is not used.", &
units="m", scale=US%m_to_Z, fail_if_missing=.true.)
- CS%Hmix = GV%Z_to_H * Hmix_z
endif
if (CS%direct_stress) then
if (GV%nkml < 1) then
call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, &
"The depth over which the wind stress is applied if DIRECT_STRESS is true.", &
- units="m", default=US%Z_to_m*Hmix_z, scale=GV%m_to_H)
+ units="m", default=US%Z_to_m*CS%Hmix, scale=GV%m_to_H)
else
call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, &
"The depth over which the wind stress is applied if DIRECT_STRESS is true.", &
@@ -2647,17 +2737,20 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // &
"HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.")
endif
- call get_param(param_file, mdl, "KV", CS%Kv, &
+ call get_param(param_file, mdl, "KV", Kv_back_z, &
"The background kinematic viscosity in the interior. "//&
"The molecular value, ~1e-6 m2 s-1, may be used.", &
units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T)
+ ! Convert input kinematic viscosity to dynamic viscosity when non-Boussinesq.
+ CS%Kv = (US%Z2_T_to_m2_s*GV%m2_s_to_HZ_T) * Kv_back_z
+
call get_param(param_file, mdl, "USE_GL90_IN_SSW", CS%use_GL90_in_SSW, &
"If true, use simpler method to calculate 1/N^2 in GL90 vertical "// &
"viscosity coefficient. This method is valid in stacked shallow water mode.", &
default=.false.)
call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, &
"The scalar diffusivity used in GL90 vertical viscosity scheme.", &
- units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, &
+ units="m2 s-1", default=0.0, scale=US%m_to_L*US%Z_to_L*GV%m_to_H*US%T_to_s, &
do_not_log=.not.CS%use_GL90_in_SSW)
call get_param(param_file, mdl, "READ_KD_GL90", CS%read_kappa_gl90, &
"If true, read a file (given by KD_GL90_FILE) containing the "//&
@@ -2681,7 +2774,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
kappa_gl90_file = trim(inputdir) // trim(kappa_gl90_file)
allocate(CS%kappa_gl90_2d(G%isd:G%ied, G%jsd:G%jed), source=0.0)
- call MOM_read_data(kappa_gl90_file, kdgl90_varname, CS%kappa_gl90_2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s)
+ call MOM_read_data(kappa_gl90_file, kdgl90_varname, CS%kappa_gl90_2d(:,:), G%domain, &
+ scale=US%m_to_L*US%Z_to_L*GV%m_to_H*US%T_to_s)
call pass_var(CS%kappa_gl90_2d, G%domain)
endif
call get_param(param_file, mdl, "USE_GL90_N2", CS%use_GL90_N2, &
@@ -2704,7 +2798,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
"viscosity via Kv_GL90 = alpha_GL90 * f2. Is only used "// &
"if USE_GL90_N2 is true. Note that the implied Kv_GL90 "// &
"corresponds to a KD_GL90 that scales as N^2 with depth.", &
- units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T, &
+ units="m2 s", default=0.0, scale=GV%m_to_H*US%m_to_Z*US%s_to_T, &
do_not_log=.not.CS%use_GL90_in_SSW)
endif
call get_param(param_file, mdl, "HBBL_GL90", CS%Hbbl_gl90, &
@@ -2712,46 +2806,39 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
"which defines the range over which the GL90 coupling "//&
"coefficient is zeroed out, in order to avoid fluxing "//&
"momentum into vanished layers over steep topography.", &
- units="m", default=5.0, scale=GV%m_to_H, do_not_log=.not.CS%use_GL90_in_SSW)
+ units="m", default=5.0, scale=US%m_to_Z, do_not_log=.not.CS%use_GL90_in_SSW)
CS%Kvml_invZ2 = 0.0
if (GV%nkml < 1) then
- call get_param(param_file, mdl, "KV_ML_INVZ2", CS%Kvml_invZ2, &
- "An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, "//&
- "with the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the "//&
- "distance from the surface, to allow for finite wind stresses to be "//&
- "transmitted through infinitesimally thin surface layers. This is an "//&
- "older option for numerical convenience without a strong physical basis, "//&
- "and its use is now discouraged.", &
- units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.)
- if (CS%Kvml_invZ2 < 0.0) then
- call get_param(param_file, mdl, "KVML", CS%Kvml_invZ2, &
+ call get_param(param_file, mdl, "KVML", Kv_mks, &
"The scale for an extra kinematic viscosity in the mixed layer", &
- units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.)
- if (CS%Kvml_invZ2 >= 0.0) &
- call MOM_error(WARNING, "KVML is a deprecated parameter. Use KV_ML_INVZ2 instead.")
+ units="m2 s-1", default=-1.0, do_not_log=.true.)
+ if (Kv_mks >= 0.0) then
+ call MOM_error(WARNING, "KVML is a deprecated parameter. Use KV_ML_INVZ2 instead.")
+ else
+ Kv_mks = 0.0
endif
- if (CS%Kvml_invZ2 < 0.0) CS%Kvml_invZ2 = 0.0
- call log_param(param_file, mdl, "KV_ML_INVZ2", CS%Kvml_invZ2, &
+ call get_param(param_file, mdl, "KV_ML_INVZ2", CS%Kvml_invZ2, &
"An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, "//&
"with the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the "//&
"distance from the surface, to allow for finite wind stresses to be "//&
"transmitted through infinitesimally thin surface layers. This is an "//&
"older option for numerical convenience without a strong physical basis, "//&
"and its use is now discouraged.", &
- units="m2 s-1", default=0.0, unscale=US%Z2_T_to_m2_s)
+ units="m2 s-1", default=Kv_mks, scale=GV%m2_s_to_HZ_T)
endif
if (.not.CS%bottomdraglaw) then
call get_param(param_file, mdl, "KV_EXTRA_BBL", CS%Kv_extra_bbl, &
"An extra kinematic viscosity in the benthic boundary layer. "//&
"KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", &
- units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.)
+ units="m2 s-1", default=0.0, scale=GV%m2_s_to_HZ_T, do_not_log=.true.)
if (CS%Kv_extra_bbl == 0.0) then
call get_param(param_file, mdl, "KVBBL", Kv_BBL, &
"An extra kinematic viscosity in the benthic boundary layer. "//&
"KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", &
- units="m2 s-1", default=US%Z2_T_to_m2_s*CS%Kv, scale=US%m2_s_to_Z2_T, do_not_log=.true.)
+ units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_back_z, scale=GV%m2_s_to_HZ_T, &
+ do_not_log=.true.)
if (abs(Kv_BBL - CS%Kv) > 1.0e-15*abs(CS%Kv)) then
call MOM_error(WARNING, "KVBBL is a deprecated parameter. Use KV_EXTRA_BBL instead.")
CS%Kv_extra_bbl = Kv_BBL - CS%Kv
@@ -2760,14 +2847,14 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
call log_param(param_file, mdl, "KV_EXTRA_BBL", CS%Kv_extra_bbl, &
"An extra kinematic viscosity in the benthic boundary layer. "//&
"KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", &
- units="m2 s-1", default=0.0, unscale=US%Z2_T_to_m2_s)
+ units="m2 s-1", default=0.0, unscale=GV%HZ_T_to_m2_s)
endif
call get_param(param_file, mdl, "HBBL", CS%Hbbl, &
"The thickness of a bottom boundary layer with a viscosity increased by "//&
"KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which "//&
"near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is "//&
"defined but LINEAR_DRAG is not.", &
- units="m", fail_if_missing=.true., scale=GV%m_to_H)
+ units="m", fail_if_missing=.true., scale=US%m_to_Z)
call get_param(param_file, mdl, "MAXVEL", CS%maxvel, &
"The maximum velocity allowed before the velocity components are truncated.", &
units="m s-1", default=3.0e8, scale=US%m_s_to_L_T)
@@ -2824,31 +2911,31 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0
CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, &
- 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Slow varying vertical viscosity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, &
- 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T)
CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, &
- 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'Total vertical viscosity at v-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T)
CS%id_Kv_gl90_u = register_diag_field('ocean_model', 'Kv_gl90_u', diag%axesCuL, Time, &
- 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T)
CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, &
- 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s)
+ 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T)
CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, &
- 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T)
+ 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T)
CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, &
- 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T)
+ 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T)
CS%id_au_gl90_vv = register_diag_field('ocean_model', 'au_gl90_visc', diag%axesCui, Time, &
- 'Zonal Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T)
+ 'Zonal Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T)
CS%id_av_gl90_vv = register_diag_field('ocean_model', 'av_gl90_visc', diag%axesCvi, Time, &
- 'Meridional Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T)
+ 'Meridional Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T)
CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, &
'Thickness at Zonal Velocity Points for Viscosity', &
@@ -2862,11 +2949,11 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, &
CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, &
'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', &
- thickness_units, conversion=GV%H_to_MKS)
+ thickness_units, conversion=US%Z_to_m)
CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, &
'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', &
- thickness_units, conversion=GV%H_to_MKS)
+ thickness_units, conversion=US%Z_to_m)
CS%id_FPw2x = register_diag_field('ocean_model', 'FPw2x', diag%axesT1, Time, &
'Wind direction from x-axis','radians')
diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90
index 98788843e3..e0bd659a60 100644
--- a/src/tracer/DOME_tracer.F90
+++ b/src/tracer/DOME_tracer.F90
@@ -10,6 +10,7 @@ module DOME_tracer
use MOM_forcing_type, only : forcing
use MOM_hor_index, only : hor_index_type
use MOM_grid, only : ocean_grid_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc
use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_tracer_type
use MOM_open_boundary, only : OBC_segment_type
@@ -19,7 +20,7 @@ module DOME_tracer
use MOM_tracer_registry, only : register_tracer, tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : surface
+use MOM_variables, only : surface, thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
implicit none ; private
@@ -156,7 +157,7 @@ end function register_DOME_tracer
!> Initializes the NTR tracer fields in tr(:,:,:,:) and sets up the tracer output.
subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, &
- sponge_CSp, param_file)
+ sponge_CSp, tv)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -170,27 +171,27 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, &
!! call to DOME_register_tracer.
type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure
!! for the sponges, if they are in use.
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
-! Local variables
+ ! Local variables
real, allocatable :: temp(:,:,:) ! Target values for the tracers in the sponges, perhaps in [g kg-1]
character(len=16) :: name ! A variable's name in a NetCDF file.
real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1]
+ real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
real :: tr_y ! Initial zonally uniform tracer concentrations, perhaps in [g kg-1]
- real :: h_neglect ! A thickness that is so small it is usually lost
- ! in roundoff and can be neglected [H ~> m or kg m-2].
+ real :: dz_neglect ! A thickness that is so small it is usually lost
+ ! in roundoff and can be neglected [Z ~> m or kg m-2].
real :: e(SZK_(GV)+1) ! Interface heights relative to the sea surface (negative down) [Z ~> m]
real :: e_top ! Height of the top of the tracer band relative to the sea surface [Z ~> m]
real :: e_bot ! Height of the bottom of the tracer band relative to the sea surface [Z ~> m]
real :: d_tr ! A change in tracer concentrations, in tracer units, perhaps [g kg-1]
integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m
- integer :: IsdB, IedB, JsdB, JedB
if (.not.associated(CS)) return
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
- IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
- h_neglect = GV%H_subroundoff
+
+ dz_neglect = GV%dz_subroundoff
CS%Time => day
CS%diag => diag
@@ -225,31 +226,34 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, &
enddo ; enddo ; enddo
if (NTR >= 7) then
- do j=js,je ; do i=is,ie
- e(1) = 0.0
- do k=1,nz
- e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z
- do m=7,NTR
- e_top = -CS%sheet_spacing * (real(m-6))
- e_bot = -CS%sheet_spacing * (real(m-6) + 0.5)
- if (e_top < e(K)) then
- if (e_top < e(K+1)) then ; d_tr = 0.0
- elseif (e_bot < e(K+1)) then
- d_tr = 1.0 * (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_Z)
- else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z)
+ do j=js,je
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+ do i=is,ie
+ e(1) = 0.0
+ do k=1,nz
+ e(K+1) = e(K) - dz(i,k)
+ do m=7,NTR
+ e_top = -CS%sheet_spacing * (real(m-6))
+ e_bot = -CS%sheet_spacing * (real(m-6) + 0.5)
+ if (e_top < e(K)) then
+ if (e_top < e(K+1)) then ; d_tr = 0.0
+ elseif (e_bot < e(K+1)) then
+ d_tr = 1.0 * (e_top-e(K+1)) / (dz(i,k)+dz_neglect)
+ else ; d_tr = 1.0 * (e_top-e_bot) / (dz(i,k)+dz_neglect)
+ endif
+ elseif (e_bot < e(K)) then
+ if (e_bot < e(K+1)) then ; d_tr = 1.0
+ else ; d_tr = 1.0 * (e(K)-e_bot) / (dz(i,k)+dz_neglect)
+ endif
+ else
+ d_tr = 0.0
endif
- elseif (e_bot < e(K)) then
- if (e_bot < e(K+1)) then ; d_tr = 1.0
- else ; d_tr = 1.0 * (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z)
- endif
- else
- d_tr = 0.0
- endif
- if (h(i,j,k) < 2.0*GV%Angstrom_H) d_tr=0.0
- CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr
+ if (dz(i,k) < 2.0*GV%Angstrom_Z) d_tr=0.0
+ CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr
+ enddo
enddo
enddo
- enddo ; enddo
+ enddo
endif
endif
diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90
index 41a9cba8f4..16506b41c3 100644
--- a/src/tracer/MOM_CFC_cap.F90
+++ b/src/tracer/MOM_CFC_cap.F90
@@ -230,7 +230,7 @@ subroutine initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS)
type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type
!! specifies whether, where, and what
!! open boundary conditions are used.
- type(CFC_cap_CS), pointer :: CS !< The control structure returned by a
+ type(CFC_cap_CS), pointer :: CS !< The control structure returned by a
!! previous call to register_CFC_cap.
! local variables
@@ -259,7 +259,8 @@ subroutine initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS)
write(m2char, "(I1)") m
CS%CFC_data(m)%id_cmor = register_diag_field('ocean_model', &
'cfc1'//m2char, diag%axesTL, day, &
- 'Mole Concentration of CFC1'//m2char//' in Sea Water', 'mol m-3')
+ 'Mole Concentration of CFC1'//m2char//' in Sea Water', 'mol m-3', &
+ conversion=GV%Rho0*US%R_to_kg_m3)
CS%CFC_data(m)%id_sfc_flux = register_diag_field('ocean_model', &
'cfc1'//m2char//'_flux', diag%axesT1, day, &
@@ -360,7 +361,7 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C
! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2]
- real :: flux_scale
+ real :: flux_scale ! A dimensional rescaling factor for fluxes [H R-1 Z-1 ~> m3 kg-1 or nondim]
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -403,8 +404,7 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C
! If needed, write out any desired diagnostics from tracer sources & sinks here.
do m=1,NTR
if (CS%CFC_data(m)%id_cmor > 0) &
- call post_data(CS%CFC_data(m)%id_cmor, &
- (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(m)%conc, CS%diag)
+ call post_data(CS%CFC_data(m)%id_cmor, CS%CFC_data(m)%conc, CS%diag)
if (CS%CFC_data(m)%id_sfc_flux > 0) &
call post_data(CS%CFC_data(m)%id_sfc_flux, CS%CFC_data(m)%sfc_flux, CS%diag)
diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90
index d0f75e8197..bbca7ca9d6 100644
--- a/src/tracer/MOM_neutral_diffusion.F90
+++ b/src/tracer/MOM_neutral_diffusion.F90
@@ -142,10 +142,6 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS,
! Local variables
character(len=80) :: string ! Temporary strings
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that
- ! recover the answers for remapping from the end of 2018.
- ! Otherwise, use more robust forms of the same expressions.
logical :: debug ! If true, write verbose checksums for debugging purposes.
logical :: boundary_extrap ! Indicate whether high-order boundary
!! extrapolation should be used within boundary cells.
@@ -216,23 +212,13 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS,
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, &
- "If true, use the order of arithmetic and expressions that recover the "//&
- "answers from the end of 2018. Otherwise, use updated and more robust "//&
- "forms of the same expressions.", default=default_2018_answers)
- ! Revise inconsistent default answer dates for remapping.
- if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, &
"The vintage of the expressions and order of arithmetic to use for remapping. "//&
"Values below 20190101 result in the use of older, less accurate expressions "//&
"that were in use at the end of 2018. Higher values result in the use of more "//&
- "robust and accurate forms of mathematically equivalent expressions. "//&
- "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//&
- "latter takes precedence.", default=default_answer_date)
+ "robust and accurate forms of mathematically equivalent expressions.", &
+ default=default_answer_date, do_not_log=.not.GV%Boussinesq)
+ if (.not.GV%Boussinesq) CS%remap_answer_date = max(CS%remap_answer_date, 20230701)
call initialize_remapping( CS%remap_CS, string, boundary_extrapolation=boundary_extrap, &
answer_date=CS%remap_answer_date )
call extract_member_remapping_CS(CS%remap_CS, degree=CS%deg)
diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90
index 7619cac2bd..bd105439c7 100644
--- a/src/tracer/MOM_offline_aux.F90
+++ b/src/tracer/MOM_offline_aux.F90
@@ -642,7 +642,8 @@ subroutine update_offline_from_files(G, GV, US, nk_input, mean_file, sum_file, s
real, dimension(SZI_(G),SZJ_(G)), &
intent(inout) :: mld !< Averaged mixed layer depth [Z ~> m]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
- intent(inout) :: Kd !< Diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]
+ intent(inout) :: Kd !< Diapycnal diffusivities at interfaces
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes
integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files
integer, intent(in ) :: ridx_snap !< Read index for snapshot file
@@ -696,7 +697,7 @@ subroutine update_offline_from_files(G, GV, US, nk_input, mean_file, sum_file, s
! Check if reading vertical diffusivities or entrainment fluxes
call MOM_read_data( mean_file, 'Kd_interface', Kd(:,:,1:nk_input+1), G%Domain, &
- timelevel=ridx_sum, position=CENTER, scale=US%m2_s_to_Z2_T)
+ timelevel=ridx_sum, position=CENTER, scale=GV%m2_s_to_HZ_T)
! This block makes sure that the fluxes control structure, which may not be used in the solo_driver,
! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine
diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90
index 40dced9b20..06af35cefd 100644
--- a/src/tracer/MOM_offline_main.F90
+++ b/src/tracer/MOM_offline_main.F90
@@ -22,7 +22,7 @@ module MOM_offline_main
use MOM_file_parser, only : read_param, get_param, log_version, param_file_type
use MOM_forcing_type, only : forcing
use MOM_grid, only : ocean_grid_type
-use MOM_interface_heights, only : calc_derived_thermo
+use MOM_interface_heights, only : calc_derived_thermo, thickness_to_dz
use MOM_io, only : MOM_read_data, MOM_read_vector, CENTER
use MOM_offline_aux, only : update_offline_from_arrays, update_offline_from_files
use MOM_offline_aux, only : next_modulo_time, offline_add_diurnal_sw
@@ -121,7 +121,8 @@ module MOM_offline_main
real :: minimum_forcing_depth !< The smallest depth over which fluxes can be applied [H ~> m or kg m-2].
!! This is copied from diabatic_CS controlling how tracers follow freshwater fluxes
- real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity [Z2 T-1 ~> m2 s-1]
+ real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity
+ !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: min_residual !< The minimum amount of total mass flux before exiting the main advection
!! routine [H L2 ~> m3 or kg]
!>@{ Diagnostic manager IDs for some fields that may be of interest when doing offline transport
@@ -169,7 +170,7 @@ module MOM_offline_main
!< Amount of fluid entrained from the layer below within
!! one time step [H ~> m or kg m-2]
! Fields at T-points on interfaces
- real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity [Z2 T-1 ~> m2 s-1]
+ real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep [H ~> m or kg m-2]
real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m]
@@ -364,6 +365,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C
! Remap all variables from the old grid h_new onto the new grid h_post_remap
call ALE_remap_tracers(CS%ALE_CSp, G, GV, h_new, h_post_remap, CS%tracer_Reg, &
CS%debug, dt=CS%dt_offline)
+ if (allocated(CS%tv%SpV_avg)) CS%tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1
h_new(i,j,k) = h_post_remap(i,j,k)
@@ -650,7 +652,7 @@ end function remaining_transport_sum
!> The vertical/diabatic driver for offline tracers. First the eatr/ebtr associated with the interpolated
!! vertical diffusivities are calculated and then any tracer column functions are done which can include
!! vertical diffuvities and source/sink terms.
-subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_pre, eatr, ebtr)
+subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_pre, tv, eatr, ebtr)
type(forcing), intent(inout) :: fluxes !< pointers to forcing fields
type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type
@@ -661,17 +663,20 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_p
type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2]
+ type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various thermodynamic variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2]
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G)) :: &
sw, sw_vis, sw_nir !< Save old values of shortwave radiation [Q R Z T-1 ~> W m-2]
- real :: I_hval ! An inverse thickness [H-1 ~> m2 kg-1]
+ real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! Vertical distance across layers [Z ~> m]
+ real :: I_dZval ! An inverse distance between layer centers [Z-1 ~> m]
integer :: i, j, k, is, ie, js, je, nz
integer :: k_nonzero
- real :: Kd_bot ! Near-bottom diffusivity [Z2 T-1 ~> m2 s-1]
+ real :: Kd_bot ! Near-bottom diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
nz = GV%ke
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
@@ -686,6 +691,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_p
call MOM_tracer_chkinv("Before offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg)
endif
+ call thickness_to_dz(h_pre, tv, dz, G, GV, US)
+
eatr(:,:,:) = 0.
ebtr(:,:,:) = 0.
! Calculate eatr and ebtr if vertical diffusivity is read
@@ -712,8 +719,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_p
eatr(i,j,1) = 0.
enddo ; enddo
do k=2,nz ; do j=js,je ; do i=is,ie
- I_hval = 1.0 / (GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k)))
- eatr(i,j,k) = GV%Z_to_H**2 * CS%dt_offline_vertical * I_hval * CS%Kd(i,j,k)
+ I_dZval = 1.0 / (GV%dZ_subroundoff + 0.5*(dz(i,j,k-1) + dz(i,j,k)))
+ eatr(i,j,k) = CS%dt_offline_vertical * I_dZval * CS%Kd(i,j,k)
ebtr(i,j,k-1) = eatr(i,j,k)
enddo ; enddo ; enddo
do j=js,je ; do i=is,ie
@@ -1069,7 +1076,7 @@ subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale)
call pass_var(h, G%Domain)
call pass_var(CS%tv%T, G%Domain)
call pass_var(CS%tv%S, G%Domain)
- call ALE_offline_inputs(CS%ALE_CSp, G, GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, &
+ call ALE_offline_inputs(CS%ALE_CSp, G, GV, US, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, &
CS%debug, CS%OBC)
if (CS%id_temp_regrid>0) call post_data(CS%id_temp_regrid, CS%tv%T, CS%diag)
if (CS%id_salt_regrid>0) call post_data(CS%id_salt_regrid, CS%tv%S, CS%diag)
@@ -1417,7 +1424,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US)
call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, &
"The maximum permitted increment for the diapycnal "//&
"diffusivity from TKE-based parameterizations, or a "//&
- "negative value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T)
+ "negative value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m2_s_to_HZ_T)
call get_param(param_file, mdl, "MIN_RESIDUAL_TRANSPORT", CS%min_residual, &
"How much remaining transport before the main offline advection is exited. "//&
"The default value corresponds to about 1 meter of difference in a grid cell", &
diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90
index 5abca6e578..efe6397de0 100644
--- a/src/tracer/MOM_tracer_advect.F90
+++ b/src/tracer/MOM_tracer_advect.F90
@@ -381,7 +381,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
real :: a6 ! Curvature of the reconstruction tracer values [conc]
logical :: do_i(SZIB_(G),SZJ_(G)) ! If true, work on given points.
logical :: usePLMslope
- integer :: i, j, m, n, i_up, stencil
+ integer :: i, j, m, n, i_up, stencil, ntr_id
type(OBC_segment_type), pointer :: segment=>NULL()
logical, dimension(SZJ_(G),SZK_(GV)) :: domore_u_initial
@@ -442,18 +442,19 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
if (segment%is_E_or_W) then
if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then
I = segment%HI%IsdB
- do m = 1,ntr ! replace tracers with OBC values
+ do m = 1,segment%tr_Reg%ntseg ! replace tracers with OBC values
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
if (allocated(segment%tr_Reg%Tr(m)%tres)) then
if (segment%direction == OBC_DIRECTION_W) then
- T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ T_tmp(i,ntr_id) = segment%tr_Reg%Tr(m)%tres(i,j,k)
else
- T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ T_tmp(i+1,ntr_id) = segment%tr_Reg%Tr(m)%tres(i,j,k)
endif
else
if (segment%direction == OBC_DIRECTION_W) then
- T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ T_tmp(i,ntr_id) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
else
- T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ T_tmp(i+1,ntr_id) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
endif
endif
enddo
@@ -586,10 +587,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
(uhr(I,j,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_E)) then
uhh(I) = uhr(I,j,k)
! should the reservoir evolve for this case Kate ?? - Nope
- do m=1,ntr
+ do m=1,segment%tr_Reg%ntseg
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
if (allocated(segment%tr_Reg%Tr(m)%tres)) then
- flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k)
- else ; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif
+ flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k)
+ else ; flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif
enddo
endif
endif
@@ -609,10 +611,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. &
(uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then
uhh(I) = uhr(I,j,k)
- do m=1,ntr
+ do m=1,segment%tr_Reg%ntseg
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
if (allocated(segment%tr_Reg%Tr(m)%tres)) then
- flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k)
- else; flux_x(I,j,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif
+ flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k)
+ else; flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif
enddo
endif
endif
@@ -655,7 +658,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
enddo
! diagnostics
- if (associated(Tr(m)%ad_x)) then ; do i=is,ie ; if (do_i(i,j)) then
+ if (associated(Tr(m)%ad_x)) then ; do I=is-1,ie ; if (do_i(i,j)) then
Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,j,m)*Idt
endif ; enddo ; endif
@@ -682,13 +685,13 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
! compute ad2d_x diagnostic outside above j-loop so as to make the summation ordered when OMP is active.
!$OMP ordered
- do j=js,je ; if (domore_u_initial(j,k)) then
- do m=1,ntr
- if (associated(Tr(m)%ad2d_x)) then ; do i=is,ie ; if (do_i(i,j)) then
+ do m=1,ntr ; if (associated(Tr(m)%ad2d_x)) then
+ do j=js,je ; if (domore_u_initial(j,k)) then
+ do I=is-1,ie ; if (do_i(i,j)) then
Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,j,m)*Idt
- endif ; enddo ; endif
- enddo
- endif ; enddo ! End of j-loop.
+ endif ; enddo
+ endif ; enddo
+ endif ; enddo ! End of m-loop.
!$OMP end ordered
end subroutine advect_x
@@ -754,8 +757,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
logical :: do_j_tr(SZJ_(G)) ! If true, calculate the tracer profiles.
logical :: do_i(SZIB_(G), SZJ_(G)) ! If true, work on given points.
logical :: usePLMslope
- integer :: i, j, j2, m, n, j_up, stencil
+ integer :: i, j, j2, m, n, j_up, stencil, ntr_id
type(OBC_segment_type), pointer :: segment=>NULL()
+ logical :: domore_v_initial(SZJB_(G)) ! Initial state of domore_v
usePLMslope = .not. (usePPM .and. useHuynh)
! stencil for calculating slope values
@@ -778,6 +782,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
! this would require an additional loop, etc.
do_j_tr(:) = .false.
do J=js-1,je ; if (domore_v(J,k)) then ; do j2=1-stencil,stencil ; do_j_tr(j+j2) = .true. ; enddo ; endif ; enddo
+ domore_v_initial(:) = domore_v(:,k)
! Calculate the j-direction profiles (slopes) of each tracer that
! is being advected.
@@ -821,18 +826,19 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
if (segment%is_N_or_S) then
if (i>=segment%HI%isd .and. i<=segment%HI%ied) then
J = segment%HI%JsdB
- do m = 1,ntr ! replace tracers with OBC values
+ do m = 1,segment%tr_Reg%ntseg ! replace tracers with OBC values
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
if (allocated(segment%tr_Reg%Tr(m)%tres)) then
if (segment%direction == OBC_DIRECTION_S) then
- T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ T_tmp(i,ntr_id,j) = segment%tr_Reg%Tr(m)%tres(i,j,k)
else
- T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k)
+ T_tmp(i,ntr_id,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k)
endif
else
if (segment%direction == OBC_DIRECTION_S) then
- T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ T_tmp(i,ntr_id,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
else
- T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
+ T_tmp(i,ntr_id,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc
endif
endif
enddo
@@ -966,10 +972,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
if ((vhr(i,J,k) > 0.0) .and. (segment%direction == OBC_DIRECTION_S) .or. &
(vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then
vhh(i,J) = vhr(i,J,k)
- do m=1,ntr
+ do m=1,segment%tr_Reg%ntseg
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
if (allocated(segment%tr_Reg%Tr(m)%tres)) then
- flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k)
- else ; flux_y(i,m,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif
+ flux_y(i,ntr_id,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k)
+ else ; flux_y(i,ntr_id,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif
enddo
endif
enddo
@@ -989,10 +996,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. &
(vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then
vhh(i,J) = vhr(i,J,k)
- do m=1,ntr
+ do m=1,segment%tr_Reg%ntseg
+ ntr_id = segment%tr_reg%Tr(m)%ntr_index
if (allocated(segment%tr_Reg%Tr(m)%tres)) then
- flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k)
- else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif
+ flux_y(i,ntr_id,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k)
+ else ; flux_y(i,ntr_id,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif
enddo
endif
enddo
@@ -1034,11 +1042,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
(flux_y(i,m,J) - flux_y(i,m,J-1))) * Ihnew(i)
endif ; enddo
- ! diagnostics
- if (associated(Tr(m)%ad_y)) then ; do i=is,ie ; if (do_i(i,j)) then
- Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt
- endif ; enddo ; endif
-
! diagnose convergence of flux_y and add to convergence of flux_x.
! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt.
if (associated(Tr(m)%advection_xy)) then
@@ -1058,16 +1061,24 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
enddo ; enddo
endif ; enddo
- ! compute ad2d_y diagnostic outside above j-loop so as to make the summation ordered when OMP is active.
-
+ ! compute ad_y and ad2d_y diagnostic outside above j-loop so as to make the summation ordered when OMP is active.
!$OMP ordered
- do j=js,je ; if (do_j_tr(j)) then
- do m=1,ntr
- if (associated(Tr(m)%ad2d_y)) then ; do i=is,ie ; if (do_i(i,j)) then
+ do m=1,ntr ; if (associated(Tr(m)%ad_y)) then
+ do J=js-1,je ; if (domore_v_initial(J)) then
+ ! (The logical test could be "do_i(i,j) .or. do_i(i+1,j)" to be clearer, but not needed)
+ do i=is,ie ; if (do_i(i,j)) then
+ Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt
+ endif ; enddo
+ endif ; enddo
+ endif ; enddo ! End of m-loop.
+
+ do m=1,ntr ; if (associated(Tr(m)%ad2d_y)) then
+ do J=js-1,je ; if (domore_v_initial(J)) then
+ do i=is,ie ; if (do_i(i,j)) then
Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt
- endif ; enddo ; endif
- enddo
- endif ; enddo ! End of j-loop.
+ endif ; enddo
+ endif ; enddo
+ endif ; enddo ! End of m-loop.
!$OMP end ordered
end subroutine advect_y
diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90
index 4e067e6896..f18c14e105 100644
--- a/src/tracer/MOM_tracer_diabatic.F90
+++ b/src/tracer/MOM_tracer_diabatic.F90
@@ -56,7 +56,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, &
btm_src !< The time-integrated bottom source of the tracer [CU H ~> CU m or CU kg m-2].
real, dimension(SZI_(G)) :: &
b1, & !< b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
- d1 !! d1=1-c1 is used by the tridiagonal solver, nondimensional.
+ d1 !! d1=1-c1 is used by the tridiagonal solver [nondim].
real :: c1(SZI_(G),SZK_(GV)) !< c1 is used by the tridiagonal solver [nondim].
real :: h_minus_dsink(SZI_(G),SZK_(GV)) !< The layer thickness minus the
!! difference in sinking rates across the layer [H ~> m or kg m-2].
@@ -253,7 +253,7 @@ subroutine tracer_vertdiff_Eulerian(h_old, ent, dt, tr, G, GV, &
btm_src !< The time-integrated bottom source of the tracer [CU H ~> CU m or CU kg m-2].
real, dimension(SZI_(G)) :: &
b1, & !< b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
- d1 !! d1=1-c1 is used by the tridiagonal solver, nondimensional.
+ d1 !! d1=1-c1 is used by the tridiagonal solver [nondim].
real :: c1(SZI_(G),SZK_(GV)) !< c1 is used by the tridiagonal solver [nondim].
real :: h_minus_dsink(SZI_(G),SZK_(GV)) !< The layer thickness minus the
!! difference in sinking rates across the layer [H ~> m or kg m-2].
diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90
index 5d227defec..c8ce2f5f75 100644
--- a/src/tracer/MOM_tracer_flow_control.F90
+++ b/src/tracer/MOM_tracer_flow_control.F90
@@ -317,34 +317,31 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag
sponge_CSp)
if (CS%use_DOME_tracer) &
call initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS%DOME_tracer_CSp, &
- sponge_CSp, param_file)
+ sponge_CSp, tv)
if (CS%use_ISOMIP_tracer) &
call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, &
ALE_sponge_CSp)
if (CS%use_RGC_tracer) &
- call initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, &
- CS%RGC_tracer_CSp, sponge_CSp, ALE_sponge_CSp)
+ call initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS%RGC_tracer_CSp, &
+ sponge_CSp, ALE_sponge_CSp)
if (CS%use_ideal_age) &
call initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS%ideal_age_tracer_CSp, &
- sponge_CSp)
+ sponge_CSp)
if (CS%use_regional_dyes) &
- call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, &
- sponge_CSp)
+ call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, sponge_CSp, tv)
if (CS%use_oil) &
- call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, &
- sponge_CSp)
+ call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, sponge_CSp)
if (CS%use_advection_test_tracer) &
call initialize_advection_test_tracer(restart, day, G, GV, h, diag, OBC, CS%advection_test_tracer_CSp, &
sponge_CSp)
if (CS%use_OCMIP2_CFC) &
- call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, &
- sponge_CSp)
+ call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, sponge_CSp)
if (CS%use_CFC_cap) &
call initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS%CFC_cap_CSp)
if (CS%use_MOM_generic_tracer) &
call initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, &
- CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp)
+ CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp)
if (CS%use_pseudo_salt_tracer) &
call initialize_pseudo_salt_tracer(restart, day, G, GV, US, h, diag, OBC, CS%pseudo_salt_tracer_CSp, &
sponge_CSp, tv)
@@ -493,13 +490,13 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
minimum_forcing_depth=minimum_forcing_depth)
if (CS%use_ideal_age) &
call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%ideal_age_tracer_CSp, &
+ G, GV, US, tv, CS%ideal_age_tracer_CSp, &
evap_CFL_limit=evap_CFL_limit, &
minimum_forcing_depth=minimum_forcing_depth, &
Hbl=Hml)
if (CS%use_regional_dyes) &
call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%dye_tracer_CSp, &
+ G, GV, US, tv, CS%dye_tracer_CSp, &
evap_CFL_limit=evap_CFL_limit, &
minimum_forcing_depth=minimum_forcing_depth)
if (CS%use_oil) &
@@ -572,10 +569,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
G, GV, US, CS%RGC_tracer_CSp)
if (CS%use_ideal_age) &
call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%ideal_age_tracer_CSp, Hbl=Hml)
+ G, GV, US, tv, CS%ideal_age_tracer_CSp, Hbl=Hml)
if (CS%use_regional_dyes) &
call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%dye_tracer_CSp)
+ G, GV, US, tv, CS%dye_tracer_CSp)
if (CS%use_oil) &
call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
G, GV, US, CS%oil_tracer_CSp, tv)
diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90
index 6e1f2bee5a..c01419f3f8 100644
--- a/src/tracer/MOM_tracer_registry.F90
+++ b/src/tracer/MOM_tracer_registry.F90
@@ -836,16 +836,21 @@ end subroutine tracer_Reg_chkinv
!> Find a tracer in the tracer registry by name.
-subroutine tracer_name_lookup(Reg, tr_ptr, name)
+subroutine tracer_name_lookup(Reg, n, tr_ptr, name)
type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry
type(tracer_type), pointer :: tr_ptr !< target or pointer to the tracer array
character(len=32), intent(in) :: name !< tracer name
+ integer, intent(out) :: n !< index to tracer registery
- integer n
do n=1,Reg%ntr
- if (lowercase(Reg%Tr(n)%name) == lowercase(name)) tr_ptr => Reg%Tr(n)
+ if (lowercase(Reg%Tr(n)%name) == lowercase(name)) then
+ tr_ptr => Reg%Tr(n)
+ return
+ endif
enddo
+ call MOM_error(FATAL,"MOM cannot find registered tracer: "//name)
+
end subroutine tracer_name_lookup
!> Initialize the tracer registry.
diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90
index fbc2b28a95..ff2199fc80 100644
--- a/src/tracer/dye_example.F90
+++ b/src/tracer/dye_example.F90
@@ -11,6 +11,7 @@ module regional_dyes
use MOM_forcing_type, only : forcing
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_io, only : vardesc, var_desc, query_vardesc
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
@@ -21,7 +22,7 @@ module regional_dyes
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : surface
+use MOM_variables, only : surface, thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
implicit none ; private
@@ -189,7 +190,7 @@ end function register_dye_tracer
!> This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:)
!! and it sets up the tracer output.
-subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp)
+subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv)
logical, intent(in) :: restart !< .true. if the fields have already been
!! read from a restart file.
type(time_type), target, intent(in) :: day !< Time of the start of the run.
@@ -202,10 +203,12 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C
!! conditions are used.
type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_dye_tracer.
- type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure
- !! for the sponges, if they are in use.
+ type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure
+ !! for the sponges, if they are in use.
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
-! Local variables
+ ! Local variables
+ real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m]
real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m]
integer :: i, j, k, m
@@ -216,8 +219,9 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C
CS%diag => diag
! Establish location of source
- do m= 1, CS%ntr
- do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ do j=G%jsc,G%jec
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+ do m=1,CS%ntr ; do i=G%isc,G%iec
! A dye is set dependent on the center of the cell being inside the rectangular box.
if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. &
CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. &
@@ -226,8 +230,8 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C
G%mask2dT(i,j) > 0.0 ) then
z_bot = 0.0
do k = 1, GV%ke
- z_bot = z_bot - h(i,j,k)*GV%H_to_Z
- z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_Z
+ z_bot = z_bot - dz(i,k)
+ z_center = z_bot + 0.5*dz(i,k)
if ( z_center > -CS%dye_source_maxdepth(m) .and. &
z_center < -CS%dye_source_mindepth(m) ) then
CS%tr(i,j,k,m) = 1.0
@@ -244,7 +248,7 @@ end subroutine initialize_dye_tracer
!! This is a simple example of a set of advected passive tracers.
!! The arguments to this subroutine are redundant in that
!! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
-subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
+subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, tv, CS, &
evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -264,6 +268,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
!! and tracer forcing fields. Unused fields have NULL ptrs.
real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_dye_tracer.
real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can
@@ -271,8 +276,9 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
!! fluxes can be applied [H ~> m or kg m-2]
-! Local variables
+ ! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2]
+ real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m]
real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m]
integer :: i, j, k, is, ie, js, je, nz, m
@@ -284,7 +290,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
do m=1,CS%ntr
- do k=1,nz ;do j=js,je ; do i=is,ie
+ do k=1,nz ; do j=js,je ; do i=is,ie
h_work(i,j,k) = h_old(i,j,k)
enddo ; enddo ; enddo
call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m), dt, fluxes, h_work, &
@@ -297,8 +303,9 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
enddo
endif
- do m=1,CS%ntr
- do j=G%jsd,G%jed ; do i=G%isd,G%ied
+ do j=js,je
+ call thickness_to_dz(h_new, tv, dz, j, G, GV)
+ do m=1,CS%ntr ; do i=is,ie
! A dye is set dependent on the center of the cell being inside the rectangular box.
if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. &
CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. &
@@ -307,8 +314,8 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
G%mask2dT(i,j) > 0.0 ) then
z_bot = 0.0
do k=1,nz
- z_bot = z_bot - h_new(i,j,k)*GV%H_to_Z
- z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_Z
+ z_bot = z_bot - dz(i,k)
+ z_center = z_bot + 0.5*dz(i,k)
if ( z_center > -CS%dye_source_maxdepth(m) .and. &
z_center < -CS%dye_source_mindepth(m) ) then
CS%tr(i,j,k,m) = 1.0
diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90
index 285abe3785..92e10187a6 100644
--- a/src/tracer/dyed_obc_tracer.F90
+++ b/src/tracer/dyed_obc_tracer.F90
@@ -213,7 +213,7 @@ subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
!! fluxes can be applied [H ~> m or kg m-2]
! Local variables
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2]
integer :: i, j, k, is, ie, js, je, nz, m
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90
index dfa5e894db..8492437cb6 100644
--- a/src/tracer/ideal_age_example.F90
+++ b/src/tracer/ideal_age_example.F90
@@ -12,6 +12,7 @@ module ideal_age_example
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc
+use MOM_interface_heights, only : thickness_to_dz
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS
use MOM_spatial_means, only : global_mass_int_EFP
@@ -21,7 +22,7 @@ module ideal_age_example
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : surface
+use MOM_variables, only : surface, thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
implicit none ; private
@@ -46,13 +47,13 @@ module ideal_age_example
logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false.
type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry
- real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3?
- real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value.
- real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface.
- real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out.
- real, dimension(NTR_MAX) :: growth_rate !< The exponential growth rate for the young value [year-1].
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package [years] or other units
+ real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value [years] or other units
+ real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface [years] or other units
+ real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out [years] or other units
+ real, dimension(NTR_MAX) :: growth_rate !< The exponential growth rate for the young value [year-1]
real, dimension(NTR_MAX) :: tracer_start_year !< The year in which tracers start aging, or at which the
- !! surface value equals young_val, in years.
+ !! surface value equals young_val [years].
logical :: use_real_BL_depth !< If true, uses the BL scheme to determine the number of
!! layers above the BL depth instead of the fixed nkbl value.
integer :: BL_residence_num !< The tracer number assigned to the BL residence tracer in this module
@@ -296,7 +297,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS
end subroutine initialize_ideal_age_tracer
!> Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers
-subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
+subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, tv, CS, &
evap_CFL_limit, minimum_forcing_depth, Hbl)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -316,6 +317,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
!! and tracer forcing fields. Unused fields have NULL ptrs.
real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_ideal_age_tracer.
real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can
@@ -331,12 +333,12 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
! The arguments to this subroutine are redundant in that
! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
! Local variables
- real, dimension(SZI_(G),SZJ_(G)) :: BL_layers ! Stores number of layers in boundary layer
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified
- real :: young_val ! The "young" value for the tracers.
+ real, dimension(SZI_(G),SZJ_(G)) :: BL_layers ! Stores number of layers in boundary layer [nondim]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2]
+ real :: young_val ! The "young" value for the tracers [years] or other units
real :: Isecs_per_year ! The inverse of the amount of time in a year [T-1 ~> s-1]
- real :: year ! The time in years.
- real :: layer_frac
+ real :: year ! The time in years [years]
+ real :: layer_frac ! The fraction of the current layer that is within the mixed layer [nondim]
integer :: i, j, k, is, ie, js, je, nz, m, nk
character(len=255) :: msg
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -347,7 +349,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G,
endif
if (CS%use_real_BL_depth .and. present(Hbl)) then
- call count_BL_layers(G, GV, h_old, Hbl, BL_layers)
+ call count_BL_layers(G, GV, h_old, Hbl, tv, BL_layers)
endif
if (.not.associated(CS)) return
@@ -576,33 +578,37 @@ subroutine ideal_age_example_end(CS)
endif
end subroutine ideal_age_example_end
-subroutine count_BL_layers(G, GV, h, Hbl, BL_layers)
+subroutine count_BL_layers(G, GV, h, Hbl, tv, BL_layers)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
+ intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hbl !< Boundary layer depth [Z ~> m]
- real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BL_layers !< Number of model layers in the boundary layer
+ type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
+ real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BL_layers !< Number of model layers in the boundary layer [nondim]
- real :: current_depth
+ real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m]
+ real :: current_depth ! Distance from the free surface [Z ~> m]
integer :: i, j, k, is, ie, js, je, nz, m, nk
character(len=255) :: msg
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
BL_layers(:,:) = 0.
- do j=js,je ; do i=is,ie
-
- current_depth = 0.
- do k=1,nz
- current_depth = current_depth + h(i,j,k)*GV%H_to_Z
- if (Hbl(i,j) <= current_depth) then
- BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / (h(i,j,k)*GV%H_to_Z))
- exit
- else
- BL_layers(i,j) = BL_layers(i,j) + 1.0
- endif
+ do j=js,je
+ call thickness_to_dz(h, tv, dz, j, G, GV)
+ do i=is,ie
+ current_depth = 0.
+ do k=1,nz
+ current_depth = current_depth + dz(i,k)
+ if (Hbl(i,j) <= current_depth) then
+ BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / dz(i,k))
+ exit
+ else
+ BL_layers(i,j) = BL_layers(i,j) + 1.0
+ endif
+ enddo
enddo
- enddo ; enddo
+ enddo
end subroutine count_BL_layers
diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90
index e9d0bd5ef7..3c8fbe4ae8 100644
--- a/src/tracer/nw2_tracers.F90
+++ b/src/tracer/nw2_tracers.F90
@@ -9,6 +9,7 @@ module nw2_tracers
use MOM_forcing_type, only : forcing
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
+use MOM_interface_heights, only : thickness_to_dz
use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc
use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS
use MOM_time_manager, only : time_type, time_type_to_real
@@ -115,7 +116,7 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
!! thermodynamic variables
@@ -124,7 +125,8 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS)
type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous
!! call to register_nw2_tracer.
! Local variables
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Interface heights [Z ~> m]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Vertical extent of layers [Z ~> m]
real :: rscl ! z* scaling factor [nondim]
character(len=8) :: var_name ! The variable's name.
integer :: i, j, k, m
@@ -135,20 +137,22 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS)
CS%diag => diag
! Calculate z* interface positions
+ call thickness_to_dz(h, tv, dz, G, GV, US)
+
if (GV%Boussinesq) then
! First calculate interface positions in z-space (m)
do j=G%jsc,G%jec ; do i=G%isc,G%iec
eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j)
enddo ; enddo
do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec
- eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z
+ eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k)
enddo ; enddo ; enddo
! Re-calculate for interface positions in z*-space (m)
do j=G%jsc,G%jec ; do i=G%isc,G%iec
if (G%bathyT(i,j)>0.) then
rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) )
do K=GV%ke, 1, -1
- eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z * rscl
+ eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k) * rscl
enddo
endif
enddo ; enddo
@@ -176,15 +180,15 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2].
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2].
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: ea !< an array to which the amount of fluid entrained
!! from the layer above during this call will be
!! added [H ~> m or kg m-2].
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: eb !< an array to which the amount of fluid entrained
!! from the layer below during this call will be
!! added [H ~> m or kg m-2].
@@ -206,8 +210,9 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
! The arguments to this subroutine are redundant in that
! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
! Local variables
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2]
- real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Interface heights [Z ~> m]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Vertical extent of layers [Z ~> m]
integer :: i, j, k, m
real :: dt_x_rate ! dt * restoring rate [nondim]
real :: rscl ! z* scaling factor [nondim]
@@ -231,20 +236,22 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US
endif
! Calculate z* interface positions
+ call thickness_to_dz(h_new, tv, dz, G, GV, US)
+
if (GV%Boussinesq) then
- ! First calculate interface positions in z-space (m)
+ ! First calculate interface positions in z-space [Z ~> m]
do j=G%jsc,G%jec ; do i=G%isc,G%iec
eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j)
enddo ; enddo
do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec
- eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z
+ eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k)
enddo ; enddo ; enddo
- ! Re-calculate for interface positions in z*-space (m)
+ ! Re-calculate for interface positions in z*-space [Z ~> m]
do j=G%jsc,G%jec ; do i=G%isc,G%iec
if (G%bathyT(i,j)>0.) then
rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) )
do K=GV%ke, 1, -1
- eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z * rscl
+ eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k) * rscl
enddo
endif
enddo ; enddo
@@ -269,7 +276,7 @@ real function nw2_tracer_dist(m, G, GV, eta, i, j, k)
integer, intent(in) :: m !< Indicates the NW2 tracer
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
- real, dimension(SZI_(G),SZJ_(G),0:SZK_(G)), &
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
intent(in) :: eta !< Interface position [Z ~> m]
integer, intent(in) :: i !< Cell index i
integer, intent(in) :: j !< Cell index j
@@ -280,7 +287,7 @@ real function nw2_tracer_dist(m, G, GV, eta, i, j, k)
pi = 2.*acos(0.)
x = ( G%geolonT(i,j) - G%west_lon ) / G%len_lon ! 0 ... 1
y = -G%geolatT(i,j) / G%south_lat ! -1 ... 1
- z = - 0.5 * ( eta(i,j,K-1) + eta(i,j,K) ) / GV%max_depth ! 0 ... 1
+ z = - 0.5 * ( eta(i,j,K) + eta(i,j,K+1) ) / GV%max_depth ! 0 ... 1
select case ( mod(m-1,3) )
case (0) ! sin(2 pi x/L)
nw2_tracer_dist = sin( 2.0 * pi * x )
diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90
index 71800284a6..fc8f82f0df 100644
--- a/src/tracer/oil_tracer.F90
+++ b/src/tracer/oil_tracer.F90
@@ -42,18 +42,18 @@ module oil_tracer
character(len=200) :: IC_file !< The file in which the age-tracer initial values
!! can be found, or an empty string for internal initialization.
logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false.
- real :: oil_source_longitude !< Latitude of source location (geographic)
- real :: oil_source_latitude !< Longitude of source location (geographic)
- integer :: oil_source_i=-999 !< Local i of source location (computational)
- integer :: oil_source_j=-999 !< Local j of source location (computational)
+ real :: oil_source_longitude !< Latitude of source location (geographic) [degrees_N]
+ real :: oil_source_latitude !< Longitude of source location (geographic) [degrees_E]
+ integer :: oil_source_i=-999 !< Local i of source location (computational index location)
+ integer :: oil_source_j=-999 !< Local j of source location (computational index location)
real :: oil_source_rate !< Rate of oil injection [kg T-1 ~> kg s-1]
real :: oil_start_year !< The time at which the oil source starts [years]
real :: oil_end_year !< The time at which the oil source ends [years]
type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry
- real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3?
- real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value.
- real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out.
+ real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, [kg m-3]
+ real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value [kg m-3]
+ real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out [kg m-3]
real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil [T-1 ~> s-1] calculated from oil_decay_days
integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source
logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code
diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90
index 3efc908ffb..67381bfdc5 100644
--- a/src/user/BFB_initialization.F90
+++ b/src/user/BFB_initialization.F90
@@ -38,8 +38,11 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file)
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
+ real :: Rho_T0_S0 ! The density at T=0, S=0 [R ~> kg m-3]
real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
+ real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]
real :: SST_s, T_bot ! Temperatures at the surface and seafloor [C ~> degC]
+ real :: S_ref ! Reference salinity [S ~> ppt]
real :: rho_top, rho_bot ! Densities at the surface and seafloor [R ~> kg m-3]
integer :: k, nz
! This include declares and sets the variable "version".
@@ -47,23 +50,33 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file)
character(len=40) :: mdl = "BFB_initialization" ! This module's name.
call log_version(param_file, mdl, version, "")
- call get_param(param_file, mdl, "DRHO_DT", drho_dt, &
- "Rate of change of density with temperature.", &
- units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC)
+ call get_param(param_file, mdl, "DRHO_DT", dRho_dT, &
+ "The partial derivative of density with temperature.", &
+ units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC)
+ call get_param(param_file, mdl, "DRHO_DS", dRho_dS, &
+ "The partial derivative of density with salinity.", &
+ units="kg m-3 PSU-1", default=0.8, scale=US%kg_m3_to_R*US%S_to_ppt)
+ call get_param(param_file, mdl, "RHO_T0_S0", Rho_T0_S0, &
+ "The density at T=0, S=0.", units="kg m-3", default=1000.0, scale=US%kg_m3_to_R)
call get_param(param_file, mdl, "SST_S", SST_s, &
- "SST at the southern edge of the domain.", units="degC", default=20.0, scale=US%degC_to_C)
+ "SST at the southern edge of the domain.", &
+ units="degC", default=20.0, scale=US%degC_to_C)
call get_param(param_file, mdl, "T_BOT", T_bot, &
"Bottom temperature", units="degC", default=5.0, scale=US%degC_to_C)
- rho_top = GV%Rho0 + drho_dt*SST_s
- rho_bot = GV%Rho0 + drho_dt*T_bot
+ call get_param(param_file, mdl, "S_REF", S_ref, &
+ "The initial salinities.", units="PSU", default=35.0, scale=US%ppt_to_S)
+ rho_top = (Rho_T0_S0 + dRho_dS*S_ref) + dRho_dT*SST_s
+ rho_bot = (Rho_T0_S0 + dRho_dS*S_ref) + dRho_dT*T_bot
nz = GV%ke
do k = 1,nz
Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top
- if (k >1) then
- g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth / (GV%Rho0)
- else
+ if (k==1) then
g_prime(k) = GV%g_Earth
+ elseif (GV%Boussinesq) then
+ g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth / GV%Rho0
+ else
+ g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth / (0.5*(Rlay(k) + Rlay(k-1)))
endif
enddo
diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90
index f3d04980f6..fcbd66e1d8 100644
--- a/src/user/BFB_surface_forcing.F90
+++ b/src/user/BFB_surface_forcing.F90
@@ -29,12 +29,17 @@ module BFB_surface_forcing
real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3].
real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]
real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1].
+ real :: rho_restore !< The density that is used to convert piston velocities into salt
+ !! or heat fluxes with salinity or temperature restoring [R ~> kg m-3]
real :: SST_s !< SST at the southern edge of the linear forcing ramp [C ~> degC]
real :: SST_n !< SST at the northern edge of the linear forcing ramp [C ~> degC]
+ real :: S_ref !< Reference salinity used throughout the domain [S ~> ppt]
real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degrees_N] or [km]
real :: lfrnlat !< Northern latitude where the linear forcing ramp ends [degrees_N] or [km]
- real :: drho_dt !< Rate of change of density with temperature [R C-1 ~> kg m-3 degC-1].
- !! Note that temperature is being used as a dummy variable here.
+ real :: Rho_T0_S0 !< The density at T=0, S=0 [R ~> kg m-3]
+ real :: dRho_dT !< The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
+ real :: dRho_dS !< The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]
+ !! Note that temperature and salinity are being used as dummy variables here.
!! All temperatures are converted into density.
type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to
@@ -125,7 +130,7 @@ subroutine BFB_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // &
"Temperature and salinity restoring used without modification." )
- rhoXcp = CS%Rho0 * fluxes%C_p
+ rhoXcp = CS%rho_restore * fluxes%C_p
do j=js,je ; do i=is,ie
! Set Temp_restore and Salin_restore to the temperature (in [C ~> degC]) and
! salinity (in [S ~> ppt]) that are being restored toward.
@@ -134,7 +139,7 @@ subroutine BFB_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * &
(Temp_restore - sfc_state%SST(i,j))
- fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * &
+ fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%rho_restore*CS%Flux_const)) * &
((Salin_restore - sfc_state%SSS(i,j)) / (0.5 * (Salin_restore + sfc_state%SSS(i,j))))
enddo ; enddo
else
@@ -144,7 +149,7 @@ subroutine BFB_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
! "Buoyancy restoring used without modification." )
! The -1 is because density has the opposite sign to buoyancy.
- buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0
+ buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%rho_restore
Temp_restore = 0.0
do j=js,je ; do i=is,ie
! Set density_restore to an expression for the surface potential
@@ -158,8 +163,7 @@ subroutine BFB_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
(G%geoLatT(i,j) - CS%lfrslat) + CS%SST_s
endif
- density_restore = Temp_restore*CS%drho_dt + CS%Rho0
-
+ density_restore = (CS%Rho_T0_S0 + CS%dRho_dS*CS%S_ref) + CS%dRho_dT*Temp_restore
fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * &
(density_restore - sfc_state%sfc_density(i,j))
enddo ; enddo
@@ -216,9 +220,17 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS)
call get_param(param_file, mdl, "SST_N", CS%SST_n, &
"SST at the northern edge of the linear forcing ramp.", &
units="degC", default=10.0, scale=US%degC_to_C)
- call get_param(param_file, mdl, "DRHO_DT", CS%drho_dt, &
- "The rate of change of density with temperature.", &
+ call get_param(param_file, mdl, "DRHO_DT", CS%dRho_dT, &
+ "The partial derivative of density with temperature.", &
units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC)
+ call get_param(param_file, mdl, "DRHO_DS", CS%dRho_dS, &
+ "The partial derivative of density with salinity.", &
+ units="kg m-3 PSU-1", default=0.8, scale=US%kg_m3_to_R*US%S_to_ppt)
+ call get_param(param_file, mdl, "RHO_T0_S0", CS%Rho_T0_S0, &
+ "The density at T=0, S=0.", units="kg m-3", default=1000.0, scale=US%kg_m3_to_R)
+ call get_param(param_file, mdl, "S_REF", CS%S_ref, &
+ "The reference salinity used here throughout the domain.", &
+ units="PSU", default=35.0, scale=US%ppt_to_S)
call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, &
"If true, the buoyancy fluxes drive the model back "//&
@@ -231,6 +243,11 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS)
default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s)
! Convert CS%Flux_const from m day-1 to m s-1.
CS%Flux_const = CS%Flux_const / 86400.0
+ call get_param(param_file, mdl, "RESTORE_FLUX_RHO", CS%rho_restore, &
+ "The density that is used to convert piston velocities into salt or heat "//&
+ "fluxes with RESTORE_SALINITY or RESTORE_TEMPERATURE.", &
+ units="kg m-3", default=CS%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=(CS%Flux_const==0.0))
endif
end subroutine BFB_surface_forcing_init
diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90
index 4a12387d9d..858ca32f93 100644
--- a/src/user/DOME_initialization.F90
+++ b/src/user/DOME_initialization.F90
@@ -322,6 +322,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg)
real :: D_edge ! The thickness [Z ~> m] of the dense fluid at the
! inner edge of the inflow
real :: RLay_range ! The range of densities [R ~> kg m-3].
+ real :: Rlay_Ref ! The surface layer's target density [R ~> kg m-3].
real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1]
real :: f_inflow ! The value of the Coriolis parameter used to determine DOME inflow
! properties [T-1 ~> s-1]
@@ -333,7 +334,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg)
! region of the specified shear profile [nondim]
character(len=32) :: name ! The name of a tracer field.
character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name.
- integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz, ntherm
+ integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz, ntherm, ntr_id
integer :: IsdB, IedB, JsdB, JedB
type(OBC_segment_type), pointer :: segment => NULL()
type(tracer_type), pointer :: tr_ptr => NULL()
@@ -351,6 +352,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg)
call get_param(PF, mdl, "DENSITY_RANGE", Rlay_range, &
"The range of reference potential densities in the layers.", &
units="kg m-3", default=2.0, scale=US%kg_m3_to_R)
+ call get_param(PF, mdl, "LIGHTEST_DENSITY", Rlay_Ref, &
+ "The reference potential density used for layer 1.", &
+ units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R)
call get_param(PF, mdl, "F_0", f_0, &
"The reference value of the Coriolis parameter with the betaplane option.", &
units="s-1", default=0.0, scale=US%T_to_s)
@@ -369,9 +373,15 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg)
if (.not.associated(OBC)) return
- g_prime_tot = (GV%g_Earth / GV%Rho0) * Rlay_range
- Def_Rad = sqrt(D_edge*g_prime_tot) / abs(f_inflow)
- tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5*Def_Rad) * GV%Z_to_H
+ if (GV%Boussinesq) then
+ g_prime_tot = (GV%g_Earth / GV%Rho0) * Rlay_range
+ Def_Rad = sqrt(D_edge*g_prime_tot) / abs(f_inflow)
+ tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5*Def_Rad) * GV%Z_to_H
+ else
+ g_prime_tot = (GV%g_Earth / (Rlay_Ref + 0.5*Rlay_range)) * Rlay_range
+ Def_Rad = sqrt(D_edge*g_prime_tot) / abs(f_inflow)
+ tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5*Def_Rad) * (Rlay_Ref + 0.5*Rlay_range) * GV%RZ_to_H
+ endif
I_Def_Rad = 1.0 / (1.0e-3*US%L_to_m*Def_Rad)
@@ -424,8 +434,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg)
if (associated(tv%S)) then
! In this example, all S inflows have values given by S_ref.
name = 'salt'
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
- call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_scalar=S_ref, scale=US%ppt_to_S)
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
+ call register_segment_tracer(tr_ptr, ntr_id, PF, GV, segment, OBC_scalar=S_ref, scale=US%ppt_to_S)
endif
if (associated(tv%T)) then
! In this example, the T values are set to be consistent with the layer
@@ -449,8 +459,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg)
segment%field(1)%buffer_src(i,j,k) = T0(k)
enddo ; enddo ; enddo
name = 'temp'
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
- call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_array=.true., scale=US%degC_to_C)
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
+ call register_segment_tracer(tr_ptr, ntr_id, PF, GV, segment, OBC_array=.true., scale=US%degC_to_C)
endif
! Set up dye tracers
@@ -462,16 +472,16 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg)
else ; segment%field(ntherm+1)%buffer_src(i,j,k) = 1.0 ; endif
enddo ; enddo ; enddo
name = 'tr_D1'
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
- call register_segment_tracer(tr_ptr, PF, GV, OBC%segment(1), OBC_array=.true.)
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
+ call register_segment_tracer(tr_ptr, ntr_id, PF, GV, OBC%segment(1), OBC_array=.true.)
! All tracers but the first have 0 concentration in their inflows. As 0 is the
! default value for the inflow concentrations, the following calls are unnecessary.
do m=2,tr_Reg%ntr
if (m < 10) then ; write(name,'("tr_D",I1.1)') m
else ; write(name,'("tr_D",I2.2)') m ; endif
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
- call register_segment_tracer(tr_ptr, PF, GV, OBC%segment(1), OBC_scalar=0.0)
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
+ call register_segment_tracer(tr_ptr, ntr_id, PF, GV, OBC%segment(1), OBC_scalar=0.0)
enddo
end subroutine DOME_set_OBC_data
diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90
index ad930911ca..0c9d5cd330 100644
--- a/src/user/Idealized_Hurricane.F90
+++ b/src/user/Idealized_Hurricane.F90
@@ -22,7 +22,7 @@ module Idealized_hurricane
use MOM_error_handler, only : MOM_error, FATAL
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_forcing_type, only : forcing, mech_forcing
-use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing
+use MOM_forcing_type, only : allocate_mech_forcing
use MOM_grid, only : ocean_grid_type
use MOM_safe_alloc, only : safe_alloc_ptr
use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real
@@ -104,10 +104,6 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS)
real :: dP ! The pressure difference across the hurricane [R L2 T-2 ~> Pa]
real :: C ! A temporary variable [nondim]
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
- logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
- logical :: answers_2018 ! If true, use expressions driving the idealized hurricane test
- ! case that recover the answers from the end of 2018. Otherwise use
- ! expressions that are rescalable and respect rotational symmetry.
! This include declares and sets the variable "version".
# include "version_variable.h"
@@ -174,23 +170,11 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
- call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
- "This sets the default value for the various _2018_ANSWERS parameters.", &
- default=(default_answer_date<20190101))
- call get_param(param_file, mdl, "IDL_HURR_2018_ANSWERS", answers_2018, &
- "If true, use expressions driving the idealized hurricane test case that recover "//&
- "the answers from the end of 2018. Otherwise use expressions that are rescalable "//&
- "and respect rotational symmetry.", default=default_2018_answers)
-
- ! Revise inconsistent default answer dates.
- if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
- if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "IDL_HURR_ANSWER_DATE", CS%answer_date, &
"The vintage of the expressions in the idealized hurricane test case. "//&
"Values below 20190101 recover the answers from the end of 2018, while higher "//&
- "values use expressions that are rescalable and respect rotational symmetry. "//&
- "If both IDL_HURR_2018_ANSWERS and IDL_HURR_ANSWER_DATE are specified, "//&
- "the latter takes precedence.", default=default_answer_date)
+ "values use expressions that are rescalable and respect rotational symmetry.", &
+ default=default_answer_date)
! The following parameters are model run-time parameters which are used
! and logged elsewhere and so should not be logged here. The default
@@ -251,7 +235,7 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS)
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
! Allocate the forcing arrays, if necessary.
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., tau_mag=.true.)
if (CS%relative_tau) then
REL_TAU_FAC = 1.
@@ -325,16 +309,20 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS)
enddo
!> Get Ustar
- do j=js,je
- do i=is,ie
- ! This expression can be changed if desired, but need not be.
- forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gustiness/CS%Rho0 + &
- sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
- 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0))
- enddo
- enddo
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
+ ! This expression can be changed if desired, but need not be.
+ forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gustiness/CS%Rho0 + &
+ sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
+ 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0))
+ enddo ; enddo ; endif
+
+ !> Get tau_mag [R L Z T-2 ~> Pa]
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
+ forces%tau_mag(i,j) = G%mask2dT(i,j) * (CS%gustiness + &
+ sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
+ 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2)))
+ enddo ; enddo ; endif
- return
end subroutine idealized_hurricane_wind_forcing
!> Calculate the wind speed at a location as a function of time.
@@ -522,7 +510,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C
! Allocate the forcing arrays, if necessary.
- call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.)
+ call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., tau_mag=.true.)
pie = 4.0*atan(1.0) ; Deg2Rad = pie/180.
!/ BR
! Implementing Holland (1980) parameteric wind profile
@@ -667,13 +655,21 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C
endif
forces%tauy(I,j) = CS%rho_a * US%L_to_Z * G%mask2dCv(I,j) * Cd*dU10*dV
enddo ; enddo
+
! Set the surface friction velocity [Z T-1 ~> m s-1]. ustar is always positive.
- do j=js,je ; do i=is,ie
+ if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
! This expression can be changed if desired, but need not be.
forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gustiness/CS%Rho0 + &
sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0))
- enddo ; enddo
+ enddo ; enddo ; endif
+
+ !> Set magnitude of the wind stress [R L Z T-2 ~> Pa]
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
+ forces%tau_mag(i,j) = G%mask2dT(i,j) * (CS%gustiness + &
+ sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
+ 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2)))
+ enddo ; enddo ; endif
end subroutine SCM_idealized_hurricane_wind_forcing
diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90
index 88d0cbb482..1fc8a2f564 100644
--- a/src/user/Kelvin_initialization.F90
+++ b/src/user/Kelvin_initialization.F90
@@ -265,7 +265,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time)
! Use inside bathymetry
cff = sqrt(GV%g_Earth * depth_tot(i+1,j) )
val2 = mag_SSH * exp(- CS%F_0 * y / cff)
- segment%eta(I,j) = GV%Z_to_H*val2 * cos(omega * time_sec)
+ segment%SSH(I,j) = val2 * cos(omega * time_sec)
segment%normal_vel_bt(I,j) = val2 * (val1 * cff * cosa / depth_tot(i+1,j) )
if (segment%nudged) then
do k=1,nz
@@ -279,7 +279,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time)
endif
else
! Baroclinic, not rotated yet
- segment%eta(I,j) = 0.0
+ segment%SSH(I,j) = 0.0
segment%normal_vel_bt(I,j) = 0.0
if (segment%nudged) then
do k=1,nz
@@ -323,7 +323,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time)
if (CS%mode == 0) then
cff = sqrt(GV%g_Earth * depth_tot(i,j+1) )
val2 = mag_SSH * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff)
- segment%eta(I,j) = GV%Z_to_H*val2 * cos(omega * time_sec)
+ segment%SSH(I,j) = val2 * cos(omega * time_sec)
segment%normal_vel_bt(I,j) = (val1 * cff * sina / depth_tot(i,j+1) ) * val2
if (segment%nudged) then
do k=1,nz
@@ -337,7 +337,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time)
endif
else
! Not rotated yet
- segment%eta(i,J) = 0.0
+ segment%SSH(i,J) = 0.0
segment%normal_vel_bt(i,J) = 0.0
if (segment%nudged) then
do k=1,nz
diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90
index 02da5a0007..fa7b567845 100644
--- a/src/user/MOM_wave_interface.F90
+++ b/src/user/MOM_wave_interface.F90
@@ -97,7 +97,7 @@ module MOM_wave_interface
!! Horizontal -> V points
!! Vertical -> Mid-points
real, allocatable, dimension(:,:,:), public :: &
- KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1]
+ KvS !< Viscosity for Stokes Drift shear [H Z T-1 ~> m2 s-1 or Pa s]
real, allocatable, dimension(:), public :: &
WaveNum_Cen !< Wavenumber bands for read/coupled [Z-1 ~> m-1]
real, allocatable, dimension(:,:,:), public :: &
@@ -206,6 +206,8 @@ module MOM_wave_interface
real :: VonKar = -1.0 !< The von Karman coefficient as used in the MOM_wave_interface module [nondim]
real :: rho_air !< A typical density of air at sea level, as used in wave calculations [R ~> kg m-3]
real :: nu_air !< The viscosity of air, as used in wave calculations [Z2 T-1 ~> m2 s-1]
+ real :: rho_ocn !< A typical surface density of seawater, as used in wave calculations in
+ !! comparison with the density of air [R ~> kg m-3]. The default is RHO_0.
real :: SWH_from_u10sq !< A factor for converting the square of the 10 m wind speed to the
!! significant wave height [Z T2 L-2 ~> s2 m-1]
real :: Charnock_min !< The minimum value of the Charnock coefficient, which relates the square of
@@ -268,7 +270,7 @@ module MOM_wave_interface
contains
!> Initializes parameters related to MOM_wave_interface
-subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restart_CSp)
+subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag)
type(time_type), target, intent(in) :: Time !< Model time
type(ocean_grid_type), intent(inout) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -276,7 +278,6 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar
type(param_file_type), intent(in) :: param_file !< Input parameter structure
type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer
- type(MOM_restart_CS), optional, pointer:: restart_CSp!< Restart control structure
! Local variables
character(len=40) :: mdl = "MOM_wave_interface" !< This module's name.
@@ -329,7 +330,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar
"\t >= 20230101 - More robust expressions for Update_Stokes_Drift\n"//&
"\t >= 20230102 - More robust expressions for get_StokesSL_LiFoxKemper\n"//&
"\t >= 20230103 - More robust expressions for ust_2_u10_coare3p5", &
- default=20221231) ! In due course change the default to default=default_answer_date)
+ default=20221231, do_not_log=.not.GV%Boussinesq)
+ !### In due course change the default to default=default_answer_date)
+ if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
! Langmuir number Options
call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LA_FracHBL, &
@@ -342,7 +345,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar
if (StatisticalWaves) then
CS%WaveMethod = LF17
- call set_LF17_wave_params(param_file, mdl, US, CS)
+ call set_LF17_wave_params(param_file, mdl, GV, US, CS)
if (.not.use_waves) return
else
CS%WaveMethod = NULL_WaveMethod
@@ -512,7 +515,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar
"Flag to disable updating DHH85 Stokes drift.", default=.false.)
case (LF17_STRING) !Li and Fox-Kemper 17 wind-sea Langmuir number
CS%WaveMethod = LF17
- call set_LF17_wave_params(param_file, mdl, US, CS)
+ call set_LF17_wave_params(param_file, mdl, GV, US, CS)
case (EFACTOR_STRING) !Li and Fox-Kemper 16
CS%WaveMethod = EFACTOR
case default
@@ -590,9 +593,10 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar
end subroutine MOM_wave_interface_init
!> Set the parameters that are used to determine the averaged Stokes drift and Langmuir numbers
-subroutine set_LF17_wave_params(param_file, mdl, US, CS)
+subroutine set_LF17_wave_params(param_file, mdl, GV, US, CS)
type(param_file_type), intent(in) :: param_file !< Input parameter structure
character(len=*), intent(in) :: mdl !< A module name to use in the get_param calls
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure
@@ -608,6 +612,10 @@ subroutine set_LF17_wave_params(param_file, mdl, US, CS)
call get_param(param_file, mdl, "RHO_AIR", CS%rho_air, &
"A typical density of air at sea level, as used in wave calculations", &
units="kg m-3", default=1.225, scale=US%kg_m3_to_R)
+ call get_param(param_file, mdl, "RHO_SFC_WAVES", CS%Rho_ocn, &
+ "A typical surface density of seawater, as used in wave calculations in "//&
+ "comparison with the density of air. The default is RHO_0.", &
+ units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R)
call get_param(param_file, mdl, "WAVE_HEIGHT_SCALE_FACTOR", CS%SWH_from_u10sq, &
"A factor relating the square of the 10 m wind speed to the significant "//&
"wave height, with a default value based on the Pierson-Moskowitz spectrum.", &
@@ -707,7 +715,7 @@ subroutine Update_Surface_Waves(G, GV, US, Time_present, dt, CS, forces)
enddo
do jj=G%jsc,G%jec
do ii=G%isc,G%iec
- CS%Omega_w2x(ii,jj) = forces%omega_w2x(ii,jj)
+ !CS%Omega_w2x(ii,jj) = forces%omega_w2x(ii,jj)
do b=1,CS%NumBands
CS%UStk_Hb(ii,jj,b) = US%m_s_to_L_T*forces%UStkb(ii,jj,b)
CS%VStk_Hb(ii,jj,b) = US%m_s_to_L_T*forces%VStkb(ii,jj,b)
@@ -734,13 +742,13 @@ end subroutine Update_Surface_Waves
!> Constructs the Stokes Drift profile on the model grid based on
!! desired coupling options
-subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
+subroutine Update_Stokes_Drift(G, GV, US, CS, dz, ustar, dt, dynamics_step)
type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure
type(ocean_grid_type), intent(inout) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(in) :: h !< Thickness [H ~> m or kg m-2]
+ intent(in) :: dz !< Thickness in height units [Z ~> m]
real, dimension(SZI_(G),SZJ_(G)), &
intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1].
real, intent(in) :: dt !< Time-step for computing Stokes-tendency [T ~> s]
@@ -749,7 +757,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
! Local Variables
real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m]
real :: level_thick ! The thickness of each layer [Z ~> m]
- real :: DecayScale ! A vertical decay scale in the test profile [Z ~> m]
+ real :: DecayScale ! A vertical decay scale in the test profile [Z-1 ~> m-1]
real :: CMN_FAC ! A nondimensional factor [nondim]
real :: WN ! Model wavenumber [Z-1 ~> m-1]
real :: UStokes ! A Stokes drift velocity [L T-1 ~> m s-1]
@@ -776,8 +784,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
MidPoint = 0.0
do kk = 1,GV%ke
Top = Bottom
- MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk))
- Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk))
+ MidPoint = Bottom - 0.25*(dz(II,jj,kk)+dz(IIm1,jj,kk))
+ Bottom = Bottom - 0.5*(dz(II,jj,kk)+dz(IIm1,jj,kk))
CS%Us_x(II,jj,kk) = CS%TP_STKX0*exp(MidPoint*DecayScale)
enddo
enddo
@@ -789,8 +797,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
MidPoint = 0.0
do kk = 1,GV%ke
Top = Bottom
- MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk))
- Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk))
+ MidPoint = Bottom - 0.25*(dz(ii,JJ,kk)+dz(ii,JJm1,kk))
+ Bottom = Bottom - 0.5*(dz(ii,JJ,kk)+dz(ii,JJm1,kk))
CS%Us_y(ii,JJ,kk) = CS%TP_STKY0*exp(MidPoint*DecayScale)
enddo
enddo
@@ -817,7 +825,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
do kk = 1,GV%ke
Top = Bottom
IIm1 = max(II-1,1)
- level_thick = 0.5*GV%H_to_Z*(h(II,jj,kk)+h(IIm1,jj,kk))
+ level_thick = 0.5*(dz(II,jj,kk)+dz(IIm1,jj,kk))
MidPoint = Top - 0.5*level_thick
Bottom = Top - level_thick
@@ -875,7 +883,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
do kk = 1,GV%ke
Top = Bottom
JJm1 = max(JJ-1,1)
- level_thick = 0.5*GV%H_to_Z*(h(ii,JJ,kk)+h(ii,JJm1,kk))
+ level_thick = 0.5*(dz(ii,JJ,kk)+dz(ii,JJm1,kk))
MidPoint = Top - 0.5*level_thick
Bottom = Top - level_thick
@@ -929,8 +937,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
do kk = 1,GV%ke
Top = Bottom
IIm1 = max(II-1,1)
- MidPoint = Top - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk))
- Bottom = Top - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk))
+ MidPoint = Top - 0.25*(dz(II,jj,kk)+dz(IIm1,jj,kk))
+ Bottom = Top - 0.5*(dz(II,jj,kk)+dz(IIm1,jj,kk))
!bgr note that this is using a u-point ii on h-point ustar
! this code has only been previous used for uniform
! grid cases. This needs fixed if DHH85 is used for non
@@ -947,8 +955,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
do kk=1, GV%ke
Top = Bottom
JJm1 = max(JJ-1,1)
- MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk))
- Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk))
+ MidPoint = Bottom - 0.25*(dz(ii,JJ,kk)+dz(ii,JJm1,kk))
+ Bottom = Bottom - 0.5*(dz(ii,JJ,kk)+dz(ii,JJm1,kk))
!bgr note that this is using a v-point jj on h-point ustar
! this code has only been previous used for uniform
! grid cases. This needs fixed if DHH85 is used for non
@@ -986,9 +994,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
! in the routine it is needed by (e.g. KPP or ePBL).
do jj = G%jsc, G%jec
do ii = G%isc,G%iec
- Top = h(ii,jj,1)*GV%H_to_Z
- call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, &
- h(ii,jj,:), CS, Override_MA=.false.)
+ call get_Langmuir_Number( La, G, GV, US, dz(ii,jj,1), ustar(ii,jj), ii, jj, &
+ dz(ii,jj,:), CS, Override_MA=.false.)
CS%La_turb(ii,jj) = La
enddo
enddo
@@ -1159,7 +1166,7 @@ end subroutine Surface_Bands_by_data_override
!! Note this can be called with an unallocated Waves pointer, which is okay if we
!! want the wind-speed only dependent Langmuir number. Therefore, we need to be
!! careful about what we try to access here.
-subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, &
+subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, dz, Waves, &
U_H, V_H, Override_MA )
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure
@@ -1169,7 +1176,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, &
real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1]
integer, intent(in) :: i !< Meridional index of h-point
integer, intent(in) :: j !< Zonal index of h-point
- real, dimension(SZK_(GV)), intent(in) :: h !< Grid layer thickness [H ~> m or kg m-2]
+ real, dimension(SZK_(GV)), intent(in) :: dz !< Grid layer thickness [Z ~> m]
type(Wave_parameters_CS), pointer :: Waves !< Surface wave control structure.
real, dimension(SZK_(GV)), &
optional, intent(in) :: U_H !< Zonal velocity at H point [L T-1 ~> m s-1] or [m s-1]
@@ -1182,7 +1189,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, &
!Local Variables
- real :: Top, bottom, midpoint ! Positions within each layer [Z ~> m]
+ real :: Top, Bottom, MidPoint ! Positions within each layer [Z ~> m]
real :: Dpt_LASL ! Averaging depth for Stokes drift [Z ~> m]
real :: ShearDirection ! Shear angular direction from atan2 [radians]
real :: WaveDirection ! Wave angular direction from atan2 [radians]
@@ -1206,8 +1213,11 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, &
bottom = 0.0
do kk = 1,GV%ke
Top = Bottom
- MidPoint = Bottom + GV%H_to_Z*0.5*h(kk)
- Bottom = Bottom + GV%H_to_Z*h(kk)
+ MidPoint = Bottom + 0.5*dz(kk)
+ Bottom = Bottom + dz(kk)
+ !### Given the sign convention that Dpt_LASL is negative, the next line seems to have a bug.
+ ! To correct this bug, this line should be changed to:
+ ! if (MidPoint > abs(Dpt_LASL) .and. (kk > 1) .and. ContinueLoop) then
if (MidPoint > Dpt_LASL .and. kk > 1 .and. ContinueLoop) then
ShearDirection = atan2(V_H(1)-V_H(kk),U_H(1)-U_H(kk))
ContinueLoop = .false.
@@ -1220,8 +1230,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, &
US_H(kk) = 0.5*(Waves%US_X(I,j,kk)+Waves%US_X(I-1,j,kk))
VS_H(kk) = 0.5*(Waves%US_Y(i,J,kk)+Waves%US_Y(i,J-1,kk))
enddo
- call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx)
- call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy)
+ call Get_SL_Average_Prof( GV, Dpt_LASL, dz, US_H, LA_STKx)
+ call Get_SL_Average_Prof( GV, Dpt_LASL, dz, VS_H, LA_STKy)
LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY)
elseif (Waves%WaveMethod==SURFBANDS) then
allocate(StkBand_X(Waves%NumBands), StkBand_Y(Waves%NumBands))
@@ -1239,11 +1249,11 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, &
US_H(kk) = 0.5*(Waves%US_X(I,j,kk)+Waves%US_X(I-1,j,kk))
VS_H(kk) = 0.5*(Waves%US_Y(i,J,kk)+Waves%US_Y(i,J-1,kk))
enddo
- call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx)
- call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy)
+ call Get_SL_Average_Prof( GV, Dpt_LASL, dz, US_H, LA_STKx)
+ call Get_SL_Average_Prof( GV, Dpt_LASL, dz, VS_H, LA_STKy)
LA_STK = sqrt(LA_STKX**2 + LA_STKY**2)
elseif (Waves%WaveMethod==LF17) then
- call get_StokesSL_LiFoxKemper(ustar, hbl*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA)
+ call get_StokesSL_LiFoxKemper(ustar, HBL*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA)
elseif (Waves%WaveMethod==Null_WaveMethod) then
call MOM_error(FATAL, "Get_Langmuir_number called without defining a WaveMethod. "//&
"Suggest to make sure USE_LT is set/overridden to False or choose "//&
@@ -1343,7 +1353,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA)
! This code should be revised to minimize the number of divisions and cancel out common factors.
! Computing u10 based on u_star and COARE 3.5 relationships
- call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/CS%rho_air), u10, GV, US, CS)
+ call ust_2_u10_coare3p5(ustar*sqrt(CS%rho_ocn/CS%rho_air), u10, GV, US, CS)
! surface Stokes drift
UStokes = us_to_u10*u10
!
@@ -1427,19 +1437,19 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA)
end subroutine Get_StokesSL_LiFoxKemper
!> Get SL Averaged Stokes drift from a Stokes drift Profile
-subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average )
+subroutine Get_SL_Average_Prof( GV, AvgDepth, dz, Profile, Average )
type(verticalGrid_type), &
intent(in) :: GV !< Ocean vertical grid structure
- real, intent(in) :: AvgDepth !< Depth to average over (negative) [Z ~> m].
+ real, intent(in) :: AvgDepth !< Depth to average over (negative) [Z ~> m]
real, dimension(SZK_(GV)), &
- intent(in) :: H !< Grid thickness [H ~> m or kg m-2]
+ intent(in) :: dz !< Grid thickness [Z ~> m]
real, dimension(SZK_(GV)), &
intent(in) :: Profile !< Profile of quantity to be averaged in arbitrary units [A]
!! (used here for Stokes drift)
real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth [A]
!! (used here for Stokes drift)
!Local variables
- real :: top, midpoint, bottom ! Depths, negative downward [Z ~> m].
+ real :: Top, Bottom ! Depths, negative downward [Z ~> m]
real :: Sum ! The depth weighted vertical sum of a quantity [A Z ~> A m]
integer :: kk
@@ -1450,10 +1460,9 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average )
bottom = 0.0
do kk = 1, GV%ke
Top = Bottom
- MidPoint = Bottom - GV%H_to_Z * 0.5*h(kk)
- Bottom = Bottom - GV%H_to_Z * h(kk)
+ Bottom = Bottom - dz(kk)
if (AvgDepth < Bottom) then ! The whole cell is within H_LA
- Sum = Sum + Profile(kk) * (GV%H_to_Z * H(kk))
+ Sum = Sum + Profile(kk) * dz(kk)
elseif (AvgDepth < Top) then ! A partial cell is within H_LA
Sum = Sum + Profile(kk) * (Top-AvgDepth)
exit
@@ -1567,7 +1576,7 @@ end subroutine DHH85_mid
!> Explicit solver for Stokes mixing.
!! Still in development do not use.
-subroutine StokesMixing(G, GV, dt, h, u, v, Waves )
+subroutine StokesMixing(G, GV, dt, h, dz, u, v, Waves )
type(ocean_grid_type), &
intent(in) :: G !< Ocean grid
type(verticalGrid_type), &
@@ -1575,6 +1584,8 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves )
real, intent(in) :: dt !< Time step of MOM6 [T ~> s] for explicit solver
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
+ intent(in) :: dz !< Vertical distance between interfaces around a layer [Z ~> m]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
intent(inout) :: u !< Velocity i-component [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
@@ -1582,8 +1593,9 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves )
type(Wave_parameters_CS), &
pointer :: Waves !< Surface wave related control structure.
! Local variables
- real :: dTauUp, dTauDn ! Vertical momentum fluxes [Z L T-2 ~> m2 s-2]
- real :: h_Lay ! The layer thickness at a velocity point [Z ~> m].
+ real :: dTauUp, dTauDn ! Vertical momentum fluxes [H L T-2 ~> m2 s-2 or Pa]
+ real :: h_lay ! The layer thickness at a velocity point [H ~> m or kg m-2]
+ real :: dz_lay ! The distance between interfaces at a velocity point [Z ~> m]
integer :: i, j, k
! This is a template to think about down-Stokes mixing.
@@ -1592,18 +1604,19 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves )
do k = 1, GV%ke
do j = G%jsc, G%jec
do I = G%iscB, G%iecB
- h_lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i+1,j,k))
+ h_lay = 0.5*(h(i,j,k)+h(i+1,j,k))
+ dz_lay = 0.5*(dz(i,j,k)+dz(i+1,j,k))
dTauUp = 0.0
if (k > 1) &
- dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k)) * &
+ dTauUp = (0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k))) * &
(waves%us_x(i,j,k-1)-waves%us_x(i,j,k)) / &
- (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i+1,j,k-1)) ))
+ (0.5*(dz_lay + 0.5*(dz(i,j,k-1)+dz(i+1,j,k-1)) ))
dTauDn = 0.0
if (k < GV%ke-1) &
- dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1)) * &
+ dTauDn = (0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1))) * &
(waves%us_x(i,j,k)-waves%us_x(i,j,k+1)) / &
- (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i+1,j,k+1)) ))
- u(i,j,k) = u(i,j,k) + dt * (dTauUp-dTauDn) / h_Lay
+ (0.5*(dz_lay + 0.5*(dz(i,j,k+1)+dz(i+1,j,k+1)) ))
+ u(i,j,k) = u(i,j,k) + dt * (dTauUp-dTauDn) / h_lay
enddo
enddo
enddo
@@ -1611,18 +1624,19 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves )
do k = 1, GV%ke
do J = G%jscB, G%jecB
do i = G%isc, G%iec
- h_Lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i,j+1,k))
+ h_lay = 0.5*(h(i,j,k)+h(i,j+1,k))
+ dz_lay = 0.5*(dz(i,j,k)+dz(i,j+1,k))
dTauUp = 0.
if (k > 1) &
- dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k)) * &
+ dTauUp = (0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k))) * &
(waves%us_y(i,j,k-1)-waves%us_y(i,j,k)) / &
- (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i,j+1,k-1)) ))
+ (0.5*(dz_lay + 0.5*(dz(i,j,k-1)+dz(i,j+1,k-1)) ))
dTauDn = 0.0
if (k < GV%ke-1) &
- dTauDn =0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1)) * &
+ dTauDn = (0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1))) * &
(waves%us_y(i,j,k)-waves%us_y(i,j,k+1)) / &
- (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i,j+1,k+1)) ))
- v(i,J,k) = v(i,J,k) + dt * (dTauUp-dTauDn) / h_Lay
+ (0.5*(dz_lay + 0.5*(dz(i,j,k+1)+dz(i,j+1,k+1)) ))
+ v(i,J,k) = v(i,J,k) + dt * (dTauUp-dTauDn) / h_lay
enddo
enddo
enddo
@@ -1679,13 +1693,15 @@ end subroutine CoriolisStokes
!! including analytical integration of Stokes shear using multiple-exponential decay
!! Stokes drift profile and vertical integration of the resulting pressure
!! anomaly to the total pressure gradient force
-subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS )
+subroutine Stokes_PGF(G, GV, US, dz, u, v, PFu_Stokes, PFv_Stokes, CS )
type(ocean_grid_type), &
intent(in) :: G !< Ocean grid
type(verticalGrid_type), &
intent(in) :: GV !< Ocean vertical grid
+ type(unit_scale_type), &
+ intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(G)),&
- intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ intent(in) :: dz !< Layer thicknesses in height units [Z ~> m]
real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
intent(in) :: u !< Lagrangian Velocity i-component [L T-1 ~> m s-1]
real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
@@ -1758,12 +1774,13 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS )
zi_l(1) = 0.0
zi_r(1) = 0.0
do k = 1, G%ke
- h_l = h(i,j,k)*GV%H_to_Z
- h_r = h(i+1,j,k)*GV%H_to_Z
+ h_l = dz(i,j,k)
+ h_r = dz(i+1,j,k)
zi_l(k+1) = zi_l(k) - h_l
zi_r(k+1) = zi_r(k) - h_r
- Idz_l(k) = 1./max(0.1,h_l)
- Idz_r(k) = 1./max(0.1,h_r)
+ !### If the code were properly refactored, the following hard-coded constants would be unnecessary.
+ Idz_l(k) = 1./max(0.1*US%m_to_Z, h_l)
+ Idz_r(k) = 1./max(0.1*US%m_to_Z, h_r)
enddo
do k = 1,G%ke
! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the
@@ -1851,12 +1868,13 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS )
zi_l(1) = 0.0
zi_r(1) = 0.0
do k = 1, G%ke
- h_l = h(i,j,k)*GV%H_to_Z
- h_r = h(i,j+1,k)*GV%H_to_Z
+ h_l = dz(i,j,k)
+ h_r = dz(i,j+1,k)
zi_l(k+1) = zi_l(k) - h_l
zi_r(k+1) = zi_r(k) - h_r
- Idz_l(k) = 1./max(0.1,h_l)
- Idz_r(k) = 1./max(0.1,h_r)
+ !### If the code were properly refactored, the following hard-coded constants would be unnecessary.
+ Idz_l(k) = 1. / max(0.1*US%m_to_Z, h_l)
+ Idz_r(k) = 1. / max(0.1*US%m_to_Z, h_r)
enddo
do k = 1,G%ke
! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the
diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90
index 4f213d86d9..b76e69bb44 100644
--- a/src/user/Rossby_front_2d_initialization.F90
+++ b/src/user/Rossby_front_2d_initialization.F90
@@ -40,21 +40,23 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(out) :: h !< The thickness that is being initialized [Z ~> m]
+ intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]
type(param_file_type), intent(in) :: param_file !< A structure indicating the open file
!! to parse for model parameter values.
logical, intent(in) :: just_read !< If true, this call will only read
!! parameters without changing h.
- integer :: i, j, k, is, ie, js, je, nz
- real :: Tz ! Vertical temperature gradient [C Z-1 ~> degC m-1]
- real :: Dml ! Mixed layer depth [Z ~> m]
- real :: eta ! An interface height depth [Z ~> m]
+ ! Local variables
+ real :: Tz ! Vertical temperature gradient [C H-1 ~> degC m2 kg-1]
+ real :: Dml ! Mixed layer depth [H ~> m or kg m-2]
+ real :: eta ! An interface height depth [H ~> m or kg m-2]
real :: stretch ! A nondimensional stretching factor [nondim]
- real :: h0 ! The stretched thickness per layer [Z ~> m]
+ real :: h0 ! The stretched thickness per layer [H ~> m or kg m-2]
real :: T_range ! Range of temperatures over the vertical [C ~> degC]
real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
+ real :: max_depth ! Maximum depth of the model bathymetry [H ~> m or kg m-2]
character(len=40) :: verticalCoordinate
+ integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -69,40 +71,57 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read
units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read)
call get_param(param_file, mdl, "DRHO_DT", dRho_dT, &
units="kg m-3 degC-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.)
+ call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, &
+ units="m", default=-1.e9, scale=GV%m_to_H, do_not_log=.true.)
if (just_read) return ! All run-time parameters have been read, so return.
- Tz = T_range / G%max_depth
-
- select case ( coordinateMode(verticalCoordinate) )
-
- case (REGRIDDING_LAYER, REGRIDDING_RHO)
- do j = G%jsc,G%jec ; do i = G%isc,G%iec
- Dml = Hml( G, G%geoLatT(i,j) )
- eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml )
- stretch = ( ( G%max_depth + eta ) / G%max_depth )
- h0 = ( G%max_depth / real(nz) ) * stretch
- do k = 1, nz
- h(i,j,k) = h0
- enddo
- enddo ; enddo
-
- case (REGRIDDING_ZSTAR, REGRIDDING_SIGMA)
- do j = G%jsc,G%jec ; do i = G%isc,G%iec
- Dml = Hml( G, G%geoLatT(i,j) )
- eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml )
- stretch = ( ( G%max_depth + eta ) / G%max_depth )
- h0 = ( G%max_depth / real(nz) ) * stretch
- do k = 1, nz
- h(i,j,k) = h0
- enddo
- enddo ; enddo
-
- case default
- call MOM_error(FATAL,"Rossby_front_initialize: "// &
- "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE")
-
- end select
+ if (max_depth <= 0.0) call MOM_error(FATAL, &
+ "Rossby_front_initialize_thickness, Rossby_front_initialize_thickness: "//&
+ "This module requires a positive value of MAXIMUM_DEPTH.")
+
+ Tz = T_range / max_depth
+
+ if (GV%Boussinesq) then
+ select case ( coordinateMode(verticalCoordinate) )
+
+ case (REGRIDDING_LAYER, REGRIDDING_RHO)
+ ! This code is identical to the REGRIDDING_ZSTAR case but probably should not be.
+ do j = G%jsc,G%jec ; do i = G%isc,G%iec
+ Dml = Hml( G, G%geoLatT(i,j), max_depth )
+ eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml )
+ stretch = ( ( max_depth + eta ) / max_depth )
+ h0 = ( max_depth / real(nz) ) * stretch
+ do k = 1, nz
+ h(i,j,k) = h0
+ enddo
+ enddo ; enddo
+
+ case (REGRIDDING_ZSTAR, REGRIDDING_SIGMA)
+ do j = G%jsc,G%jec ; do i = G%isc,G%iec
+ Dml = Hml( G, G%geoLatT(i,j), max_depth )
+ ! The free surface height is set so that the bottom pressure gradient is 0.
+ eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml )
+ stretch = ( ( max_depth + eta ) / max_depth )
+ h0 = ( max_depth / real(nz) ) * stretch
+ do k = 1, nz
+ h(i,j,k) = h0
+ enddo
+ enddo ; enddo
+
+ case default
+ call MOM_error(FATAL,"Rossby_front_initialize: "// &
+ "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE")
+
+ end select
+ else
+ ! In non-Boussinesq mode with a flat bottom, the only requirement for no bottom pressure
+ ! gradient and no abyssal flow is that all columns have the same mass.
+ h0 = max_depth / real(nz)
+ do k=1,nz ; do j=G%jsc,G%jec ; do i=G%isc,G%iec
+ h(i,j,k) = h0
+ enddo ; enddo ; enddo
+ endif
end subroutine Rossby_front_initialize_thickness
@@ -114,20 +133,22 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, &
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [Z ~> m]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2]
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(param_file_type), intent(in) :: param_file !< Parameter file handle
logical, intent(in) :: just_read !< If true, this call will
!! only read parameters without changing T & S.
-
- integer :: i, j, k, is, ie, js, je, nz
+ ! Local variables
real :: T_ref ! Reference temperature within the surface layer [C ~> degC]
real :: S_ref ! Reference salinity within the surface layer [S ~> ppt]
real :: T_range ! Range of temperatures over the vertical [C ~> degC]
- real :: zc ! Position of the middle of the cell [Z ~> m]
- real :: zi ! Bottom interface position relative to the sea surface [Z ~> m]
- real :: dTdz ! Vertical temperature gradient [C Z-1 ~> degC m-1]
+ real :: zc ! Position of the middle of the cell [H ~> m or kg m-2]
+ real :: zi ! Bottom interface position relative to the sea surface [H ~> m or kg m-2]
+ real :: dTdz ! Vertical temperature gradient [C H-1 ~> degC m-1 or degC m2 kg-1]
+ real :: Dml ! Mixed layer depth [H ~> m or kg m-2]
+ real :: max_depth ! Maximum depth of the model bathymetry [H ~> m or kg m-2]
character(len=40) :: verticalCoordinate
+ integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
@@ -135,24 +156,32 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, &
default=DEFAULT_COORDINATE_MODE, do_not_log=just_read)
call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', &
default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read)
- call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', &
+ call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', &
units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read)
- call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range',&
+ call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', &
units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read)
+ call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, &
+ units="m", default=-1.e9, scale=GV%m_to_H, do_not_log=.true.)
if (just_read) return ! All run-time parameters have been read, so return.
+ if (max_depth <= 0.0) call MOM_error(FATAL, &
+ "Rossby_front_initialize_thickness, Rossby_front_initialize_temperature_salinity: "//&
+ "This module requires a positive value of MAXIMUM_DEPTH.")
+
T(:,:,:) = 0.0
S(:,:,:) = S_ref
- dTdz = T_range / G%max_depth
+ dTdz = T_range / max_depth
+ ! This sets the temperature to the value at the base of the specified mixed layer
+ ! depth from a horizontally uniform constant thermal stratification.
do j = G%jsc,G%jec ; do i = G%isc,G%iec
zi = 0.
+ Dml = Hml(G, G%geoLatT(i,j), max_depth)
do k = 1, nz
zi = zi - h(i,j,k) ! Bottom interface position
zc = zi - 0.5*h(i,j,k) ! Position of middle of cell
- zc = min( zc, -Hml(G, G%geoLatT(i,j)) ) ! Bound by depth of mixed layer
- T(i,j,k) = T_ref + dTdz * zc ! Linear temperature profile
+ T(i,j,k) = T_ref + dTdz * min( zc, -Dml ) ! Linear temperature profile below the mixed layer
enddo
enddo ; enddo
@@ -176,13 +205,24 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just
!! read parameters without setting u & v.
real :: T_range ! Range of temperatures over the vertical [C ~> degC]
- real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 C-1 ~> m s-1 degC-1]
+ real :: T_ref ! Reference temperature within the surface layer [C ~> degC]
+ real :: S_ref ! Reference salinity within the surface layer [S ~> ppt]
+ real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f with rescaling
+ ! [L2 H-1 T-1 C-1 ~> m s-1 degC-1 or m4 kg-1 s-1 degC-1]
+ real :: Rho_T0_S0 ! The density at T=0, S=0 [R ~> kg m-3]
real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1]
- real :: Dml ! Mixed layer depth [Z ~> m]
- real :: zi, zc, zm ! Depths [Z ~> m].
+ real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]
+ real :: dSpV_dT ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]
+ real :: T_here ! The temperature in the middle of a layer [C ~> degC]
+ real :: dTdz ! Vertical temperature gradient [C H-1 ~> degC m-1 or degC m2 kg-1]
+ real :: Dml ! Mixed layer depth [H ~> m or kg m-2]
+ real :: zi, zc, zm ! Depths in thickness units [H ~> m or kg m-2].
real :: f ! The local Coriolis parameter [T-1 ~> s-1]
+ real :: I_f ! The Adcroft reciprocal of the local Coriolis parameter [T ~> s]
real :: Ty ! The meridional temperature gradient [C L-1 ~> degC m-1]
- real :: hAtU ! Interpolated layer thickness [Z ~> m].
+ real :: hAtU ! Interpolated layer thickness in height units [H ~> m or kg m-2].
+ real :: u_int ! The zonal velocity at an interface [L T-1 ~> m s=1]
+ real :: max_depth ! Maximum depth of the model bathymetry [H ~> m or kg m-2]
integer :: i, j, k, is, ie, js, je, nz
character(len=40) :: verticalCoordinate
@@ -192,30 +232,73 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just
default=DEFAULT_COORDINATE_MODE, do_not_log=just_read)
call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', &
units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read)
+ call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', &
+ default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=.true.)
+ call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', &
+ units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=.true.)
+ call get_param(param_file, mdl, "RHO_T0_S0", Rho_T0_S0, &
+ units="kg m-3", default=1000.0, scale=US%kg_m3_to_R, do_not_log=.true.)
call get_param(param_file, mdl, "DRHO_DT", dRho_dT, &
- units='kg m-3 degC-1', default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.)
+ units="kg m-3 degC-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.)
+ call get_param(param_file, mdl, "DRHO_DS", dRho_dS, &
+ units="kg m-3 ppt-1", default=0.8, scale=US%kg_m3_to_R*US%S_to_ppt, do_not_log=.true.)
+ call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, &
+ units="m", default=-1.e9, scale=GV%m_to_H, do_not_log=.true.)
if (just_read) return ! All run-time parameters have been read, so return.
+ if (max_depth <= 0.0) call MOM_error(FATAL, &
+ "Rossby_front_initialize_thickness, Rossby_front_initialize_velocity: "//&
+ "This module requires a positive value of MAXIMUM_DEPTH.")
+
v(:,:,:) = 0.0
u(:,:,:) = 0.0
- do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1
- f = 0.5* (G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) )
- dUdT = 0.0 ; if (abs(f) > 0.0) &
- dUdT = ( GV%g_Earth*dRho_dT ) / ( f * GV%Rho0 )
- Dml = Hml( G, G%geoLatT(i,j) )
- Ty = dTdy( G, T_range, G%geoLatT(i,j), US )
- zi = 0.
- do k = 1, nz
- hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z
- zi = zi - hAtU ! Bottom interface position
- zc = zi - 0.5*hAtU ! Position of middle of cell
- zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer
- u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML
- enddo
- enddo ; enddo
-
+ if (GV%Boussinesq) then
+ do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1
+ f = 0.5* (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) )
+ dUdT = 0.0 ; if (abs(f) > 0.0) &
+ dUdT = ( GV%H_to_Z*GV%g_Earth*dRho_dT ) / ( f * GV%Rho0 )
+ Dml = Hml( G, G%geoLatCu(I,j), max_depth )
+ Ty = dTdy( G, T_range, G%geoLatCu(I,j), US )
+ zi = 0.
+ do k = 1, nz
+ hAtU = 0.5 * (h(i,j,k) + h(i+1,j,k))
+ zi = zi - hAtU ! Bottom interface position
+ zc = zi - 0.5*hAtU ! Position of middle of cell
+ zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer
+ u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML
+ enddo
+ enddo ; enddo
+ else
+ ! With an equation of state that is linear in density, the nonlinearies in
+ ! specific volume require that temperature be calculated for each layer.
+
+ dTdz = T_range / max_depth
+
+ do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1
+ f = 0.5* (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) )
+ I_f = 0.0 ; if (abs(f) > 0.0) I_f = 1.0 / f
+ Dml = Hml( G, G%geoLatCu(I,j), max_depth )
+ Ty = dTdy( G, T_range, G%geoLatCu(I,j), US )
+ zi = -max_depth
+ u_int = 0.0 ! The velocity at an interface
+ ! Work upward in non-Boussinesq mode
+ do k = nz, 1, -1
+ hAtU = 0.5 * (h(i,j,k) + h(i+1,j,k))
+ zc = zi + 0.5*hAtU ! Position of middle of cell
+ T_here = T_ref + dTdz * min(zc, -Dml) ! Linear temperature profile below the mixed layer
+ dSpV_dT = -dRho_dT / (Rho_T0_S0 + (dRho_dS * S_ref + dRho_dT * T_here) )**2
+ dUdT = -( GV%H_to_RZ * GV%g_Earth * dSpV_dT ) * I_f
+
+ ! There is thermal wind shear only within the mixed layer.
+ u(I,j,k) = u_int + dUdT * Ty * min(max((zi + Dml) + 0.5*hAtU, 0.0), 0.5*hAtU)
+ u_int = u_int + dUdT * Ty * min(max((zi + Dml) + hAtU, 0.0), hAtU)
+
+ zi = zi + hAtU ! Update the layer top interface position
+ enddo
+ enddo ; enddo
+ endif
end subroutine Rossby_front_initialize_velocity
!> Pseudo coordinate across domain used by Hml() and dTdy()
@@ -234,15 +317,16 @@ end function yPseudo
!> Analytic prescription of mixed layer depth in 2d Rossby front test,
-!! in the same units as G%max_depth (usually [Z ~> m])
-real function Hml( G, lat )
+!! in the same units as max_depth (usually [Z ~> m] or [H ~> m or kg m-2])
+real function Hml( G, lat, max_depth )
type(ocean_grid_type), intent(in) :: G !< Grid structure
real, intent(in) :: lat !< Latitude in arbitrary units, often [km]
+ real, intent(in) :: max_depth !< The maximum depth of the ocean [Z ~> m] or [H ~> m or kg m-2]
! Local
- real :: dHML, HMLmean ! The range and mean of the mixed layer depths [Z ~> m]
+ real :: dHML, HMLmean ! The range and mean of the mixed layer depths [Z ~> m] or [H ~> m or kg m-2]
- dHML = 0.5 * ( HMLmax - HMLmin ) * G%max_depth
- HMLmean = 0.5 * ( HMLmin + HMLmax ) * G%max_depth
+ dHML = 0.5 * ( HMLmax - HMLmin ) * max_depth
+ HMLmean = 0.5 * ( HMLmin + HMLmax ) * max_depth
Hml = HMLmean + dHML * sin( yPseudo(G, lat) )
end function Hml
diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90
index 7b1b4b3946..104a2b0312 100644
--- a/src/user/SCM_CVMix_tests.F90
+++ b/src/user/SCM_CVMix_tests.F90
@@ -42,6 +42,8 @@ module SCM_CVMix_tests
real :: surf_evap !< (Constant) Evaporation rate [Z T-1 ~> m s-1]
real :: Max_sw !< maximum of diurnal sw radiation [C Z T-1 ~> degC m s-1]
real :: Rho0 !< reference density [R ~> kg m-3]
+ real :: rho_restore !< The density that is used to convert piston velocities
+ !! into salt or heat fluxes [R ~> kg m-3]
end type
! This include declares and sets the variable "version".
@@ -184,6 +186,9 @@ subroutine SCM_CVMix_tests_surface_forcing_init(Time, G, param_file, CS)
"properties, or with BOUSSINSEQ false to convert some "//&
"parameters from vertical units of m to kg m-2.", &
units="kg m-3", default=1035.0, scale=US%kg_m3_to_R)
+ call get_param(param_file, mdl, "RESTORE_FLUX_RHO", CS%rho_restore, &
+ "The density that is used to convert piston velocities into salt or heat fluxes.", &
+ units="kg m-3", default=CS%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R)
end subroutine SCM_CVMix_tests_surface_forcing_init
@@ -214,7 +219,11 @@ subroutine SCM_CVMix_tests_wind_forcing(sfc_state, forces, day, G, US, CS)
mag_tau = sqrt(CS%tau_x*CS%tau_x + CS%tau_y*CS%tau_y)
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
- forces%ustar(i,j) = sqrt( US%L_to_Z * mag_tau / (CS%Rho0) )
+ forces%ustar(i,j) = sqrt( US%L_to_Z * mag_tau / CS%Rho0 )
+ enddo ; enddo ; endif
+
+ if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
+ forces%tau_mag(i,j) = mag_tau
enddo ; enddo ; endif
end subroutine SCM_CVMix_tests_wind_forcing
@@ -246,7 +255,7 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(sfc_state, fluxes, day, G, US, CS)
! therefore must convert to [Q R Z T-1 ~> W m-2] by multiplying
! by Rho0*Cp
do J=Jsq,Jeq ; do i=is,ie
- fluxes%sens(i,J) = CS%surf_HF * CS%Rho0 * fluxes%C_p
+ fluxes%sens(i,J) = CS%surf_HF * CS%rho_restore * fluxes%C_p
enddo ; enddo
endif
@@ -255,7 +264,7 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(sfc_state, fluxes, day, G, US, CS)
! Note CVMix test inputs give evaporation in [Z T-1 ~> m s-1]
! This therefore must be converted to mass flux in [R Z T-1 ~> kg m-2 s-1]
! by multiplying by density and some unit conversion factors.
- fluxes%evap(i,J) = CS%surf_evap * CS%Rho0
+ fluxes%evap(i,J) = CS%surf_evap * CS%rho_restore
enddo ; enddo
endif
@@ -264,7 +273,8 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(sfc_state, fluxes, day, G, US, CS)
! Note CVMix test inputs give max sw rad in [Z C T-1 ~> m degC s-1]
! therefore must convert to [Q R Z T-1 ~> W m-2] by multiplying by Rho0*Cp
! Note diurnal cycle peaks at Noon.
- fluxes%sw(i,J) = CS%Max_sw * max(0.0, cos(2*PI*(time_type_to_real(DAY)/86400.0 - 0.5))) * CS%RHO0 * fluxes%C_p
+ fluxes%sw(i,J) = CS%Max_sw * max(0.0, cos(2*PI*(time_type_to_real(DAY)/86400.0 - 0.5))) * &
+ CS%rho_restore * fluxes%C_p
enddo ; enddo
endif
diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90
index 333f53895e..ad75d83efa 100644
--- a/src/user/benchmark_initialization.F90
+++ b/src/user/benchmark_initialization.F90
@@ -142,7 +142,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e
units="degC", default=29.0, scale=US%degC_to_C, do_not_log=just_read)
call get_param(param_file, mdl, "S_REF", S_ref, &
"The uniform salinities used to initialize the benchmark test case.", &
- units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=just_read)
+ units="PSU", default=35.0, scale=US%ppt_to_S, do_not_log=just_read)
if (just_read) return ! This subroutine has no run-time parameters.
diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90
index b2ed47f89b..492cb3ebe8 100644
--- a/src/user/dumbbell_initialization.F90
+++ b/src/user/dumbbell_initialization.F90
@@ -10,6 +10,7 @@ module dumbbell_initialization
use MOM_get_input, only : directories
use MOM_grid, only : ocean_grid_type
use MOM_interface_heights, only : dz_to_thickness, dz_to_thickness_simple
+use MOM_interface_heights, only : thickness_to_dz
use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS
use MOM_tracer_registry, only : tracer_registry_type
use MOM_unit_scaling, only : unit_scale_type
@@ -472,10 +473,13 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil
if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', &
sp_long_name='salinity', sp_unit='g kg-1 s-1')
else
+ ! Convert thicknesses from thickness units to height units
+ call thickness_to_dz(h_in, tv, dz, G, GV, US)
+
do j=G%jsc,G%jec ; do i=G%isc,G%iec
eta(i,j,1) = 0.0
do k=2,nz
- eta(i,j,k) = eta(i,j,k-1) - GV%H_to_Z * h_in(i,j,k-1)
+ eta(i,j,k) = eta(i,j,k-1) - dz(i,j,k-1)
enddo
eta(i,j,nz+1) = -depth_tot(i,j)
do k=1,nz
diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90
index ca383ba1f1..6f6e4da439 100644
--- a/src/user/dumbbell_surface_forcing.F90
+++ b/src/user/dumbbell_surface_forcing.F90
@@ -25,9 +25,8 @@ module dumbbell_surface_forcing
type, public :: dumbbell_surface_forcing_CS ; private
logical :: use_temperature !< If true, temperature and salinity are used as state variables.
logical :: restorebuoy !< If true, use restoring surface buoyancy forcing.
- real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3].
real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]
- real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1].
+ real :: Flux_const !< The restoring rate at the surface [R Z T-1 ~> kg m-2 s-1].
! real :: gust_const !< A constant unresolved background gustiness
! !! that contributes to ustar [R L Z T-2 ~> Pa].
real :: slp_amplitude !< The amplitude of pressure loading [R L2 T-2 ~> Pa] applied
@@ -114,7 +113,7 @@ subroutine dumbbell_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
if (CS%use_temperature .and. CS%restorebuoy) then
do j=js,je ; do i=is,ie
if (CS%forcing_mask(i,j)>0.) then
- fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * &
+ fluxes%vprec(i,j) = - (G%mask2dT(i,j) * CS%Flux_const) * &
((CS%S_restore(i,j) - sfc_state%SSS(i,j)) / (0.5 * (CS%S_restore(i,j) + sfc_state%SSS(i,j))))
endif
@@ -181,6 +180,9 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS)
real :: S_surf ! Initial surface salinity [S ~> ppt]
real :: S_range ! Range of the initial vertical distribution of salinity [S ~> ppt]
real :: x ! Latitude normalized by the domain size [nondim]
+ real :: Rho0 ! The density used in the Boussinesq approximation [R ~> kg m-3]
+ real :: rho_restore ! The density that is used to convert piston velocities into salt
+ ! or heat fluxes with salinity or temperature restoring [R ~> kg m-3]
integer :: i, j
logical :: dbrotate ! If true, rotate the domain.
# include "version_variable.h"
@@ -202,7 +204,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS)
call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, &
"The gravitational acceleration of the Earth.", &
units="m s-2", default=9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2)
- call get_param(param_file, mdl, "RHO_0", CS%Rho0, &
+ call get_param(param_file, mdl, "RHO_0", Rho0, &
"The mean ocean density used with BOUSSINESQ true to "//&
"calculate accelerations and the mass for conservation "//&
"properties, or with BOUSSINSEQ false to convert some "//&
@@ -233,8 +235,13 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS)
"The constant that relates the restoring surface fluxes to the relative "//&
"surface anomalies (akin to a piston velocity). Note the non-MKS units.", &
default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s)
- ! Convert CS%Flux_const from m day-1 to m s-1.
- CS%Flux_const = CS%Flux_const / 86400.0
+ call get_param(param_file, mdl, "RESTORE_FLUX_RHO", rho_restore, &
+ "The density that is used to convert piston velocities into salt or heat "//&
+ "fluxes with RESTORE_SALINITY or RESTORE_TEMPERATURE.", &
+ units="kg m-3", default=Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
+ do_not_log=(CS%Flux_const==0.0))
+ ! Convert FLUXCONST from m day-1 to m s-1 and Flux_const to [R Z T-1 ~> kg m-2 s-1]
+ CS%Flux_const = rho_restore * (CS%Flux_const / 86400.0)
allocate(CS%forcing_mask(G%isd:G%ied, G%jsd:G%jed), source=0.0)
diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90
index aed7142fad..2dde65148b 100644
--- a/src/user/dyed_channel_initialization.F90
+++ b/src/user/dyed_channel_initialization.F90
@@ -93,7 +93,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg)
! Local variables
character(len=40) :: mdl = "dyed_channel_set_OBC_tracer_data" ! This subroutine's name.
character(len=80) :: name, longname
- integer :: m, n
+ integer :: m, n, ntr_id
real :: dye ! Inflow dye concentrations [arbitrary]
type(tracer_type), pointer :: tr_ptr => NULL()
@@ -115,7 +115,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg)
do m=1,ntr
write(name,'("dye_",I2.2)') m
write(longname,'("Concentration of dyed_obc Tracer ",I2.2, " on segment ",I2.2)') m, m
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
do n=1,OBC%number_of_segments
if (n == m) then
@@ -123,7 +123,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg)
else
dye = 0.0
endif
- call register_segment_tracer(tr_ptr, param_file, GV, &
+ call register_segment_tracer(tr_ptr, ntr_id, param_file, GV, &
OBC%segment(n), OBC_scalar=dye)
enddo
enddo
diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90
index 6248efab2f..7d1c0635f9 100644
--- a/src/user/dyed_obcs_initialization.F90
+++ b/src/user/dyed_obcs_initialization.F90
@@ -39,7 +39,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg)
! Local variables
character(len=40) :: mdl = "dyed_obcs_set_OBC_data" ! This subroutine's name.
character(len=80) :: name, longname
- integer :: is, ie, js, je, isd, ied, jsd, jed, m, n, nz
+ integer :: is, ie, js, je, isd, ied, jsd, jed, m, n, nz, ntr_id
integer :: IsdB, IedB, JsdB, JedB
real :: dye ! Inflow dye concentration [arbitrary]
type(tracer_type), pointer :: tr_ptr => NULL()
@@ -65,7 +65,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg)
do m=1,ntr
write(name,'("dye_",I2.2)') m
write(longname,'("Concentration of dyed_obc Tracer ",I2.2, " on segment ",I2.2)') m, m
- call tracer_name_lookup(tr_Reg, tr_ptr, name)
+ call tracer_name_lookup(tr_Reg, ntr_id, tr_ptr, name)
do n=1,OBC%number_of_segments
if (n == m) then
@@ -73,7 +73,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg)
else
dye = 0.0
endif
- call register_segment_tracer(tr_ptr, param_file, GV, &
+ call register_segment_tracer(tr_ptr, ntr_id, param_file, GV, &
OBC%segment(n), OBC_scalar=dye)
enddo
enddo
diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90
index 4a20f0e9b3..37a908d3a8 100644
--- a/src/user/tidal_bay_initialization.F90
+++ b/src/user/tidal_bay_initialization.F90
@@ -74,7 +74,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time)
! The following variables are used to set up the transport in the tidal_bay example.
real :: time_sec ! Elapsed model time [T ~> s]
- real :: cff_eta ! The total column thickness anomalies associated with the inflow [H ~> m or kg m-2]
+ real :: cff_eta ! The sea surface height anomalies associated with the inflow [Z ~> m]
real :: my_flux ! The vlume flux through the face [L2 Z T-1 ~> m3 s-1]
real :: total_area ! The total face area of the OBCs [L Z ~> m2]
real :: PI ! The ratio of the circumference of a circle to its diameter [nondim]
@@ -97,7 +97,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time)
flux_scale = GV%H_to_m*US%L_to_m
time_sec = US%s_to_T*time_type_to_real(Time)
- cff_eta = CS%tide_ssh_amp*GV%Z_to_H * sin(2.0*PI*time_sec / CS%tide_period)
+ cff_eta = CS%tide_ssh_amp * sin(2.0*PI*time_sec / CS%tide_period)
my_area = 0.0
my_flux = 0.0
segment => OBC%segment(1)
@@ -119,7 +119,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time)
if (.not. segment%on_pe) cycle
segment%normal_vel_bt(:,:) = my_flux / (US%m_to_Z*US%m_to_L*total_area)
- segment%eta(:,:) = cff_eta
+ segment%SSH(:,:) = cff_eta
enddo ! end segment loop
diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90
index c12d34a721..9a56c12b9c 100644
--- a/src/user/user_change_diffusivity.F90
+++ b/src/user/user_change_diffusivity.F90
@@ -26,8 +26,8 @@ module user_change_diffusivity
!> Control structure for user_change_diffusivity
type, public :: user_change_diff_CS ; private
logical :: initialized = .false. !< True if this control structure has been initialized.
- real :: Kd_add !< The scale of a diffusivity that is added everywhere
- !! without any filtering or scaling [Z2 T-1 ~> m2 s-1].
+ real :: Kd_add !< The scale of a diffusivity that is added everywhere without
+ !! any filtering or scaling [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real :: lat_range(4) !< 4 values that define the latitude range over which
!! a diffusivity scaled by Kd_add is added [degrees_N].
real :: rho_range(4) !< 4 values that define the coordinate potential
@@ -54,17 +54,17 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i
!! fields. Absent fields have NULL ptrs.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(user_change_diff_CS), pointer :: CS !< This module's control structure.
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of
- !! each layer [Z2 T-1 ~> m2 s-1].
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity
- !! at each interface [Z2 T-1 ~> m2 s-1].
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of each
+ !! layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at each
+ !! interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: T_f !< Temperature with massless
!! layers filled in vertically [C ~> degC].
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: S_f !< Salinity with massless
!! layers filled in vertically [S ~> ppt].
real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal
!! diffusivity that is being added at
- !! each interface [Z2 T-1 ~> m2 s-1].
+ !! each interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
! Local variables
real :: Rcv(SZI_(G),SZK_(GV)) ! The coordinate density in layers [R ~> kg m-3].
real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures [R L2 T-2 ~> Pa].
@@ -222,7 +222,7 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS)
call log_version(param_file, mdl, version, "")
call get_param(param_file, mdl, "USER_KD_ADD", CS%Kd_add, &
"A user-specified additional diffusivity over a range of "//&
- "latitude and density.", default=0.0, units="m2 s-1", scale=US%m2_s_to_Z2_T)
+ "latitude and density.", default=0.0, units="m2 s-1", scale=GV%m2_s_to_HZ_T)
if (CS%Kd_add /= 0.0) then
call get_param(param_file, mdl, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), &
"Four successive values that define a range of latitudes "//&